From 8956f7f6dace2a9c06e6920cbf5c343f2d6412f5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Jun 2019 14:39:51 +0200 Subject: [PATCH] pInt not needed --- src/IO.f90 | 12 +-- src/debug.f90 | 110 ++++++++++++------------ src/numerics.f90 | 216 +++++++++++++++++++++++------------------------ 3 files changed, 169 insertions(+), 169 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index d3bed09df..a6e0c7836 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -356,7 +356,7 @@ logical pure function IO_isBlank(string) character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces character(len=*), parameter :: comment = achar(35) ! comment id '#' - integer :: posNonBlank, posComment ! no pInt + integer :: posNonBlank, posComment posNonBlank = verify(string,blankChar) posComment = scan(string,comment) @@ -377,7 +377,7 @@ pure function IO_getTag(string,openChar,closeChar) closeChar !< indicates end of tag character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces - integer :: left,right ! no pInt + integer :: left,right IO_getTag = '' @@ -408,7 +408,7 @@ pure function IO_stringPos(string) character(len=*), intent(in) :: string !< string in which chunk positions are searched for character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces - integer :: left, right ! no pInt (verify and scan return default integer) + integer :: left, right allocate(IO_stringPos(1), source=0) right = 0 @@ -417,7 +417,7 @@ pure function IO_stringPos(string) left = right + verify(string(right+1:),SEP) right = left + scan(string(left:),SEP) - 2 if ( string(left:left) == '#' ) exit - IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)] + IO_stringPos = [IO_stringPos,left, right] IO_stringPos(1) = IO_stringPos(1)+1 endOfString: if (right < left) then IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string) @@ -568,7 +568,7 @@ pure function IO_lc(string) character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - integer :: i,n ! no pInt (len returns default integer) + integer :: i,n IO_lc = string do i=1,len(string) @@ -590,7 +590,7 @@ pure function IO_intOut(intToPrint) character(len=19) :: width ! maximum digits for 64 bit integer character(len=20) :: min_width ! longer for negative values - N_digits = 1 + int(log10(real(max(abs(intToPrint),1))),pInt) + N_digits = 1 + int(log10(real(max(abs(intToPrint),1)))) write(width, '(I19.19)') N_digits write(min_width, '(I20.20)') N_digits + merge(1,0,intToPrint < 0) IO_intOut = 'I'//trim(min_width)//'.'//trim(width) diff --git a/src/debug.f90 b/src/debug.f90 index ff084b133..10fc59631 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -12,49 +12,49 @@ module debug implicit none private - integer(pInt), parameter, public :: & - debug_LEVELSELECTIVE = 2_pInt**0_pInt, & - debug_LEVELBASIC = 2_pInt**1_pInt, & - debug_LEVELEXTENSIVE = 2_pInt**2_pInt - integer(pInt), parameter, private :: & + integer, parameter, public :: & + debug_LEVELSELECTIVE = 2**0, & + debug_LEVELBASIC = 2**1, & + debug_LEVELEXTENSIVE = 2**2 + integer, parameter, private :: & debug_MAXGENERAL = debug_LEVELEXTENSIVE ! must be set to the last bitcode used by (potentially) all debug types - integer(pInt), parameter, public :: & - debug_SPECTRALRESTART = debug_MAXGENERAL*2_pInt**1_pInt, & - debug_SPECTRALFFTW = debug_MAXGENERAL*2_pInt**2_pInt, & - debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2_pInt**3_pInt, & - debug_SPECTRALROTATION = debug_MAXGENERAL*2_pInt**4_pInt, & - debug_SPECTRALPETSC = debug_MAXGENERAL*2_pInt**5_pInt + integer, parameter, public :: & + debug_SPECTRALRESTART = debug_MAXGENERAL*2**1, & + debug_SPECTRALFFTW = debug_MAXGENERAL*2**2, & + debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2**3, & + debug_SPECTRALROTATION = debug_MAXGENERAL*2**4, & + debug_SPECTRALPETSC = debug_MAXGENERAL*2**5 - integer(pInt), parameter, public :: & - debug_DEBUG = 1_pInt, & - debug_MATH = 2_pInt, & - debug_FESOLVING = 3_pInt, & - debug_MESH = 4_pInt, & !< stores debug level for mesh part of DAMASK bitwise coded - debug_MATERIAL = 5_pInt, & !< stores debug level for material part of DAMASK bitwise coded - debug_LATTICE = 6_pInt, & !< stores debug level for lattice part of DAMASK bitwise coded - debug_CONSTITUTIVE = 7_pInt, & !< stores debug level for constitutive part of DAMASK bitwise coded - debug_CRYSTALLITE = 8_pInt, & - debug_HOMOGENIZATION = 9_pInt, & - debug_CPFEM = 10_pInt, & - debug_SPECTRAL = 11_pInt, & - debug_MARC = 12_pInt, & - debug_ABAQUS = 13_pInt - integer(pInt), parameter, private :: & + integer, parameter, public :: & + debug_DEBUG = 1, & + debug_MATH = 2, & + debug_FESOLVING = 3, & + debug_MESH = 4, & !< stores debug level for mesh part of DAMASK bitwise coded + debug_MATERIAL = 5, & !< stores debug level for material part of DAMASK bitwise coded + debug_LATTICE = 6, & !< stores debug level for lattice part of DAMASK bitwise coded + debug_CONSTITUTIVE = 7, & !< stores debug level for constitutive part of DAMASK bitwise coded + debug_CRYSTALLITE = 8, & + debug_HOMOGENIZATION = 9, & + debug_CPFEM = 10, & + debug_SPECTRAL = 11, & + debug_MARC = 12, & + debug_ABAQUS = 13 + integer, parameter, private :: & debug_MAXNTYPE = debug_ABAQUS !< must be set to the maximum defined debug type - integer(pInt),protected, dimension(debug_maxNtype+2_pInt), public :: & ! specific ones, and 2 for "all" and "other" - debug_level = 0_pInt + integer,protected, dimension(debug_maxNtype+2), public :: & ! specific ones, and 2 for "all" and "other" + debug_level = 0 - integer(pInt), protected, public :: & - debug_e = 1_pInt, & - debug_i = 1_pInt, & - debug_g = 1_pInt + integer, protected, public :: & + debug_e = 1, & + debug_i = 1, & + debug_g = 1 - integer(pInt), dimension(2), public :: & - debug_stressMaxLocation = 0_pInt, & - debug_stressMinLocation = 0_pInt, & - debug_jacobianMaxLocation = 0_pInt, & - debug_jacobianMinLocation = 0_pInt + integer, dimension(2), public :: & + debug_stressMaxLocation = 0, & + debug_stressMinLocation = 0, & + debug_jacobianMaxLocation = 0, & + debug_jacobianMinLocation = 0 real(pReal), public :: & @@ -100,17 +100,17 @@ subroutine debug_init line = fileContent(j) if (IO_isBlank(line)) cycle ! skip empty lines chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key select case(tag) case ('element','e','el') - debug_e = IO_intValue(line,chunkPos,2_pInt) + debug_e = IO_intValue(line,chunkPos,2) case ('integrationpoint','i','ip') - debug_i = IO_intValue(line,chunkPos,2_pInt) + debug_i = IO_intValue(line,chunkPos,2) case ('grain','g','gr') - debug_g = IO_intValue(line,chunkPos,2_pInt) + debug_g = IO_intValue(line,chunkPos,2) end select - what = 0_pInt + what = 0 select case(tag) case ('debug') what = debug_DEBUG @@ -139,12 +139,12 @@ subroutine debug_init case ('abaqus') what = debug_ABAQUS case ('all') - what = debug_MAXNTYPE + 1_pInt + what = debug_MAXNTYPE + 1 case ('other') - what = debug_MAXNTYPE + 2_pInt + what = debug_MAXNTYPE + 2 end select if (what /= 0) then - do i = 2_pInt, chunkPos(1) + do i = 2, chunkPos(1) select case(IO_lc(IO_stringValue(line,chunkPos,i))) case('basic') debug_level(what) = ior(debug_level(what), debug_LEVELBASIC) @@ -167,11 +167,11 @@ subroutine debug_init endif enddo - do i = 1_pInt, debug_maxNtype + do i = 1, debug_maxNtype if (debug_level(i) == 0) & - debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 2_pInt)) ! fill undefined debug types with levels specified by "other" + debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 2)) ! fill undefined debug types with levels specified by "other" - debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 1_pInt)) ! fill all debug types with levels specified by "all" + debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 1)) ! fill all debug types with levels specified by "all" enddo if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) & @@ -184,7 +184,7 @@ subroutine debug_init !-------------------------------------------------------------------------------------------------- ! output switched on (debug level for debug must be extensive) if (iand(debug_level(debug_debug),debug_LEVELEXTENSIVE) /= 0) then - do i = 1_pInt, debug_MAXNTYPE + do i = 1, debug_MAXNTYPE select case(i) case (debug_DEBUG) tag = ' Debug' @@ -241,10 +241,10 @@ end subroutine debug_init !-------------------------------------------------------------------------------------------------- subroutine debug_reset - debug_stressMaxLocation = 0_pInt - debug_stressMinLocation = 0_pInt - debug_jacobianMaxLocation = 0_pInt - debug_jacobianMinLocation = 0_pInt + debug_stressMaxLocation = 0 + debug_stressMinLocation = 0 + debug_jacobianMaxLocation = 0 + debug_jacobianMinLocation = 0 debug_stressMax = -huge(1.0_pReal) debug_stressMin = huge(1.0_pReal) debug_jacobianMax = -huge(1.0_pReal) @@ -260,8 +260,8 @@ subroutine debug_info !$OMP CRITICAL (write2out) debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 & - .and. any(debug_stressMinLocation /= 0_pInt) & - .and. any(debug_stressMaxLocation /= 0_pInt) ) then + .and. any(debug_stressMinLocation /= 0) & + .and. any(debug_stressMaxLocation /= 0) ) then write(6,'(2/,a,/)') ' Extreme values of returned stress and Jacobian' write(6,'(a39)') ' value el ip' write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation diff --git a/src/numerics.f90 b/src/numerics.f90 index a40a23ee8..027296b92 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -9,13 +9,13 @@ module numerics implicit none private - integer(pInt), protected, public :: & - iJacoStiffness = 1_pInt, & !< frequency of stiffness update - nMPstate = 10_pInt, & !< materialpoint state loop limit - randomSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed - worldrank = 0_pInt, & !< MPI worldrank (/=0 for MPI simulations only) - worldsize = 1_pInt, & !< MPI worldsize (/=1 for MPI simulations only) - numerics_integrator = 1_pInt !< method used for state integration Default 1: fix-point iteration + integer, protected, public :: & + iJacoStiffness = 1, & !< frequency of stiffness update + nMPstate = 10, & !< materialpoint state loop limit + randomSeed = 0, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed + worldrank = 0, & !< MPI worldrank (/=0 for MPI simulations only) + worldsize = 1, & !< MPI worldsize (/=1 for MPI simulations only) + numerics_integrator = 1 !< method used for state integration Default 1: fix-point iteration integer(4), protected, public :: & DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive real(pReal), protected, public :: & @@ -51,11 +51,11 @@ module numerics err_thermal_tolRel = 1.0e-6_pReal, & !< relative tolerance for thermal equilibrium err_damage_tolAbs = 1.0e-2_pReal, & !< absolute tolerance for damage evolution err_damage_tolRel = 1.0e-6_pReal !< relative tolerance for damage evolution - integer(pInt), protected, public :: & - itmax = 250_pInt, & !< maximum number of iterations - itmin = 1_pInt, & !< minimum number of iterations - stagItMax = 10_pInt, & !< max number of field level staggered iterations - maxCutBack = 3_pInt !< max number of cut backs + integer, protected, public :: & + itmax = 250, & !< maximum number of iterations + itmin = 1, & !< minimum number of iterations + stagItMax = 10, & !< max number of field level staggered iterations + maxCutBack = 3 !< max number of cut backs !-------------------------------------------------------------------------------------------------- ! spectral parameters: @@ -83,9 +83,9 @@ module numerics !-------------------------------------------------------------------------------------------------- ! FEM parameters: #ifdef FEM - integer(pInt), protected, public :: & - integrationOrder = 2_pInt, & !< order of quadrature rule required - structOrder = 2_pInt !< order of displacement shape functions + integer, protected, public :: & + integrationOrder = 2, & !< order of quadrature rule required + structOrder = 2 !< order of displacement shape functions logical, protected, public :: & BBarStabilisation = .false. character(len=4096), protected, public :: & @@ -129,8 +129,8 @@ subroutine numerics_init #endif !$ use OMP_LIB, only: omp_set_num_threads !$ integer :: gotDAMASK_NUM_THREADS = 1 - integer :: i,j, ierr ! no pInt - integer(pInt), allocatable, dimension(:) :: chunkPos + integer :: i,j, ierr + integer, allocatable, dimension(:) :: chunkPos character(len=pStringLen), dimension(:), allocatable :: fileContent character(len=pStringLen) :: & tag ,& @@ -146,7 +146,7 @@ subroutine numerics_init !$ 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) then ! could not get number of threads, set it to 1 -!$ call IO_warning(35_pInt,ext_msg='BEGIN:'//DAMASK_NumThreadsString//':END') +!$ call IO_warning(35,ext_msg='BEGIN:'//DAMASK_NumThreadsString//':END') !$ DAMASK_NumThreadsInt = 1_4 !$ else !$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! read as integer @@ -170,128 +170,128 @@ subroutine numerics_init enddo if (IO_isBlank(line)) cycle ! skip empty lines chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key select case(tag) case ('defgradtolerance') - defgradTolerance = IO_floatValue(line,chunkPos,2_pInt) + defgradTolerance = IO_floatValue(line,chunkPos,2) case ('ijacostiffness') - iJacoStiffness = IO_intValue(line,chunkPos,2_pInt) + iJacoStiffness = IO_intValue(line,chunkPos,2) case ('nmpstate') - nMPstate = IO_intValue(line,chunkPos,2_pInt) + nMPstate = IO_intValue(line,chunkPos,2) case ('substepminhomog') - subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt) + subStepMinHomog = IO_floatValue(line,chunkPos,2) case ('substepsizehomog') - subStepSizeHomog = IO_floatValue(line,chunkPos,2_pInt) + subStepSizeHomog = IO_floatValue(line,chunkPos,2) case ('stepincreasehomog') - stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt) + stepIncreaseHomog = IO_floatValue(line,chunkPos,2) case ('integrator') - numerics_integrator = IO_intValue(line,chunkPos,2_pInt) + numerics_integrator = IO_intValue(line,chunkPos,2) case ('usepingpong') - usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt + usepingpong = IO_intValue(line,chunkPos,2) > 0 case ('unitlength') - numerics_unitlength = IO_floatValue(line,chunkPos,2_pInt) + numerics_unitlength = IO_floatValue(line,chunkPos,2) !-------------------------------------------------------------------------------------------------- ! RGC parameters case ('atol_rgc') - absTol_RGC = IO_floatValue(line,chunkPos,2_pInt) + absTol_RGC = IO_floatValue(line,chunkPos,2) case ('rtol_rgc') - relTol_RGC = IO_floatValue(line,chunkPos,2_pInt) + relTol_RGC = IO_floatValue(line,chunkPos,2) case ('amax_rgc') - absMax_RGC = IO_floatValue(line,chunkPos,2_pInt) + absMax_RGC = IO_floatValue(line,chunkPos,2) case ('rmax_rgc') - relMax_RGC = IO_floatValue(line,chunkPos,2_pInt) + relMax_RGC = IO_floatValue(line,chunkPos,2) case ('perturbpenalty_rgc') - pPert_RGC = IO_floatValue(line,chunkPos,2_pInt) + pPert_RGC = IO_floatValue(line,chunkPos,2) case ('relevantmismatch_rgc') - xSmoo_RGC = IO_floatValue(line,chunkPos,2_pInt) + xSmoo_RGC = IO_floatValue(line,chunkPos,2) case ('viscositypower_rgc') - viscPower_RGC = IO_floatValue(line,chunkPos,2_pInt) + viscPower_RGC = IO_floatValue(line,chunkPos,2) case ('viscositymodulus_rgc') - viscModus_RGC = IO_floatValue(line,chunkPos,2_pInt) + viscModus_RGC = IO_floatValue(line,chunkPos,2) case ('refrelaxationrate_rgc') - refRelaxRate_RGC = IO_floatValue(line,chunkPos,2_pInt) + refRelaxRate_RGC = IO_floatValue(line,chunkPos,2) case ('maxrelaxation_rgc') - maxdRelax_RGC = IO_floatValue(line,chunkPos,2_pInt) + maxdRelax_RGC = IO_floatValue(line,chunkPos,2) case ('maxvoldiscrepancy_rgc') - maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2_pInt) + maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2) case ('voldiscrepancymod_rgc') - volDiscrMod_RGC = IO_floatValue(line,chunkPos,2_pInt) + volDiscrMod_RGC = IO_floatValue(line,chunkPos,2) case ('discrepancypower_rgc') - volDiscrPow_RGC = IO_floatValue(line,chunkPos,2_pInt) + volDiscrPow_RGC = IO_floatValue(line,chunkPos,2) !-------------------------------------------------------------------------------------------------- ! random seeding parameter case ('random_seed','fixed_seed') - randomSeed = IO_intValue(line,chunkPos,2_pInt) + randomSeed = IO_intValue(line,chunkPos,2) !-------------------------------------------------------------------------------------------------- ! gradient parameter case ('charlength') - charLength = IO_floatValue(line,chunkPos,2_pInt) + charLength = IO_floatValue(line,chunkPos,2) case ('residualstiffness') - residualStiffness = IO_floatValue(line,chunkPos,2_pInt) + residualStiffness = IO_floatValue(line,chunkPos,2) !-------------------------------------------------------------------------------------------------- ! field parameters case ('err_struct_tolabs') - err_struct_tolAbs = IO_floatValue(line,chunkPos,2_pInt) + err_struct_tolAbs = IO_floatValue(line,chunkPos,2) case ('err_struct_tolrel') - err_struct_tolRel = IO_floatValue(line,chunkPos,2_pInt) + err_struct_tolRel = IO_floatValue(line,chunkPos,2) case ('err_thermal_tolabs') - err_thermal_tolabs = IO_floatValue(line,chunkPos,2_pInt) + err_thermal_tolabs = IO_floatValue(line,chunkPos,2) case ('err_thermal_tolrel') - err_thermal_tolrel = IO_floatValue(line,chunkPos,2_pInt) + err_thermal_tolrel = IO_floatValue(line,chunkPos,2) case ('err_damage_tolabs') - err_damage_tolabs = IO_floatValue(line,chunkPos,2_pInt) + err_damage_tolabs = IO_floatValue(line,chunkPos,2) case ('err_damage_tolrel') - err_damage_tolrel = IO_floatValue(line,chunkPos,2_pInt) + err_damage_tolrel = IO_floatValue(line,chunkPos,2) case ('itmax') - itmax = IO_intValue(line,chunkPos,2_pInt) + itmax = IO_intValue(line,chunkPos,2) case ('itmin') - itmin = IO_intValue(line,chunkPos,2_pInt) + itmin = IO_intValue(line,chunkPos,2) case ('maxcutback') - maxCutBack = IO_intValue(line,chunkPos,2_pInt) + maxCutBack = IO_intValue(line,chunkPos,2) case ('maxstaggerediter') - stagItMax = IO_intValue(line,chunkPos,2_pInt) + stagItMax = IO_intValue(line,chunkPos,2) !-------------------------------------------------------------------------------------------------- ! spectral parameters #ifdef Grid case ('err_div_tolabs') - err_div_tolAbs = IO_floatValue(line,chunkPos,2_pInt) + err_div_tolAbs = IO_floatValue(line,chunkPos,2) case ('err_div_tolrel') - err_div_tolRel = IO_floatValue(line,chunkPos,2_pInt) + err_div_tolRel = IO_floatValue(line,chunkPos,2) case ('err_stress_tolrel') - err_stress_tolrel = IO_floatValue(line,chunkPos,2_pInt) + err_stress_tolrel = IO_floatValue(line,chunkPos,2) case ('err_stress_tolabs') - err_stress_tolabs = IO_floatValue(line,chunkPos,2_pInt) + err_stress_tolabs = IO_floatValue(line,chunkPos,2) case ('continuecalculation') - continueCalculation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt + continueCalculation = IO_intValue(line,chunkPos,2) > 0 case ('petsc_options') petsc_options = trim(line(chunkPos(4):)) case ('err_curl_tolabs') - err_curl_tolAbs = IO_floatValue(line,chunkPos,2_pInt) + err_curl_tolAbs = IO_floatValue(line,chunkPos,2) case ('err_curl_tolrel') - err_curl_tolRel = IO_floatValue(line,chunkPos,2_pInt) + err_curl_tolRel = IO_floatValue(line,chunkPos,2) case ('polaralpha') - polarAlpha = IO_floatValue(line,chunkPos,2_pInt) + polarAlpha = IO_floatValue(line,chunkPos,2) case ('polarbeta') - polarBeta = IO_floatValue(line,chunkPos,2_pInt) + polarBeta = IO_floatValue(line,chunkPos,2) #endif !-------------------------------------------------------------------------------------------------- ! FEM parameters #ifdef FEM case ('integrationorder') - integrationorder = IO_intValue(line,chunkPos,2_pInt) + integrationorder = IO_intValue(line,chunkPos,2) case ('structorder') - structorder = IO_intValue(line,chunkPos,2_pInt) + structorder = IO_intValue(line,chunkPos,2) case ('petsc_options') petsc_options = trim(line(chunkPos(4):)) case ('bbarstabilisation') - BBarStabilisation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt + BBarStabilisation = IO_intValue(line,chunkPos,2) > 0 #endif end select enddo @@ -334,7 +334,7 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! Random seeding parameter write(6,'(a16,1x,i16,/)') ' random_seed: ',randomSeed - if (randomSeed <= 0_pInt) & + if (randomSeed <= 0) & write(6,'(a,/)') ' random seed will be generated!' !-------------------------------------------------------------------------------------------------- @@ -386,50 +386,50 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! sanity checks - if (defgradTolerance <= 0.0_pReal) call IO_error(301_pInt,ext_msg='defgradTolerance') - if (iJacoStiffness < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoStiffness') - if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate') - if (subStepMinHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinHomog') - if (subStepSizeHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeHomog') - if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseHomog') - if (numerics_integrator <= 0_pInt .or. numerics_integrator >= 6_pInt) & - call IO_error(301_pInt,ext_msg='integrator') - if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength') - if (absTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absTol_RGC') - if (relTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relTol_RGC') - if (absMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absMax_RGC') - if (relMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relMax_RGC') - if (pPert_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pPert_RGC') - if (xSmoo_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='xSmoo_RGC') - if (viscPower_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscPower_RGC') - if (viscModus_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscModus_RGC') - if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='refRelaxRate_RGC') - if (maxdRelax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxdRelax_RGC') - if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxVolDiscr_RGC') - if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrMod_RGC') - if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrPw_RGC') - if (residualStiffness < 0.0_pReal) call IO_error(301_pInt,ext_msg='residualStiffness') - if (itmax <= 1_pInt) call IO_error(301_pInt,ext_msg='itmax') - if (itmin > itmax .or. itmin < 1_pInt) call IO_error(301_pInt,ext_msg='itmin') - if (maxCutBack < 0_pInt) call IO_error(301_pInt,ext_msg='maxCutBack') - if (stagItMax < 0_pInt) call IO_error(301_pInt,ext_msg='maxStaggeredIter') - if (err_struct_tolRel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_struct_tolRel') - if (err_struct_tolAbs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_struct_tolAbs') - if (err_thermal_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_thermal_tolabs') - if (err_thermal_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_thermal_tolrel') - if (err_damage_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_damage_tolabs') - if (err_damage_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_damage_tolrel') + if (defgradTolerance <= 0.0_pReal) call IO_error(301,ext_msg='defgradTolerance') + if (iJacoStiffness < 1) call IO_error(301,ext_msg='iJacoStiffness') + if (nMPstate < 1) call IO_error(301,ext_msg='nMPstate') + if (subStepMinHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinHomog') + if (subStepSizeHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeHomog') + if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseHomog') + if (numerics_integrator <= 0 .or. numerics_integrator >= 6) & + call IO_error(301,ext_msg='integrator') + if (numerics_unitlength <= 0.0_pReal) call IO_error(301,ext_msg='unitlength') + if (absTol_RGC <= 0.0_pReal) call IO_error(301,ext_msg='absTol_RGC') + if (relTol_RGC <= 0.0_pReal) call IO_error(301,ext_msg='relTol_RGC') + if (absMax_RGC <= 0.0_pReal) call IO_error(301,ext_msg='absMax_RGC') + if (relMax_RGC <= 0.0_pReal) call IO_error(301,ext_msg='relMax_RGC') + if (pPert_RGC <= 0.0_pReal) call IO_error(301,ext_msg='pPert_RGC') + if (xSmoo_RGC <= 0.0_pReal) call IO_error(301,ext_msg='xSmoo_RGC') + if (viscPower_RGC < 0.0_pReal) call IO_error(301,ext_msg='viscPower_RGC') + if (viscModus_RGC < 0.0_pReal) call IO_error(301,ext_msg='viscModus_RGC') + if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(301,ext_msg='refRelaxRate_RGC') + if (maxdRelax_RGC <= 0.0_pReal) call IO_error(301,ext_msg='maxdRelax_RGC') + if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301,ext_msg='maxVolDiscr_RGC') + if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301,ext_msg='volDiscrMod_RGC') + if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301,ext_msg='volDiscrPw_RGC') + if (residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness') + if (itmax <= 1) call IO_error(301,ext_msg='itmax') + if (itmin > itmax .or. itmin < 1) call IO_error(301,ext_msg='itmin') + if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack') + if (stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter') + if (err_struct_tolRel <= 0.0_pReal) call IO_error(301,ext_msg='err_struct_tolRel') + if (err_struct_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_struct_tolAbs') + if (err_thermal_tolabs <= 0.0_pReal) call IO_error(301,ext_msg='err_thermal_tolabs') + if (err_thermal_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_thermal_tolrel') + if (err_damage_tolabs <= 0.0_pReal) call IO_error(301,ext_msg='err_damage_tolabs') + if (err_damage_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_damage_tolrel') #ifdef Grid - if (err_stress_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolRel') - if (err_stress_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolAbs') - if (err_div_tolRel < 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tolRel') - if (err_div_tolAbs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tolAbs') - if (err_curl_tolRel < 0.0_pReal) call IO_error(301_pInt,ext_msg='err_curl_tolRel') - if (err_curl_tolAbs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_curl_tolAbs') + if (err_stress_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_stress_tolRel') + if (err_stress_tolabs <= 0.0_pReal) call IO_error(301,ext_msg='err_stress_tolAbs') + if (err_div_tolRel < 0.0_pReal) call IO_error(301,ext_msg='err_div_tolRel') + if (err_div_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_div_tolAbs') + if (err_curl_tolRel < 0.0_pReal) call IO_error(301,ext_msg='err_curl_tolRel') + if (err_curl_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_curl_tolAbs') if (polarAlpha <= 0.0_pReal .or. & - polarAlpha > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarAlpha') + polarAlpha > 2.0_pReal) call IO_error(301,ext_msg='polarAlpha') if (polarBeta < 0.0_pReal .or. & - polarBeta > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarBeta') + polarBeta > 2.0_pReal) call IO_error(301,ext_msg='polarBeta') #endif end subroutine numerics_init