polishing: removed variable names like 'unit' and 'data' that are keywords of fortran and ensured that integer and real precision matches independent of machine standard.
removed cut_off parameter for damask_spectral removed outpot of derived divergence measures and added RMS output in brackets added comments and options to the makefile
This commit is contained in:
Martin Diehl
parent
d642730776
commit
6c0f9d163b
|
|
@ -53,7 +53,6 @@ program DAMASK_spectral
|
|||
use numerics, only: err_div_tol, err_stress_tolrel, rotation_tol, itmax, &
|
||||
memory_efficient, update_gamma, &
|
||||
simplified_algorithm, divergence_correction, &
|
||||
cut_off_value, &
|
||||
DAMASK_NumThreadsInt, &
|
||||
fftw_planner_flag, fftw_timelimit
|
||||
use homogenization, only: materialpoint_sizeResults, materialpoint_results
|
||||
|
|
@ -121,18 +120,9 @@ program DAMASK_spectral
|
|||
s0_reference
|
||||
real(pReal), dimension(6) :: cstress ! cauchy stress
|
||||
real(pReal), dimension(6,6) :: dsde, c0_66, s0_66 ! small strain stiffness
|
||||
real(pReal), dimension(9,9) :: s_prev99, c_prev99, c0_99, s0_99 ! compliance and stiffness in matrix notation
|
||||
real(pReal), dimension(9,9) :: s_prev99, c_prev99 ! compliance and stiffness in matrix notation
|
||||
real(pReal), dimension(:,:), allocatable :: s_reduced, c_reduced ! reduced compliance and stiffness (only for stress BC)
|
||||
real(pReal), dimension(6,6) :: mask_inversion = reshape([&
|
||||
1.0_pReal, 1.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal,&
|
||||
1.0_pReal, 1.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal,&
|
||||
1.0_pReal, 1.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal,&
|
||||
0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal,&
|
||||
0.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal,&
|
||||
0.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal],&
|
||||
[ 6_pInt, 6_pInt])
|
||||
real(pReal), dimension(3,3,3,3) :: temp_3333 = 0.0_pReal
|
||||
integer(pInt) :: size_reduced = 0_pInt ! number of stress BCs
|
||||
integer(pInt) :: size_reduced = 0_pInt ! number of stress BCs
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! pointwise data
|
||||
|
|
@ -151,7 +141,7 @@ program DAMASK_spectral
|
|||
real(pReal), dimension(3,3) :: xiDyad ! product of wave vectors
|
||||
real(pReal), dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat ! gamma operator (field) for spectral method
|
||||
real(pReal), dimension(:,:,:,:), allocatable :: xi ! wave vector field for divergence and for gamma operator
|
||||
integer(pInt), dimension(3) :: k_s, cutting_freq
|
||||
integer(pInt), dimension(3) :: k_s
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! loop variables, convergence etc.
|
||||
|
|
@ -174,7 +164,7 @@ program DAMASK_spectral
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!variables for additional output due to general debugging
|
||||
real(pReal) :: defgradDetMax, defgradDetMin, maxCorrectionSym, maxCorrectionSkew, max_diag, max_offdiag
|
||||
real(pReal) :: defgradDetMax, defgradDetMin, maxCorrectionSym, maxCorrectionSkew
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! variables for additional output of divergence calculations
|
||||
|
|
@ -378,8 +368,6 @@ program DAMASK_spectral
|
|||
res1_red = res(1)/2_pInt + 1_pInt ! size of complex array in first dimension (c2r, r2c)
|
||||
Npoints = res(1)*res(2)*res(3)
|
||||
wgt = 1.0_pReal/real(Npoints, pReal)
|
||||
if (cut_off_value <0.0_pReal .or. cut_off_value >0.9_pReal) stop
|
||||
cutting_freq = nint(real(res,pReal)*cut_off_value,pInt) ! for cut_off_value=0.0 just the highest freq. is removed
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! output of geometry
|
||||
|
|
@ -394,7 +382,6 @@ program DAMASK_spectral
|
|||
print '(a,3(i12 ))','resolution a b c:', res
|
||||
print '(a,3(f12.5))','dimension x y z:', geomdim
|
||||
print '(a,i5)','homogenization: ',homog
|
||||
if(cut_off_value/=0.0_pReal) print '(a,3(i12),a)', 'cutting away ', cutting_freq, ' frequencies'
|
||||
print '(a)', '#############################################################'
|
||||
print '(a,a)', 'loadcase file: ',trim(getLoadcaseName())
|
||||
|
||||
|
|
@ -421,8 +408,8 @@ program DAMASK_spectral
|
|||
write (*,'(3(3(f12.7,1x)/))',advance='no') merge(math_transpose33(bc(loadcase)%deformation),&
|
||||
reshape(spread(DAMASK_NaN,1,9),[ 3,3]),transpose(bc(loadcase)%maskDeformation))
|
||||
write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') ' stress / GPa:',&
|
||||
1e-9*merge(math_transpose33(bc(loadcase)%stress),reshape(spread(DAMASK_NaN,1,9),[ 3,3])&
|
||||
,transpose(bc(loadcase)%maskStress))
|
||||
1e-9_pReal*merge(math_transpose33(bc(loadcase)%stress),&
|
||||
reshape(spread(DAMASK_NaN,1,9),[ 3,3]),transpose(bc(loadcase)%maskStress))
|
||||
if (any(bc(loadcase)%rotation /= math_I3)) &
|
||||
write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') ' rotation of loadframe:',&
|
||||
math_transpose33(bc(loadcase)%rotation)
|
||||
|
|
@ -473,7 +460,7 @@ program DAMASK_spectral
|
|||
ielem = ielem + 1_pInt
|
||||
defgrad(i,j,k,1:3,1:3) = math_I3
|
||||
defgradold(i,j,k,1:3,1:3) = math_I3
|
||||
coordinates(i,j,k,1:3) = geomdim/real(res, pReal)*[i,j,k] - geomdim/real(2_pInt*res,pReal)
|
||||
coordinates(i,j,k,1:3) = geomdim/real(res * [i,j,k], pReal) - geomdim/real(2_pInt*res,pReal)
|
||||
call CPFEM_general(2_pInt,coordinates(i,j,k,1:3),math_I3,math_I3,temperature(i,j,k),&
|
||||
0.0_pReal,ielem,1_pInt,cstress,dsde,pstress,dPdF)
|
||||
c_current = c_current + dPdF
|
||||
|
|
@ -511,16 +498,16 @@ program DAMASK_spectral
|
|||
do j = 1_pInt, res(2)
|
||||
k_s(2) = j - 1_pInt
|
||||
if(j > res(2)/2_pInt + 1_pInt) k_s(2) = k_s(2) - res(2)
|
||||
do i = 1, res1_red
|
||||
do i = 1_pInt, res1_red
|
||||
k_s(1) = i - 1_pInt
|
||||
xi(1:3,i,j,k) = real(k_s, pReal)/geomdim
|
||||
enddo; enddo; enddo
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! calculate the gamma operator
|
||||
if(memory_efficient) then ! allocate just single fourth order tensor
|
||||
if(memory_efficient) then ! allocate just single fourth order tensor
|
||||
allocate (gamma_hat(1,1,1,3,3,3,3)); gamma_hat = 0.0_pReal
|
||||
else ! precalculation of gamma_hat field
|
||||
else ! precalculation of gamma_hat field
|
||||
allocate (gamma_hat(res1_red ,res(2),res(3),3,3,3,3)); gamma_hat = 0.0_pReal
|
||||
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res1_red
|
||||
! if(k==res(3)/2 .or. k==res(3)/2+2 .or.&
|
||||
|
|
@ -528,21 +515,22 @@ program DAMASK_spectral
|
|||
! i==res(1)/2 .or. i==res(1)/2+2) then
|
||||
! gamma_hat(i,j,k,1:3,1:3,1:3,1:3) = s0_reference
|
||||
! else
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
xiDyad(l,m) = xi(l, i,j,k)*xi(m, i,j,k)
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
temp33_Real(l,m) = sum(c0_reference(l,m,1:3,1:3)*xiDyad)
|
||||
temp33_Real = math_inv33(temp33_Real)
|
||||
forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, p=1_pInt:3_pInt)&
|
||||
gamma_hat(i,j,k, l,m,n,p) = temp33_Real(l,n)*xiDyad(m,p)
|
||||
! endif
|
||||
if(any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
xiDyad(l,m) = xi(l, i,j,k)*xi(m, i,j,k)
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
temp33_Real(l,m) = sum(c0_reference(l,m,1:3,1:3)*xiDyad)
|
||||
temp33_Real = math_inv33(temp33_Real)
|
||||
forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, p=1_pInt:3_pInt)&
|
||||
gamma_hat(i,j,k, l,m,n,p) = temp33_Real(l,n)*xiDyad(m,p)
|
||||
endif
|
||||
enddo; enddo; enddo
|
||||
gamma_hat(1,1,1, 1:3,1:3,1:3,1:3) = 0.0_pReal ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
|
||||
endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! general initialization of fftw (see manual on fftw.org for more details)
|
||||
if (pReal /= C_DOUBLE .or. pInt /= C_INT) call IO_error(error_ID=808_pInt) ! check for correct precision in C
|
||||
if (pReal /= C_DOUBLE .or. pInt /= C_INT) call IO_error(error_ID=808_pInt) ! check for correct precision in C
|
||||
#ifdef _OPENMP
|
||||
if(DAMASK_NumThreadsInt > 0_pInt) then
|
||||
ierr = fftw_init_threads()
|
||||
|
|
@ -550,7 +538,7 @@ program DAMASK_spectral
|
|||
call fftw_plan_with_nthreads(DAMASK_NumThreadsInt)
|
||||
endif
|
||||
#endif
|
||||
call fftw_set_timelimit(fftw_timelimit) ! set timelimit for plan creation
|
||||
call fftw_set_timelimit(fftw_timelimit) ! set timelimit for plan creation
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! creating plans
|
||||
|
|
@ -739,7 +727,7 @@ program DAMASK_spectral
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! report begin of new increment
|
||||
print '(a)', '##################################################################'
|
||||
print '(A,I5.5,A,es12.6)', 'Increment ', totalIncsCounter, ' Time ',time
|
||||
print '(A,I5.5,A,es12.5)', 'Increment ', totalIncsCounter, ' Time ',time
|
||||
|
||||
guessmode = 1.0_pReal ! keep guessing along former trajectory during same loadcase
|
||||
CPFEM_mode = 1_pInt ! winding forward
|
||||
|
|
@ -801,7 +789,7 @@ program DAMASK_spectral
|
|||
row = (mod(totalIncsCounter+iter-2_pInt,9_pInt))/3_pInt + 1_pInt ! go through the elements of the tensors, controlled by totalIncsCounter and iter, starting at 1
|
||||
column = (mod(totalIncsCounter+iter-2_pInt,3_pInt)) + 1_pInt
|
||||
scalarField_real(1:res(1),1:res(2),1:res(3)) =& ! store the selected component
|
||||
tensorField_real(1:res(1),1:res(2),1:res(3),row,column)
|
||||
cmplx(tensorField_real(1:res(1),1:res(2),1:res(3),row,column),0.0_pReal,pReal)
|
||||
endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -829,7 +817,7 @@ program DAMASK_spectral
|
|||
pstress_av_lab = real(tensorField_fourier(1,1,1,1:3,1:3),pReal)*wgt
|
||||
pstress_av = math_rotate_forward33(pstress_av_lab,bc(loadcase)%rotation)
|
||||
write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') 'Piola-Kirchhoff stress / MPa:',&
|
||||
math_transpose33(pstress_av)/1.e6
|
||||
math_transpose33(pstress_av)/1.e6_pReal
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! comparing 1 and 3x3 FT results
|
||||
|
|
@ -940,20 +928,17 @@ program DAMASK_spectral
|
|||
print '(a,es11.4)', 'error divergence FT max = ',err_div_max
|
||||
print '(a,es11.4)', 'error divergence Real RMS = ',err_real_div_RMS
|
||||
print '(a,es11.4)', 'error divergence Real max = ',err_real_div_max
|
||||
print '(a,es11.4)', 'divergence RMS FT/real = ',err_div_RMS/err_real_div_RMS
|
||||
print '(a,es11.4)', 'divergence max FT/real = ',err_div_max/err_real_div_max
|
||||
print '(a,es11.4)', 'max deviat. from postProc = ',max_div_error
|
||||
endif
|
||||
print '(a,f6.2,a,es11.4,a)', 'error divergence = ', err_div/err_div_tol, ' (',err_div,' 1/m)'
|
||||
print '(a,f6.2,a,es11.4,3a)','error divergence = ', err_div/err_div_tol, &
|
||||
' (',err_div_RMS,' N/m',char(179),')'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! divergence is calculated from FT(stress), depending on algorithm use field for spectral method
|
||||
if (.not. simplified_algorithm) tensorField_fourier = tau_fourier
|
||||
max_diag = tiny(1.0_pReal)
|
||||
max_offdiag = tiny(1.0_pReal)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! to the actual spectral method calculation (mechanical equilibrium)
|
||||
if(memory_efficient) then ! memory saving version, on-the-fly calculation of gamma_hat
|
||||
if(memory_efficient) then ! memory saving version, on-the-fly calculation of gamma_hat
|
||||
|
||||
do k = 1_pInt, res(3); do j = 1_pInt, res(2) ;do i = 1_pInt, res1_red
|
||||
! if(k==res(3)/2 .or. k==res(3)/2+2 .or.&
|
||||
|
|
@ -962,34 +947,38 @@ program DAMASK_spectral
|
|||
! forall( m = 1_pInt:3_pInt, n = 1_pInt:3_pInt)&
|
||||
! temp33_Complex(m,n) = sum(s0_reference(m,n, 1:3,1:3)* tensorField_fourier(i,j,k,1:3,1:3))
|
||||
! else
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
xiDyad(l,m) = xi(l, i,j,k)*xi(m, i,j,k)
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
temp33_Real(l,m) = sum(c0_reference(l,m,1:3,1:3)*xiDyad)
|
||||
temp33_Real = math_inv33(temp33_Real)
|
||||
forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, p=1_pInt:3_pInt)&
|
||||
gamma_hat(1,1,1, l,m,n,p) = temp33_Real(l,n)*xiDyad(m,p)
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
temp33_Complex(l,m) = sum(gamma_hat(1,1,1, l,m, 1:3,1:3) * tensorField_fourier(i,j,k,1:3,1:3))
|
||||
tensorField_fourier(i,j,k,1:3,1:3) = temp33_Complex
|
||||
! endif
|
||||
if(any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
xiDyad(l,m) = xi(l, i,j,k)*xi(m, i,j,k)
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
temp33_Real(l,m) = sum(c0_reference(l,m,1:3,1:3)*xiDyad)
|
||||
temp33_Real = math_inv33(temp33_Real)
|
||||
forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, p=1_pInt:3_pInt)&
|
||||
gamma_hat(1,1,1, l,m,n,p) = temp33_Real(l,n)*xiDyad(m,p)
|
||||
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
|
||||
temp33_Complex(l,m) = sum(gamma_hat(1,1,1, l,m, 1:3,1:3) *&
|
||||
tensorField_fourier(i,j,k,1:3,1:3))
|
||||
tensorField_fourier(i,j,k,1:3,1:3) = temp33_Complex
|
||||
endif
|
||||
enddo; enddo; enddo
|
||||
|
||||
else ! use precalculated gamma-operator
|
||||
else ! use precalculated gamma-operator
|
||||
|
||||
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt,res1_red
|
||||
forall( m = 1_pInt:3_pInt, n = 1_pInt:3_pInt) &
|
||||
temp33_Complex(m,n) = sum(gamma_hat(i,j,k, m,n, 1:3,1:3) * tensorField_fourier(i,j,k,1:3,1:3))
|
||||
temp33_Complex(m,n) = sum(gamma_hat(i,j,k, m,n, 1:3,1:3) *&
|
||||
tensorField_fourier(i,j,k,1:3,1:3))
|
||||
tensorField_fourier(i,j,k, 1:3,1:3) = temp33_Complex
|
||||
enddo; enddo; enddo
|
||||
|
||||
endif
|
||||
|
||||
if (simplified_algorithm) then ! do not use the polarization field based algorithm
|
||||
tensorField_fourier(1,1,1,1:3,1:3) = (defgrad_av_lab - defgradAim_lab) & ! assign (negative) average deformation gradient change to zero frequency (real part)
|
||||
* real(Npoints,pReal) ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
|
||||
if (simplified_algorithm) then ! do not use the polarization field based algorithm
|
||||
tensorField_fourier(1,1,1,1:3,1:3) = cmplx((defgrad_av_lab - defgradAim_lab) & ! assign (negative) average deformation gradient change to zero frequency (real part)
|
||||
* real(Npoints,pReal),0.0_pReal,pReal) ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
|
||||
else
|
||||
tensorField_fourier(1,1,1,1:3,1:3) = defgradAim_lab * real(Npoints,pReal) ! assign deformation aim to zero frequency (real part)
|
||||
tensorField_fourier(1,1,1,1:3,1:3) = cmplx(defgradAim_lab*real(Npoints,pReal),& ! assign deformation aim to zero frequency (real part)
|
||||
0.0_pReal,pReal)
|
||||
endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -998,7 +987,7 @@ program DAMASK_spectral
|
|||
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res1_red
|
||||
scalarField_fourier(i,j,k) = tensorField_fourier(i,j,k,row,column)
|
||||
enddo; enddo; enddo
|
||||
do i = 0_pInt, res(1)/2_pInt-2_pInt !unpack fft data for conj complex symmetric part. can be directly used in calculation of cstress_field
|
||||
do i = 0_pInt, res(1)/2_pInt-2_pInt !unpack fft data for conj complex symmetric part
|
||||
m = 1_pInt
|
||||
do k = 1_pInt, res(3)
|
||||
n = 1_pInt
|
||||
|
|
@ -1136,11 +1125,13 @@ end program DAMASK_spectral
|
|||
! quit subroutine to satisfy IO_error
|
||||
!
|
||||
!********************************************************************
|
||||
subroutine quit(id)
|
||||
subroutine quit(stop_id)
|
||||
use prec
|
||||
implicit none
|
||||
|
||||
integer(pInt) id
|
||||
integer(pInt), intent(in) :: stop_id
|
||||
print*, stop_id
|
||||
|
||||
stop 'abnormal termination of DAMASK_spectral'
|
||||
|
||||
stop
|
||||
end subroutine
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ subroutine DAMASK_interface_init()
|
|||
implicit none
|
||||
|
||||
character(len=1024) commandLine, hostName, userName
|
||||
integer(pInt):: i, start = 0_pInt, length=0_pInt
|
||||
integer :: i, start = 0, length=0
|
||||
integer, dimension(8) :: date_and_time_values ! type default integer
|
||||
call get_command(commandLine)
|
||||
call DATE_AND_TIME(VALUES=date_and_time_values)
|
||||
|
|
@ -47,7 +47,7 @@ subroutine DAMASK_interface_init()
|
|||
if(64<iachar(commandLine(i:i)) .and. iachar(commandLine(i:i))<91) commandLine(i:i) =achar(iachar(commandLine(i:i))+32)
|
||||
enddo
|
||||
|
||||
if(index(commandLine,' -h ',.true.)>0_pInt .or. index(commandLine,' --help ',.true.)>0_pInt) then ! search for ' -h ' or '--help'
|
||||
if(index(commandLine,' -h ',.true.)>0 .or. index(commandLine,' --help ',.true.)>0) then ! search for ' -h ' or '--help'
|
||||
write(6,*) '$Id$'
|
||||
#include "compilation_info.f90"
|
||||
print '(a)', '#############################################################'
|
||||
|
|
@ -87,12 +87,12 @@ subroutine DAMASK_interface_init()
|
|||
endif
|
||||
if (.not.(command_argument_count()==4 .or. command_argument_count()==6)) & ! check for correct number of given arguments (no --help)
|
||||
stop 'Wrong Nr. of Arguments. Run DAMASK_spectral.exe --help' ! Could not find valid keyword (position 0 +3). Functions from IO.f90 are not available
|
||||
start = index(commandLine,'-g',.true.) + 3_pInt ! search for '-g' and jump to first char of geometry
|
||||
start = index(commandLine,'-g',.true.) + 3 ! search for '-g' and jump to first char of geometry
|
||||
if (index(commandLine,'--geom',.true.)>0) then ! if '--geom' is found, use that (contains '-g')
|
||||
start = index(commandLine,'--geom',.true.) + 7_pInt
|
||||
start = index(commandLine,'--geom',.true.) + 7
|
||||
endif
|
||||
if (index(commandLine,'--geometry',.true.)>0) then ! again, now searching for --geometry'
|
||||
start = index(commandLine,'--geometry',.true.) + 11_pInt
|
||||
start = index(commandLine,'--geometry',.true.) + 11
|
||||
endif
|
||||
if(start==3_pInt) stop 'No Geometry specified, terminating DAMASK'! Could not find valid keyword (position 0 +3). Functions from IO.f90 are not available
|
||||
length = index(commandLine(start:len(commandLine)),' ',.false.)
|
||||
|
|
@ -105,12 +105,12 @@ subroutine DAMASK_interface_init()
|
|||
if(64<iachar(commandLine(i:i)) .and. iachar(commandLine(i:i))<91) commandLine(i:i) =achar(iachar(commandLine(i:i))+32)
|
||||
enddo
|
||||
|
||||
start = index(commandLine,'-l',.true.) + 3_pInt ! search for '-l' and jump forward iby 3 to given name
|
||||
start = index(commandLine,'-l',.true.) + 3 ! search for '-l' and jump forward iby 3 to given name
|
||||
if (index(commandLine,'--load',.true.)>0) then ! if '--load' is found, use that (contains '-l')
|
||||
start = index(commandLine,'--load',.true.) + 7_pInt
|
||||
start = index(commandLine,'--load',.true.) + 7
|
||||
endif
|
||||
if (index(commandLine,'--loadcase',.true.)>0) then ! again, now searching for --loadcase'
|
||||
start = index(commandLine,'--loadcase',.true.) + 11_pInt
|
||||
start = index(commandLine,'--loadcase',.true.) + 11
|
||||
endif
|
||||
if(start==3_pInt) stop 'No Loadcase specified, terminating DAMASK'! Could not find valid keyword (position 0 +3). Functions from IO.f90 are not available
|
||||
length = index(commandLine(start:len(commandLine)),' ',.false.)
|
||||
|
|
@ -123,9 +123,9 @@ subroutine DAMASK_interface_init()
|
|||
if(64<iachar(commandLine(i:i)) .and. iachar(commandLine(i:i))<91) commandLine(i:i) =achar(iachar(commandLine(i:i))+32)
|
||||
enddo
|
||||
|
||||
start = index(commandLine,'-r',.true.) + 3_pInt ! search for '-r' and jump forward iby 3 to given name
|
||||
start = index(commandLine,'-r',.true.) + 3 ! search for '-r' and jump forward iby 3 to given name
|
||||
if (index(commandLine,'--restart',.true.)>0) then ! if '--restart' is found, use that (contains '-l')
|
||||
start = index(commandLine,'--restart',.true.) + 7_pInt
|
||||
start = index(commandLine,'--restart',.true.) + 7
|
||||
endif
|
||||
length = index(commandLine(start:len(commandLine)),' ',.false.)
|
||||
|
||||
|
|
@ -201,12 +201,12 @@ function getModelName()
|
|||
|
||||
character(1024) getModelName, cwd
|
||||
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forwardslash, backwardslash
|
||||
integer(pInt) :: posExt,posSep
|
||||
integer :: posExt,posSep
|
||||
|
||||
posExt = scan(geometryParameter,'.',back=.true.)
|
||||
posSep = scan(geometryParameter,pathSep,back=.true.)
|
||||
|
||||
if (posExt <= posSep) posExt = len_trim(geometryParameter)+1_pInt ! no extension present
|
||||
if (posExt <= posSep) posExt = len_trim(geometryParameter)+1 ! no extension present
|
||||
getModelName = geometryParameter(1:posExt-1_pInt) ! path to geometry file (excl. extension)
|
||||
|
||||
if (scan(getModelName,pathSep) /= 1) then ! relative path given as command line argument
|
||||
|
|
@ -227,19 +227,17 @@ endfunction getModelName
|
|||
!********************************************************************
|
||||
function getLoadCase()
|
||||
|
||||
use prec, only: pInt
|
||||
|
||||
implicit none
|
||||
|
||||
character(1024) getLoadCase
|
||||
character(1024) :: getLoadCase
|
||||
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forwardslash, backwardslash
|
||||
integer(pInt) posExt,posSep
|
||||
integer :: posExt,posSep
|
||||
|
||||
posExt = scan(loadcaseParameter,'.',back=.true.)
|
||||
posSep = scan(loadcaseParameter,pathSep,back=.true.)
|
||||
|
||||
if (posExt <= posSep) posExt = len_trim(loadcaseParameter)+1_pInt ! no extension present
|
||||
getLoadCase = loadcaseParameter(posSep+1_pInt:posExt-1_pInt) ! name of load case file exluding extension
|
||||
if (posExt <= posSep) posExt = len_trim(loadcaseParameter)+1 ! no extension present
|
||||
getLoadCase = loadcaseParameter(posSep+1:posExt-1) ! name of load case file exluding extension
|
||||
|
||||
endfunction getLoadCase
|
||||
|
||||
|
|
@ -254,11 +252,9 @@ function getLoadcaseName()
|
|||
|
||||
implicit none
|
||||
|
||||
character(len=1024) getLoadcaseName,cwd
|
||||
character(len=1024) :: getLoadcaseName,cwd
|
||||
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forwardslash, backwardslash
|
||||
integer(pInt) posExt,posSep
|
||||
posExt = 0_pInt
|
||||
|
||||
integer :: posExt = 0, posSep
|
||||
getLoadcaseName = loadcaseParameter
|
||||
posExt = scan(getLoadcaseName,'.',back=.true.)
|
||||
posSep = scan(getLoadcaseName,pathSep,back=.true.)
|
||||
|
|
@ -286,31 +282,31 @@ function rectifyPath(path)
|
|||
|
||||
implicit none
|
||||
|
||||
character(len=*) path
|
||||
character(len=len_trim(path)) rectifyPath
|
||||
integer(pInt) i,j,k,l
|
||||
character(len=*) :: path
|
||||
character(len=len_trim(path)) :: rectifyPath
|
||||
integer :: i,j,k,l !no pInt
|
||||
|
||||
!remove ./ from path
|
||||
l = len_trim(path)
|
||||
rectifyPath = path
|
||||
do i = l,3_pInt,-1_pInt
|
||||
if ( rectifyPath(i-1_pInt:i) == './' .and. rectifyPath(i-2_pInt:i-2_pInt) /= '.' ) &
|
||||
rectifyPath(i-1_pInt:l) = rectifyPath(i+1_pInt:l)//' '
|
||||
do i = l,3,-1
|
||||
if ( rectifyPath(i-1:i) == './' .and. rectifyPath(i-2:i-2) /= '.' ) &
|
||||
rectifyPath(i-1:l) = rectifyPath(i+1:l)//' '
|
||||
enddo
|
||||
|
||||
!remove ../ and corresponding directory from rectifyPath
|
||||
l = len_trim(rectifyPath)
|
||||
i = index(rectifyPath(i:l),'../')
|
||||
j = 0_pInt
|
||||
j = 0
|
||||
do while (i > j)
|
||||
j = scan(rectifyPath(1:i-2_pInt),'/',back=.true.)
|
||||
rectifyPath(j+1_pInt:l) = rectifyPath(i+3_pInt:l)//repeat(' ',2_pInt+i-j)
|
||||
if (rectifyPath(j+1_pInt:j+1_pInt) == '/') then !search for '//' that appear in case of XXX/../../XXX
|
||||
j = scan(rectifyPath(1:i-2),'/',back=.true.)
|
||||
rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j)
|
||||
if (rectifyPath(j+1:j+1) == '/') then !search for '//' that appear in case of XXX/../../XXX
|
||||
k = len_trim(rectifyPath)
|
||||
rectifyPath(j+1_pInt:k-1_pInt) = rectifyPath(j+2_pInt:k)
|
||||
rectifyPath(j+1:k-1) = rectifyPath(j+2:k)
|
||||
rectifyPath(k:k) = ' '
|
||||
endif
|
||||
i = j+index(rectifyPath(j+1_pInt:l),'../')
|
||||
i = j+index(rectifyPath(j+1:l),'../')
|
||||
enddo
|
||||
if(len_trim(rectifyPath) == 0) rectifyPath = '/'
|
||||
|
||||
|
|
@ -330,18 +326,18 @@ function makeRelativePath(a,b)
|
|||
|
||||
character (len=*) :: a,b
|
||||
character (len=1024) :: makeRelativePath
|
||||
integer(pInt) i,posLastCommonSlash,remainingSlashes
|
||||
integer :: i,posLastCommonSlash,remainingSlashes !no pInt
|
||||
|
||||
posLastCommonSlash = 0_pInt
|
||||
remainingSlashes = 0_pInt
|
||||
do i = 1_pInt,min(1024,len_trim(a),len_trim(b))
|
||||
posLastCommonSlash = 0
|
||||
remainingSlashes = 0
|
||||
do i = 1, min(1024,len_trim(a),len_trim(b))
|
||||
if (a(i:i) /= b(i:i)) exit
|
||||
if (a(i:i) == '/') posLastCommonSlash = i
|
||||
enddo
|
||||
do i = posLastCommonSlash+1_pInt,len_trim(a)
|
||||
if (a(i:i) == '/') remainingSlashes = remainingSlashes + 1_pInt
|
||||
do i = posLastCommonSlash+1,len_trim(a)
|
||||
if (a(i:i) == '/') remainingSlashes = remainingSlashes + 1
|
||||
enddo
|
||||
makeRelativePath = repeat('../',remainingSlashes)//b(posLastCommonSlash+1_pInt:len_trim(b))
|
||||
makeRelativePath = repeat('../',remainingSlashes)//b(posLastCommonSlash+1:len_trim(b))
|
||||
|
||||
endfunction makeRelativePath
|
||||
|
||||
|
|
|
|||
|
|
@ -70,9 +70,9 @@
|
|||
commandLine(i:i) = achar(iachar(commandLine(i:i))+32) ! make lowercase
|
||||
enddo
|
||||
if (index(commandLine,'-r ',.true.)>0) & ! look for -r
|
||||
start = index(commandLine,'-r ',.true.) + 3_pInt ! set to position after trailing space
|
||||
start = index(commandLine,'-r ',.true.) + 3 ! set to position after trailing space
|
||||
if (index(commandLine,'--restart ',.true.)>0) & ! look for --restart
|
||||
start = index(commandLine,'--restart ',.true.) + 10_pInt ! set to position after trailing space
|
||||
start = index(commandLine,'--restart ',.true.) + 10 ! set to position after trailing space
|
||||
if(start /= 0_pInt) then ! found something
|
||||
length = verify(commandLine(start:len(commandLine)),'0123456789',.false.) ! where is first non number after argument?
|
||||
read(commandLine(start:start+length),'(I12)') restartInc ! read argument
|
||||
|
|
@ -99,12 +99,12 @@
|
|||
restartWrite = iand(IO_intValue(line,positions,1_pInt),1_pInt) > 0_pInt
|
||||
restartRead = iand(IO_intValue(line,positions,1_pInt),2_pInt) > 0_pInt
|
||||
case ('*restart')
|
||||
do i=2,positions(1)
|
||||
restartWrite = (IO_lc(IO_StringValue(line,positions,i)) == 'write') .or. restartWrite
|
||||
restartRead = (IO_lc(IO_StringValue(line,positions,i)) == 'read') .or. restartRead
|
||||
do j=2_pInt,positions(1)
|
||||
restartWrite = (IO_lc(IO_StringValue(line,positions,j)) == 'write') .or. restartWrite
|
||||
restartRead = (IO_lc(IO_StringValue(line,positions,j)) == 'read') .or. restartRead
|
||||
enddo
|
||||
if(restartWrite) then
|
||||
do j=2,positions(1)
|
||||
do j=2_pInt,positions(1)
|
||||
restartWrite = (IO_lc(IO_StringValue(line,positions,j)) /= 'frequency=0') .and. restartWrite
|
||||
enddo
|
||||
endif
|
||||
|
|
|
|||
434
code/IO.f90
434
code/IO.f90
|
|
@ -25,20 +25,20 @@
|
|||
CONTAINS
|
||||
!---------------------------
|
||||
! function IO_abaqus_assembleInputFile
|
||||
! subroutine IO_open_file(unit,relPath)
|
||||
! subroutine IO_open_inputFile(unit, model)
|
||||
! subroutine IO_open_logFile(unit)
|
||||
! subroutine IO_open_file(myUnit,relPath)
|
||||
! subroutine IO_open_inputFile(myUnit, model)
|
||||
! subroutine IO_open_logFile(myUnit)
|
||||
! function IO_hybridIA(Nast,ODFfileName)
|
||||
! private function hybridIA_reps(dV_V,steps,C)
|
||||
! function IO_stringPos(line,maxN)
|
||||
! function IO_stringValue(line,positions,pos)
|
||||
! function IO_floatValue(line,positions,pos)
|
||||
! function IO_intValue(line,positions,pos)
|
||||
! function IO_fixedStringValue(line,ends,pos)
|
||||
! function IO_fixedFloatValue(line,ends,pos)
|
||||
! function IO_fixedFloatNoEValue(line,ends,pos)
|
||||
! function IO_fixedIntValue(line,ends,pos)
|
||||
! function IO_continousIntValues(unit,maxN)
|
||||
! function IO_stringValue(line,positions,myPos)
|
||||
! function IO_floatValue(line,positions,myPos)
|
||||
! function IO_intValue(line,positions,myPos)
|
||||
! function IO_fixedStringValue(line,ends,myPos)
|
||||
! function IO_fixedFloatValue(line,ends,myPos)
|
||||
! function IO_fixedFloatNoEValue(line,ends,myPos)
|
||||
! function IO_fixedIntValue(line,ends,myPos)
|
||||
! function IO_continousIntValues(myUnit,maxN)
|
||||
! function IO_lc(line)
|
||||
! subroutine IO_lcInplace(line)
|
||||
! subroutine IO_error(ID)
|
||||
|
|
@ -76,7 +76,7 @@ recursive function IO_abaqus_assembleInputFile(unit1,unit2) result(createSuccess
|
|||
character(len=300) line,fname
|
||||
integer(pInt), intent(in) :: unit1, unit2
|
||||
logical createSuccess,fexist
|
||||
integer(pInt), parameter :: maxNchunks = 6
|
||||
integer(pInt), parameter :: maxNchunks = 6_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: positions
|
||||
|
||||
|
||||
|
|
@ -88,7 +88,7 @@ recursive function IO_abaqus_assembleInputFile(unit1,unit2) result(createSuccess
|
|||
|
||||
! call IO_lcInPlace(line)
|
||||
if (IO_lc(IO_StringValue(line,positions,1_pInt))=='*include') then
|
||||
fname = trim(getSolverWorkingDirectoryName())//trim(line(9_pInt+scan(line(9_pInt:),'='):))
|
||||
fname = trim(getSolverWorkingDirectoryName())//trim(line(9+scan(line(9:),'='):))
|
||||
inquire(file=fname, exist=fexist)
|
||||
if (.not.(fexist)) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
|
|
@ -121,25 +121,25 @@ end function
|
|||
!***********************************************************
|
||||
! check if the input file for Abaqus contains part info
|
||||
!***********************************************************
|
||||
function IO_abaqus_hasNoPart(unit)
|
||||
function IO_abaqus_hasNoPart(myUnit)
|
||||
|
||||
use prec, only: pInt
|
||||
implicit none
|
||||
|
||||
integer(pInt) unit
|
||||
integer(pInt), parameter :: maxNchunks = 1
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: pos
|
||||
integer(pInt) myUnit
|
||||
integer(pInt), parameter :: maxNchunks = 1_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: myPos
|
||||
logical IO_abaqus_hasNoPart
|
||||
character(len=300) line
|
||||
|
||||
IO_abaqus_hasNoPart = .true.
|
||||
|
||||
610 FORMAT(A300)
|
||||
rewind(unit)
|
||||
rewind(myUnit)
|
||||
do
|
||||
read(unit,610,END=620) line
|
||||
pos = IO_stringPos(line,maxNchunks)
|
||||
if (IO_lc(IO_stringValue(line,pos,1_pInt)) == '*part' ) then
|
||||
read(myUnit,610,END=620) line
|
||||
myPos = IO_stringPos(line,maxNchunks)
|
||||
if (IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) then
|
||||
IO_abaqus_hasNoPart = .false.
|
||||
exit
|
||||
endif
|
||||
|
|
@ -150,22 +150,22 @@ end function
|
|||
|
||||
|
||||
!********************************************************************
|
||||
! open existing file to given unit
|
||||
! open existing file to given myUnit
|
||||
! path to file is relative to working directory
|
||||
!********************************************************************
|
||||
logical function IO_open_file_stat(unit,relPath)
|
||||
logical function IO_open_file_stat(myUnit,relPath)
|
||||
|
||||
use prec, only: pInt
|
||||
use DAMASK_interface
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: unit
|
||||
integer(pInt), intent(in) :: myUnit
|
||||
character(len=*), intent(in) :: relPath
|
||||
character(len=1024) path
|
||||
integer(pInt) stat
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//relPath
|
||||
open(unit,status='old',iostat=stat,file=path)
|
||||
open(myUnit,status='old',iostat=stat,file=path)
|
||||
IO_open_file_stat = (stat == 0_pInt)
|
||||
|
||||
endfunction
|
||||
|
|
@ -175,37 +175,37 @@ end function
|
|||
! open existing file to given unit
|
||||
! path to file is relative to working directory
|
||||
!********************************************************************
|
||||
subroutine IO_open_file(unit,relPath)
|
||||
subroutine IO_open_file(myUnit,relPath)
|
||||
|
||||
use prec, only: pInt
|
||||
use DAMASK_interface
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: unit
|
||||
integer(pInt), intent(in) ::myUnit
|
||||
character(len=*), intent(in) :: relPath
|
||||
character(len=1024) path
|
||||
integer(pInt) stat
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//relPath
|
||||
open(unit,status='old',iostat=stat,file=path)
|
||||
open(myUnit,status='old',iostat=stat,file=path)
|
||||
if (stat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
|
||||
|
||||
endsubroutine
|
||||
|
||||
|
||||
!********************************************************************
|
||||
! open FEM inputfile to given unit
|
||||
! open FEM inputfile to given myUnit
|
||||
! AP: 12.07.10
|
||||
! : changed the function to open *.inp_assembly, which is basically
|
||||
! the input file without comment lines and possibly assembled includes
|
||||
!********************************************************************
|
||||
subroutine IO_open_inputFile(unit,model)
|
||||
subroutine IO_open_inputFile(myUnit,model)
|
||||
|
||||
use prec, only: pReal, pInt
|
||||
use DAMASK_interface
|
||||
implicit none
|
||||
|
||||
integer(pInt), intent(in) :: unit
|
||||
integer(pInt), intent(in) :: myUnit
|
||||
character(len=*), intent(in) :: model
|
||||
character(len=1024) path
|
||||
integer(pInt) stat
|
||||
|
|
@ -214,19 +214,18 @@ end function
|
|||
if (FEsolver == 'Abaqus') then
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(model)//InputFileExtension
|
||||
open(unit+1,status='old',iostat=stat,file=path)
|
||||
open(myUnit+1,status='old',iostat=stat,file=path)
|
||||
if (stat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(model)//InputFileExtension//'_assembly'
|
||||
open(unit,iostat=stat,file=path)
|
||||
open(myUnit,iostat=stat,file=path)
|
||||
if (stat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
|
||||
if (IO_abaqus_assembleInputFile(unit,unit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s
|
||||
close(unit+1_pInt)
|
||||
if (IO_abaqus_assembleInputFile(myUnit,myUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s
|
||||
close(myUnit+1_pInt)
|
||||
|
||||
else
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(model)//InputFileExtension
|
||||
open(unit,status='old',iostat=stat,file=path)
|
||||
open(myUnit,status='old',iostat=stat,file=path)
|
||||
if (stat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
|
||||
|
||||
endif
|
||||
|
|
@ -235,20 +234,19 @@ end function
|
|||
|
||||
|
||||
!********************************************************************
|
||||
! open FEM logfile to given unit
|
||||
! open FEM logfile to given myUnit
|
||||
!********************************************************************
|
||||
subroutine IO_open_logFile(unit)
|
||||
|
||||
subroutine IO_open_logFile(myUnit)
|
||||
use prec, only: pReal, pInt
|
||||
use DAMASK_interface
|
||||
implicit none
|
||||
|
||||
integer(pInt), intent(in) :: unit
|
||||
integer(pInt), intent(in) :: myUnit
|
||||
character(len=1024) path
|
||||
integer(pInt) stat
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//LogFileExtension
|
||||
open(unit,status='old',iostat=stat,file=path)
|
||||
open(myUnit,status='old',iostat=stat,file=path)
|
||||
if (stat /= 0) call IO_error(100_pInt,ext_msg=path)
|
||||
|
||||
endsubroutine
|
||||
|
|
@ -256,23 +254,23 @@ end function
|
|||
|
||||
!********************************************************************
|
||||
! open (write) file related to current job
|
||||
! but with different extension to given unit
|
||||
! but with different extension to given myUnit
|
||||
!********************************************************************
|
||||
logical function IO_open_jobFile_stat(unit,newExt)
|
||||
logical function IO_open_jobFile_stat(myUnit,newExt)
|
||||
|
||||
use prec, only: pReal, pInt
|
||||
use DAMASK_interface
|
||||
implicit none
|
||||
|
||||
integer(pInt), intent(in) :: unit
|
||||
integer(pInt), intent(in) :: myUnit
|
||||
character(len=*), intent(in) :: newExt
|
||||
character(len=1024) path
|
||||
integer(pInt) stat
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt
|
||||
open(unit,status='old',iostat=stat,file=path)
|
||||
open(myUnit,status='old',iostat=stat,file=path)
|
||||
IO_open_jobFile_stat = (stat == 0_pInt)
|
||||
|
||||
|
||||
endfunction
|
||||
|
||||
|
||||
|
|
@ -280,19 +278,19 @@ end function
|
|||
! open (write) file related to current job
|
||||
! but with different extension to given unit
|
||||
!********************************************************************
|
||||
subroutine IO_open_jobFile(unit,newExt)
|
||||
subroutine IO_open_jobFile(myUnit,newExt)
|
||||
|
||||
use prec, only: pReal, pInt
|
||||
use DAMASK_interface
|
||||
implicit none
|
||||
|
||||
integer(pInt), intent(in) :: unit
|
||||
integer(pInt), intent(in) :: myUnit
|
||||
character(len=*), intent(in) :: newExt
|
||||
character(len=1024) path
|
||||
integer(pInt) stat
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt
|
||||
open(unit,status='old',iostat=stat,file=path)
|
||||
open(myUnit,status='old',iostat=stat,file=path)
|
||||
if (stat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
|
||||
|
||||
endsubroutine
|
||||
|
|
@ -300,21 +298,21 @@ end function
|
|||
|
||||
!********************************************************************
|
||||
! open (write) file related to current job
|
||||
! but with different extension to given unit
|
||||
! but with different extension to given myUnit
|
||||
!********************************************************************
|
||||
subroutine IO_write_jobFile(unit,newExt)
|
||||
subroutine IO_write_jobFile(myUnit,newExt)
|
||||
|
||||
use prec, only: pReal, pInt
|
||||
use DAMASK_interface
|
||||
implicit none
|
||||
|
||||
integer(pInt), intent(in) :: unit
|
||||
integer(pInt), intent(in) :: myUnit
|
||||
character(len=*), intent(in) :: newExt
|
||||
character(len=1024) path
|
||||
integer(pInt) stat
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt
|
||||
open(unit,status='replace',iostat=stat,file=path)
|
||||
open(myUnit,status='replace',iostat=stat,file=path)
|
||||
if (stat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
|
||||
|
||||
endsubroutine
|
||||
|
|
@ -322,15 +320,15 @@ end function
|
|||
|
||||
!********************************************************************
|
||||
! open (write) binary file related to current job
|
||||
! but with different extension to given unit
|
||||
! but with different extension to given myUnit
|
||||
!********************************************************************
|
||||
subroutine IO_write_jobBinaryFile(unit,newExt,recMultiplier)
|
||||
subroutine IO_write_jobBinaryFile(myUnit,newExt,recMultiplier)
|
||||
|
||||
use prec, only: pReal, pInt
|
||||
use DAMASK_interface
|
||||
implicit none
|
||||
|
||||
integer(pInt), intent(in) :: unit
|
||||
integer(pInt), intent(in) :: myUnit
|
||||
integer(pInt), intent(in), optional :: recMultiplier
|
||||
character(len=*), intent(in) :: newExt
|
||||
character(len=1024) path
|
||||
|
|
@ -338,9 +336,9 @@ end function
|
|||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt
|
||||
if (present(recMultiplier)) then
|
||||
open(unit,status='replace',form='unformatted',access='direct',recl=pReal*recMultiplier,iostat=stat,file=path)
|
||||
open(myUnit,status='replace',form='unformatted',access='direct',recl=pReal*recMultiplier,iostat=stat,file=path)
|
||||
else
|
||||
open(unit,status='replace',form='unformatted',access='direct',recl=pReal,iostat=stat,file=path)
|
||||
open(myUnit,status='replace',form='unformatted',access='direct',recl=pReal,iostat=stat,file=path)
|
||||
endif
|
||||
if (stat /= 0_pInt) call IO_error(100_pInt,ext_msg=path)
|
||||
|
||||
|
|
@ -349,15 +347,15 @@ end function
|
|||
|
||||
!********************************************************************
|
||||
! open (read) binary file related to restored job
|
||||
! and with different extension to given unit
|
||||
! and with different extension to given myUnit
|
||||
!********************************************************************
|
||||
subroutine IO_read_jobBinaryFile(unit,newExt,jobName,recMultiplier)
|
||||
subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier)
|
||||
|
||||
use prec, only: pReal, pInt
|
||||
use DAMASK_interface
|
||||
implicit none
|
||||
|
||||
integer(pInt), intent(in) :: unit
|
||||
integer(pInt), intent(in) :: myUnit
|
||||
integer(pInt), intent(in), optional :: recMultiplier
|
||||
character(len=*), intent(in) :: newExt, jobName
|
||||
character(len=1024) path
|
||||
|
|
@ -365,9 +363,9 @@ end function
|
|||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(jobName)//'.'//newExt
|
||||
if (present(recMultiplier)) then
|
||||
open(unit,status='old',form='unformatted',access='direct',recl=pReal*recMultiplier,iostat=stat,file=path)
|
||||
open(myUnit,status='old',form='unformatted',access='direct',recl=pReal*recMultiplier,iostat=stat,file=path)
|
||||
else
|
||||
open(unit,status='old',form='unformatted',access='direct',recl=pReal,iostat=stat,file=path)
|
||||
open(myUnit,status='old',form='unformatted',access='direct',recl=pReal,iostat=stat,file=path)
|
||||
endif
|
||||
if (stat /= 0) then
|
||||
call IO_error(100_pInt,ext_msg=path)
|
||||
|
|
@ -390,9 +388,9 @@ end function
|
|||
real(pReal), intent(in) :: C
|
||||
|
||||
hybridIA_reps = 0_pInt
|
||||
do phi1=1,steps(1)
|
||||
do Phi =1,steps(2)
|
||||
do phi2=1,steps(3)
|
||||
do phi1=1_pInt,steps(1)
|
||||
do Phi =1_pInt,steps(2)
|
||||
do phi2=1_pInt,steps(3)
|
||||
hybridIA_reps = hybridIA_reps+nint(C*dV_V(phi2,Phi,phi1), pInt)
|
||||
enddo
|
||||
enddo
|
||||
|
|
@ -416,7 +414,7 @@ end function
|
|||
character(len=80) line
|
||||
character(len=*), parameter :: fileFormat = '(A80)'
|
||||
integer(pInt) i,j,bin,Nast,NnonZero,Nset,Nreps,reps,phi1,Phi,phi2
|
||||
integer(pInt), dimension(7) :: pos
|
||||
integer(pInt), dimension(7) :: myPos
|
||||
integer(pInt), dimension(3) :: steps
|
||||
integer(pInt), dimension(:), allocatable :: binSet
|
||||
real(pReal) center,sum_dV_V,prob,dg_0,C,lowerC,upperC,rnd
|
||||
|
|
@ -429,18 +427,18 @@ end function
|
|||
!--- parse header of ODF file ---
|
||||
!--- limits in phi1, Phi, phi2 ---
|
||||
read(999,fmt=fileFormat,end=100) line
|
||||
pos = IO_stringPos(line,3_pInt)
|
||||
if (pos(1).ne.3) goto 100
|
||||
do i=1,3
|
||||
limits(i) = IO_floatValue(line,pos,i)*inRad
|
||||
myPos = IO_stringPos(line,3_pInt)
|
||||
if (myPos(1).ne.3) goto 100
|
||||
do i=1_pInt,3_pInt
|
||||
limits(i) = IO_floatValue(line,myPos,i)*inRad
|
||||
enddo
|
||||
|
||||
!--- deltas in phi1, Phi, phi2 ---
|
||||
read(999,fmt=fileFormat,end=100) line
|
||||
pos = IO_stringPos(line,3_pInt)
|
||||
if (pos(1).ne.3) goto 100
|
||||
do i=1,3
|
||||
deltas(i) = IO_floatValue(line,pos,i)*inRad
|
||||
myPos = IO_stringPos(line,3_pInt)
|
||||
if (myPos(1).ne.3) goto 100
|
||||
do i=1_pInt,3_pInt
|
||||
deltas(i) = IO_floatValue(line,myPos,i)*inRad
|
||||
enddo
|
||||
steps = nint(limits/deltas,pInt)
|
||||
allocate(dV_V(steps(3),steps(2),steps(1)))
|
||||
|
|
@ -461,12 +459,12 @@ end function
|
|||
dg_0 = deltas(1)*deltas(3)*2.0_pReal*sin(deltas(2)/2.0_pReal)
|
||||
NnonZero = 0_pInt
|
||||
|
||||
do phi1=1,steps(1)
|
||||
do Phi=1,steps(2)
|
||||
do phi2=1,steps(3)
|
||||
do phi1=1_pInt,steps(1)
|
||||
do Phi=1_pInt,steps(2)
|
||||
do phi2=1_pInt,steps(3)
|
||||
read(999,fmt=*,end=100) prob
|
||||
if (prob > 0.0_pReal) then
|
||||
NnonZero = NnonZero+1
|
||||
NnonZero = NnonZero+1_pInt
|
||||
sum_dV_V = sum_dV_V+prob
|
||||
else
|
||||
prob = 0.0_pReal
|
||||
|
|
@ -506,19 +504,19 @@ end function
|
|||
|
||||
allocate(binSet(Nreps))
|
||||
bin = 0_pInt ! bin counter
|
||||
i = 1 ! set counter
|
||||
do phi1=1,steps(1)
|
||||
do Phi=1,steps(2)
|
||||
do phi2=1,steps(3)
|
||||
i = 1_pInt ! set counter
|
||||
do phi1=1_pInt,steps(1)
|
||||
do Phi=1_pInt,steps(2)
|
||||
do phi2=1_pInt,steps(3)
|
||||
reps = nint(C*dV_V(phi2,Phi,phi1), pInt)
|
||||
binSet(i:i+reps-1) = bin
|
||||
bin = bin+1 ! advance bin
|
||||
bin = bin+1_pInt ! advance bin
|
||||
i = i+reps ! advance set
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do i=1,Nast
|
||||
do i=1_pInt,Nast
|
||||
if (i < Nast) then
|
||||
call random_number(rnd)
|
||||
j = nint(rnd*(Nreps-i)+i+0.5_pReal,pInt)
|
||||
|
|
@ -552,7 +550,7 @@ end function
|
|||
character(len=*), intent(in) :: line
|
||||
character(len=*), parameter :: blank = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
|
||||
character(len=*), parameter :: comment = achar(35) ! comment id '#'
|
||||
integer(pInt) posNonBlank, posComment
|
||||
integer :: posNonBlank, posComment !no pInt
|
||||
logical IO_isBlank
|
||||
|
||||
posNonBlank = verify(line,blank)
|
||||
|
|
@ -572,7 +570,7 @@ end function
|
|||
character(len=*), intent(in) :: line,openChar,closeChar
|
||||
character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
|
||||
character(len=len_trim(line)) IO_getTag
|
||||
integer(pInt) left,right
|
||||
integer :: left,right !no pInt
|
||||
|
||||
IO_getTag = ''
|
||||
left = scan(line,openChar)
|
||||
|
|
@ -596,7 +594,7 @@ end function
|
|||
integer(pInt) IO_countSections
|
||||
character(len=1024) line
|
||||
|
||||
IO_countSections = 0
|
||||
IO_countSections = 0_pInt
|
||||
line = ''
|
||||
rewind(file)
|
||||
|
||||
|
|
@ -609,7 +607,7 @@ end function
|
|||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
|
||||
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
|
||||
IO_countSections = IO_countSections + 1
|
||||
IO_countSections = IO_countSections + 1_pInt
|
||||
enddo
|
||||
|
||||
100 endfunction
|
||||
|
|
@ -627,7 +625,7 @@ end function
|
|||
integer(pInt), intent(in) :: file, Nsections
|
||||
character(len=*), intent(in) :: part, myTag
|
||||
integer(pInt), dimension(Nsections) :: IO_countTagInPart, counter
|
||||
integer(pInt), parameter :: maxNchunks = 1
|
||||
integer(pInt), parameter :: maxNchunks = 1_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: positions
|
||||
integer(pInt) section
|
||||
character(len=1024) line,tag
|
||||
|
|
@ -646,7 +644,7 @@ end function
|
|||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
|
||||
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
|
||||
section = section + 1
|
||||
section = section + 1_pInt
|
||||
if (section > 0) then
|
||||
positions = IO_stringPos(line,maxNchunks)
|
||||
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
|
||||
|
|
@ -672,7 +670,7 @@ endfunction
|
|||
integer(pInt), intent(in) :: file, Nsections
|
||||
character(len=*), intent(in) :: part, myTag
|
||||
logical, dimension(Nsections) :: IO_spotTagInPart
|
||||
integer(pInt), parameter :: maxNchunks = 1
|
||||
integer(pInt), parameter :: maxNchunks = 1_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: positions
|
||||
integer(pInt) section
|
||||
character(len=1024) line,tag
|
||||
|
|
@ -691,8 +689,8 @@ endfunction
|
|||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
|
||||
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
|
||||
section = section + 1
|
||||
if (section > 0) then
|
||||
section = section + 1_pInt
|
||||
if (section > 0_pInt) then
|
||||
positions = IO_stringPos(line,maxNchunks)
|
||||
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
|
||||
if (tag == myTag) & ! match
|
||||
|
|
@ -716,11 +714,11 @@ endfunction
|
|||
character(len=*), intent(in) :: line
|
||||
character(len=*), parameter :: sep=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces
|
||||
integer(pInt), intent(in) :: N
|
||||
integer(pInt) left,right
|
||||
integer(pInt) IO_stringPos(1+N*2)
|
||||
integer :: left,right !no pInt (verify and scan return default integer)
|
||||
integer(pInt) :: IO_stringPos(1_pInt+N*2_pInt)
|
||||
|
||||
IO_stringPos = -1
|
||||
IO_stringPos(1) = 0
|
||||
IO_stringPos = -1_pInt
|
||||
IO_stringPos(1) = 0_pInt
|
||||
right = 0
|
||||
|
||||
do while (verify(line(right+1:),sep)>0)
|
||||
|
|
@ -730,55 +728,55 @@ endfunction
|
|||
exit
|
||||
endif
|
||||
if ( IO_stringPos(1)<N ) then
|
||||
IO_stringPos(1+IO_stringPos(1)*2+1) = left
|
||||
IO_stringPos(1+IO_stringPos(1)*2+2) = right
|
||||
IO_stringPos(1_pInt+IO_stringPos(1)*2_pInt+1_pInt) = int(left, pInt)
|
||||
IO_stringPos(1_pInt+IO_stringPos(1)*2_pInt+2_pInt) = int(right, pInt)
|
||||
endif
|
||||
IO_stringPos(1) = IO_stringPos(1)+1
|
||||
IO_stringPos(1) = IO_stringPos(1)+1_pInt
|
||||
enddo
|
||||
|
||||
endfunction
|
||||
|
||||
|
||||
!********************************************************************
|
||||
! read string value at pos from line
|
||||
! read string value at myPos from line
|
||||
!********************************************************************
|
||||
pure function IO_stringValue (line,positions,pos)
|
||||
pure function IO_stringValue (line,positions,myPos)
|
||||
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: line
|
||||
integer(pInt), intent(in) :: positions(*),pos
|
||||
character(len=1+positions(pos*2+1)-positions(pos*2)) IO_stringValue
|
||||
integer(pInt), intent(in) :: positions(*),myPos
|
||||
character(len=1+positions(myPos*2+1)-positions(myPos*2)) :: IO_stringValue
|
||||
|
||||
if (positions(1) < pos) then
|
||||
if (positions(1) < myPos) then
|
||||
IO_stringValue = ''
|
||||
else
|
||||
IO_stringValue = line(positions(pos*2):positions(pos*2+1))
|
||||
IO_stringValue = line(positions(myPos*2):positions(myPos*2+1))
|
||||
endif
|
||||
|
||||
endfunction
|
||||
|
||||
|
||||
!********************************************************************
|
||||
! read string value at pos from fixed format line
|
||||
! read string value at myPos from fixed format line
|
||||
!********************************************************************
|
||||
pure function IO_fixedStringValue (line,ends,pos)
|
||||
pure function IO_fixedStringValue (line,ends,myPos)
|
||||
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: line
|
||||
integer(pInt), intent(in) :: ends(*),pos
|
||||
character(len=ends(pos+1)-ends(pos)) IO_fixedStringValue
|
||||
integer(pInt), intent(in) :: ends(*),myPos
|
||||
character(len=ends(myPos+1)-ends(myPos)) :: IO_fixedStringValue
|
||||
|
||||
IO_fixedStringValue = line(ends(pos)+1:ends(pos+1))
|
||||
IO_fixedStringValue = line(ends(myPos)+1:ends(myPos+1))
|
||||
|
||||
endfunction
|
||||
|
||||
|
||||
!********************************************************************
|
||||
! read float value at pos from line
|
||||
! read float value at myPos from line
|
||||
!********************************************************************
|
||||
pure function IO_floatValue (line,positions,myPos)
|
||||
|
||||
|
|
@ -787,7 +785,7 @@ endfunction
|
|||
|
||||
character(len=*), intent(in) :: line
|
||||
integer(pInt), intent(in) :: positions(*),myPos
|
||||
real(pReal) IO_floatValue
|
||||
real(pReal) :: IO_floatValue
|
||||
|
||||
if (positions(1) < myPos) then
|
||||
IO_floatValue = 0.0_pReal
|
||||
|
|
@ -801,18 +799,18 @@ endfunction
|
|||
|
||||
|
||||
!********************************************************************
|
||||
! read float value at pos from fixed format line
|
||||
! read float value at myPos from fixed format line
|
||||
!********************************************************************
|
||||
pure function IO_fixedFloatValue (line,ends,pos)
|
||||
pure function IO_fixedFloatValue (line,ends,myPos)
|
||||
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: line
|
||||
integer(pInt), intent(in) :: ends(*),pos
|
||||
real(pReal) IO_fixedFloatValue
|
||||
integer(pInt), intent(in) :: ends(*),myPos
|
||||
real(pReal) :: IO_fixedFloatValue
|
||||
|
||||
read(UNIT=line(ends(pos-1)+1:ends(pos)),ERR=100,FMT=*) IO_fixedFloatValue
|
||||
read(UNIT=line(ends(myPos-1)+1:ends(myPos)),ERR=100,FMT=*) IO_fixedFloatValue
|
||||
return
|
||||
100 IO_fixedFloatValue = huge(1.0_pReal)
|
||||
|
||||
|
|
@ -820,24 +818,25 @@ endfunction
|
|||
|
||||
|
||||
!********************************************************************
|
||||
! read float x.y+z value at pos from format line line
|
||||
! read float x.y+z value at myPos from format line line
|
||||
!********************************************************************
|
||||
pure function IO_fixedNoEFloatValue (line,ends,pos)
|
||||
pure function IO_fixedNoEFloatValue (line,ends,myPos)
|
||||
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: line
|
||||
integer(pInt), intent(in) :: ends(*),pos
|
||||
integer(pInt) pos_exp,expon
|
||||
integer(pInt), intent(in) :: ends(*),myPos
|
||||
integer(pInt) :: expon
|
||||
integer :: pos_exp
|
||||
real(pReal) IO_fixedNoEFloatValue,base
|
||||
|
||||
pos_exp = scan(line(ends(pos)+1:ends(pos+1)),'+-',back=.true.)
|
||||
pos_exp = scan(line(ends(myPos)+1:ends(myPos+1)),'+-',back=.true.)
|
||||
if (pos_exp > 1) then
|
||||
read(UNIT=line(ends(pos)+1:ends(pos)+pos_exp-1),ERR=100,FMT=*) base
|
||||
read(UNIT=line(ends(pos)+pos_exp:ends(pos+1)),ERR=100,FMT=*) expon
|
||||
read(UNIT=line(ends(myPos)+1:ends(myPos)+pos_exp-1),ERR=100,FMT=*) base
|
||||
read(UNIT=line(ends(myPos)+pos_exp:ends(myPos+1)),ERR=100,FMT=*) expon
|
||||
else
|
||||
read(UNIT=line(ends(pos)+1:ends(pos+1)),ERR=100,FMT=*) base
|
||||
read(UNIT=line(ends(myPos)+1:ends(myPos+1)),ERR=100,FMT=*) base
|
||||
expon = 0_pInt
|
||||
endif
|
||||
IO_fixedNoEFloatValue = base*10.0_pReal**expon
|
||||
|
|
@ -848,21 +847,21 @@ endfunction
|
|||
|
||||
|
||||
!********************************************************************
|
||||
! read int value at pos from line
|
||||
! read int value at myPos from line
|
||||
!********************************************************************
|
||||
pure function IO_intValue (line,positions,pos)
|
||||
pure function IO_intValue (line,positions,myPos)
|
||||
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: line
|
||||
integer(pInt), intent(in) :: positions(*),pos
|
||||
integer(pInt) IO_intValue
|
||||
integer(pInt), intent(in) :: positions(*),myPos
|
||||
integer(pInt) :: IO_intValue
|
||||
|
||||
if (positions(1) < pos) then
|
||||
if (positions(1) < myPos) then
|
||||
IO_intValue = 0_pInt
|
||||
else
|
||||
read(UNIT=line(positions(pos*2):positions(pos*2+1)),ERR=100,FMT=*) IO_intValue
|
||||
read(UNIT=line(positions(myPos*2):positions(myPos*2+1)),ERR=100,FMT=*) IO_intValue
|
||||
endif
|
||||
return
|
||||
100 IO_intValue = huge(1_pInt)
|
||||
|
|
@ -871,18 +870,18 @@ endfunction
|
|||
|
||||
|
||||
!********************************************************************
|
||||
! read int value at pos from fixed format line
|
||||
! read int value at myPos from fixed format line
|
||||
!********************************************************************
|
||||
pure function IO_fixedIntValue (line,ends,pos)
|
||||
pure function IO_fixedIntValue (line,ends,myPos)
|
||||
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: line
|
||||
integer(pInt), intent(in) :: ends(*),pos
|
||||
integer(pInt), intent(in) :: ends(*),myPos
|
||||
integer(pInt) IO_fixedIntValue
|
||||
|
||||
read(UNIT=line(ends(pos)+1:ends(pos+1)),ERR=100,FMT=*) IO_fixedIntValue
|
||||
read(UNIT=line(ends(myPos)+1:ends(myPos+1)),ERR=100,FMT=*) IO_fixedIntValue
|
||||
return
|
||||
100 IO_fixedIntValue = huge(1_pInt)
|
||||
|
||||
|
|
@ -899,7 +898,7 @@ endfunction
|
|||
|
||||
character (len=*), intent(in) :: line
|
||||
character (len=len(line)) IO_lc
|
||||
integer(pInt) i
|
||||
integer :: i !no pInt (len returns default integer)
|
||||
|
||||
IO_lc = line
|
||||
do i=1,len(line)
|
||||
|
|
@ -919,7 +918,7 @@ endfunction
|
|||
|
||||
character (len=*) line
|
||||
character (len=len(line)) IO_lc
|
||||
integer(pInt) i
|
||||
integer :: i !no pInt (len returns default integer)
|
||||
|
||||
IO_lc = line
|
||||
do i=1,len(line)
|
||||
|
|
@ -939,15 +938,15 @@ endfunction
|
|||
implicit none
|
||||
|
||||
integer(pInt) remainingChunks,unit,N
|
||||
integer(pInt), parameter :: maxNchunks = 64
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: pos
|
||||
integer(pInt), parameter :: maxNchunks = 64_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: myPos
|
||||
character(len=300) line
|
||||
|
||||
remainingChunks = N
|
||||
do while (remainingChunks > 0)
|
||||
read(unit,'(A300)',end=100) line
|
||||
pos = IO_stringPos(line,maxNchunks)
|
||||
remainingChunks = remainingChunks - pos(1)
|
||||
myPos = IO_stringPos(line,maxNchunks)
|
||||
remainingChunks = remainingChunks - myPos(1)
|
||||
enddo
|
||||
100 endsubroutine
|
||||
|
||||
|
|
@ -957,19 +956,18 @@ endfunction
|
|||
!********************************************************************
|
||||
pure function IO_extractValue (line,key)
|
||||
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: line,key
|
||||
character(len=*), parameter :: sep = achar(61) ! '='
|
||||
integer(pInt) pos
|
||||
integer :: myPos ! no pInt (scan returns default integer)
|
||||
character(len=300) IO_extractValue
|
||||
|
||||
IO_extractValue = ''
|
||||
|
||||
pos = scan(line,sep)
|
||||
if (pos > 0 .and. line(:pos-1) == key(:pos-1)) & ! key matches expected key
|
||||
IO_extractValue = line(pos+1:) ! extract value
|
||||
myPos = scan(line,sep)
|
||||
if (myPos > 0 .and. line(:myPos-1) == key(:myPos-1)) & ! key matches expected key
|
||||
IO_extractValue = line(myPos+1:) ! extract value
|
||||
|
||||
endfunction
|
||||
|
||||
|
|
@ -980,28 +978,28 @@ endfunction
|
|||
! : is not changed back to the original version since *.inp_assembly does not
|
||||
! : contain any comment lines (12.07.2010)
|
||||
!********************************************************************
|
||||
function IO_countDataLines (unit)
|
||||
function IO_countDataLines (myUnit)
|
||||
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
integer(pInt) IO_countDataLines,unit
|
||||
integer(pInt), parameter :: maxNchunks = 1
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: pos
|
||||
character(len=300) line,tmp
|
||||
integer(pInt) :: IO_countDataLines,myUnit
|
||||
integer(pInt), parameter :: maxNchunks = 1_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: myPos
|
||||
character(len=300) :: line,tmp
|
||||
|
||||
IO_countDataLines = 0
|
||||
IO_countDataLines = 0_pInt
|
||||
do
|
||||
read(unit,'(A300)',end=100) line
|
||||
pos = IO_stringPos(line,maxNchunks)
|
||||
tmp = IO_lc(IO_stringValue(line,pos,1_pInt))
|
||||
read(myUnit,'(A300)',end=100) line
|
||||
myPos = IO_stringPos(line,maxNchunks)
|
||||
tmp = IO_lc(IO_stringValue(line,myPos,1_pInt))
|
||||
if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword
|
||||
exit
|
||||
else
|
||||
if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt
|
||||
endif
|
||||
enddo
|
||||
100 backspace(unit)
|
||||
100 backspace(myUnit)
|
||||
|
||||
endfunction
|
||||
|
||||
|
|
@ -1011,16 +1009,16 @@ endfunction
|
|||
! Marc: ints concatenated by "c" as last char or range of values a "to" b
|
||||
! Abaqus: triplet of start,stop,inc
|
||||
!********************************************************************
|
||||
function IO_countContinousIntValues (unit)
|
||||
function IO_countContinousIntValues (myUnit)
|
||||
|
||||
use DAMASK_interface
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
integer(pInt) unit,l,count
|
||||
integer(pInt) IO_countContinousIntValues
|
||||
integer(pInt), parameter :: maxNchunks = 8192
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: pos
|
||||
integer(pInt) :: myUnit,l,c
|
||||
integer(pInt) :: IO_countContinousIntValues
|
||||
integer(pInt), parameter :: maxNchunks = 8192_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: myPos
|
||||
character(len=65536) line
|
||||
|
||||
IO_countContinousIntValues = 0_pInt
|
||||
|
|
@ -1029,15 +1027,15 @@ endfunction
|
|||
case ('Marc','Spectral')
|
||||
|
||||
do
|
||||
read(unit,'(A300)',end=100) line
|
||||
pos = IO_stringPos(line,maxNchunks)
|
||||
if (IO_lc(IO_stringValue(line,pos,2_pInt)) == 'to' ) then ! found range indicator
|
||||
IO_countContinousIntValues = 1_pInt + IO_intValue(line,pos,3_pInt) - IO_intValue(line,pos,1_pInt)
|
||||
read(myUnit,'(A300)',end=100) line
|
||||
myPos = IO_stringPos(line,maxNchunks)
|
||||
if (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator
|
||||
IO_countContinousIntValues = 1_pInt + IO_intValue(line,myPos,3_pInt) - IO_intValue(line,myPos,1_pInt)
|
||||
exit ! only one single range indicator allowed
|
||||
else
|
||||
IO_countContinousIntValues = IO_countContinousIntValues+pos(1)-1_pInt ! add line's count when assuming 'c'
|
||||
if ( IO_lc(IO_stringValue(line,pos,pos(1))) /= 'c' ) then ! line finished, read last value
|
||||
IO_countContinousIntValues = IO_countContinousIntValues+1
|
||||
IO_countContinousIntValues = IO_countContinousIntValues+myPos(1)-1_pInt ! add line's count when assuming 'c'
|
||||
if ( IO_lc(IO_stringValue(line,myPos,myPos(1))) /= 'c' ) then ! line finished, read last value
|
||||
IO_countContinousIntValues = IO_countContinousIntValues+1_pInt
|
||||
exit ! data ended
|
||||
endif
|
||||
endif
|
||||
|
|
@ -1045,17 +1043,17 @@ endfunction
|
|||
|
||||
case('Abaqus')
|
||||
|
||||
count = IO_countDataLines(unit)
|
||||
do l = 1,count
|
||||
backspace(unit)
|
||||
c = IO_countDataLines(myUnit)
|
||||
do l = 1_pInt,c
|
||||
backspace(myUnit)
|
||||
enddo
|
||||
|
||||
do l = 1,count
|
||||
read(unit,'(A300)',end=100) line
|
||||
pos = IO_stringPos(line,maxNchunks)
|
||||
IO_countContinousIntValues = IO_countContinousIntValues + 1 + & ! assuming range generation
|
||||
(IO_intValue(line,pos,2_pInt)-IO_intValue(line,pos,1_pInt))/&
|
||||
max(1_pInt,IO_intValue(line,pos,3_pInt))
|
||||
do l = 1_pInt,c
|
||||
read(myUnit,'(A300)',end=100) line
|
||||
myPos = IO_stringPos(line,maxNchunks)
|
||||
IO_countContinousIntValues = IO_countContinousIntValues + 1_pInt + & ! assuming range generation
|
||||
(IO_intValue(line,myPos,2_pInt)-IO_intValue(line,myPos,1_pInt))/&
|
||||
max(1_pInt,IO_intValue(line,myPos,3_pInt))
|
||||
enddo
|
||||
|
||||
endselect
|
||||
|
|
@ -1068,53 +1066,53 @@ endfunction
|
|||
! Marc: ints concatenated by "c" as last char, range of a "to" b, or named set
|
||||
! Abaqus: triplet of start,stop,inc or named set
|
||||
!********************************************************************
|
||||
function IO_continousIntValues (unit,maxN,lookupName,lookupMap,lookupMaxN)
|
||||
function IO_continousIntValues (myUnit,maxN,lookupName,lookupMap,lookupMaxN)
|
||||
|
||||
use DAMASK_interface
|
||||
use prec, only: pReal,pInt
|
||||
implicit none
|
||||
|
||||
integer(pInt) unit,maxN,i,j,l,count,first,last
|
||||
integer(pInt) myUnit,maxN,i,j,l,c,first,last
|
||||
integer(pInt), dimension(1+maxN) :: IO_continousIntValues
|
||||
integer(pInt), parameter :: maxNchunks = 8192_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: pos
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: myPos
|
||||
character(len=64), dimension(:) :: lookupName
|
||||
integer(pInt) :: lookupMaxN
|
||||
integer(pInt), dimension(:,:) :: lookupMap
|
||||
character(len=65536) line
|
||||
logical rangeGeneration
|
||||
|
||||
IO_continousIntValues = 0
|
||||
IO_continousIntValues = 0_pInt
|
||||
rangeGeneration = .false.
|
||||
|
||||
select case (FEsolver)
|
||||
case ('Marc','Spectral')
|
||||
|
||||
do
|
||||
read(unit,'(A65536)',end=100) line
|
||||
pos = IO_stringPos(line,maxNchunks)
|
||||
if (verify(IO_stringValue(line,pos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name
|
||||
do i = 1_pInt,lookupMaxN ! loop over known set names
|
||||
if (IO_stringValue(line,pos,1_pInt) == lookupName(i)) then ! found matching name
|
||||
read(myUnit,'(A65536)',end=100) line
|
||||
myPos = IO_stringPos(line,maxNchunks)
|
||||
if (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name
|
||||
do i = 1_pInt, lookupMaxN ! loop over known set names
|
||||
if (IO_stringValue(line,myPos,1_pInt) == lookupName(i)) then ! found matching name
|
||||
IO_continousIntValues = lookupMap(:,i) ! return resp. entity list
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
exit
|
||||
else if (pos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,pos,2_pInt)) == 'to' ) then ! found range indicator
|
||||
do i = IO_intValue(line,pos,1_pInt),IO_intValue(line,pos,3_pInt)
|
||||
else if (myPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator
|
||||
do i = IO_intValue(line,myPos,1_pInt),IO_intValue(line,myPos,3_pInt)
|
||||
IO_continousIntValues(1) = IO_continousIntValues(1) + 1_pInt
|
||||
IO_continousIntValues(1+IO_continousIntValues(1)) = i
|
||||
enddo
|
||||
exit
|
||||
else
|
||||
do i = 1,pos(1)-1 ! interpret up to second to last value
|
||||
do i = 1_pInt ,myPos(1)-1_pInt ! interpret up to second to last value
|
||||
IO_continousIntValues(1) = IO_continousIntValues(1) + 1_pInt
|
||||
IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,pos,i)
|
||||
IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,myPos,i)
|
||||
enddo
|
||||
if ( IO_lc(IO_stringValue(line,pos,pos(1))) /= 'c' ) then ! line finished, read last value
|
||||
if ( IO_lc(IO_stringValue(line,myPos,myPos(1))) /= 'c' ) then ! line finished, read last value
|
||||
IO_continousIntValues(1) = IO_continousIntValues(1) + 1_pInt
|
||||
IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,pos,pos(1))
|
||||
IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,myPos,myPos(1))
|
||||
exit
|
||||
endif
|
||||
endif
|
||||
|
|
@ -1122,43 +1120,43 @@ endfunction
|
|||
|
||||
case('Abaqus')
|
||||
|
||||
count = IO_countDataLines(unit)
|
||||
do l = 1,count
|
||||
backspace(unit)
|
||||
c = IO_countDataLines(myUnit)
|
||||
do l = 1_pInt,c
|
||||
backspace(myUnit)
|
||||
enddo
|
||||
|
||||
! check if the element values in the elset are auto generated
|
||||
backspace(unit)
|
||||
read(unit,'(A65536)',end=100) line
|
||||
pos = IO_stringPos(line,maxNchunks)
|
||||
do i = 1,pos(1)
|
||||
if (IO_lc(IO_stringValue(line,pos,i)) == 'generate') rangeGeneration = .true.
|
||||
backspace(myUnit)
|
||||
read(myUnit,'(A65536)',end=100) line
|
||||
myPos = IO_stringPos(line,maxNchunks)
|
||||
do i = 1_pInt,myPos(1)
|
||||
if (IO_lc(IO_stringValue(line,myPos,i)) == 'generate') rangeGeneration = .true.
|
||||
enddo
|
||||
|
||||
do l = 1,count
|
||||
read(unit,'(A65536)',end=100) line
|
||||
pos = IO_stringPos(line,maxNchunks)
|
||||
if (verify(IO_stringValue(line,pos,1_pInt),'0123456789') > 0_pInt) then ! a non-int, i.e. set names follow on this line
|
||||
do i = 1,pos(1) ! loop over set names in line
|
||||
do j = 1,lookupMaxN ! look thru known set names
|
||||
if (IO_stringValue(line,pos,i) == lookupName(j)) then ! found matching name
|
||||
first = 2 + IO_continousIntValues(1) ! where to start appending data
|
||||
last = first + lookupMap(1,j) - 1 ! up to where to append data
|
||||
do l = 1_pInt,c
|
||||
read(myUnit,'(A65536)',end=100) line
|
||||
myPos = IO_stringPos(line,maxNchunks)
|
||||
if (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line
|
||||
do i = 1_pInt,myPos(1) ! loop over set names in line
|
||||
do j = 1_pInt,lookupMaxN ! look thru known set names
|
||||
if (IO_stringValue(line,myPos,i) == lookupName(j)) then ! found matching name
|
||||
first = 2_pInt + IO_continousIntValues(1) ! where to start appending data
|
||||
last = first + lookupMap(1,j) - 1_pInt ! up to where to append data
|
||||
IO_continousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list
|
||||
IO_continousIntValues(1) = IO_continousIntValues(1) + lookupMap(1,j) ! count them
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
else if (rangeGeneration) then ! range generation
|
||||
do i = IO_intValue(line,pos,1_pInt),IO_intValue(line,pos,2_pInt),max(1_pInt,IO_intValue(line,pos,3_pInt))
|
||||
IO_continousIntValues(1) = IO_continousIntValues(1) + 1
|
||||
do i = IO_intValue(line,myPos,1_pInt),IO_intValue(line,myPos,2_pInt),max(1_pInt,IO_intValue(line,myPos,3_pInt))
|
||||
IO_continousIntValues(1) = IO_continousIntValues(1) + 1_pInt
|
||||
IO_continousIntValues(1+IO_continousIntValues(1)) = i
|
||||
enddo
|
||||
else ! read individual elem nums
|
||||
do i = 1,pos(1)
|
||||
! write(*,*)'IO_CIV-int',IO_intValue(line,pos,i)
|
||||
IO_continousIntValues(1) = IO_continousIntValues(1) + 1
|
||||
IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,pos,i)
|
||||
do i = 1_pInt,myPos(1)
|
||||
! write(*,*)'IO_CIV-int',IO_intValue(line,myPos,i)
|
||||
IO_continousIntValues(1) = IO_continousIntValues(1) + 1_pInt
|
||||
IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,myPos,i)
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
|
|
|
|||
|
|
@ -3178,7 +3178,7 @@ function crystallite_postResults(&
|
|||
|
||||
crystallite_postResults = 0.0_pReal
|
||||
c = 0_pInt
|
||||
crystallite_postResults(c+1) = crystallite_sizePostResults(crystID) ! size of results from cryst
|
||||
crystallite_postResults(c+1) = real(crystallite_sizePostResults(crystID),pReal) ! size of results from cryst
|
||||
c = c + 1_pInt
|
||||
|
||||
do o = 1,crystallite_Noutput(crystID)
|
||||
|
|
@ -3186,10 +3186,10 @@ function crystallite_postResults(&
|
|||
select case(crystallite_output(o,crystID))
|
||||
case ('phase')
|
||||
mySize = 1_pInt
|
||||
crystallite_postResults(c+1) = material_phase(g,i,e) ! phaseID of grain
|
||||
crystallite_postResults(c+1) = real(material_phase(g,i,e),pReal) ! phaseID of grain
|
||||
case ('texture')
|
||||
mySize = 1_pInt
|
||||
crystallite_postResults(c+1) = material_texture(g,i,e) ! textureID of grain
|
||||
crystallite_postResults(c+1) = real(material_texture(g,i,e),pReal) ! textureID of grain
|
||||
case ('volume')
|
||||
mySize = 1_pInt
|
||||
detF = math_det33(crystallite_partionedF(1:3,1:3,g,i,e)) ! V_current = det(F) * V_reference
|
||||
|
|
@ -3210,36 +3210,36 @@ function crystallite_postResults(&
|
|||
|
||||
case ('defgrad','f')
|
||||
mySize = 9_pInt
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_partionedF(1:3,1:3,g,i,e)),(/mySize/))
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_partionedF(1:3,1:3,g,i,e)),[mySize])
|
||||
case ('e')
|
||||
mySize = 9_pInt
|
||||
crystallite_postResults(c+1:c+mySize) = 0.5_pReal * reshape((math_mul33x33( &
|
||||
math_transpose33(crystallite_partionedF(1:3,1:3,g,i,e)), &
|
||||
crystallite_partionedF(1:3,1:3,g,i,e)) - math_I3),(/mySize/))
|
||||
crystallite_partionedF(1:3,1:3,g,i,e)) - math_I3),[mySize])
|
||||
case ('fe')
|
||||
mySize = 9_pInt
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_Fe(1:3,1:3,g,i,e)),(/mySize/))
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_Fe(1:3,1:3,g,i,e)),[mySize])
|
||||
case ('ee')
|
||||
Ee = 0.5_pReal * (math_mul33x33(math_transpose33(crystallite_Fe(1:3,1:3,g,i,e)), crystallite_Fe(1:3,1:3,g,i,e)) - math_I3)
|
||||
mySize = 9_pInt
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(Ee,(/mySize/))
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(Ee,[mySize])
|
||||
case ('fp')
|
||||
mySize = 9_pInt
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_Fp(1:3,1:3,g,i,e)),(/mySize/))
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_Fp(1:3,1:3,g,i,e)),[mySize])
|
||||
case ('lp')
|
||||
mySize = 9_pInt
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_Lp(1:3,1:3,g,i,e)),(/mySize/))
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_Lp(1:3,1:3,g,i,e)),[mySize])
|
||||
case ('p','firstpiola','1stpiola')
|
||||
mySize = 9_pInt
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_P(1:3,1:3,g,i,e)),(/mySize/))
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_transpose33(crystallite_P(1:3,1:3,g,i,e)),[mySize])
|
||||
case ('s','tstar','secondpiola','2ndpiola')
|
||||
mySize = 9_pInt
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_Mandel6to33(crystallite_Tstar_v(1:6,g,i,e)),(/mySize/))
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(math_Mandel6to33(crystallite_Tstar_v(1:6,g,i,e)),[mySize])
|
||||
end select
|
||||
c = c + mySize
|
||||
enddo
|
||||
|
||||
crystallite_postResults(c+1) = constitutive_sizePostResults(g,i,e) ! size of constitutive results
|
||||
crystallite_postResults(c+1) = real(constitutive_sizePostResults(g,i,e),pReal) ! size of constitutive results
|
||||
c = c + 1_pInt
|
||||
crystallite_postResults(c+1:c+constitutive_sizePostResults(g,i,e)) = constitutive_postResults(crystallite_Tstar_v(1:6,g,i,e), &
|
||||
crystallite_Fe, &
|
||||
|
|
|
|||
|
|
@ -562,7 +562,7 @@ subroutine materialpoint_postResults(dt)
|
|||
thePos = 0_pInt
|
||||
|
||||
theSize = homogenization_sizePostResults(i,e)
|
||||
materialpoint_results(thePos+1,i,e) = theSize ! tell size of homogenization results
|
||||
materialpoint_results(thePos+1,i,e) = real(theSize,pReal) ! tell size of homogenization results
|
||||
thePos = thePos + 1_pInt
|
||||
|
||||
if (theSize > 0_pInt) then ! any homogenization results to mention?
|
||||
|
|
@ -570,7 +570,7 @@ subroutine materialpoint_postResults(dt)
|
|||
thePos = thePos + theSize
|
||||
endif
|
||||
|
||||
materialpoint_results(thePos+1,i,e) = myNgrains ! tell number of grains at materialpoint
|
||||
materialpoint_results(thePos+1,i,e) = real(myNgrains,pReal) ! tell number of grains at materialpoint
|
||||
thePos = thePos + 1_pInt
|
||||
|
||||
do g = 1,myNgrains ! loop over all grains
|
||||
|
|
|
|||
|
|
@ -281,7 +281,7 @@ subroutine homogenization_RGC_partitionDeformation(&
|
|||
write(6,'(1x,a,i3,a,i3,a)')'========== Increment: ',theInc,' Cycle: ',cycleCounter,' =========='
|
||||
write(6,'(1x,a32)')'Overall deformation gradient: '
|
||||
do i = 1_pInt,3_pInt
|
||||
write(6,'(1x,3(e14.8,1x))')(avgF(i,j), j = 1_pInt,3_pInt)
|
||||
write(6,'(1x,3(e15.8,1x))')(avgF(i,j), j = 1_pInt,3_pInt)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
call flush(6)
|
||||
|
|
@ -307,7 +307,7 @@ subroutine homogenization_RGC_partitionDeformation(&
|
|||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain
|
||||
do i = 1_pInt,3_pInt
|
||||
write(6,'(1x,3(e14.8,1x))')(F(i,j,iGrain), j = 1_pInt,3_pInt)
|
||||
write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1_pInt,3_pInt)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
call flush(6)
|
||||
|
|
@ -394,7 +394,7 @@ function homogenization_RGC_updateState(&
|
|||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a30)')'Obtained state: '
|
||||
do i = 1,3*nIntFaceTot
|
||||
write(6,'(1x,2(e14.8,1x))')state%p(i)
|
||||
write(6,'(1x,2(e15.8,1x))')state%p(i)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
!$OMP END CRITICAL (write2out)
|
||||
|
|
@ -410,11 +410,11 @@ function homogenization_RGC_updateState(&
|
|||
if (debug_verbosity == 4) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
do iGrain = 1,nGrain
|
||||
write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e14.8))')'Mismatch magnitude of grain(',iGrain,') :',NN(1,iGrain),NN(2,iGrain),NN(3,iGrain)
|
||||
write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e15.8))')'Mismatch magnitude of grain(',iGrain,') :',NN(1,iGrain),NN(2,iGrain),NN(3,iGrain)
|
||||
write(6,*)' '
|
||||
write(6,'(1x,a30,1x,i3)')'Stress and penalties of grain: ',iGrain
|
||||
do i = 1,3
|
||||
write(6,'(1x,3(e14.8,1x),1x,3(e14.8,1x),1x,3(e14.8,1x))')(P(i,j,iGrain), j = 1,3), &
|
||||
write(6,'(1x,3(e15.8,1x),1x,3(e15.8,1x),1x,3(e15.8,1x))')(P(i,j,iGrain), j = 1,3), &
|
||||
(R(i,j,iGrain), j = 1,3), &
|
||||
(D(i,j,iGrain), j = 1,3)
|
||||
enddo
|
||||
|
|
@ -459,7 +459,7 @@ function homogenization_RGC_updateState(&
|
|||
if (debug_verbosity == 4) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum
|
||||
write(6,'(1x,3(e14.8,1x))')(tract(iNum,j), j = 1,3)
|
||||
write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1,3)
|
||||
write(6,*)' '
|
||||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
|
|
@ -478,9 +478,9 @@ function homogenization_RGC_updateState(&
|
|||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a)')' '
|
||||
write(6,'(1x,a,1x,i2,1x,i4)')'RGC residual check ...',ip,el
|
||||
write(6,'(1x,a15,1x,e14.8,1x,a7,i3,1x,a12,i2,i2)')'Max stress: ',stresMax, &
|
||||
write(6,'(1x,a15,1x,e15.8,1x,a7,i3,1x,a12,i2,i2)')'Max stress: ',stresMax, &
|
||||
'@ grain',stresLoc(3),'in component',stresLoc(1),stresLoc(2)
|
||||
write(6,'(1x,a15,1x,e14.8,1x,a7,i3,1x,a12,i2)')'Max residual: ',residMax, &
|
||||
write(6,'(1x,a15,1x,e15.8,1x,a7,i3,1x,a12,i2)')'Max residual: ',residMax, &
|
||||
'@ iface',residLoc(1),'in direction',residLoc(2)
|
||||
call flush(6)
|
||||
!$OMP END CRITICAL (write2out)
|
||||
|
|
@ -523,15 +523,15 @@ function homogenization_RGC_updateState(&
|
|||
|
||||
if (debug_verbosity == 4 .and. debug_e == el .and. debug_i == ip) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a30,1x,e14.8)')'Constitutive work: ',constitutiveWork
|
||||
write(6,'(1x,a30,3(1x,e14.8))')'Magnitude mismatch: ',sum(NN(1,:))/dble(nGrain), &
|
||||
write(6,'(1x,a30,1x,e15.8)')'Constitutive work: ',constitutiveWork
|
||||
write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',sum(NN(1,:))/dble(nGrain), &
|
||||
sum(NN(2,:))/dble(nGrain), &
|
||||
sum(NN(3,:))/dble(nGrain)
|
||||
write(6,'(1x,a30,1x,e14.8)')'Penalty energy: ',penaltyEnergy
|
||||
write(6,'(1x,a30,1x,e14.8)')'Volume discrepancy: ',volDiscrep
|
||||
write(6,'(1x,a30,1x,e15.8)')'Penalty energy: ',penaltyEnergy
|
||||
write(6,'(1x,a30,1x,e15.8)')'Volume discrepancy: ',volDiscrep
|
||||
write(6,*)''
|
||||
write(6,'(1x,a30,1x,e14.8)')'Maximum relaxation rate: ',maxval(abs(drelax))/dt
|
||||
write(6,'(1x,a30,1x,e14.8)')'Average relaxation rate: ',sum(abs(drelax))/dt/dble(3*nIntFaceTot)
|
||||
write(6,'(1x,a30,1x,e15.8)')'Maximum relaxation rate: ',maxval(abs(drelax))/dt
|
||||
write(6,'(1x,a30,1x,e15.8)')'Average relaxation rate: ',sum(abs(drelax))/dt/dble(3*nIntFaceTot)
|
||||
write(6,*)''
|
||||
call flush(6)
|
||||
!$OMP END CRITICAL (write2out)
|
||||
|
|
@ -619,7 +619,7 @@ function homogenization_RGC_updateState(&
|
|||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a30)')'Jacobian matrix of stress'
|
||||
do i = 1,3*nIntFaceTot
|
||||
write(6,'(1x,100(e10.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
call flush(6)
|
||||
|
|
@ -675,7 +675,7 @@ function homogenization_RGC_updateState(&
|
|||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a30)')'Jacobian matrix of penalty'
|
||||
do i = 1,3*nIntFaceTot
|
||||
write(6,'(1x,100(e10.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
call flush(6)
|
||||
|
|
@ -695,7 +695,7 @@ function homogenization_RGC_updateState(&
|
|||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a30)')'Jacobian matrix of penalty'
|
||||
do i = 1,3*nIntFaceTot
|
||||
write(6,'(1x,100(e10.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
call flush(6)
|
||||
|
|
@ -709,7 +709,7 @@ function homogenization_RGC_updateState(&
|
|||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a30)')'Jacobian matrix (total)'
|
||||
do i = 1,3*nIntFaceTot
|
||||
write(6,'(1x,100(e10.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
call flush(6)
|
||||
|
|
@ -728,7 +728,7 @@ function homogenization_RGC_updateState(&
|
|||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a30)')'Jacobian inverse'
|
||||
do i = 1,3*nIntFaceTot
|
||||
write(6,'(1x,100(e10.4,1x))')(jnverse(i,j), j = 1_pInt,3_pInt*nIntFaceTot)
|
||||
write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1_pInt,3_pInt*nIntFaceTot)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
call flush(6)
|
||||
|
|
@ -748,7 +748,7 @@ function homogenization_RGC_updateState(&
|
|||
homogenization_RGC_updateState = (/.true.,.false./)
|
||||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a,1x,i3,1x,a,1x,i3,1x,a)')'RGC_updateState: ip',ip,'| el',el,'enforces cutback'
|
||||
write(6,'(1x,a,1x,e14.8)')'due to large relaxation change =',maxval(abs(drelax))
|
||||
write(6,'(1x,a,1x,e15.8)')'due to large relaxation change =',maxval(abs(drelax))
|
||||
call flush(6)
|
||||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
|
|
@ -758,7 +758,7 @@ function homogenization_RGC_updateState(&
|
|||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(1x,a30)')'Returned state: '
|
||||
do i = 1,3*nIntFaceTot
|
||||
write(6,'(1x,2(e14.8,1x))')state%p(i)
|
||||
write(6,'(1x,2(e15.8,1x))')state%p(i)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
call flush(6)
|
||||
|
|
@ -810,7 +810,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(&
|
|||
dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain))
|
||||
write(6,'(1x,a30,1x,i3)')'Stress tangent of grain: ',iGrain
|
||||
do i = 1,9
|
||||
write(6,'(1x,(e14.8,1x))') (dPdF99(i,j), j = 1,9)
|
||||
write(6,'(1x,(e15.8,1x))') (dPdF99(i,j), j = 1,9)
|
||||
enddo
|
||||
write(6,*)' '
|
||||
enddo
|
||||
|
|
@ -955,7 +955,7 @@ subroutine homogenization_RGC_stressPenalty(&
|
|||
!* Debugging the surface correction factor
|
||||
! if (ip == 1 .and. el == 1) then
|
||||
! write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el
|
||||
! write(6,'(1x,3(e10.4,1x))')(surfCorr(i), i = 1,3)
|
||||
! write(6,'(1x,3(e11.4,1x))')(surfCorr(i), i = 1,3)
|
||||
! endif
|
||||
|
||||
!* -------------------------------------------------------------------------------------------------------------
|
||||
|
|
@ -1005,9 +1005,9 @@ subroutine homogenization_RGC_stressPenalty(&
|
|||
! if (ip == 1 .and. el == 1) then
|
||||
! write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb
|
||||
! do i = 1,3
|
||||
! write(6,'(1x,3(e10.4,1x))')(nDef(i,j), j = 1,3)
|
||||
! write(6,'(1x,3(e11.4,1x))')(nDef(i,j), j = 1,3)
|
||||
! enddo
|
||||
! write(6,'(1x,a20,e10.4))')'with magnitude: ',nDefNorm
|
||||
! write(6,'(1x,a20,e11.4))')'with magnitude: ',nDefNorm
|
||||
! endif
|
||||
|
||||
!* Compute the stress penalty of all interfaces
|
||||
|
|
@ -1030,7 +1030,7 @@ subroutine homogenization_RGC_stressPenalty(&
|
|||
! if (ip == 1 .and. el == 1) then
|
||||
! write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain
|
||||
! do i = 1,3
|
||||
! write(6,'(1x,3(e10.4,1x))')(rPen(i,j,iGrain), j = 1,3)
|
||||
! write(6,'(1x,3(e11.4,1x))')(rPen(i,j,iGrain), j = 1,3)
|
||||
! enddo
|
||||
! endif
|
||||
|
||||
|
|
@ -1090,7 +1090,7 @@ subroutine homogenization_RGC_volumePenalty(&
|
|||
! if (ip == 1 .and. el == 1) then
|
||||
! write(6,'(1x,a30,i2)')'Volume penalty of grain: ',iGrain
|
||||
! do i = 1,3
|
||||
! write(6,'(1x,3(e10.4,1x))')(vPen(i,j,iGrain), j = 1,3)
|
||||
! write(6,'(1x,3(e11.4,1x))')(vPen(i,j,iGrain), j = 1,3)
|
||||
! enddo
|
||||
! endif
|
||||
|
||||
|
|
@ -1230,16 +1230,16 @@ function homogenization_RGC_interfaceNormal(&
|
|||
|
||||
!* Get the normal of the interface, identified from the value of intFace(1)
|
||||
homogenization_RGC_interfaceNormal = 0.0_pReal
|
||||
nPos = abs(intFace(1)) ! identify the position of the interface in global state array
|
||||
homogenization_RGC_interfaceNormal(nPos) = intFace(1)/abs(intFace(1)) ! get the normal vector w.r.t. cluster axis
|
||||
nPos = abs(intFace(1)) ! identify the position of the interface in global state array
|
||||
homogenization_RGC_interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis
|
||||
|
||||
homogenization_RGC_interfaceNormal = &
|
||||
math_mul33x3(homogenization_RGC_orientation(:,:,ip,el),homogenization_RGC_interfaceNormal)
|
||||
! map the normal vector into sample coordinate system (basis)
|
||||
! map the normal vector into sample coordinate system (basis)
|
||||
|
||||
! if (ip == 1 .and. el == 1) then
|
||||
! write(6,'(1x,a32,3(1x,i3))')'Interface normal: ',intFace(1)
|
||||
! write(6,'(1x,3(e14.8,1x))')(nVect(i), i = 1,3)
|
||||
! write(6,'(1x,3(e15.8,1x))')(nVect(i), i = 1,3)
|
||||
! write(6,*)' '
|
||||
! call flush(6)
|
||||
! endif
|
||||
|
|
|
|||
227
code/kdtree2.f90
227
code/kdtree2.f90
|
|
@ -64,7 +64,7 @@ module kdtree2_priority_queue_module
|
|||
! There are heap_size active elements.
|
||||
! Assumes the allocation is always sufficient. Will NOT increase it
|
||||
! to match.
|
||||
integer(pInt) :: heap_size = 0
|
||||
integer(pInt) :: heap_size = 0_pInt
|
||||
type(kdtree2_result), pointer :: elems(:)
|
||||
end type pq
|
||||
|
||||
|
|
@ -97,14 +97,14 @@ contains
|
|||
type(pq) :: res
|
||||
!
|
||||
!
|
||||
integer(pInt) :: nalloc
|
||||
integer :: nalloc
|
||||
|
||||
nalloc = size(results_in,1)
|
||||
if (nalloc .lt. 1) then
|
||||
write (*,*) 'PQ_CREATE: error, input arrays must be allocated.'
|
||||
end if
|
||||
res%elems => results_in
|
||||
res%heap_size = 0
|
||||
res%heap_size = 0_pInt
|
||||
return
|
||||
end function pq_create
|
||||
|
||||
|
|
@ -160,8 +160,8 @@ contains
|
|||
i = i_in
|
||||
|
||||
bigloop: do
|
||||
l = 2*i ! left(i)
|
||||
r = l+1 ! right(i)
|
||||
l = 2_pInt*i ! left(i)
|
||||
r = l+1_pInt ! right(i)
|
||||
!
|
||||
! set 'largest' to the index of either i, l, r
|
||||
! depending on whose priority is largest.
|
||||
|
|
@ -296,11 +296,11 @@ bigloop: do
|
|||
! write (*,*) 'PQ_INSERT: error, attempt made to insert element on full PQ'
|
||||
! stop
|
||||
! else
|
||||
a%heap_size = a%heap_size + 1
|
||||
a%heap_size = a%heap_size + 1_pInt
|
||||
i = a%heap_size
|
||||
|
||||
do while (i .gt. 1)
|
||||
isparent = int(i/2)
|
||||
isparent = int(i/2_pInt, pInt) !needed casting?
|
||||
parentdis = a%elems(isparent)%dis
|
||||
if (dis .gt. parentdis) then
|
||||
! move what was in i's parent into i.
|
||||
|
|
@ -339,13 +339,13 @@ bigloop: do
|
|||
e = a%elems(i)
|
||||
|
||||
parent = i
|
||||
child = 2*i
|
||||
child = 2_pInt*i
|
||||
N = a%heap_size
|
||||
|
||||
do while (child .le. N)
|
||||
if (child .lt. N) then
|
||||
if (a%elems(child)%dis .lt. a%elems(child+1)%dis) then
|
||||
child = child+1
|
||||
child = child+1_pInt
|
||||
endif
|
||||
endif
|
||||
prichild = a%elems(child)%dis
|
||||
|
|
@ -355,7 +355,7 @@ bigloop: do
|
|||
! move child into parent.
|
||||
a%elems(parent) = a%elems(child)
|
||||
parent = child
|
||||
child = 2*parent
|
||||
child = 2_pInt*parent
|
||||
end if
|
||||
end do
|
||||
a%elems(parent) = e
|
||||
|
|
@ -384,8 +384,8 @@ bigloop: do
|
|||
if (.true.) then
|
||||
N=a%heap_size
|
||||
if (N .ge. 1) then
|
||||
parent =1
|
||||
child=2
|
||||
parent =1_pInt
|
||||
child=2_pInt
|
||||
|
||||
loop: do while (child .le. N)
|
||||
prichild = a%elems(child)%dis
|
||||
|
|
@ -396,9 +396,9 @@ bigloop: do
|
|||
!
|
||||
|
||||
if (child .lt. N) then
|
||||
prichildp1 = a%elems(child+1)%dis
|
||||
prichildp1 = a%elems(child+1_pInt)%dis
|
||||
if (prichild .lt. prichildp1) then
|
||||
child = child+1
|
||||
child = child+1_pInt
|
||||
prichild = prichildp1
|
||||
endif
|
||||
endif
|
||||
|
|
@ -411,7 +411,7 @@ bigloop: do
|
|||
! move child into parent.
|
||||
a%elems(parent) = a%elems(child)
|
||||
parent = child
|
||||
child = 2*parent
|
||||
child = 2_pInt*parent
|
||||
end if
|
||||
end do loop
|
||||
a%elems(parent)%dis = dis
|
||||
|
|
@ -449,7 +449,7 @@ bigloop: do
|
|||
! swap the item to be deleted with the last element
|
||||
! and shorten heap by one.
|
||||
a%elems(i) = a%elems(a%heap_size)
|
||||
a%heap_size = a%heap_size - 1
|
||||
a%heap_size = a%heap_size - 1_pInt
|
||||
|
||||
call heapify(a,i)
|
||||
|
||||
|
|
@ -469,10 +469,10 @@ module kdtree2_module
|
|||
! This module is identical to 'kd_tree', except that the order
|
||||
! of subscripts is reversed in the data file.
|
||||
! In otherwords for an embedding of N D-dimensional vectors, the
|
||||
! data file is here, in natural Fortran order data(1:D, 1:N)
|
||||
! data file is here, in natural Fortran order myData(1:D, 1:N)
|
||||
! because Fortran lays out columns first,
|
||||
!
|
||||
! whereas conventionally (C-style) it is data(1:N,1:D)
|
||||
! whereas conventionally (C-style) it is myData(1:N,1:D)
|
||||
! as in the original kd_tree module.
|
||||
!
|
||||
!-------------DATA TYPE, CREATION, DELETION---------------------
|
||||
|
|
@ -498,7 +498,7 @@ module kdtree2_module
|
|||
!----------------------------------------------------------------
|
||||
|
||||
|
||||
integer(pInt), parameter :: bucket_size = 12
|
||||
integer(pInt), parameter :: bucket_size = 12_pInt
|
||||
! The maximum number of points to keep in a terminal node.
|
||||
|
||||
type interval
|
||||
|
|
@ -525,7 +525,7 @@ module kdtree2_module
|
|||
|
||||
type :: kdtree2
|
||||
! Global information about the tree, one per tree
|
||||
integer(pInt) :: dimen=0, n=0
|
||||
integer(pInt) :: dimen=0_pInt, n=0_pInt
|
||||
! dimensionality and total # of points
|
||||
real(pReal), pointer :: the_data(:,:) => null()
|
||||
! pointer to the actual data array
|
||||
|
|
@ -570,7 +570,7 @@ module kdtree2_module
|
|||
integer(pInt) :: dimen
|
||||
integer(pInt) :: nn, nfound
|
||||
real(pReal) :: ballsize
|
||||
integer(pInt) :: centeridx=999, correltime=9999
|
||||
integer(pInt) :: centeridx=999_pInt, correltime=9999_pInt
|
||||
! exclude points within 'correltime' of 'centeridx', iff centeridx >= 0
|
||||
integer(pInt) :: nalloc ! how much allocated for results(:)?
|
||||
logical :: rearrange ! are the data rearranged or original?
|
||||
|
|
@ -579,7 +579,7 @@ module kdtree2_module
|
|||
real(pReal), pointer :: qv(:) ! query vector
|
||||
type(kdtree2_result), pointer :: results(:) ! results
|
||||
type(pq) :: pq
|
||||
real(pReal), pointer :: data(:,:) ! temp pointer to data
|
||||
real(pReal), pointer :: myData(:,:) ! temp pointer to data
|
||||
integer(pInt), pointer :: ind(:) ! temp pointer to indexes
|
||||
end type tree_search_record
|
||||
|
||||
|
|
@ -590,7 +590,7 @@ module kdtree2_module
|
|||
|
||||
contains
|
||||
|
||||
function kdtree2_create(input_data,dim,sort,rearrange) result (mr)
|
||||
function kdtree2_create(input_data,myDim,sort,rearrange) result (mr)
|
||||
!
|
||||
! create the actual tree structure, given an input array of data.
|
||||
!
|
||||
|
|
@ -598,9 +598,9 @@ contains
|
|||
! THIS IS THE REVERSE OF THE PREVIOUS VERSION OF THIS MODULE.
|
||||
! The reason for it is cache friendliness, improving performance.
|
||||
!
|
||||
! Optional arguments: If 'dim' is specified, then the tree
|
||||
! will only search the first 'dim' components
|
||||
! of input_data, otherwise, dim is inferred
|
||||
! Optional arguments: If 'myDim' is specified, then the tree
|
||||
! will only search the first 'myDim' components
|
||||
! of input_data, otherwise, myDim is inferred
|
||||
! from SIZE(input_data,1).
|
||||
!
|
||||
! if sort .eqv. .true. then output results
|
||||
|
|
@ -615,7 +615,7 @@ contains
|
|||
!
|
||||
! .. Function Return Cut_value ..
|
||||
type (kdtree2), pointer :: mr
|
||||
integer(pInt), intent(in), optional :: dim
|
||||
integer(pInt), intent(in), optional :: myDim
|
||||
logical, intent(in), optional :: sort
|
||||
logical, intent(in), optional :: rearrange
|
||||
! ..
|
||||
|
|
@ -628,19 +628,19 @@ contains
|
|||
mr%the_data => input_data
|
||||
! pointer assignment
|
||||
|
||||
if (present(dim)) then
|
||||
mr%dimen = dim
|
||||
if (present(myDim)) then
|
||||
mr%dimen = myDim
|
||||
else
|
||||
mr%dimen = size(input_data,1)
|
||||
mr%dimen = int(size(input_data,1), pInt) ! size returns default integer
|
||||
end if
|
||||
mr%n = size(input_data,2)
|
||||
mr%n = int(size(input_data,2), pInt) ! size returns default integer
|
||||
|
||||
if (mr%dimen > mr%n) then
|
||||
! unlikely to be correct
|
||||
write (*,*) 'KD_TREE_TRANS: likely user error.'
|
||||
write (*,*) 'KD_TREE_TRANS: You passed in matrix with D=',mr%dimen
|
||||
write (*,*) 'KD_TREE_TRANS: and N=',mr%n
|
||||
write (*,*) 'KD_TREE_TRANS: note, that new format is data(1:D,1:N)'
|
||||
write (*,*) 'KD_TREE_TRANS: note, that new format is myData(1:D,1:N)'
|
||||
write (*,*) 'KD_TREE_TRANS: with usually N >> D. If N =approx= D, then a k-d tree'
|
||||
write (*,*) 'KD_TREE_TRANS: is not an appropriate data structure.'
|
||||
stop
|
||||
|
|
@ -662,7 +662,7 @@ contains
|
|||
|
||||
if (mr%rearrange) then
|
||||
allocate(mr%rearranged_data(mr%dimen,mr%n))
|
||||
do i=1,mr%n
|
||||
do i=1_pInt,mr%n
|
||||
mr%rearranged_data(:,i) = mr%the_data(:, &
|
||||
mr%ind(i))
|
||||
enddo
|
||||
|
|
@ -679,7 +679,7 @@ contains
|
|||
type(tree_node), pointer :: dummy => null()
|
||||
! ..
|
||||
allocate (tp%ind(tp%n))
|
||||
forall (j=1:tp%n)
|
||||
forall (j=1_pInt:tp%n)
|
||||
tp%ind(j) = j
|
||||
end forall
|
||||
tp%root => build_tree_for_range(tp,1_pInt,tp%n, dummy)
|
||||
|
|
@ -729,10 +729,10 @@ contains
|
|||
!
|
||||
! always compute true bounding box for terminal nodes.
|
||||
!
|
||||
do i=1,dimen
|
||||
do i=1_pInt,dimen
|
||||
call spread_in_coordinate(tp,i,l,u,res%box(i))
|
||||
end do
|
||||
res%cut_dim = 0
|
||||
res%cut_dim = 0_pInt
|
||||
res%cut_val = 0.0_pReal
|
||||
res%l = l
|
||||
res%u = u
|
||||
|
|
@ -764,7 +764,7 @@ contains
|
|||
end do
|
||||
|
||||
|
||||
c = maxloc(res%box(1:dimen)%upper-res%box(1:dimen)%lower,1)
|
||||
c = int(maxloc(res%box(1:dimen)%upper-res%box(1:dimen)%lower,1), pInt)
|
||||
!
|
||||
! c is the identity of which coordinate has the greatest spread.
|
||||
!
|
||||
|
|
@ -867,11 +867,11 @@ contains
|
|||
do while (lb < rb)
|
||||
if ( v(c,ind(lb)) <= alpha ) then
|
||||
! it is good where it is.
|
||||
lb = lb+1
|
||||
lb = lb+1_pInt
|
||||
else
|
||||
! swap it with rb.
|
||||
tmp = ind(lb); ind(lb) = ind(rb); ind(rb) = tmp
|
||||
rb = rb-1
|
||||
rb = rb-1_pInt
|
||||
endif
|
||||
end do
|
||||
|
||||
|
|
@ -879,7 +879,7 @@ contains
|
|||
if (v(c,ind(lb)) <= alpha) then
|
||||
res = lb
|
||||
else
|
||||
res = lb-1
|
||||
res = lb-1_pInt
|
||||
endif
|
||||
|
||||
end function select_on_coordinate_value
|
||||
|
|
@ -901,9 +901,9 @@ contains
|
|||
do while (l<u)
|
||||
t = ind(l)
|
||||
m = l
|
||||
do i = l + 1, u
|
||||
do i = l + 1_pInt, u
|
||||
if (v(c,ind(i))<v(c,t)) then
|
||||
m = m + 1
|
||||
m = m + 1_pInt
|
||||
s = ind(m)
|
||||
ind(m) = ind(i)
|
||||
ind(i) = s
|
||||
|
|
@ -912,8 +912,8 @@ contains
|
|||
s = ind(l)
|
||||
ind(l) = ind(m)
|
||||
ind(m) = s
|
||||
if (m<=k) l = m + 1
|
||||
if (m>=k) u = m - 1
|
||||
if (m<=k) l = m + 1_pInt
|
||||
if (m>=k) u = m - 1_pInt
|
||||
end do
|
||||
end subroutine select_on_coordinate
|
||||
|
||||
|
|
@ -944,8 +944,8 @@ contains
|
|||
|
||||
ulocal = u
|
||||
|
||||
do i = l + 2, ulocal, 2
|
||||
lmin = v(c,ind(i-1))
|
||||
do i = l + 2_pInt, ulocal, 2_pInt
|
||||
lmin = v(c,ind(i-1_pInt))
|
||||
lmax = v(c,ind(i))
|
||||
if (lmin>lmax) then
|
||||
t = lmin
|
||||
|
|
@ -1022,9 +1022,9 @@ contains
|
|||
sr%ballsize = huge(1.0_pReal)
|
||||
sr%qv => qv
|
||||
sr%nn = nn
|
||||
sr%nfound = 0
|
||||
sr%centeridx = -1
|
||||
sr%correltime = 0
|
||||
sr%nfound = 0_pInt
|
||||
sr%centeridx = -1_pInt
|
||||
sr%correltime = 0_pInt
|
||||
sr%overflow = .false.
|
||||
|
||||
sr%results => results
|
||||
|
|
@ -1034,9 +1034,9 @@ contains
|
|||
sr%ind => tp%ind
|
||||
sr%rearrange = tp%rearrange
|
||||
if (tp%rearrange) then
|
||||
sr%Data => tp%rearranged_data
|
||||
sr%myData => tp%rearranged_data
|
||||
else
|
||||
sr%Data => tp%the_data
|
||||
sr%myData => tp%the_data
|
||||
endif
|
||||
sr%dimen = tp%dimen
|
||||
|
||||
|
|
@ -1067,7 +1067,7 @@ contains
|
|||
sr%correltime = correltime
|
||||
|
||||
sr%nn = nn
|
||||
sr%nfound = 0
|
||||
sr%nfound = 0_pInt
|
||||
|
||||
sr%dimen = tp%dimen
|
||||
sr%nalloc = nn
|
||||
|
|
@ -1078,9 +1078,9 @@ contains
|
|||
sr%rearrange = tp%rearrange
|
||||
|
||||
if (sr%rearrange) then
|
||||
sr%Data => tp%rearranged_data
|
||||
sr%myData => tp%rearranged_data
|
||||
else
|
||||
sr%Data => tp%the_data
|
||||
sr%myData => tp%the_data
|
||||
endif
|
||||
|
||||
call validate_query_storage(nn)
|
||||
|
|
@ -1116,10 +1116,10 @@ contains
|
|||
!
|
||||
sr%qv => qv
|
||||
sr%ballsize = r2
|
||||
sr%nn = 0 ! flag for fixed ball search
|
||||
sr%nfound = 0
|
||||
sr%centeridx = -1
|
||||
sr%correltime = 0
|
||||
sr%nn = 0_pInt ! flag for fixed ball search
|
||||
sr%nfound = 0_pInt
|
||||
sr%centeridx = -1_pInt
|
||||
sr%correltime = 0_pInt
|
||||
|
||||
sr%results => results
|
||||
|
||||
|
|
@ -1130,9 +1130,9 @@ contains
|
|||
sr%rearrange= tp%rearrange
|
||||
|
||||
if (tp%rearrange) then
|
||||
sr%Data => tp%rearranged_data
|
||||
sr%myData => tp%rearranged_data
|
||||
else
|
||||
sr%Data => tp%the_data
|
||||
sr%myData => tp%the_data
|
||||
endif
|
||||
sr%dimen = tp%dimen
|
||||
|
||||
|
|
@ -1176,8 +1176,8 @@ contains
|
|||
allocate (sr%qv(tp%dimen))
|
||||
sr%qv = tp%the_data(:,idxin) ! copy the vector
|
||||
sr%ballsize = r2
|
||||
sr%nn = 0 ! flag for fixed r search
|
||||
sr%nfound = 0
|
||||
sr%nn = 0_pInt ! flag for fixed r search
|
||||
sr%nfound = 0_pInt
|
||||
sr%centeridx = idxin
|
||||
sr%correltime = correltime
|
||||
|
||||
|
|
@ -1195,9 +1195,9 @@ contains
|
|||
sr%rearrange = tp%rearrange
|
||||
|
||||
if (tp%rearrange) then
|
||||
sr%Data => tp%rearranged_data
|
||||
sr%myData => tp%rearranged_data
|
||||
else
|
||||
sr%Data => tp%the_data
|
||||
sr%myData => tp%the_data
|
||||
endif
|
||||
sr%rearrange = tp%rearrange
|
||||
sr%dimen = tp%dimen
|
||||
|
|
@ -1236,21 +1236,21 @@ contains
|
|||
sr%qv => qv
|
||||
sr%ballsize = r2
|
||||
|
||||
sr%nn = 0 ! flag for fixed r search
|
||||
sr%nfound = 0
|
||||
sr%centeridx = -1
|
||||
sr%correltime = 0
|
||||
sr%nn = 0_pInt ! flag for fixed r search
|
||||
sr%nfound = 0_pInt
|
||||
sr%centeridx = -1_pInt
|
||||
sr%correltime = 0_pInt
|
||||
|
||||
nullify(sr%results) ! for some reason, FTN 95 chokes on '=> null()'
|
||||
|
||||
sr%nalloc = 0 ! we do not allocate any storage but that's OK
|
||||
sr%nalloc = 0_pInt ! we do not allocate any storage but that's OK
|
||||
! for counting.
|
||||
sr%ind => tp%ind
|
||||
sr%rearrange = tp%rearrange
|
||||
if (tp%rearrange) then
|
||||
sr%Data => tp%rearranged_data
|
||||
sr%myData => tp%rearranged_data
|
||||
else
|
||||
sr%Data => tp%the_data
|
||||
sr%myData => tp%the_data
|
||||
endif
|
||||
sr%dimen = tp%dimen
|
||||
|
||||
|
|
@ -1285,22 +1285,22 @@ contains
|
|||
sr%qv = tp%the_data(:,idxin)
|
||||
sr%ballsize = r2
|
||||
|
||||
sr%nn = 0 ! flag for fixed r search
|
||||
sr%nfound = 0
|
||||
sr%nn = 0_pInt ! flag for fixed r search
|
||||
sr%nfound = 0_pInt
|
||||
sr%centeridx = idxin
|
||||
sr%correltime = correltime
|
||||
nullify(sr%results)
|
||||
|
||||
sr%nalloc = 0 ! we do not allocate any storage but that's OK
|
||||
sr%nalloc = 0_pInt ! we do not allocate any storage but that's OK
|
||||
! for counting.
|
||||
|
||||
sr%ind => tp%ind
|
||||
sr%rearrange = tp%rearrange
|
||||
|
||||
if (sr%rearrange) then
|
||||
sr%Data => tp%rearranged_data
|
||||
sr%myData => tp%rearranged_data
|
||||
else
|
||||
sr%Data => tp%the_data
|
||||
sr%myData => tp%the_data
|
||||
endif
|
||||
sr%dimen = tp%dimen
|
||||
|
||||
|
|
@ -1324,7 +1324,7 @@ contains
|
|||
!
|
||||
integer(pInt), intent(in) :: n
|
||||
|
||||
if (size(sr%results,1) .lt. n) then
|
||||
if (int(size(sr%results,1),pInt) .lt. n) then
|
||||
write (*,*) 'KD_TREE_TRANS: you did not provide enough storage for results(1:n)'
|
||||
stop
|
||||
return
|
||||
|
|
@ -1408,7 +1408,7 @@ contains
|
|||
! check will also be false.
|
||||
!
|
||||
box => node%box(1:)
|
||||
do i=1,sr%dimen
|
||||
do i=1_pInt,sr%dimen
|
||||
if (i .ne. cut_dim) then
|
||||
dis = dis + dis2_from_bnd(qv(i),box(i)%lower,box(i)%upper)
|
||||
if (dis > ballsize) then
|
||||
|
|
@ -1486,7 +1486,7 @@ contains
|
|||
!
|
||||
real(pReal), pointer :: qv(:)
|
||||
integer(pInt), pointer :: ind(:)
|
||||
real(pReal), pointer :: data(:,:)
|
||||
real(pReal), pointer :: myData(:,:)
|
||||
!
|
||||
integer(pInt) :: dimen, i, indexofi, k, centeridx, correltime
|
||||
real(pReal) :: ballsize, sd, newpri
|
||||
|
|
@ -1505,7 +1505,7 @@ contains
|
|||
ballsize = sr%ballsize
|
||||
rearrange = sr%rearrange
|
||||
ind => sr%ind(1:)
|
||||
data => sr%Data(1:,1:)
|
||||
myData => sr%myData(1:,1:)
|
||||
centeridx = sr%centeridx
|
||||
correltime = sr%correltime
|
||||
|
||||
|
|
@ -1517,7 +1517,7 @@ contains
|
|||
if (rearrange) then
|
||||
sd = 0.0_pReal
|
||||
do k = 1_pInt,dimen
|
||||
sd = sd + (data(k,i) - qv(k))**2.0_pReal
|
||||
sd = sd + (myData(k,i) - qv(k))**2.0_pReal
|
||||
if (sd>ballsize) cycle mainloop
|
||||
end do
|
||||
indexofi = ind(i) ! only read it if we have not broken out
|
||||
|
|
@ -1525,7 +1525,7 @@ contains
|
|||
indexofi = ind(i)
|
||||
sd = 0.0_pReal
|
||||
do k = 1_pInt,dimen
|
||||
sd = sd + (data(k,indexofi) - qv(k))**2.0_pReal
|
||||
sd = sd + (myData(k,indexofi) - qv(k))**2.0_pReal
|
||||
if (sd>ballsize) cycle mainloop
|
||||
end do
|
||||
endif
|
||||
|
|
@ -1557,7 +1557,7 @@ contains
|
|||
!
|
||||
! add this point unconditionally to fill list.
|
||||
!
|
||||
sr%nfound = sr%nfound +1
|
||||
sr%nfound = sr%nfound +1_pInt
|
||||
newpri = pq_insert(pqp,sd,indexofi)
|
||||
if (sr%nfound .eq. sr%nn) ballsize = newpri
|
||||
! we have just filled the working list.
|
||||
|
|
@ -1592,7 +1592,7 @@ contains
|
|||
!
|
||||
real(pReal), pointer :: qv(:)
|
||||
integer(pInt), pointer :: ind(:)
|
||||
real(pReal), pointer :: data(:,:)
|
||||
real(pReal), pointer :: myData(:,:)
|
||||
!
|
||||
integer(pInt) :: nfound
|
||||
integer(pInt) :: dimen, i, indexofi, k
|
||||
|
|
@ -1608,7 +1608,7 @@ contains
|
|||
ballsize = sr%ballsize
|
||||
rearrange = sr%rearrange
|
||||
ind => sr%ind(1:)
|
||||
data => sr%Data(1:,1:)
|
||||
myData => sr%myData(1:,1:)
|
||||
centeridx = sr%centeridx
|
||||
correltime = sr%correltime
|
||||
nn = sr%nn ! number to search for
|
||||
|
|
@ -1640,7 +1640,7 @@ contains
|
|||
if (rearrange) then
|
||||
sd = 0.0_pReal
|
||||
do k = 1_pInt,dimen
|
||||
sd = sd + (data(k,i) - qv(k))**2.0_pReal
|
||||
sd = sd + (myData(k,i) - qv(k))**2.0_pReal
|
||||
if (sd>ballsize) cycle mainloop
|
||||
end do
|
||||
indexofi = ind(i) ! only read it if we have not broken out
|
||||
|
|
@ -1648,7 +1648,7 @@ contains
|
|||
indexofi = ind(i)
|
||||
sd = 0.0_pReal
|
||||
do k = 1_pInt,dimen
|
||||
sd = sd + (data(k,indexofi) - qv(k))**2.0_pReal
|
||||
sd = sd + (myData(k,indexofi) - qv(k))**2.0_pReal
|
||||
if (sd>ballsize) cycle mainloop
|
||||
end do
|
||||
endif
|
||||
|
|
@ -1698,12 +1698,12 @@ contains
|
|||
do i = 1_pInt, tp%n
|
||||
if (all_distances(i)<results(nn)%dis) then
|
||||
! insert it somewhere on the list
|
||||
do j = 1, nn
|
||||
do j = 1_pInt, nn
|
||||
if (all_distances(i)<results(j)%dis) exit
|
||||
end do
|
||||
! now we know 'j'
|
||||
do k = nn - 1_pInt, j, -1_pInt
|
||||
results(k+1) = results(k)
|
||||
results(k+1_pInt) = results(k)
|
||||
end do
|
||||
results(j)%dis = all_distances(i)
|
||||
results(j)%idx = i
|
||||
|
|
@ -1724,22 +1724,23 @@ contains
|
|||
integer(pInt), intent(out) :: nfound
|
||||
type(kdtree2_result) :: results(:)
|
||||
|
||||
integer(pInt) :: i, nalloc
|
||||
integer(pInt) :: i
|
||||
integer :: nalloc
|
||||
real(pReal), allocatable :: all_distances(:)
|
||||
! ..
|
||||
allocate (all_distances(tp%n))
|
||||
do i = 1, tp%n
|
||||
do i = 1_pInt, tp%n
|
||||
all_distances(i) = square_distance(tp%dimen,qv,tp%the_data(:,i))
|
||||
end do
|
||||
|
||||
nfound = 0
|
||||
nfound = 0_pInt
|
||||
nalloc = size(results,1)
|
||||
|
||||
do i = 1, tp%n
|
||||
do i = 1_pInt, tp%n
|
||||
if (all_distances(i)< r2) then
|
||||
! insert it somewhere on the list
|
||||
if (nfound .lt. nalloc) then
|
||||
nfound = nfound+1
|
||||
nfound = nfound+1_pInt
|
||||
results(nfound)%dis = all_distances(i)
|
||||
results(nfound)%idx = i
|
||||
endif
|
||||
|
|
@ -1763,7 +1764,7 @@ contains
|
|||
!THIS IS BUGGY WITH INTEL FORTRAN
|
||||
! If (nfound .Gt. 1) Call heapsort(results(1:nfound)%dis,results(1:nfound)%ind,nfound)
|
||||
!
|
||||
if (nfound .gt. 1) call heapsort_struct(results,nfound)
|
||||
if (nfound .gt. 1_pInt) call heapsort_struct(results,nfound)
|
||||
|
||||
return
|
||||
end subroutine kdtree2_sort_results
|
||||
|
|
@ -1786,7 +1787,7 @@ contains
|
|||
integer(pInt) :: i,j
|
||||
integer(pInt) :: ileft,iright
|
||||
|
||||
ileft=n/2+1
|
||||
ileft=n/2_pInt+1_pInt
|
||||
iright=n
|
||||
|
||||
! do i=1,n
|
||||
|
|
@ -1794,33 +1795,33 @@ contains
|
|||
! Generate initial idum array
|
||||
! end do
|
||||
|
||||
if(n.eq.1) return
|
||||
if(n.eq.1_pInt) return
|
||||
|
||||
do
|
||||
if(ileft > 1)then
|
||||
ileft=ileft-1
|
||||
if(ileft > 1_pInt)then
|
||||
ileft=ileft-1_pInt
|
||||
value=a(ileft); ivalue=ind(ileft)
|
||||
else
|
||||
value=a(iright); ivalue=ind(iright)
|
||||
a(iright)=a(1); ind(iright)=ind(1)
|
||||
iright=iright-1
|
||||
if (iright == 1) then
|
||||
iright=iright-1_pInt
|
||||
if (iright == 1_pInt) then
|
||||
a(1)=value;ind(1)=ivalue
|
||||
return
|
||||
endif
|
||||
endif
|
||||
i=ileft
|
||||
j=2*ileft
|
||||
j=2_pInt*ileft
|
||||
do while (j <= iright)
|
||||
if(j < iright) then
|
||||
if(a(j) < a(j+1)) j=j+1
|
||||
if(a(j) < a(j+1_pInt)) j=j+1_pInt
|
||||
endif
|
||||
if(value < a(j)) then
|
||||
a(i)=a(j); ind(i)=ind(j)
|
||||
i=j
|
||||
j=j+j
|
||||
else
|
||||
j=iright+1
|
||||
j=iright+1_pInt
|
||||
endif
|
||||
end do
|
||||
a(i)=value; ind(i)=ivalue
|
||||
|
|
@ -1842,7 +1843,7 @@ contains
|
|||
integer(pInt) :: i,j
|
||||
integer(pInt) :: ileft,iright
|
||||
|
||||
ileft=n/2+1
|
||||
ileft=n/2_pInt+1_pInt
|
||||
iright=n
|
||||
|
||||
! do i=1,n
|
||||
|
|
@ -1850,33 +1851,33 @@ contains
|
|||
! Generate initial idum array
|
||||
! end do
|
||||
|
||||
if(n.eq.1) return
|
||||
if(n.eq.1_pInt) return
|
||||
|
||||
do
|
||||
if(ileft > 1)then
|
||||
ileft=ileft-1
|
||||
if(ileft > 1_pInt)then
|
||||
ileft=ileft-1_pInt
|
||||
value=a(ileft)
|
||||
else
|
||||
value=a(iright)
|
||||
a(iright)=a(1)
|
||||
iright=iright-1
|
||||
if (iright == 1) then
|
||||
iright=iright-1_pInt
|
||||
if (iright == 1_pInt) then
|
||||
a(1) = value
|
||||
return
|
||||
endif
|
||||
endif
|
||||
i=ileft
|
||||
j=2*ileft
|
||||
j=2_pInt*ileft
|
||||
do while (j <= iright)
|
||||
if(j < iright) then
|
||||
if(a(j)%dis < a(j+1)%dis) j=j+1
|
||||
if(a(j)%dis < a(j+1_pInt)%dis) j=j+1_pInt
|
||||
endif
|
||||
if(value%dis < a(j)%dis) then
|
||||
a(i)=a(j);
|
||||
i=j
|
||||
j=j+j
|
||||
else
|
||||
j=iright+1
|
||||
j=iright+1_pInt
|
||||
endif
|
||||
end do
|
||||
a(i)=value
|
||||
|
|
|
|||
|
|
@ -39,11 +39,11 @@ implicit none
|
|||
|
||||
integer(pInt) lattice_Nhexagonal, & ! # of hexagonal lattice structure (from tag CoverA_ratio)
|
||||
lattice_Nstructure ! # of lattice structures (1: fcc,2: bcc,3+: hexagonal)
|
||||
integer(pInt), parameter :: lattice_maxNslipFamily = 5 ! max # of slip system families over lattice structures
|
||||
integer(pInt), parameter :: lattice_maxNtwinFamily = 4 ! max # of twin system families over lattice structures
|
||||
integer(pInt), parameter :: lattice_maxNslip = 54 ! max # of slip systems over lattice structures
|
||||
integer(pInt), parameter :: lattice_maxNtwin = 24 ! max # of twin systems over lattice structures
|
||||
integer(pInt), parameter :: lattice_maxNinteraction = 30 ! max # of interaction types (in hardening matrix part)
|
||||
integer(pInt), parameter :: lattice_maxNslipFamily = 5_pInt ! max # of slip system families over lattice structures
|
||||
integer(pInt), parameter :: lattice_maxNtwinFamily = 4_pInt ! max # of twin system families over lattice structures
|
||||
integer(pInt), parameter :: lattice_maxNslip = 54_pInt ! max # of slip systems over lattice structures
|
||||
integer(pInt), parameter :: lattice_maxNtwin = 24_pInt ! max # of twin systems over lattice structures
|
||||
integer(pInt), parameter :: lattice_maxNinteraction = 30_pInt ! max # of interaction types (in hardening matrix part)
|
||||
|
||||
integer(pInt), pointer, dimension(:,:) :: interactionSlipSlip, &
|
||||
interactionSlipTwin, &
|
||||
|
|
@ -81,10 +81,10 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
|
|||
|
||||
!============================== fcc (1) =================================
|
||||
|
||||
integer(pInt), parameter, dimension(lattice_maxNslipFamily) :: lattice_fcc_NslipSystem = (/12, 0, 0, 0, 0/)
|
||||
integer(pInt), parameter, dimension(lattice_maxNtwinFamily) :: lattice_fcc_NtwinSystem = (/12, 0, 0, 0/)
|
||||
integer(pInt), parameter :: lattice_fcc_Nslip = 12 ! sum(lattice_fcc_NslipSystem)
|
||||
integer(pInt), parameter :: lattice_fcc_Ntwin = 12 ! sum(lattice_fcc_NtwinSystem)
|
||||
integer(pInt), parameter, dimension(lattice_maxNslipFamily) :: lattice_fcc_NslipSystem = int([12, 0, 0, 0, 0],pInt)
|
||||
integer(pInt), parameter, dimension(lattice_maxNtwinFamily) :: lattice_fcc_NtwinSystem = int([12, 0, 0, 0],pInt)
|
||||
integer(pInt), parameter :: lattice_fcc_Nslip = 12_pInt ! sum(lattice_fcc_NslipSystem)
|
||||
integer(pInt), parameter :: lattice_fcc_Ntwin = 12_pInt ! sum(lattice_fcc_NtwinSystem)
|
||||
integer(pInt) :: lattice_fcc_Nstructure = 0_pInt
|
||||
|
||||
real(pReal), dimension(3+3,lattice_fcc_Nslip), parameter :: lattice_fcc_systemSlip = &
|
||||
|
|
@ -442,10 +442,10 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
|
|||
|
||||
!============================== hex (3+) =================================
|
||||
|
||||
integer(pInt), parameter, dimension(lattice_maxNslipFamily) :: lattice_hex_NslipSystem = (/ 3, 3, 6,12, 6/)
|
||||
integer(pInt), parameter, dimension(lattice_maxNtwinFamily) :: lattice_hex_NtwinSystem = (/ 6, 6, 6, 6/)
|
||||
integer(pInt), parameter :: lattice_hex_Nslip = 30 ! sum(lattice_hex_NslipSystem)
|
||||
integer(pInt), parameter :: lattice_hex_Ntwin = 24 ! sum(lattice_hex_NtwinSystem)
|
||||
integer(pInt), parameter, dimension(lattice_maxNslipFamily) :: lattice_hex_NslipSystem = int([ 3, 3, 6,12, 6],pInt)
|
||||
integer(pInt), parameter, dimension(lattice_maxNtwinFamily) :: lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt)
|
||||
integer(pInt), parameter :: lattice_hex_Nslip = 30_pInt ! sum(lattice_hex_NslipSystem)
|
||||
integer(pInt), parameter :: lattice_hex_Ntwin = 24_pInt ! sum(lattice_hex_NtwinSystem)
|
||||
integer(pInt) :: lattice_hex_Nstructure = 0_pInt
|
||||
|
||||
!* sorted by A. Alankar & P. Eisenlohr
|
||||
|
|
@ -824,12 +824,12 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
lattice_fcc_Nstructure = lattice_fcc_Nstructure + 1_pInt ! count fcc instances
|
||||
if (lattice_fcc_Nstructure == 1_pInt) then ! me is first fcc structure
|
||||
processMe = .true.
|
||||
do i = 1,myNslip ! calculate slip system vectors
|
||||
do i = 1_pInt,myNslip ! calculate slip system vectors
|
||||
sd(1:3,i) = lattice_fcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(1:3,i),lattice_fcc_systemSlip(1:3,i)))
|
||||
sn(1:3,i) = lattice_fcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemSlip(4:6,i),lattice_fcc_systemSlip(4:6,i)))
|
||||
st(1:3,i) = math_vectorproduct(sd(1:3,i),sn(1:3,i))
|
||||
enddo
|
||||
do i = 1,myNtwin ! calculate twin system vectors and (assign) shears
|
||||
do i = 1_pInt,myNtwin ! calculate twin system vectors and (assign) shears
|
||||
td(1:3,i) = lattice_fcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(1:3,i),lattice_fcc_systemTwin(1:3,i)))
|
||||
tn(1:3,i) = lattice_fcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_fcc_systemTwin(4:6,i),lattice_fcc_systemTwin(4:6,i)))
|
||||
tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i))
|
||||
|
|
@ -850,12 +850,12 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
lattice_bcc_Nstructure = lattice_bcc_Nstructure + 1_pInt ! count bcc instances
|
||||
if (lattice_bcc_Nstructure == 1_pInt) then ! me is first bcc structure
|
||||
processMe = .true.
|
||||
do i = 1,myNslip ! calculate slip system vectors
|
||||
do i = 1_pInt,myNslip ! calculate slip system vectors
|
||||
sd(1:3,i) = lattice_bcc_systemSlip(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(1:3,i),lattice_bcc_systemSlip(1:3,i)))
|
||||
sn(1:3,i) = lattice_bcc_systemSlip(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemSlip(4:6,i),lattice_bcc_systemSlip(4:6,i)))
|
||||
st(1:3,i) = math_vectorproduct(sd(1:3,i),sn(1:3,i))
|
||||
enddo
|
||||
do i = 1,myNtwin ! calculate twin system vectors and (assign) shears
|
||||
do i = 1_pInt,myNtwin ! calculate twin system vectors and (assign) shears
|
||||
td(1:3,i) = lattice_bcc_systemTwin(1:3,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(1:3,i),lattice_bcc_systemTwin(1:3,i)))
|
||||
tn(1:3,i) = lattice_bcc_systemTwin(4:6,i)/sqrt(math_mul3x3(lattice_bcc_systemTwin(4:6,i),lattice_bcc_systemTwin(4:6,i)))
|
||||
tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i))
|
||||
|
|
@ -877,7 +877,7 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
myNtwin = lattice_hex_Ntwin ! overall number of twin systems
|
||||
processMe = .true.
|
||||
! converting from 4 axes coordinate system (a1=a2=a3=c) to ortho-hexgonal system (a, b, c)
|
||||
do i = 1,myNslip
|
||||
do i = 1_pInt,myNslip
|
||||
hex_d(1) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]
|
||||
hex_d(2) = (lattice_hex_systemSlip(1,i)+2.0_pReal*lattice_hex_systemSlip(2,i))*(0.5_pReal*sqrt(3.0_pReal))
|
||||
hex_d(3) = lattice_hex_systemSlip(4,i)*CoverA
|
||||
|
|
@ -889,7 +889,7 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
sn(1:3,i) = hex_n/sqrt(math_mul3x3(hex_n,hex_n))
|
||||
st(1:3,i) = math_vectorproduct(sd(1:3,i),sn(1:3,i))
|
||||
enddo
|
||||
do i = 1,myNtwin
|
||||
do i = 1_pInt,myNtwin
|
||||
hex_d(1) = lattice_hex_systemTwin(1,i)*1.5_pReal
|
||||
hex_d(2) = (lattice_hex_systemTwin(1,i)+2.0_pReal*lattice_hex_systemTwin(2,i))*(0.5_pReal*sqrt(3.0_pReal))
|
||||
hex_d(3) = lattice_hex_systemTwin(4,i)*CoverA
|
||||
|
|
@ -923,14 +923,14 @@ function lattice_initializeStructure(struct,CoverA)
|
|||
if (processMe) then
|
||||
if (myStructure > lattice_Nstructure) &
|
||||
call IO_error(666_pInt,0_pInt,0_pInt,0_pInt,'structure index too large') ! check for memory leakage
|
||||
do i = 1,myNslip ! store slip system vectors and Schmid matrix for my structure
|
||||
do i = 1_pInt,myNslip ! store slip system vectors and Schmid matrix for my structure
|
||||
lattice_sd(1:3,i,myStructure) = sd(1:3,i)
|
||||
lattice_st(1:3,i,myStructure) = st(1:3,i)
|
||||
lattice_sn(1:3,i,myStructure) = sn(1:3,i)
|
||||
lattice_Sslip(1:3,1:3,i,myStructure) = math_tensorproduct(sd(1:3,i),sn(1:3,i))
|
||||
lattice_Sslip_v(1:6,i,myStructure) = math_Mandel33to6(math_symmetric33(lattice_Sslip(1:3,1:3,i,myStructure)))
|
||||
enddo
|
||||
do i = 1,myNtwin ! store twin system vectors and Schmid plus rotation matrix for my structure
|
||||
do i = 1_pInt,myNtwin ! store twin system vectors and Schmid plus rotation matrix for my structure
|
||||
lattice_td(1:3,i,myStructure) = td(1:3,i)
|
||||
lattice_tt(1:3,i,myStructure) = tt(1:3,i)
|
||||
lattice_tn(1:3,i,myStructure) = tn(1:3,i)
|
||||
|
|
|
|||
187
code/makefile
187
code/makefile
|
|
@ -32,42 +32,13 @@
|
|||
# PREFIX = arbitrary prefix
|
||||
# SUFFIX = arbitrary suffix
|
||||
# STANDARD_CHECK = checking for Fortran 2008, compiler dependend
|
||||
########################################################################################
|
||||
# Here are some useful debugging switches for ifort. Switch on by uncommenting the #SUFFIX line at the end of this section:
|
||||
# information on http://software.intel.com/en-us/articles/determining-root-cause-of-sigsegv-or-sigbus-errors/
|
||||
|
||||
# check if an array index is too small (<1) or too large!
|
||||
DEBUG1 =-check bounds -g
|
||||
|
||||
#will cause a lot of warnings because we create a bunch of temporary arrays
|
||||
DEBUG2 =-check arg_temp_created
|
||||
|
||||
#check from time to time
|
||||
DEBUG3 =-fp-stack-check -g -traceback -gen-interfaces -warn interfaces
|
||||
|
||||
#should not be done for OpenMP, but set "ulimit -s unlimited" on shell. Probably it helps also to unlimit other limits
|
||||
DEBUG4 =-heap-arrays
|
||||
|
||||
#additional warnings
|
||||
DEBUG5 =-warn all
|
||||
# or one or more of those: alignments, declarations,general, ignore_loc, uncalled, unuses, usage
|
||||
|
||||
#set precision (check for missing _pInt and _pReal)
|
||||
DEBUG6= -real-size 32 -integer-size 16
|
||||
#or one of those 16/32/64/128 (= 2,4,8,16 bytes)
|
||||
#SUFFIX =$(DEBUG1) $(DEBUG2) $(DEBUG3) $(DEBUG4) $(DEBUG5) $(DEBUG6)
|
||||
|
||||
# Here are some useful debugging switches for gfortran
|
||||
# fcheck-bounds: eqv to DEBUG1 of ifort
|
||||
|
||||
|
||||
########################################################################################
|
||||
|
||||
#auto values will be set by setup_code.py
|
||||
FFTWROOT := $(DAMASK_ROOT)/lib/fftw
|
||||
IKMLROOT :=
|
||||
ACMLROOT := /opt/acml4.4.0
|
||||
LAPACKROOT :=
|
||||
FFTWROOT :=/$(DAMASK_ROOT)/lib/fftw
|
||||
IKMLROOT :=
|
||||
ACMLROOT :=/opt/acml4.4.0
|
||||
#LAPACKROOT := /usr
|
||||
|
||||
F90 ?= ifort
|
||||
COMPILERNAME ?= $(F90)
|
||||
|
|
@ -144,38 +115,71 @@ OPTIMIZATION_OFF_ifort :=-O0
|
|||
OPTIMIZATION_OFF_gfortran :=-O0
|
||||
OPTIMIZATION_DEFENSIVE_ifort :=-O2
|
||||
OPTIMIZATION_DEFENSIVE_gfortran :=-O2
|
||||
OPTIMIZATION_AGGRESSIVE_ifort :=-O3 $(PORTABLE_SWITCH) -ip -static -fp-model fast=2 -no-prec-div
|
||||
OPTIMIZATION_AGGRESSIVE_ifort :=-O3 $(PORTABLE_SWITCH) -ipo -static -no-prec-div -fp-model fast=2
|
||||
OPTIMIZATION_AGGRESSIVE_gfortran :=-O3 $(PORTABLE_SWITCH) -ffast-math -funroll-loops -ftree-vectorize
|
||||
|
||||
|
||||
COMPILE_OPTIONS_ifort :=-fpp\
|
||||
-implicitnone\
|
||||
-diag-enable sc3\
|
||||
-diag-disable 8291,8290,5268\
|
||||
-diag-disable 5268\
|
||||
-warn declarations\
|
||||
-warn general\
|
||||
-warn usage
|
||||
-warn usage\
|
||||
-warn interfaces\
|
||||
-warn ignore_loc\
|
||||
-warn alignments\
|
||||
-warn unused\
|
||||
-warn errors\
|
||||
-warn stderrors
|
||||
|
||||
#-fpp: preprocessor
|
||||
#-fimplicit-none: assume "implicit-none" even if not present in source
|
||||
#-diag-disable: disables warnings, where
|
||||
# warning ID 5268: the text exceeds right hand column allowed on the line (we have only comments there)
|
||||
#-warn: enables warnings, where
|
||||
# declarations: any undeclared names
|
||||
# general: warning messages and informational messages are issued by the compiler
|
||||
# usage: questionable programming practices
|
||||
# interfaces: checks the interfaces of all SUBROUTINEs called and FUNCTIONs invoked in your compilation against an external set of interface blocks
|
||||
# ignore_loc: %LOC is stripped from an actual argument
|
||||
# alignments: data that is not naturally aligned
|
||||
# unused: declared variables that are never used
|
||||
# errors: warnings are changed to errors
|
||||
# stderrors: warnings about Fortran standard violations are changed to errors
|
||||
#
|
||||
###################################################################################################
|
||||
#MORE OPTIONS FOR DEBUGGING DURING COMPILING
|
||||
#-warn: enables warnings, where
|
||||
# truncated_source: Determines whether warnings occur when source exceeds the maximum column width in fixed-format files. (too many warnings because we have comments beyond character 132)
|
||||
# uncalled: Determines whether warnings occur when a statement function is never called
|
||||
# all:
|
||||
#
|
||||
#OPTIONS FOR DEGUBBING DURING RUNTIME
|
||||
# information on http://software.intel.com/en-us/articles/determining-root-cause-of-sigsegv-or-sigbus-errors/
|
||||
#-g: Generate symbolic debugging information in the object file
|
||||
#-traceback: Generate extra information in the object file to provide source file traceback information when a severe error occurs at run time.
|
||||
#-gen-interfaces: Generate an interface block for each routine. http://software.intel.com/en-us/blogs/2012/01/05/doctor-fortran-gets-explicit-again/
|
||||
#-fp-stack-check: Generate extra code after every function call to ensure that the floating-point (FP) stack is in the expected state.
|
||||
#-check: checks at runtime, where
|
||||
# bounds: check if an array index is too small (<1) or too large!
|
||||
# arg_temp_created: will cause a lot of warnings because we create a bunch of temporary arrays
|
||||
# format: Checking for the data type of an item being formatted for output.
|
||||
# output_conversion: Checking for the fit of data items within a designated format descriptor field.
|
||||
# pointers: Checking for certain disassociated or uninitialized pointers or unallocated allocatable objects.
|
||||
# uninit: Checking for uninitialized variables.
|
||||
#-heap-arrays: should not be done for OpenMP, but set "ulimit -s unlimited" on shell. Probably it helps also to unlimit other limits
|
||||
#
|
||||
#OPTIONS FOR TYPE DEBUGGING
|
||||
#-real-size 32: set precision to one of those 32/64/128 (= 4/8/16 bytes) for standard real (=8 for pReal)
|
||||
#-integer-size 16: set precision to one of those 16/32/64 (= 2/4/8 bytes) for standard integer (=4 for pInt)
|
||||
###################################################################################################
|
||||
|
||||
#alignments: Determines whether warnings occur for data that is not naturally aligned.
|
||||
#declarations: Determines whether warnings occur for any undeclared names.
|
||||
#errors: Determines whether warnings are changed to errors.
|
||||
#general: Determines whether warning messages and informational messages are issued by the compiler.
|
||||
#ignore_loc: Determines whether warnings occur when %LOC is stripped from an actual argument.
|
||||
#interfaces: Determines whether the compiler checks the interfaces of all SUBROUTINEs called and FUNCTIONs invoked in your compilation against an external set of interface blocks.
|
||||
#stderrors: Determines whether warnings about Fortran standard violations are changed to errors.
|
||||
#truncated_source: Determines whether warnings occur when source exceeds the maximum column width in fixed-format files.
|
||||
#uncalled: Determines whether warnings occur when a statement function is never called
|
||||
#unused: Determines whether warnings occur for declared variables that are never used.
|
||||
#usage: Determines whether warnings occur for questionable programming practices.
|
||||
|
||||
#-fpp: preprocessor
|
||||
#-diag-disable: disables warnings, where
|
||||
# warning ID 9291:
|
||||
# warning ID 8290:
|
||||
# warning ID 5268: The text exceeds right hand column allowed on the line (we have only comments there)
|
||||
COMPILE_OPTIONS_gfortran :=-xf95-cpp-input\
|
||||
-ffree-line-length-132\
|
||||
-fno-range-check\
|
||||
-fimplicit-none\
|
||||
-fall-intrinsics\
|
||||
-pedantic\
|
||||
-Warray-bounds\
|
||||
-Wunused-parameter\
|
||||
|
|
@ -189,47 +193,50 @@ COMPILE_OPTIONS_gfortran :=-xf95-cpp-input\
|
|||
-Wunused-value\
|
||||
-Wunderflow
|
||||
|
||||
#-xf95-cpp-input: preprocessor
|
||||
#-ffree-line-length-132: restrict line length to the standard 132 characters
|
||||
#-fno-range-check: disables checking if result can be represented by variable. Needs to be set to enable DAMASK_NaN
|
||||
#-fimplicit-none: assume "implicit-none" even if not present in source
|
||||
#-pedantic: more strict on standard, enables some of the warnings below
|
||||
#-Warray-bounds: checks if array reference is out of bounds at compile time. use -fcheck-bounds to also check during runtime
|
||||
#-Wunused-parameter: find usused variables with "parameter" attribute
|
||||
#-Wampersand: checks if a character expression is continued proberly by an ampersand at the end of the line and at the beginning of the new line
|
||||
#-Wno-tabs: do not allow tabs in source
|
||||
#-Wcharacter-truncation: warn if character expressions (strings) are truncated
|
||||
#-Wintrinsic-shadow: warn if a user-defined procedure or module procedure has the same name as an intrinsic
|
||||
#-Waliasing: warn about possible aliasing of dummy arguments. Specifically, it warns if the same actual argument is associated with a dummy argument with "INTENT(IN)" and a dummy argument with "INTENT(OUT)" in a call with an explicit interface.
|
||||
#-Wconversion: warn about implicit conversions between different type
|
||||
#-Wsurprising: warn when "suspicious" code constructs are encountered. While technically legal these usually indicate that an error has been made.
|
||||
#-xf95-cpp-input: preprocessor
|
||||
#-ffree-line-length-132: restrict line length to the standard 132 characters
|
||||
#-fno-range-check: disables checking if result can be represented by variable. Needs to be set to enable DAMASK_NaN
|
||||
#-fimplicit-none: assume "implicit-none" even if not present in source
|
||||
#-fall-intrinsics:
|
||||
#-pedantic: more strict on standard, enables some of the warnings below
|
||||
#-Warray-bounds: checks if array reference is out of bounds at compile time. use -fcheck-bounds to also check during runtime
|
||||
#-Wunused-parameter: find usused variables with "parameter" attribute
|
||||
#-Wampersand: checks if a character expression is continued proberly by an ampersand at the end of the line and at the beginning of the new line
|
||||
#-Wno-tabs: do not allow tabs in source
|
||||
#-Wcharacter-truncation: warn if character expressions (strings) are truncated
|
||||
#-Wintrinsic-shadow: warn if a user-defined procedure or module procedure has the same name as an intrinsic
|
||||
#-Waliasing: warn about possible aliasing of dummy arguments. Specifically, it warns if the same actual argument is associated with a dummy argument with "INTENT(IN)" and a dummy argument with "INTENT(OUT)" in a call with an explicit interface.
|
||||
#-Wconversion: warn about implicit conversions between different type
|
||||
#-Wsurprising: warn when "suspicious" code constructs are encountered. While technically legal these usually indicate that an error has been made.
|
||||
#-Wunused-value:
|
||||
#-Wunderflow: produce a warning when numerical constant expressions are encountered, which yield an UNDERFLOW during compilation
|
||||
|
||||
|
||||
|
||||
#MORE OPTIONS
|
||||
|
||||
# only for gfortran 4.6:
|
||||
#-Wsuggest-attribute=const
|
||||
#-Wsuggest-attribute=noreturn
|
||||
#-Wsuggest-attribute=pure
|
||||
|
||||
# too many warnings because we have comments beyond character 132:
|
||||
#-Wline-truncation
|
||||
# warnings because of "flush" is not longer in the standard, but still an intrinsic fuction of the compilers:
|
||||
#-Wintrinsic-std
|
||||
# warnings because we have many temporary arrays (performance issue?):
|
||||
#-Warray-temporaries
|
||||
|
||||
# -Wimplicit-interface
|
||||
# -pedantic-errors
|
||||
# -fmodule-private
|
||||
|
||||
#-Wunderflow: produce a warning when numerical constant expressions are encountered, which yield an UNDERFLOW during compilation
|
||||
#
|
||||
###################################################################################################
|
||||
#OPTIONS FOR GFORTRAN 4.6
|
||||
#-Wsuggest-attribute=const:
|
||||
#-Wsuggest-attribute=noreturn:
|
||||
#-Wsuggest-attribute=pure:
|
||||
#
|
||||
#MORE OPTIONS FOR DEBUGGING DURING COMPILING
|
||||
#-Wline-truncation: too many warnings because we have comments beyond character 132
|
||||
#-Wintrinsic-std: warnings because of "flush" is not longer in the standard, but still an intrinsic fuction of the compilers:
|
||||
#-Warray-temporarieswarnings:
|
||||
# because we have many temporary arrays (performance issue?):
|
||||
#-Wimplicit-interface
|
||||
#-pedantic-errors
|
||||
#-fmodule-private
|
||||
#
|
||||
#OPTIONS FOR DEGUBBING DURING RUNTIME
|
||||
#-fcheck-bounds: check if an array index is too small (<1) or too large!
|
||||
#
|
||||
#OPTIONS FOR TYPE DEBUGGING
|
||||
#-fdefault-real-8: set precision to 8 bytes for standard real (=8 for pReal). Will set size of double to 16 bytes as long as -fdefault-double-8 is not set
|
||||
#-fdefault-integer-8: set precision to 8 bytes for standard integer (=4 for pInt)
|
||||
##################################################################################################
|
||||
|
||||
COMPILE =$(OPENMP_FLAG_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(OPTI)_$(F90)) -c
|
||||
COMPILE_MAXOPTI =$(OPENMP_FLAG_$(F90)) $(COMPILE_OPTIONS_$(F90)) $(STANDARD_CHECK_$(F90)) $(OPTIMIZATION_$(MAXOPTI)_$(F90)) -c
|
||||
|
||||
###################################################################################################
|
||||
|
||||
DAMASK_spectral.exe: DAMASK_spectral.o CPFEM.a
|
||||
$(PREFIX) $(COMPILERNAME) ${OPENMP_FLAG_${F90}} -o DAMASK_spectral.exe DAMASK_spectral.o CPFEM.a \
|
||||
|
|
|
|||
|
|
@ -114,7 +114,7 @@ subroutine material_init()
|
|||
implicit none
|
||||
|
||||
!* Definition of variables
|
||||
integer(pInt), parameter :: fileunit = 200
|
||||
integer(pInt), parameter :: fileunit = 200_pInt
|
||||
integer(pInt) i,j
|
||||
|
||||
!$OMP CRITICAL (write2out)
|
||||
|
|
@ -128,46 +128,46 @@ subroutine material_init()
|
|||
call IO_open_file(fileunit,material_configFile) ! ...open material.config file
|
||||
endif
|
||||
call material_parseHomogenization(fileunit,material_partHomogenization)
|
||||
if (debug_verbosity > 0) then
|
||||
if (debug_verbosity > 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write (6,*) 'Homogenization parsed'
|
||||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
call material_parseMicrostructure(fileunit,material_partMicrostructure)
|
||||
if (debug_verbosity > 0) then
|
||||
if (debug_verbosity > 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write (6,*) 'Microstructure parsed'
|
||||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
call material_parseCrystallite(fileunit,material_partCrystallite)
|
||||
if (debug_verbosity > 0) then
|
||||
if (debug_verbosity > 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write (6,*) 'Crystallite parsed'
|
||||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
call material_parseTexture(fileunit,material_partTexture)
|
||||
if (debug_verbosity > 0) then
|
||||
if (debug_verbosity > 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write (6,*) 'Texture parsed'
|
||||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
call material_parsePhase(fileunit,material_partPhase)
|
||||
if (debug_verbosity > 0) then
|
||||
if (debug_verbosity > 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write (6,*) 'Phase parsed'
|
||||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
close(fileunit)
|
||||
|
||||
do i = 1,material_Nmicrostructure
|
||||
if (microstructure_crystallite(i) < 1 .or. &
|
||||
do i = 1_pInt,material_Nmicrostructure
|
||||
if (microstructure_crystallite(i) < 1_pInt .or. &
|
||||
microstructure_crystallite(i) > material_Ncrystallite) call IO_error(150_pInt,i)
|
||||
if (minval(microstructure_phase(1:microstructure_Nconstituents(i),i)) < 1 .or. &
|
||||
if (minval(microstructure_phase(1:microstructure_Nconstituents(i),i)) < 1_pInt .or. &
|
||||
maxval(microstructure_phase(1:microstructure_Nconstituents(i),i)) > material_Nphase) call IO_error(151_pInt,i)
|
||||
if (minval(microstructure_texture(1:microstructure_Nconstituents(i),i)) < 1 .or. &
|
||||
if (minval(microstructure_texture(1:microstructure_Nconstituents(i),i)) < 1_pInt .or. &
|
||||
maxval(microstructure_texture(1:microstructure_Nconstituents(i),i)) > material_Ntexture) call IO_error(152_pInt,i)
|
||||
if (abs(sum(microstructure_fraction(:,i)) - 1.0_pReal) >= 1.0e-10_pReal) then
|
||||
if (debug_verbosity > 0) then
|
||||
if (debug_verbosity > 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write(6,*)'sum of microstructure fraction = ',sum(microstructure_fraction(:,i))
|
||||
!$OMP END CRITICAL (write2out)
|
||||
|
|
@ -175,25 +175,25 @@ subroutine material_init()
|
|||
call IO_error(153_pInt,i)
|
||||
endif
|
||||
enddo
|
||||
if (debug_verbosity > 0) then
|
||||
if (debug_verbosity > 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write (6,*)
|
||||
write (6,*) 'MATERIAL configuration'
|
||||
write (6,*)
|
||||
write (6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains'
|
||||
do i = 1,material_Nhomogenization
|
||||
do i = 1_pInt,material_Nhomogenization
|
||||
write (6,'(1x,a32,1x,a16,1x,i4)') homogenization_name(i),homogenization_type(i),homogenization_Ngrains(i)
|
||||
enddo
|
||||
write (6,*)
|
||||
write (6,'(a32,1x,a11,1x,a12,1x,a13)') 'microstructure ','crystallite','constituents','homogeneous'
|
||||
do i = 1,material_Nmicrostructure
|
||||
do i = 1_pInt,material_Nmicrostructure
|
||||
write (6,'(a32,4x,i4,8x,i4,8x,l1)') microstructure_name(i), &
|
||||
microstructure_crystallite(i), &
|
||||
microstructure_Nconstituents(i), &
|
||||
microstructure_elemhomo(i)
|
||||
if (microstructure_Nconstituents(i) > 0_pInt) then
|
||||
do j = 1,microstructure_Nconstituents(i)
|
||||
write (6,'(a1,1x,a32,1x,a32,1x,f6.4)') '>',phase_name(microstructure_phase(j,i)),&
|
||||
do j = 1_pInt,microstructure_Nconstituents(i)
|
||||
write (6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(j,i)),&
|
||||
texture_name(microstructure_texture(j,i)),&
|
||||
microstructure_fraction(j,i)
|
||||
enddo
|
||||
|
|
@ -209,7 +209,7 @@ endsubroutine
|
|||
|
||||
|
||||
!*********************************************************************
|
||||
subroutine material_parseHomogenization(file,myPart)
|
||||
subroutine material_parseHomogenization(myFile,myPart)
|
||||
!*********************************************************************
|
||||
|
||||
use prec, only: pInt
|
||||
|
|
@ -218,14 +218,14 @@ subroutine material_parseHomogenization(file,myPart)
|
|||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: myPart
|
||||
integer(pInt), intent(in) :: file
|
||||
integer(pInt), intent(in) :: myFile
|
||||
integer(pInt), parameter :: maxNchunks = 2_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: positions
|
||||
integer(pInt) Nsections, section, s
|
||||
character(len=64) tag
|
||||
character(len=1024) line
|
||||
|
||||
Nsections = IO_countSections(file,myPart)
|
||||
Nsections = IO_countSections(myFile,myPart)
|
||||
material_Nhomogenization = Nsections
|
||||
if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart)
|
||||
|
||||
|
|
@ -236,23 +236,23 @@ subroutine material_parseHomogenization(file,myPart)
|
|||
allocate(homogenization_Noutput(Nsections)); homogenization_Noutput = 0_pInt
|
||||
allocate(homogenization_active(Nsections)); homogenization_active = .false.
|
||||
|
||||
forall (s = 1:Nsections) homogenization_active(s) = any(mesh_element(3,:) == s) ! current homogenization used in model? Homogenization view, maximum operations depend on maximum number of homog schemes
|
||||
homogenization_Noutput = IO_countTagInPart(file,myPart,'(output)',Nsections)
|
||||
forall (s = 1_pInt:Nsections) homogenization_active(s) = any(mesh_element(3,:) == s) ! current homogenization used in model? Homogenization view, maximum operations depend on maximum number of homog schemes
|
||||
homogenization_Noutput = IO_countTagInPart(myFile,myPart,'(output)',Nsections)
|
||||
|
||||
rewind(file)
|
||||
rewind(myFile)
|
||||
line = ''
|
||||
section = 0
|
||||
section = 0_pInt
|
||||
|
||||
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
enddo
|
||||
|
||||
do
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
|
||||
if (IO_getTag(line,'[',']') /= '') then ! next section
|
||||
section = section + 1
|
||||
section = section + 1_pInt
|
||||
homogenization_name(section) = IO_getTag(line,'[',']')
|
||||
endif
|
||||
if (section > 0_pInt) then
|
||||
|
|
@ -277,7 +277,7 @@ subroutine material_parseHomogenization(file,myPart)
|
|||
|
||||
|
||||
!*********************************************************************
|
||||
subroutine material_parseMicrostructure(file,myPart)
|
||||
subroutine material_parseMicrostructure(myFile,myPart)
|
||||
!*********************************************************************
|
||||
|
||||
use prec, only: pInt
|
||||
|
|
@ -286,14 +286,14 @@ subroutine material_parseMicrostructure(file,myPart)
|
|||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: myPart
|
||||
integer(pInt), intent(in) :: file
|
||||
integer(pInt), intent(in) :: myFile
|
||||
integer(pInt), parameter :: maxNchunks = 7_pInt
|
||||
integer(pInt), dimension(1_pInt+2_pInt*maxNchunks) :: positions
|
||||
integer(pInt) Nsections, section, constituent, e, i
|
||||
character(len=64) tag
|
||||
character(len=1024) line
|
||||
|
||||
Nsections = IO_countSections(file,myPart)
|
||||
Nsections = IO_countSections(myFile,myPart)
|
||||
material_Nmicrostructure = Nsections
|
||||
if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart)
|
||||
|
||||
|
|
@ -303,42 +303,42 @@ subroutine material_parseMicrostructure(file,myPart)
|
|||
allocate(microstructure_active(Nsections))
|
||||
allocate(microstructure_elemhomo(Nsections))
|
||||
|
||||
forall (e = 1:mesh_NcpElems) microstructure_active(mesh_element(4,e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
|
||||
forall (e = 1_pInt:mesh_NcpElems) microstructure_active(mesh_element(4,e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
|
||||
|
||||
microstructure_Nconstituents = IO_countTagInPart(file,myPart,'(constituent)',Nsections)
|
||||
microstructure_Nconstituents = IO_countTagInPart(myFile,myPart,'(constituent)',Nsections)
|
||||
microstructure_maxNconstituents = maxval(microstructure_Nconstituents)
|
||||
microstructure_elemhomo = IO_spotTagInPart(file,myPart,'/elementhomogeneous/',Nsections)
|
||||
microstructure_elemhomo = IO_spotTagInPart(myFile,myPart,'/elementhomogeneous/',Nsections)
|
||||
|
||||
allocate(microstructure_phase (microstructure_maxNconstituents,Nsections)); microstructure_phase = 0_pInt
|
||||
allocate(microstructure_texture (microstructure_maxNconstituents,Nsections)); microstructure_texture = 0_pInt
|
||||
allocate(microstructure_fraction(microstructure_maxNconstituents,Nsections)); microstructure_fraction = 0.0_pReal
|
||||
|
||||
rewind(file)
|
||||
rewind(myFile)
|
||||
line = ''
|
||||
section = 0
|
||||
section = 0_pInt
|
||||
|
||||
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
enddo
|
||||
|
||||
do
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
|
||||
if (IO_getTag(line,'[',']') /= '') then ! next section
|
||||
section = section + 1
|
||||
constituent = 0
|
||||
section = section + 1_pInt
|
||||
constituent = 0_pInt
|
||||
microstructure_name(section) = IO_getTag(line,'[',']')
|
||||
endif
|
||||
if (section > 0) then
|
||||
if (section > 0_pInt) then
|
||||
positions = IO_stringPos(line,maxNchunks)
|
||||
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
|
||||
select case(tag)
|
||||
case ('crystallite')
|
||||
microstructure_crystallite(section) = IO_intValue(line,positions,2_pInt)
|
||||
case ('(constituent)')
|
||||
constituent = constituent + 1
|
||||
do i=2,6,2
|
||||
constituent = constituent + 1_pInt
|
||||
do i=2_pInt,6_pInt,2_pInt
|
||||
tag = IO_lc(IO_stringValue(line,positions,i))
|
||||
select case (tag)
|
||||
case('phase')
|
||||
|
|
@ -357,7 +357,7 @@ subroutine material_parseMicrostructure(file,myPart)
|
|||
|
||||
|
||||
!*********************************************************************
|
||||
subroutine material_parseCrystallite(file,myPart)
|
||||
subroutine material_parseCrystallite(myFile,myPart)
|
||||
!*********************************************************************
|
||||
|
||||
use prec, only: pInt
|
||||
|
|
@ -366,33 +366,33 @@ subroutine material_parseCrystallite(file,myPart)
|
|||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: myPart
|
||||
integer(pInt), intent(in) :: file
|
||||
integer(pInt), intent(in) :: myFile
|
||||
integer(pInt) Nsections, section
|
||||
character(len=1024) line
|
||||
|
||||
Nsections = IO_countSections(file,myPart)
|
||||
Nsections = IO_countSections(myFile,myPart)
|
||||
material_Ncrystallite = Nsections
|
||||
if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart)
|
||||
|
||||
allocate(crystallite_name(Nsections)); crystallite_name = ''
|
||||
allocate(crystallite_Noutput(Nsections)); crystallite_Noutput = 0_pInt
|
||||
|
||||
crystallite_Noutput = IO_countTagInPart(file,myPart,'(output)',Nsections)
|
||||
crystallite_Noutput = IO_countTagInPart(myFile,myPart,'(output)',Nsections)
|
||||
|
||||
rewind(file)
|
||||
rewind(myFile)
|
||||
line = ''
|
||||
section = 0
|
||||
section = 0_pInt
|
||||
|
||||
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
enddo
|
||||
|
||||
do
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
|
||||
if (IO_getTag(line,'[',']') /= '') then ! next section
|
||||
section = section + 1
|
||||
section = section + 1_pInt
|
||||
crystallite_name(section) = IO_getTag(line,'[',']')
|
||||
endif
|
||||
enddo
|
||||
|
|
@ -401,7 +401,7 @@ subroutine material_parseCrystallite(file,myPart)
|
|||
|
||||
|
||||
!*********************************************************************
|
||||
subroutine material_parsePhase(file,myPart)
|
||||
subroutine material_parsePhase(myFile,myPart)
|
||||
!*********************************************************************
|
||||
|
||||
use prec, only: pInt
|
||||
|
|
@ -409,14 +409,14 @@ subroutine material_parsePhase(file,myPart)
|
|||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: myPart
|
||||
integer(pInt), intent(in) :: file
|
||||
integer(pInt), parameter :: maxNchunks = 2
|
||||
integer(pInt), intent(in) :: myFile
|
||||
integer(pInt), parameter :: maxNchunks = 2_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: positions
|
||||
integer(pInt) Nsections, section, s
|
||||
character(len=64) tag
|
||||
character(len=1024) line
|
||||
|
||||
Nsections = IO_countSections(file,myPart)
|
||||
Nsections = IO_countSections(myFile,myPart)
|
||||
material_Nphase = Nsections
|
||||
if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart)
|
||||
|
||||
|
|
@ -426,23 +426,23 @@ subroutine material_parsePhase(file,myPart)
|
|||
allocate(phase_Noutput(Nsections))
|
||||
allocate(phase_localConstitution(Nsections))
|
||||
|
||||
phase_Noutput = IO_countTagInPart(file,myPart,'(output)',Nsections)
|
||||
phase_localConstitution = .not. IO_spotTagInPart(file,myPart,'/nonlocal/',Nsections)
|
||||
phase_Noutput = IO_countTagInPart(myFile,myPart,'(output)',Nsections)
|
||||
phase_localConstitution = .not. IO_spotTagInPart(myFile,myPart,'/nonlocal/',Nsections)
|
||||
|
||||
rewind(file)
|
||||
rewind(myFile)
|
||||
line = ''
|
||||
section = 0
|
||||
section = 0_pInt
|
||||
|
||||
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
enddo
|
||||
|
||||
do
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
|
||||
if (IO_getTag(line,'[',']') /= '') then ! next section
|
||||
section = section + 1
|
||||
section = section + 1_pInt
|
||||
phase_name(section) = IO_getTag(line,'[',']')
|
||||
endif
|
||||
if (section > 0_pInt) then
|
||||
|
|
@ -451,9 +451,9 @@ subroutine material_parsePhase(file,myPart)
|
|||
select case(tag)
|
||||
case ('constitution')
|
||||
phase_constitution(section) = IO_lc(IO_stringValue(line,positions,2_pInt))
|
||||
do s = 1,section
|
||||
do s = 1_pInt,section
|
||||
if (phase_constitution(s) == phase_constitution(section)) &
|
||||
phase_constitutionInstance(section) = phase_constitutionInstance(section) + 1 ! count instances
|
||||
phase_constitutionInstance(section) = phase_constitutionInstance(section) + 1_pInt ! count instances
|
||||
enddo
|
||||
end select
|
||||
endif
|
||||
|
|
@ -463,7 +463,7 @@ subroutine material_parsePhase(file,myPart)
|
|||
|
||||
|
||||
!*********************************************************************
|
||||
subroutine material_parseTexture(file,myPart)
|
||||
subroutine material_parseTexture(myFile,myPart)
|
||||
!*********************************************************************
|
||||
|
||||
use prec, only: pInt, pReal
|
||||
|
|
@ -472,15 +472,15 @@ subroutine material_parseTexture(file,myPart)
|
|||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: myPart
|
||||
integer(pInt), intent(in) :: file
|
||||
integer(pInt), parameter :: maxNchunks = 13
|
||||
integer(pInt), intent(in) :: myFile
|
||||
integer(pInt), parameter :: maxNchunks = 13_pInt
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: positions
|
||||
integer(pInt) Nsections, section, gauss, fiber, i
|
||||
character(len=64) tag
|
||||
character(len=1024) line
|
||||
|
||||
|
||||
Nsections = IO_countSections(file,myPart)
|
||||
Nsections = IO_countSections(myFile,myPart)
|
||||
material_Ntexture = Nsections
|
||||
if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart)
|
||||
|
||||
|
|
@ -490,33 +490,33 @@ subroutine material_parseTexture(file,myPart)
|
|||
allocate(texture_Ngauss(Nsections)); texture_Ngauss = 0_pInt
|
||||
allocate(texture_Nfiber(Nsections)); texture_Nfiber = 0_pInt
|
||||
|
||||
texture_Ngauss = IO_countTagInPart(file,myPart,'(gauss)', Nsections) + &
|
||||
IO_countTagInPart(file,myPart,'(random)',Nsections)
|
||||
texture_Nfiber = IO_countTagInPart(file,myPart,'(fiber)', Nsections)
|
||||
texture_Ngauss = IO_countTagInPart(myFile,myPart,'(gauss)', Nsections) + &
|
||||
IO_countTagInPart(myFile,myPart,'(random)',Nsections)
|
||||
texture_Nfiber = IO_countTagInPart(myFile,myPart,'(fiber)', Nsections)
|
||||
texture_maxNgauss = maxval(texture_Ngauss)
|
||||
texture_maxNfiber = maxval(texture_Nfiber)
|
||||
allocate(texture_Gauss (5,texture_maxNgauss,Nsections)); texture_Gauss = 0.0_pReal
|
||||
allocate(texture_Fiber (6,texture_maxNfiber,Nsections)); texture_Fiber = 0.0_pReal
|
||||
|
||||
rewind(file)
|
||||
rewind(myFile)
|
||||
line = ''
|
||||
section = 0
|
||||
section = 0_pInt
|
||||
|
||||
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
enddo
|
||||
|
||||
do
|
||||
read(file,'(a1024)',END=100) line
|
||||
read(myFile,'(a1024)',END=100) line
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
|
||||
if (IO_getTag(line,'[',']') /= '') then ! next section
|
||||
section = section + 1
|
||||
gauss = 0
|
||||
fiber = 0
|
||||
section = section + 1_pInt
|
||||
gauss = 0_pInt
|
||||
fiber = 0_pInt
|
||||
texture_name(section) = IO_getTag(line,'[',']')
|
||||
endif
|
||||
if (section > 0) then
|
||||
if (section > 0_pInt) then
|
||||
positions = IO_stringPos(line,maxNchunks)
|
||||
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
|
||||
select case(tag)
|
||||
|
|
@ -528,17 +528,17 @@ subroutine material_parseTexture(file,myPart)
|
|||
tag = IO_lc(IO_stringValue(line,positions,2_pInt))
|
||||
select case (tag)
|
||||
case('orthotropic')
|
||||
texture_symmetry(section) = 4
|
||||
texture_symmetry(section) = 4_pInt
|
||||
case('monoclinic')
|
||||
texture_symmetry(section) = 2
|
||||
texture_symmetry(section) = 2_pInt
|
||||
case default
|
||||
texture_symmetry(section) = 1
|
||||
texture_symmetry(section) = 1_pInt
|
||||
end select
|
||||
|
||||
case ('(random)')
|
||||
gauss = gauss + 1
|
||||
gauss = gauss + 1_pInt
|
||||
texture_Gauss(1:3,gauss,section) = math_sampleRandomOri()
|
||||
do i = 2,4,2
|
||||
do i = 2_pInt,4_pInt,2_pInt
|
||||
tag = IO_lc(IO_stringValue(line,positions,i))
|
||||
select case (tag)
|
||||
case('scatter')
|
||||
|
|
@ -549,8 +549,8 @@ subroutine material_parseTexture(file,myPart)
|
|||
enddo
|
||||
|
||||
case ('(gauss)')
|
||||
gauss = gauss + 1
|
||||
do i = 2,10,2
|
||||
gauss = gauss + 1_pInt
|
||||
do i = 2_pInt,10_pInt,2_pInt
|
||||
tag = IO_lc(IO_stringValue(line,positions,i))
|
||||
select case (tag)
|
||||
case('phi1')
|
||||
|
|
@ -567,8 +567,8 @@ subroutine material_parseTexture(file,myPart)
|
|||
enddo
|
||||
|
||||
case ('(fiber)')
|
||||
fiber = fiber + 1
|
||||
do i = 2,12,2
|
||||
fiber = fiber + 1_pInt
|
||||
do i = 2_pInt,12_pInt,2_pInt
|
||||
tag = IO_lc(IO_stringValue(line,positions,i))
|
||||
select case (tag)
|
||||
case('alpha1')
|
||||
|
|
@ -629,7 +629,7 @@ subroutine material_populateGrains()
|
|||
allocate(Nelems(material_Nhomogenization,material_Nmicrostructure)); Nelems = 0_pInt
|
||||
|
||||
! precounting of elements for each homog/micro pair
|
||||
do e = 1, mesh_NcpElems
|
||||
do e = 1_pInt, mesh_NcpElems
|
||||
homog = mesh_element(3,e)
|
||||
micro = mesh_element(4,e)
|
||||
Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt
|
||||
|
|
@ -641,12 +641,12 @@ subroutine material_populateGrains()
|
|||
Nelems = 0_pInt ! reuse as counter
|
||||
|
||||
! identify maximum grain count per IP (from element) and find grains per homog/micro pair
|
||||
do e = 1,mesh_NcpElems
|
||||
do e = 1_pInt,mesh_NcpElems
|
||||
homog = mesh_element(3,e)
|
||||
micro = mesh_element(4,e)
|
||||
if (homog < 1 .or. homog > material_Nhomogenization) & ! out of bounds
|
||||
if (homog < 1_pInt .or. homog > material_Nhomogenization) & ! out of bounds
|
||||
call IO_error(154_pInt,e,0_pInt,0_pInt)
|
||||
if (micro < 1 .or. micro > material_Nmicrostructure) & ! out of bounds
|
||||
if (micro < 1_pInt .or. micro > material_Nmicrostructure) & ! out of bounds
|
||||
call IO_error(155_pInt,e,0_pInt,0_pInt)
|
||||
if (microstructure_elemhomo(micro)) then
|
||||
dGrains = homogenization_Ngrains(homog)
|
||||
|
|
@ -664,7 +664,7 @@ subroutine material_populateGrains()
|
|||
allocate(textureOfGrain(maxval(Ngrains))) ! reserve memory for maximum case
|
||||
allocate(orientationOfGrain(3,maxval(Ngrains))) ! reserve memory for maximum case
|
||||
|
||||
if (debug_verbosity > 0) then
|
||||
if (debug_verbosity > 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write (6,*)
|
||||
write (6,*) 'MATERIAL grain population'
|
||||
|
|
@ -672,12 +672,12 @@ subroutine material_populateGrains()
|
|||
write (6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#'
|
||||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
do homog = 1,material_Nhomogenization ! loop over homogenizations
|
||||
do homog = 1_pInt,material_Nhomogenization ! loop over homogenizations
|
||||
dGrains = homogenization_Ngrains(homog) ! grain number per material point
|
||||
do micro = 1,material_Nmicrostructure ! all pairs of homog and micro
|
||||
if (Ngrains(homog,micro) > 0) then ! an active pair of homog and micro
|
||||
do micro = 1_pInt,material_Nmicrostructure ! all pairs of homog and micro
|
||||
if (Ngrains(homog,micro) > 0_pInt) then ! an active pair of homog and micro
|
||||
myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate
|
||||
if (debug_verbosity > 0) then
|
||||
if (debug_verbosity > 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write (6,*)
|
||||
write (6,'(a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains
|
||||
|
|
@ -690,12 +690,12 @@ subroutine material_populateGrains()
|
|||
do hme = 1_pInt, Nelems(homog,micro)
|
||||
e = elemsOfHomogMicro(hme,homog,micro) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
|
||||
if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs
|
||||
volumeOfGrain(grain+1:grain+dGrains) = sum(mesh_ipVolume(1:FE_Nips(mesh_element(2,e)),e))/&
|
||||
volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:FE_Nips(mesh_element(2,e)),e))/&
|
||||
real(dGrains,pReal)
|
||||
grain = grain + dGrains ! wind forward by NgrainsPerIP
|
||||
else
|
||||
forall (i = 1:FE_Nips(mesh_element(2,e))) & ! loop over IPs
|
||||
volumeOfGrain(grain+(i-1)*dGrains+1:grain+i*dGrains) = &
|
||||
forall (i = 1_pInt:FE_Nips(mesh_element(2,e))) & ! loop over IPs
|
||||
volumeOfGrain(grain+(i-1)*dGrains+1_pInt:grain+i*dGrains) = &
|
||||
mesh_ipVolume(i,e)/dGrains ! assign IPvolume/Ngrains to all grains of IP
|
||||
grain = grain + FE_Nips(mesh_element(2,e)) * dGrains ! wind forward by Nips*NgrainsPerIP
|
||||
endif
|
||||
|
|
@ -703,13 +703,13 @@ subroutine material_populateGrains()
|
|||
|
||||
! ---------------------------------------------------------------------------- divide myNgrains as best over constituents
|
||||
NgrainsOfConstituent = 0_pInt
|
||||
forall (i = 1:microstructure_Nconstituents(micro)) &
|
||||
forall (i = 1_pInt:microstructure_Nconstituents(micro)) &
|
||||
NgrainsOfConstituent(i) = nint(microstructure_fraction(i,micro) * myNgrains, pInt) ! do rounding integer conversion
|
||||
do while (sum(NgrainsOfConstituent) /= myNgrains) ! total grain count over constituents wrong?
|
||||
sgn = sign(1_pInt, myNgrains - sum(NgrainsOfConstituent)) ! direction of required change
|
||||
extreme = 0.0_pReal
|
||||
t = 0_pInt
|
||||
do i = 1,microstructure_Nconstituents(micro) ! find largest deviator
|
||||
do i = 1_pInt,microstructure_Nconstituents(micro) ! find largest deviator
|
||||
if (real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) > extreme) then
|
||||
extreme = real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro))
|
||||
t = i
|
||||
|
|
@ -723,21 +723,21 @@ subroutine material_populateGrains()
|
|||
orientationOfGrain = 0.0_pReal
|
||||
grain = 0_pInt ! reset microstructure grain index
|
||||
|
||||
do i = 1,microstructure_Nconstituents(micro) ! loop over constituents
|
||||
do i = 1_pInt,microstructure_Nconstituents(micro) ! loop over constituents
|
||||
phaseID = microstructure_phase(i,micro)
|
||||
textureID = microstructure_texture(i,micro)
|
||||
phaseOfGrain(grain+1:grain+NgrainsOfConstituent(i)) = phaseID ! assign resp. phase
|
||||
textureOfGrain(grain+1:grain+NgrainsOfConstituent(i)) = textureID ! assign resp. texture
|
||||
phaseOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = phaseID ! assign resp. phase
|
||||
textureOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = textureID ! assign resp. texture
|
||||
|
||||
myNorientations = ceiling(real(NgrainsOfConstituent(i),pReal)/&
|
||||
real(texture_symmetry(textureID),pReal)) ! max number of unique orientations (excl. symmetry)
|
||||
real(texture_symmetry(textureID),pReal),pInt) ! max number of unique orientations (excl. symmetry)
|
||||
|
||||
constituentGrain = 0_pInt ! constituent grain index
|
||||
! ---------
|
||||
if (texture_ODFfile(textureID) == '') then ! dealing with texture components
|
||||
! ---------
|
||||
do t = 1,texture_Ngauss(textureID) ! loop over Gauss components
|
||||
do g = 1,int(myNorientations*texture_Gauss(5,t,textureID)) ! loop over required grain count
|
||||
do t = 1_pInt,texture_Ngauss(textureID) ! loop over Gauss components
|
||||
do g = 1_pInt,int(myNorientations*texture_Gauss(5,t,textureID),pInt) ! loop over required grain count
|
||||
orientationOfGrain(:,grain+constituentGrain+g) = &
|
||||
math_sampleGaussOri(texture_Gauss(1:3,t,textureID),&
|
||||
texture_Gauss( 4,t,textureID))
|
||||
|
|
@ -745,17 +745,17 @@ subroutine material_populateGrains()
|
|||
constituentGrain = constituentGrain + int(myNorientations*texture_Gauss(5,t,textureID))
|
||||
enddo
|
||||
|
||||
do t = 1,texture_Nfiber(textureID) ! loop over fiber components
|
||||
do g = 1,int(myNorientations*texture_Fiber(6,t,textureID)) ! loop over required grain count
|
||||
do t = 1_pInt,texture_Nfiber(textureID) ! loop over fiber components
|
||||
do g = 1_pInt,int(myNorientations*texture_Fiber(6,t,textureID),pInt) ! loop over required grain count
|
||||
orientationOfGrain(:,grain+constituentGrain+g) = &
|
||||
math_sampleFiberOri(texture_Fiber(1:2,t,textureID),&
|
||||
texture_Fiber(3:4,t,textureID),&
|
||||
texture_Fiber( 5,t,textureID))
|
||||
enddo
|
||||
constituentGrain = constituentGrain + int(myNorientations*texture_fiber(6,t,textureID))
|
||||
constituentGrain = constituentGrain + int(myNorientations*texture_fiber(6,t,textureID),pInt)
|
||||
enddo
|
||||
|
||||
do j = constituentGrain+1,myNorientations ! fill remainder with random
|
||||
do j = constituentGrain+1_pInt,myNorientations ! fill remainder with random
|
||||
orientationOfGrain(:,grain+j) = math_sampleRandomOri()
|
||||
enddo
|
||||
! ---------
|
||||
|
|
@ -770,12 +770,12 @@ subroutine material_populateGrains()
|
|||
symExtension = texture_symmetry(textureID) - 1_pInt
|
||||
if (symExtension > 0_pInt) then ! sample symmetry
|
||||
constituentGrain = NgrainsOfConstituent(i)-myNorientations ! calc remainder of array
|
||||
do j = 1,myNorientations ! loop over each "real" orientation
|
||||
do j = 1_pInt,myNorientations ! loop over each "real" orientation
|
||||
symOrientation = math_symmetricEulers(texture_symmetry(textureID),orientationOfGrain(:,j)) ! get symmetric equivalents
|
||||
e = min(symExtension,constituentGrain) ! are we at end of constituent grain array?
|
||||
if (e > 0_pInt) then
|
||||
orientationOfGrain(:,grain+myNorientations+1+(j-1)*symExtension:&
|
||||
grain+myNorientations+e+(j-1)*symExtension) = &
|
||||
orientationOfGrain(:,grain+myNorientations+1+(j-1_pInt)*symExtension:&
|
||||
grain+myNorientations+e+(j-1_pInt)*symExtension) = &
|
||||
symOrientation(:,1:e)
|
||||
constituentGrain = constituentGrain - e ! remainder shrinks by e
|
||||
endif
|
||||
|
|
@ -787,7 +787,7 @@ subroutine material_populateGrains()
|
|||
|
||||
! ----------------------------------------------------------------------------
|
||||
if (.not. microstructure_elemhomo(micro)) then ! unless element homogeneous, reshuffle grains
|
||||
do i=1,myNgrains-1 ! walk thru grains
|
||||
do i=1_pInt,myNgrains-1_pInt ! walk thru grains
|
||||
call random_number(rnd)
|
||||
t = nint(rnd*(myNgrains-i)+i+0.5_pReal,pInt) ! select a grain in remaining list
|
||||
m = phaseOfGrain(t) ! exchange current with random
|
||||
|
|
@ -809,7 +809,7 @@ subroutine material_populateGrains()
|
|||
do hme = 1_pInt, Nelems(homog,micro)
|
||||
e = elemsOfHomogMicro(hme,homog,micro) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
|
||||
if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs
|
||||
forall (i = 1:FE_Nips(mesh_element(2,e)), g = 1:dGrains) ! loop over IPs and grains
|
||||
forall (i = 1_pInt:FE_Nips(mesh_element(2,e)), g = 1_pInt:dGrains) ! loop over IPs and grains
|
||||
material_volume(g,i,e) = volumeOfGrain(grain+g)
|
||||
material_phase(g,i,e) = phaseOfGrain(grain+g)
|
||||
material_texture(g,i,e) = textureOfGrain(grain+g)
|
||||
|
|
@ -818,11 +818,11 @@ subroutine material_populateGrains()
|
|||
FEsolving_execIP(2,e) = 1_pInt ! restrict calculation to first IP only, since all other results are to be copied from this
|
||||
grain = grain + dGrains ! wind forward by NgrainsPerIP
|
||||
else
|
||||
forall (i = 1:FE_Nips(mesh_element(2,e)), g = 1:dGrains) ! loop over IPs and grains
|
||||
material_volume(g,i,e) = volumeOfGrain(grain+(i-1)*dGrains+g)
|
||||
material_phase(g,i,e) = phaseOfGrain(grain+(i-1)*dGrains+g)
|
||||
material_texture(g,i,e) = textureOfGrain(grain+(i-1)*dGrains+g)
|
||||
material_EulerAngles(:,g,i,e) = orientationOfGrain(:,grain+(i-1)*dGrains+g)
|
||||
forall (i = 1_pInt:FE_Nips(mesh_element(2,e)), g = 1_pInt:dGrains) ! loop over IPs and grains
|
||||
material_volume(g,i,e) = volumeOfGrain(grain+(i-1_pInt)*dGrains+g)
|
||||
material_phase(g,i,e) = phaseOfGrain(grain+(i-1_pInt)*dGrains+g)
|
||||
material_texture(g,i,e) = textureOfGrain(grain+(i-1_pInt)*dGrains+g)
|
||||
material_EulerAngles(:,g,i,e) = orientationOfGrain(:,grain+(i-1_pInt)*dGrains+g)
|
||||
end forall
|
||||
grain = grain + FE_Nips(mesh_element(2,e)) * dGrains ! wind forward by Nips*NgrainsPerIP
|
||||
endif
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
real(pReal), parameter :: pi = 3.14159265358979323846264338327950288419716939937510_pReal
|
||||
real(pReal), parameter :: inDeg = 180.0_pReal/pi
|
||||
real(pReal), parameter :: inRad = pi/180.0_pReal
|
||||
complex(pReal), parameter :: two_pi_img = cmplx(0.0_pReal,2.0_pReal* pi, pReal)
|
||||
complex(pReal), parameter :: two_pi_img = (0.0_pReal,2.0_pReal)* pi
|
||||
|
||||
! *** 3x3 Identity ***
|
||||
real(pReal), dimension(3,3), parameter :: math_I3 = &
|
||||
|
|
@ -265,7 +265,7 @@ real(pReal), dimension(4,36), parameter :: math_symOperations = &
|
|||
integer(pInt), intent(in) :: istart,iend
|
||||
integer(pInt) :: d,i,j,k,x,tmp
|
||||
|
||||
d = size(a,1_pInt) ! number of linked data
|
||||
d = int(size(a,1_pInt), pInt) ! number of linked data
|
||||
! set the starting and ending points, and the pivot point
|
||||
|
||||
i = istart
|
||||
|
|
@ -3433,7 +3433,7 @@ subroutine curl_fft(res,geomdim,vec_tens,field,curl)
|
|||
xi(i,j,k,1:3) = real(k_s, pReal)/geomdim
|
||||
enddo; enddo; enddo
|
||||
|
||||
do k = 1_pInt, res(3); do j = 1_pInt, res(2);do i = 1_pInt, res1_red
|
||||
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res1_red
|
||||
do l = 1_pInt, vec_tens
|
||||
curl_fourier(i,j,k,l,1) = ( field_fourier(i,j,k,l,3)*xi(i,j,k,2)&
|
||||
-field_fourier(i,j,k,l,2)*xi(i,j,k,3) )*two_pi_img
|
||||
|
|
|
|||
761
code/mesh.f90
761
code/mesh.f90
File diff suppressed because it is too large
Load Diff
|
|
@ -69,18 +69,18 @@ real(pReal) :: relevantStrain = 1.0e-7_pReal, &
|
|||
err_stress_tolrel = 0.01_pReal , & ! relative tolerance for fullfillment of stress BC, Default: 0.01 allowing deviation of 1% of maximum stress
|
||||
fftw_timelimit = -1.0_pReal, & ! sets the timelimit of plan creation for FFTW, see manual on www.fftw.org, Default -1.0: disable timelimit
|
||||
rotation_tol = 1.0e-12_pReal ! tolerance of rotation specified in loadcase, Default 1.0e-12: first guess
|
||||
character(len=64) :: fftw_planner_string = 'FFTW_PATIENT' ! reads the planing-rigor flag, see manual on www.fftw.org, Default FFTW_PATIENT: use patiant planner flag
|
||||
integer(pInt) :: fftw_planner_flag = -1_pInt ! conversion of fftw_planner_string to integer, basically what is usually done in the include file of fftw
|
||||
logical :: memory_efficient = .true. ,& ! for fast execution (pre calculation of gamma_hat), Default .true.: do not precalculate
|
||||
divergence_correction = .false. ,& ! correct divergence calculation in fourier space, Default .false.: no correction
|
||||
update_gamma = .false.,& ! update gamma operator with current stiffness, Default .false.: use initial stiffness
|
||||
character(len=64) :: fftw_plan_mode = 'FFTW_PATIENT' ! reads the planing-rigor flag, see manual on www.fftw.org, Default FFTW_PATIENT: use patiant planner flag
|
||||
integer(pInt) :: fftw_planner_flag = -1_pInt, & ! conversion of fftw_plan_mode to integer, basically what is usually done in the include file of fftw
|
||||
itmax = 20_pInt ! maximum number of iterations
|
||||
logical :: memory_efficient = .true., & ! for fast execution (pre calculation of gamma_hat), Default .true.: do not precalculate
|
||||
divergence_correction = .false., & ! correct divergence calculation in fourier space, Default .false.: no correction
|
||||
update_gamma = .false., & ! update gamma operator with current stiffness, Default .false.: use initial stiffness
|
||||
simplified_algorithm = .true. ! use short algorithm without fluctuation field, Default .true.: use simplified algorithm
|
||||
real(pReal) :: cut_off_value = 0.0_pReal ! percentage of frequencies to cut away, Default 0.0: use all frequencies
|
||||
integer(pInt) :: itmax = 20_pInt , & ! maximum number of iterations
|
||||
|
||||
|
||||
|
||||
!* Random seeding parameters
|
||||
fixedSeed = 0_pInt ! fixed seeding for pseudo-random number generator, Default 0: use random seed
|
||||
integer(pInt) :: fixedSeed = 0_pInt ! fixed seeding for pseudo-random number generator, Default 0: use random seed
|
||||
!* OpenMP variable
|
||||
integer(pInt) :: DAMASK_NumThreadsInt = 0_pInt ! value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive
|
||||
|
||||
|
|
@ -111,7 +111,7 @@ subroutine numerics_init()
|
|||
!*** local variables ***!
|
||||
integer(pInt), parameter :: fileunit = 300_pInt
|
||||
integer(pInt), parameter :: maxNchunks = 2_pInt
|
||||
integer(pInt) :: gotDAMASK_NUM_THREADS = 1_pInt
|
||||
integer :: gotDAMASK_NUM_THREADS = 1
|
||||
integer(pInt), dimension(1+2*maxNchunks) :: positions
|
||||
character(len=64) :: tag
|
||||
character(len=1024) :: line
|
||||
|
|
@ -127,9 +127,9 @@ subroutine numerics_init()
|
|||
!$OMP END CRITICAL (write2out)
|
||||
|
||||
!$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS...
|
||||
!$ if(gotDAMASK_NUM_THREADS /= 0_pInt) call IO_warning(47_pInt,ext_msg=DAMASK_NumThreadsString)
|
||||
!$ if(gotDAMASK_NUM_THREADS /= 0) call IO_warning(47_pInt,ext_msg=DAMASK_NumThreadsString)
|
||||
!$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! ...convert it to integer...
|
||||
!$ if (DAMASK_NumThreadsInt < 1) DAMASK_NumThreadsInt = 1 ! ...ensure that its at least one...
|
||||
!$ if (DAMASK_NumThreadsInt < 1_pInt) DAMASK_NumThreadsInt = 1_pInt ! ...ensure that its at least one...
|
||||
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! ...and use it as number of threads for parallel execution
|
||||
|
||||
! try to open the config file
|
||||
|
|
@ -238,8 +238,8 @@ subroutine numerics_init()
|
|||
memory_efficient = IO_intValue(line,positions,2_pInt) > 0_pInt
|
||||
case ('fftw_timelimit')
|
||||
fftw_timelimit = IO_floatValue(line,positions,2_pInt)
|
||||
case ('fftw_planner_string')
|
||||
fftw_planner_string = IO_stringValue(line,positions,2_pInt)
|
||||
case ('fftw_plan_mode')
|
||||
fftw_plan_mode = IO_stringValue(line,positions,2_pInt)
|
||||
case ('rotation_tol')
|
||||
rotation_tol = IO_floatValue(line,positions,2_pInt)
|
||||
case ('divergence_correction')
|
||||
|
|
@ -248,8 +248,6 @@ subroutine numerics_init()
|
|||
update_gamma = IO_intValue(line,positions,2_pInt) > 0_pInt
|
||||
case ('simplified_algorithm')
|
||||
simplified_algorithm = IO_intValue(line,positions,2_pInt) > 0_pInt
|
||||
case ('cut_off_value')
|
||||
cut_off_value = IO_floatValue(line,positions,2_pInt)
|
||||
|
||||
!* Random seeding parameters
|
||||
|
||||
|
|
@ -272,7 +270,7 @@ subroutine numerics_init()
|
|||
|
||||
endif
|
||||
|
||||
select case(IO_lc(fftw_planner_string)) ! setting parameters for the plan creation of FFTW. Basically a translation from fftw3.f
|
||||
select case(IO_lc(fftw_plan_mode)) ! setting parameters for the plan creation of FFTW. Basically a translation from fftw3.f
|
||||
case('estimate','fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution
|
||||
fftw_planner_flag = 64_pInt
|
||||
case('measure','fftw_measure')
|
||||
|
|
@ -282,7 +280,7 @@ subroutine numerics_init()
|
|||
case('exhaustive','fftw_exhaustive')
|
||||
fftw_planner_flag = 8_pInt
|
||||
case default
|
||||
call IO_warning(warning_ID=47_pInt,ext_msg=trim(IO_lc(fftw_planner_string)))
|
||||
call IO_warning(warning_ID=47_pInt,ext_msg=trim(IO_lc(fftw_plan_mode)))
|
||||
fftw_planner_flag = 32_pInt
|
||||
end select
|
||||
|
||||
|
|
@ -341,13 +339,12 @@ subroutine numerics_init()
|
|||
else
|
||||
write(6,'(a24,1x,e8.1)') ' fftw_timelimit: ',fftw_timelimit
|
||||
endif
|
||||
write(6,'(a24,1x,a)') ' fftw_planner_string: ',trim(fftw_planner_string)
|
||||
write(6,'(a24,1x,a)') ' fftw_plan_mode: ',trim(fftw_plan_mode)
|
||||
write(6,'(a24,1x,i8)') ' fftw_planner_flag: ',fftw_planner_flag
|
||||
write(6,'(a24,1x,e8.1)') ' rotation_tol: ',rotation_tol
|
||||
write(6,'(a24,1x,L8,/)') ' divergence_correction: ',divergence_correction
|
||||
write(6,'(a24,1x,L8,/)') ' update_gamma: ',update_gamma
|
||||
write(6,'(a24,1x,L8,/)') ' simplified_algorithm: ',simplified_algorithm
|
||||
write(6,'(a24,1x,e8.1)') ' cut_off_value: ',cut_off_value
|
||||
|
||||
!* Random seeding parameters
|
||||
|
||||
|
|
@ -411,7 +408,7 @@ subroutine numerics_init()
|
|||
|
||||
if (fixedSeed <= 0_pInt) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
write(6,'(a)') 'Random is random!'
|
||||
write(6,'(a)') ' Random is random!'
|
||||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
endsubroutine
|
||||
|
|
|
|||
|
|
@ -35,13 +35,13 @@ real(pReal), parameter, public :: tol_gravityNodePos = 1.0e-100_pReal
|
|||
! from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html
|
||||
! copy can be found in documentation/Code/Fortran
|
||||
#ifdef __INTEL_COMPILER
|
||||
#if __INTEL_COMPILER<12000
|
||||
real(pReal), parameter, public :: DAMASK_NaN = Z'7FF0000000000001'
|
||||
#if __INTEL_COMPILER<1200
|
||||
real(pReal), parameter, public :: DAMASK_NaN = Z'7FF0000000000001'
|
||||
#else
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF0000000000001', pReal)
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF0000000000001', pReal)
|
||||
#endif
|
||||
#else
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF0000000000001', pReal)
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF0000000000001', pReal)
|
||||
#endif
|
||||
type :: p_vec
|
||||
real(pReal), dimension(:), pointer :: p
|
||||
|
|
|
|||
|
|
@ -35,13 +35,13 @@ real(pReal), parameter, public :: tol_gravityNodePos = 1.0e-36_pReal
|
|||
! from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html
|
||||
! copy can be found in documentation/Code/Fortran
|
||||
#ifdef __INTEL_COMPILER
|
||||
#if __INTEL_COMPILER<12000
|
||||
real(pReal), parameter, public :: DAMASK_NaN = Z'Z'7F800001', pReal'
|
||||
#if __INTEL_COMPILER<1200
|
||||
real(pReal), parameter, public :: DAMASK_NaN = Z'Z'7F800001', pReal'
|
||||
#else
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7F800001', pReal)
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7F800001', pReal)
|
||||
#endif
|
||||
#else
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7F800001', pReal)
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7F800001', pReal)
|
||||
#endif
|
||||
type :: p_vec
|
||||
real(pReal), dimension(:), pointer :: p
|
||||
|
|
|
|||
Loading…
Reference in New Issue