diff --git a/code/IO.f90 b/code/IO.f90 index e9ee64920..5aee6eea0 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -21,7 +21,7 @@ !############################################################## MODULE IO !############################################################## - + CONTAINS !--------------------------- ! function IO_abaqus_assembleInputFile @@ -50,6 +50,7 @@ !******************************************************************** subroutine IO_init () +use, intrinsic :: iso_fortran_env !$OMP CRITICAL (write2out) write(6,*) write(6,*) '<<<+- IO init -+>>>' @@ -156,9 +157,8 @@ end function use prec, only: pInt use DAMASK_interface + implicit none - - character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash character(len=*) relPath integer(pInt) unit @@ -193,8 +193,8 @@ end function trim(model)//InputFileExtension) open(unit,err=100,file=trim(getSolverWorkingDirectoryName())//& trim(model)//InputFileExtension//'_assembly') - IO_open_inputFile = IO_abaqus_assembleInputFile(unit,unit+1) ! strip comments and concatenate any "include"s - close(unit+1) + IO_open_inputFile = IO_abaqus_assembleInputFile(unit,unit+1_pInt) ! strip comments and concatenate any "include"s + close(unit+1_pInt) else open(unit,status='old',err=100,file=trim(getSolverWorkingDirectoryName())//& trim(model)//InputFileExtension) @@ -382,7 +382,7 @@ end function pos = IO_stringPos(line,3_pInt) if (pos(1).ne.3) goto 100 do i=1,3 - limits(i) = IO_intValue(line,pos,i)*inRad + limits(i) = IO_floatValue(line,pos,i)*inRad enddo !--- deltas in phi1, Phi, phi2 --- @@ -390,7 +390,7 @@ end function pos = IO_stringPos(line,3_pInt) if (pos(1).ne.3) goto 100 do i=1,3 - deltas(i) = IO_intValue(line,pos,i)*inRad + deltas(i) = IO_floatValue(line,pos,i)*inRad enddo steps = nint(limits/deltas,pInt) allocate(dV_V(steps(3),steps(2),steps(1))) @@ -455,7 +455,7 @@ end function enddo allocate(binSet(Nreps)) - bin = 0 ! bin counter + bin = 0_pInt ! bin counter i = 1 ! set counter do phi1=1,steps(1) do Phi=1,steps(2) @@ -476,16 +476,16 @@ end function j = i endif bin = binSet(j) - IO_hybridIA(1,i) = deltas(1)*(mod(bin/(steps(3)*steps(2)),steps(1))+center) ! phi1 - IO_hybridIA(2,i) = deltas(2)*(mod(bin/ steps(3) ,steps(2))+center) ! Phi - IO_hybridIA(3,i) = deltas(3)*(mod(bin ,steps(3))+center) ! phi2 + IO_hybridIA(1,i) = deltas(1)*(real(mod(bin/(steps(3)*steps(2)),steps(1)),pReal)+center) ! phi1 + IO_hybridIA(2,i) = deltas(2)*(real(mod(bin/ steps(3) ,steps(2)),pReal)+center) ! Phi + IO_hybridIA(3,i) = deltas(3)*(real(mod(bin ,steps(3)),pReal)+center) ! phi2 binSet(j) = binSet(i) enddo close(999) return ! on error -100 IO_hybridIA = -1 +100 IO_hybridIA = -1.0_pReal close(999) endfunction @@ -1004,7 +1004,8 @@ endfunction 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)) + (IO_intValue(line,pos,2_pInt)-IO_intValue(line,pos,1_pInt))/& + max(1_pInt,IO_intValue(line,pos,3_pInt)) enddo endselect @@ -1175,17 +1176,19 @@ endfunction case (101_pInt) msg = 'opening input file' case (102_pInt) - msg = 'precistion not suitable for FFTW' + msg = 'non-positive dimension' case (103_pInt) msg = 'odd resolution given' - case (104_pInt) - msg = 'initializing FFTW' case (105_pInt) msg = 'reading from ODF file' case (106_pInt) msg = 'reading info on old job' case (107_pInt) msg = 'writing spectralOut file' + case (108_pInt) + msg = 'precistion not suitable for FFTW' + case (109_pInt) + msg = 'initializing FFTW' case (110_pInt) msg = 'no homogenization specified via State Variable 2' case (120_pInt) @@ -1392,7 +1395,7 @@ endfunction endif write(6,'(a38)') '+------------------------------------+' call flush(6) - call quit(9000+error_ID) + call quit(9000_pInt+error_ID) !$OMP END CRITICAL (write2out) ! ABAQUS returns in some cases diff --git a/code/debug.f90 b/code/debug.f90 index 91771e7de..42f454a80 100644 --- a/code/debug.f90 +++ b/code/debug.f90 @@ -36,9 +36,9 @@ integer(pInt), dimension(:,:), allocatable :: debug_StateLoopDistribution integer(pInt), dimension(:), allocatable :: debug_CrystalliteLoopDistribution integer(pInt), dimension(:), allocatable :: debug_MaterialpointStateLoopDistribution integer(pInt), dimension(:), allocatable :: debug_MaterialpointLoopDistribution -integer(pLongInt) :: debug_cumLpTicks = 0_pInt -integer(pLongInt) :: debug_cumDotStateTicks = 0_pInt -integer(pLongInt) :: debug_cumDotTemperatureTicks = 0_pInt +integer(pLongInt) :: debug_cumLpTicks = 0_pLongInt +integer(pLongInt) :: debug_cumDotStateTicks = 0_pLongInt +integer(pLongInt) :: debug_cumDotTemperatureTicks = 0_pLongInt integer(pInt) :: debug_cumLpCalls = 0_pInt integer(pInt) :: debug_cumDotStateCalls = 0_pInt integer(pInt) :: debug_cumDotTemperatureCalls = 0_pInt @@ -65,6 +65,7 @@ CONTAINS !******************************************************************** subroutine debug_init() + use, intrinsic :: iso_fortran_env use prec, only: pInt use numerics, only: nStress, & nState, & @@ -115,27 +116,27 @@ subroutine debug_init() read(fileunit,'(a1024)',END=100) line if (IO_isBlank(line)) cycle ! skip empty lines 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) case ('element','e','el') - debug_e = IO_intValue(line,positions,2) + debug_e = IO_intValue(line,positions,2_pInt) case ('integrationpoint','i','ip') - debug_i = IO_intValue(line,positions,2) + debug_i = IO_intValue(line,positions,2_pInt) case ('grain','g','gr') - debug_g = IO_intValue(line,positions,2) + debug_g = IO_intValue(line,positions,2_pInt) case ('selective') - debug_selectiveDebugger = IO_intValue(line,positions,2) > 0_pInt + debug_selectiveDebugger = IO_intValue(line,positions,2_pInt) > 0_pInt case ('verbosity') - debug_verbosity = IO_intValue(line,positions,2) + debug_verbosity = IO_intValue(line,positions,2_pInt) case ('(spectral)') - select case(IO_lc(IO_stringValue(line,positions,2))) + select case(IO_lc(IO_stringValue(line,positions,2_pInt))) case('general') debug_spectral = ior(debug_spectral, debug_spectralGeneral) case('divergence') debug_spectral = ior(debug_spectral, debug_spectralDivergence) case('restart') debug_spectral = ior(debug_spectral, debug_spectralRestart) - case('fftw') + case('fftw', 'fft') debug_spectral = ior(debug_spectral, debug_spectralFFTW) endselect endselect @@ -203,9 +204,9 @@ subroutine debug_reset() debug_CrystalliteLoopDistribution = 0_pInt debug_MaterialpointStateLoopDistribution = 0_pInt debug_MaterialpointLoopDistribution = 0_pInt - debug_cumLpTicks = 0_pInt - debug_cumDotStateTicks = 0_pInt - debug_cumDotTemperatureTicks = 0_pInt + debug_cumLpTicks = 0_pLongInt + debug_cumDotStateTicks = 0_pLongInt + debug_cumDotTemperatureTicks = 0_pLongInt debug_cumLpCalls = 0_pInt debug_cumDotStateCalls = 0_pInt debug_cumDotTemperatureCalls = 0_pInt @@ -247,23 +248,28 @@ subroutine debug_info() write(6,*) write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls 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 :',& - dble(debug_cumLpTicks)*1.0e6_pReal/tickrate/debug_cumLpCalls + real(debug_cumLpTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)/real(debug_cumLpCalls,pReal) endif write(6,*) write(6,'(a33,1x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls 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 :',& - dble(debug_cumDotStateTicks)*1.0e6_pReal/tickrate/debug_cumDotStateCalls + real(debug_cumDotStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)& + /real(debug_cumDotStateCalls,pReal) endif write(6,*) write(6,'(a33,1x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls 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 :',& - dble(debug_cumDotTemperatureTicks)*1.0e6_pReal/tickrate/debug_cumDotTemperatureCalls + real(debug_cumDotTemperatureTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)& + /real(debug_cumDotTemperatureCalls,pReal) endif integral = 0_pInt diff --git a/code/math.f90 b/code/math.f90 index 1918a6499..f099d97f2 100644 --- a/code/math.f90 +++ b/code/math.f90 @@ -584,7 +584,7 @@ real(pReal), dimension(4,36), parameter :: math_symOperations = & real(pReal), dimension(3), intent(in) :: B 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 @@ -2954,8 +2954,8 @@ end subroutine if (debug_verbosity > 0_pInt) then print*, 'Calculating volume mismatch' - print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim - print '(a,i5,i5,i5)', ' Resolution:', res + print '(a,3(e12.5))', ' Dimension: ', geomdim + print '(a,3(i5))', ' Resolution:', res endif 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 print*, 'Calculating shape mismatch' - print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim - print '(a,i5,i5,i5)', ' Resolution:', res + print '(a,3(e12.5))', ' Dimension: ', geomdim + print '(a,3(i5))', ' Resolution:', res endif 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 print*, 'Meshing cubes around centroids' - print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim - print '(a,i5,i5,i5)', ' Resolution:', res + print '(a,3(e12.5))', ' Dimension: ', geomdim + print '(a,3(i5))', ' Resolution:', res endif nodes = 0.0_pReal @@ -3188,8 +3188,8 @@ subroutine deformed_linear(res,geomdim,defgrad_av,defgrad,coord_avgCorner) if (debug_verbosity > 0_pInt) then print*, 'Restore geometry using linear integration' - print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim - print '(a,i5,i5,i5)', ' Resolution:', res + print '(a,3(e12.5))', ' Dimension: ', geomdim + print '(a,3(i5))', ' Resolution:', res endif 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 print*, 'Restore geometry using FFT-based integration' - print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim - print '(a,i5,i5,i5)', ' Resolution:', res + print '(a,3(e12.5))', ' Dimension: ', geomdim + print '(a,3(i5))', ' Resolution:', res endif 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 print*, 'Calculating curl of vector/tensor field' - print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim - print '(a,i5,i5,i5)', ' Resolution:', res + print '(a,3(e12.5))', ' Dimension: ', geomdim + print '(a,3(i5))', ' Resolution:', res endif 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 if(res(1)>1_pInt) & 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) & 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) & 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) 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 print '(a)', 'Calculating divergence of tensor/vector field using FFT' - print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim - print '(a,i5,i5,i5)', ' Resolution:', res + print '(a,3(e12.5))', ' Dimension: ', geomdim + print '(a,3(i5))', ' Resolution:', res endif 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 if(res(1)>1_pInt) & 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) & 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) & 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 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 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 print*, 'Calculating divergence of tensor/vector field using FDM' - print '(a,e12.5,e12.5,e12.5)', ' Dimension: ', geomdim - print '(a,i5,i5,i5)', ' Resolution:', res + print '(a,3(e12.5))', ' Dimension: ', geomdim + print '(a,3(i5))', ' Resolution:', res endif divergence = 0.0_pReal diff --git a/code/numerics.f90 b/code/numerics.f90 index da7cf834c..8a1744d92 100644 --- a/code/numerics.f90 +++ b/code/numerics.f90 @@ -127,7 +127,7 @@ use, intrinsic :: iso_fortran_env !$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,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... !$ 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