223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

removed implicit type castings

This commit is contained in:
Martin Diehl 2012-02-10 11:24:53 +00:00
parent 26b4f886ba
commit cff66b5cc3
4 changed files with 71 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
code/IO.f90
View File

@ -21,7 +21,7 @@
!############################################################## !##############################################################
MODULE IO MODULE IO
!############################################################## !##############################################################
CONTAINS CONTAINS
!--------------------------- !---------------------------
! function IO_abaqus_assembleInputFile ! function IO_abaqus_assembleInputFile
@ -50,6 +50,7 @@
!******************************************************************** !********************************************************************
subroutine IO_init () subroutine IO_init ()
use, intrinsic :: iso_fortran_env
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,*)
write(6,*) '<<<+- IO init -+>>>' write(6,*) '<<<+- IO init -+>>>'
@ -156,9 +157,8 @@ end function
use prec, only: pInt use prec, only: pInt
use DAMASK_interface use DAMASK_interface
implicit none implicit none
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
character(len=*) relPath character(len=*) relPath
integer(pInt) unit integer(pInt) unit
@ -193,8 +193,8 @@ end function
trim(model)//InputFileExtension) trim(model)//InputFileExtension)
open(unit,err=100,file=trim(getSolverWorkingDirectoryName())//& open(unit,err=100,file=trim(getSolverWorkingDirectoryName())//&
trim(model)//InputFileExtension//'_assembly') trim(model)//InputFileExtension//'_assembly')
IO_open_inputFile = IO_abaqus_assembleInputFile(unit,unit+1) ! strip comments and concatenate any "include"s IO_open_inputFile = IO_abaqus_assembleInputFile(unit,unit+1_pInt) ! strip comments and concatenate any "include"s
close(unit+1) close(unit+1_pInt)
else else
open(unit,status='old',err=100,file=trim(getSolverWorkingDirectoryName())//& open(unit,status='old',err=100,file=trim(getSolverWorkingDirectoryName())//&
trim(model)//InputFileExtension) trim(model)//InputFileExtension)
@ -382,7 +382,7 @@ end function
pos = IO_stringPos(line,3_pInt) pos = IO_stringPos(line,3_pInt)
if (pos(1).ne.3) goto 100 if (pos(1).ne.3) goto 100
do i=1,3 do i=1,3
limits(i) = IO_intValue(line,pos,i)*inRad limits(i) = IO_floatValue(line,pos,i)*inRad
enddo enddo
!--- deltas in phi1, Phi, phi2 --- !--- deltas in phi1, Phi, phi2 ---
@ -390,7 +390,7 @@ end function
pos = IO_stringPos(line,3_pInt) pos = IO_stringPos(line,3_pInt)
if (pos(1).ne.3) goto 100 if (pos(1).ne.3) goto 100
do i=1,3 do i=1,3
deltas(i) = IO_intValue(line,pos,i)*inRad deltas(i) = IO_floatValue(line,pos,i)*inRad
enddo enddo
steps = nint(limits/deltas,pInt) steps = nint(limits/deltas,pInt)
allocate(dV_V(steps(3),steps(2),steps(1))) allocate(dV_V(steps(3),steps(2),steps(1)))
@ -455,7 +455,7 @@ end function
enddo enddo
allocate(binSet(Nreps)) allocate(binSet(Nreps))
bin = 0 ! bin counter bin = 0_pInt ! bin counter
i = 1 ! set counter i = 1 ! set counter
do phi1=1,steps(1) do phi1=1,steps(1)
do Phi=1,steps(2) do Phi=1,steps(2)
@ -476,16 +476,16 @@ end function
j = i j = i
endif endif
bin = binSet(j) bin = binSet(j)
IO_hybridIA(1,i) = deltas(1)*(mod(bin/(steps(3)*steps(2)),steps(1))+center) ! phi1 IO_hybridIA(1,i) = deltas(1)*(real(mod(bin/(steps(3)*steps(2)),steps(1)),pReal)+center) ! phi1
IO_hybridIA(2,i) = deltas(2)*(mod(bin/ steps(3) ,steps(2))+center) ! Phi IO_hybridIA(2,i) = deltas(2)*(real(mod(bin/ steps(3) ,steps(2)),pReal)+center) ! Phi
IO_hybridIA(3,i) = deltas(3)*(mod(bin ,steps(3))+center) ! phi2 IO_hybridIA(3,i) = deltas(3)*(real(mod(bin ,steps(3)),pReal)+center) ! phi2
binSet(j) = binSet(i) binSet(j) = binSet(i)
enddo enddo
close(999) close(999)
return return
! on error ! on error
100 IO_hybridIA = -1 100 IO_hybridIA = -1.0_pReal
close(999) close(999)
endfunction endfunction
@ -1004,7 +1004,8 @@ endfunction
read(unit,'(A300)',end=100) line read(unit,'(A300)',end=100) line
pos = IO_stringPos(line,maxNchunks) pos = IO_stringPos(line,maxNchunks)
IO_countContinousIntValues = IO_countContinousIntValues + 1 + & ! assuming range generation 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)) (IO_intValue(line,pos,2_pInt)-IO_intValue(line,pos,1_pInt))/&
max(1_pInt,IO_intValue(line,pos,3_pInt))
enddo enddo
endselect endselect
@ -1175,17 +1176,19 @@ endfunction
case (101_pInt) case (101_pInt)
msg = 'opening input file' msg = 'opening input file'
case (102_pInt) case (102_pInt)
msg = 'precistion not suitable for FFTW' msg = 'non-positive dimension'
case (103_pInt) case (103_pInt)
msg = 'odd resolution given' msg = 'odd resolution given'
case (104_pInt)
msg = 'initializing FFTW'
case (105_pInt) case (105_pInt)
msg = 'reading from ODF file' msg = 'reading from ODF file'
case (106_pInt) case (106_pInt)
msg = 'reading info on old job' msg = 'reading info on old job'
case (107_pInt) case (107_pInt)
msg = 'writing spectralOut file' msg = 'writing spectralOut file'
case (108_pInt)
msg = 'precistion not suitable for FFTW'
case (109_pInt)
msg = 'initializing FFTW'
case (110_pInt) case (110_pInt)
msg = 'no homogenization specified via State Variable 2' msg = 'no homogenization specified via State Variable 2'
case (120_pInt) case (120_pInt)
@ -1392,7 +1395,7 @@ endfunction
endif endif
write(6,'(a38)') '+------------------------------------+' write(6,'(a38)') '+------------------------------------+'
call flush(6) call flush(6)
call quit(9000+error_ID) call quit(9000_pInt+error_ID)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
! ABAQUS returns in some cases ! ABAQUS returns in some cases

46
code/debug.f90
View File

@ -36,9 +36,9 @@ integer(pInt), dimension(:,:), allocatable :: debug_StateLoopDistribution
integer(pInt), dimension(:), allocatable :: debug_CrystalliteLoopDistribution integer(pInt), dimension(:), allocatable :: debug_CrystalliteLoopDistribution
integer(pInt), dimension(:), allocatable :: debug_MaterialpointStateLoopDistribution integer(pInt), dimension(:), allocatable :: debug_MaterialpointStateLoopDistribution
integer(pInt), dimension(:), allocatable :: debug_MaterialpointLoopDistribution integer(pInt), dimension(:), allocatable :: debug_MaterialpointLoopDistribution
integer(pLongInt) :: debug_cumLpTicks = 0_pInt integer(pLongInt) :: debug_cumLpTicks = 0_pLongInt
integer(pLongInt) :: debug_cumDotStateTicks = 0_pInt integer(pLongInt) :: debug_cumDotStateTicks = 0_pLongInt
integer(pLongInt) :: debug_cumDotTemperatureTicks = 0_pInt integer(pLongInt) :: debug_cumDotTemperatureTicks = 0_pLongInt
integer(pInt) :: debug_cumLpCalls = 0_pInt integer(pInt) :: debug_cumLpCalls = 0_pInt
integer(pInt) :: debug_cumDotStateCalls = 0_pInt integer(pInt) :: debug_cumDotStateCalls = 0_pInt
integer(pInt) :: debug_cumDotTemperatureCalls = 0_pInt integer(pInt) :: debug_cumDotTemperatureCalls = 0_pInt
@ -65,6 +65,7 @@ CONTAINS
!******************************************************************** !********************************************************************
subroutine debug_init() subroutine debug_init()
use, intrinsic :: iso_fortran_env
use prec, only: pInt use prec, only: pInt
use numerics, only: nStress, & use numerics, only: nStress, &
nState, & nState, &
@ -115,27 +116,27 @@ subroutine debug_init()
read(fileunit,'(a1024)',END=100) line read(fileunit,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('element','e','el') case ('element','e','el')
debug_e = IO_intValue(line,positions,2) debug_e = IO_intValue(line,positions,2_pInt)
case ('integrationpoint','i','ip') case ('integrationpoint','i','ip')
debug_i = IO_intValue(line,positions,2) debug_i = IO_intValue(line,positions,2_pInt)
case ('grain','g','gr') case ('grain','g','gr')
debug_g = IO_intValue(line,positions,2) debug_g = IO_intValue(line,positions,2_pInt)
case ('selective') case ('selective')
debug_selectiveDebugger = IO_intValue(line,positions,2) > 0_pInt debug_selectiveDebugger = IO_intValue(line,positions,2_pInt) > 0_pInt
case ('verbosity') case ('verbosity')
debug_verbosity = IO_intValue(line,positions,2) debug_verbosity = IO_intValue(line,positions,2_pInt)
case ('(spectral)') case ('(spectral)')
select case(IO_lc(IO_stringValue(line,positions,2))) select case(IO_lc(IO_stringValue(line,positions,2_pInt)))
case('general') case('general')
debug_spectral = ior(debug_spectral, debug_spectralGeneral) debug_spectral = ior(debug_spectral, debug_spectralGeneral)
case('divergence') case('divergence')
debug_spectral = ior(debug_spectral, debug_spectralDivergence) debug_spectral = ior(debug_spectral, debug_spectralDivergence)
case('restart') case('restart')
debug_spectral = ior(debug_spectral, debug_spectralRestart) debug_spectral = ior(debug_spectral, debug_spectralRestart)
case('fftw') case('fftw', 'fft')
debug_spectral = ior(debug_spectral, debug_spectralFFTW) debug_spectral = ior(debug_spectral, debug_spectralFFTW)
endselect endselect
endselect endselect
@ -203,9 +204,9 @@ subroutine debug_reset()
debug_CrystalliteLoopDistribution = 0_pInt debug_CrystalliteLoopDistribution = 0_pInt
debug_MaterialpointStateLoopDistribution = 0_pInt debug_MaterialpointStateLoopDistribution = 0_pInt
debug_MaterialpointLoopDistribution = 0_pInt debug_MaterialpointLoopDistribution = 0_pInt
debug_cumLpTicks = 0_pInt debug_cumLpTicks = 0_pLongInt
debug_cumDotStateTicks = 0_pInt debug_cumDotStateTicks = 0_pLongInt
debug_cumDotTemperatureTicks = 0_pInt debug_cumDotTemperatureTicks = 0_pLongInt
debug_cumLpCalls = 0_pInt debug_cumLpCalls = 0_pInt
debug_cumDotStateCalls = 0_pInt debug_cumDotStateCalls = 0_pInt
debug_cumDotTemperatureCalls = 0_pInt debug_cumDotTemperatureCalls = 0_pInt
@ -247,23 +248,28 @@ subroutine debug_info()
write(6,*) write(6,*)
write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls
if (debug_cumLpCalls > 0_pInt) then if (debug_cumLpCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',dble(debug_cumLpTicks)/tickrate write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumLpTicks,pReal)&
/real(tickrate,pReal)
write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',& write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',&
dble(debug_cumLpTicks)*1.0e6_pReal/tickrate/debug_cumLpCalls real(debug_cumLpTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)/real(debug_cumLpCalls,pReal)
endif endif
write(6,*) write(6,*)
write(6,'(a33,1x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls write(6,'(a33,1x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls
if (debug_cumdotStateCalls > 0_pInt) then if (debug_cumdotStateCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',dble(debug_cumDotStateTicks)/tickrate write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotStateTicks,pReal)&
/real(tickrate,pReal)
write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',& write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',&
dble(debug_cumDotStateTicks)*1.0e6_pReal/tickrate/debug_cumDotStateCalls real(debug_cumDotStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)&
/real(debug_cumDotStateCalls,pReal)
endif endif
write(6,*) write(6,*)
write(6,'(a33,1x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls write(6,'(a33,1x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls
if (debug_cumdotTemperatureCalls > 0_pInt) then if (debug_cumdotTemperatureCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :', dble(debug_cumDotTemperatureTicks)/tickrate write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotTemperatureTicks,pReal)&
/real(tickrate,pReal)
write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',& write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',&
dble(debug_cumDotTemperatureTicks)*1.0e6_pReal/tickrate/debug_cumDotTemperatureCalls real(debug_cumDotTemperatureTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)&
/real(debug_cumDotTemperatureCalls,pReal)
endif endif
integral = 0_pInt integral = 0_pInt

48
code/math.f90
View File

@ -584,7 +584,7 @@ real(pReal), dimension(4,36), parameter :: math_symOperations = &
real(pReal), dimension(3), intent(in) :: B real(pReal), dimension(3), intent(in) :: B
complex(pReal), dimension(3) :: math_mul33x3_complex complex(pReal), dimension(3) :: math_mul33x3_complex
forall (i=1_pInt:3_pInt) math_mul33x3_complex(i) = sum(A(i,1:3)*B) forall (i=1_pInt:3_pInt) math_mul33x3_complex(i) = sum(A(i,1:3)*cmplx(B,0.0_pReal,pReal))
endfunction math_mul33x3_complex endfunction math_mul33x3_complex
@ -2954,8 +2954,8 @@ end subroutine
if (debug_verbosity > 0_pInt) then if (debug_verbosity > 0_pInt) then
print*, 'Calculating volume mismatch' print*, 'Calculating volume mismatch'
print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,i5,i5,i5)', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
endif endif
vol_initial = geomdim(1)*geomdim(2)*geomdim(3)/(real(res(1)*res(2)*res(3), pReal)) vol_initial = geomdim(1)*geomdim(2)*geomdim(3)/(real(res(1)*res(2)*res(3), pReal))
@ -3007,8 +3007,8 @@ subroutine shape_compare(res,geomdim,defgrad,nodes,centroids,shape_mismatch)
if (debug_verbosity > 0_pInt) then if (debug_verbosity > 0_pInt) then
print*, 'Calculating shape mismatch' print*, 'Calculating shape mismatch'
print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,i5,i5,i5)', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
endif endif
coords_initial(1,1:3) = (/-geomdim(1)/2.0_pReal/real(res(1),pReal),& coords_initial(1,1:3) = (/-geomdim(1)/2.0_pReal/real(res(1),pReal),&
@ -3096,8 +3096,8 @@ subroutine mesh_regular_grid(res,geomdim,defgrad_av,centroids,nodes)
if (debug_verbosity > 0_pInt) then if (debug_verbosity > 0_pInt) then
print*, 'Meshing cubes around centroids' print*, 'Meshing cubes around centroids'
print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,i5,i5,i5)', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
endif endif
nodes = 0.0_pReal nodes = 0.0_pReal
@ -3188,8 +3188,8 @@ subroutine deformed_linear(res,geomdim,defgrad_av,defgrad,coord_avgCorner)
if (debug_verbosity > 0_pInt) then if (debug_verbosity > 0_pInt) then
print*, 'Restore geometry using linear integration' print*, 'Restore geometry using linear integration'
print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,i5,i5,i5)', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
endif endif
coord_avgOrder = 0.0_pReal coord_avgOrder = 0.0_pReal
@ -3276,8 +3276,8 @@ subroutine deformed_fft(res,geomdim,defgrad_av,scaling,defgrad,coords)
if (debug_verbosity > 0_pInt) then if (debug_verbosity > 0_pInt) then
print*, 'Restore geometry using FFT-based integration' print*, 'Restore geometry using FFT-based integration'
print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,i5,i5,i5)', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
endif endif
res1_red = res(1)/2_pInt + 1_pInt ! size of complex array in first dimension (c2r, r2c) res1_red = res(1)/2_pInt + 1_pInt ! size of complex array in first dimension (c2r, r2c)
@ -3399,8 +3399,8 @@ subroutine curl_fft(res,geomdim,vec_tens,field,curl)
if (debug_verbosity > 0_pInt) then if (debug_verbosity > 0_pInt) then
print*, 'Calculating curl of vector/tensor field' print*, 'Calculating curl of vector/tensor field'
print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,i5,i5,i5)', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
endif endif
wgt = 1.0_pReal/real(res(1)*res(2)*res(3),pReal) wgt = 1.0_pReal/real(res(1)*res(2)*res(3),pReal)
@ -3437,13 +3437,13 @@ subroutine curl_fft(res,geomdim,vec_tens,field,curl)
!remove highest frequency in each direction !remove highest frequency in each direction
if(res(1)>1_pInt) & if(res(1)>1_pInt) &
field_fourier( res(1)/2_pInt+1_pInt,1:res(2) ,1:res(3) ,& field_fourier( res(1)/2_pInt+1_pInt,1:res(2) ,1:res(3) ,&
1:3,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal) 1:vec_tens,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
if(res(2)>1_pInt) & if(res(2)>1_pInt) &
field_fourier(1:res1_red ,res(2)/2_pInt+1_pInt,1:res(3) ,& field_fourier(1:res1_red ,res(2)/2_pInt+1_pInt,1:res(3) ,&
1:3,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal) 1:vec_tens,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
if(res(3)>1_pInt) & if(res(3)>1_pInt) &
field_fourier(1:res1_red ,1:res(2) ,res(3)/2_pInt+1_pInt,& field_fourier(1:res1_red ,1:res(2) ,res(3)/2_pInt+1_pInt,&
1:3,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal) 1:vec_tens,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
do k = 1_pInt, res(3) ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around) do k = 1_pInt, res(3) ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around)
k_s(3) = k - 1_pInt k_s(3) = k - 1_pInt
@ -3517,8 +3517,8 @@ subroutine divergence_fft(res,geomdim,vec_tens,field,divergence)
if (debug_verbosity > 0_pInt) then if (debug_verbosity > 0_pInt) then
print '(a)', 'Calculating divergence of tensor/vector field using FFT' print '(a)', 'Calculating divergence of tensor/vector field using FFT'
print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,i5,i5,i5)', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
endif endif
res1_red = res(1)/2_pInt + 1_pInt ! size of complex array in first dimension (c2r, r2c) res1_red = res(1)/2_pInt + 1_pInt ! size of complex array in first dimension (c2r, r2c)
@ -3563,17 +3563,17 @@ if (pReal /= C_DOUBLE .or. pInt /= C_INT) call IO_error(error_ID=102_pInt)
!remove highest frequency in each direction !remove highest frequency in each direction
if(res(1)>1_pInt) & if(res(1)>1_pInt) &
field_fourier( res(1)/2_pInt+1_pInt,1:res(2) ,1:res(3) ,& field_fourier( res(1)/2_pInt+1_pInt,1:res(2) ,1:res(3) ,&
1:3,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal) 1:vec_tens,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
if(res(2)>1_pInt) & if(res(2)>1_pInt) &
field_fourier(1:res1_red ,res(2)/2_pInt+1_pInt,1:res(3) ,& field_fourier(1:res1_red ,res(2)/2_pInt+1_pInt,1:res(3) ,&
1:3,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal) 1:vec_tens,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
if(res(3)>1_pInt) & if(res(3)>1_pInt) &
field_fourier(1:res1_red ,1:res(2) ,res(3)/2_pInt+1_pInt,& field_fourier(1:res1_red ,1:res(2) ,res(3)/2_pInt+1_pInt,&
1:3,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal) 1:vec_tens,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
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 do l = 1_pInt, vec_tens
divergence_fourier(i,j,k,l) = sum(field_fourier(i,j,k,l,1:3)*xi(i,j,k,1:3))& divergence_fourier(i,j,k,l)=sum(field_fourier(i,j,k,l,1:3)*cmplx(xi(i,j,k,1:3),0.0_pReal,pReal))&
*two_pi_img *two_pi_img
enddo enddo
enddo; enddo; enddo enddo; enddo; enddo
@ -3623,8 +3623,8 @@ if (pReal /= C_DOUBLE .or. pInt /= C_INT) call IO_error(error_ID=102_pInt)
if (debug_verbosity > 0_pInt) then if (debug_verbosity > 0_pInt) then
print*, 'Calculating divergence of tensor/vector field using FDM' print*, 'Calculating divergence of tensor/vector field using FDM'
print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,i5,i5,i5)', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
endif endif
divergence = 0.0_pReal divergence = 0.0_pReal

2
code/numerics.f90
View File

@ -127,7 +127,7 @@ use, intrinsic :: iso_fortran_env
!$OMP END CRITICAL (write2out) !$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... !$ 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,ext_msg=DAMASK_NumThreadsString) !$ if(gotDAMASK_NUM_THREADS /= 0_pInt) call IO_warning(47_pInt,ext_msg=DAMASK_NumThreadsString)
!$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! ...convert it to integer... !$ 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) DAMASK_NumThreadsInt = 1 ! ...ensure that its at least one...
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! ...and use it as number of threads for parallel execution !$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! ...and use it as number of threads for parallel execution