From 195491aaaa80c56316930b5bf5a3bfea8977bd14 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 9 Feb 2012 12:35:55 +0000 Subject: [PATCH] added missing pInts --- code/numerics.f90 | 177 +++++++++++++++++++++++----------------------- 1 file changed, 89 insertions(+), 88 deletions(-) diff --git a/code/numerics.f90 b/code/numerics.f90 index 013f9e659..da7cf834c 100644 --- a/code/numerics.f90 +++ b/code/numerics.f90 @@ -92,6 +92,7 @@ CONTAINS !******************************************* subroutine numerics_init() +use, intrinsic :: iso_fortran_env !*** variables and functions from other modules ***! use prec, only: pInt, & pReal @@ -145,110 +146,110 @@ subroutine numerics_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 ('relevantstrain') - relevantStrain = IO_floatValue(line,positions,2) + relevantStrain = IO_floatValue(line,positions,2_pInt) case ('defgradtolerance') - defgradTolerance = IO_floatValue(line,positions,2) + defgradTolerance = IO_floatValue(line,positions,2_pInt) case ('ijacostiffness') - iJacoStiffness = IO_intValue(line,positions,2) + iJacoStiffness = IO_intValue(line,positions,2_pInt) case ('ijacolpresiduum') - iJacoLpresiduum = IO_intValue(line,positions,2) + iJacoLpresiduum = IO_intValue(line,positions,2_pInt) case ('pert_fg') - pert_Fg = IO_floatValue(line,positions,2) + pert_Fg = IO_floatValue(line,positions,2_pInt) case ('pert_method') - pert_method = IO_intValue(line,positions,2) + pert_method = IO_intValue(line,positions,2_pInt) case ('nhomog') - nHomog = IO_intValue(line,positions,2) + nHomog = IO_intValue(line,positions,2_pInt) case ('nmpstate') - nMPstate = IO_intValue(line,positions,2) + nMPstate = IO_intValue(line,positions,2_pInt) case ('ncryst') - nCryst = IO_intValue(line,positions,2) + nCryst = IO_intValue(line,positions,2_pInt) case ('nstate') - nState = IO_intValue(line,positions,2) + nState = IO_intValue(line,positions,2_pInt) case ('nstress') - nStress = IO_intValue(line,positions,2) + nStress = IO_intValue(line,positions,2_pInt) case ('substepmincryst') - subStepMinCryst = IO_floatValue(line,positions,2) + subStepMinCryst = IO_floatValue(line,positions,2_pInt) case ('substepsizecryst') - subStepSizeCryst = IO_floatValue(line,positions,2) + subStepSizeCryst = IO_floatValue(line,positions,2_pInt) case ('stepincreasecryst') - stepIncreaseCryst = IO_floatValue(line,positions,2) + stepIncreaseCryst = IO_floatValue(line,positions,2_pInt) case ('substepminhomog') - subStepMinHomog = IO_floatValue(line,positions,2) + subStepMinHomog = IO_floatValue(line,positions,2_pInt) case ('substepsizehomog') - subStepSizeHomog = IO_floatValue(line,positions,2) + subStepSizeHomog = IO_floatValue(line,positions,2_pInt) case ('stepincreasehomog') - stepIncreaseHomog = IO_floatValue(line,positions,2) + stepIncreaseHomog = IO_floatValue(line,positions,2_pInt) case ('rtol_crystallitestate') - rTol_crystalliteState = IO_floatValue(line,positions,2) + rTol_crystalliteState = IO_floatValue(line,positions,2_pInt) case ('rtol_crystallitetemperature') - rTol_crystalliteTemperature = IO_floatValue(line,positions,2) + rTol_crystalliteTemperature = IO_floatValue(line,positions,2_pInt) case ('rtol_crystallitestress') - rTol_crystalliteStress = IO_floatValue(line,positions,2) + rTol_crystalliteStress = IO_floatValue(line,positions,2_pInt) case ('atol_crystallitestress') - aTol_crystalliteStress = IO_floatValue(line,positions,2) + aTol_crystalliteStress = IO_floatValue(line,positions,2_pInt) case ('integrator') - numerics_integrator(1) = IO_intValue(line,positions,2) + numerics_integrator(1) = IO_intValue(line,positions,2_pInt) case ('integratorstiffness') - numerics_integrator(2) = IO_intValue(line,positions,2) + numerics_integrator(2) = IO_intValue(line,positions,2_pInt) !* RGC parameters: case ('atol_rgc') - absTol_RGC = IO_floatValue(line,positions,2) + absTol_RGC = IO_floatValue(line,positions,2_pInt) case ('rtol_rgc') - relTol_RGC = IO_floatValue(line,positions,2) + relTol_RGC = IO_floatValue(line,positions,2_pInt) case ('amax_rgc') - absMax_RGC = IO_floatValue(line,positions,2) + absMax_RGC = IO_floatValue(line,positions,2_pInt) case ('rmax_rgc') - relMax_RGC = IO_floatValue(line,positions,2) + relMax_RGC = IO_floatValue(line,positions,2_pInt) case ('perturbpenalty_rgc') - pPert_RGC = IO_floatValue(line,positions,2) + pPert_RGC = IO_floatValue(line,positions,2_pInt) case ('relevantmismatch_rgc') - xSmoo_RGC = IO_floatValue(line,positions,2) + xSmoo_RGC = IO_floatValue(line,positions,2_pInt) case ('viscositypower_rgc') - viscPower_RGC = IO_floatValue(line,positions,2) + viscPower_RGC = IO_floatValue(line,positions,2_pInt) case ('viscositymodulus_rgc') - viscModus_RGC = IO_floatValue(line,positions,2) + viscModus_RGC = IO_floatValue(line,positions,2_pInt) case ('refrelaxationrate_rgc') - refRelaxRate_RGC = IO_floatValue(line,positions,2) + refRelaxRate_RGC = IO_floatValue(line,positions,2_pInt) case ('maxrelaxation_rgc') - maxdRelax_RGC = IO_floatValue(line,positions,2) + maxdRelax_RGC = IO_floatValue(line,positions,2_pInt) case ('maxvoldiscrepancy_rgc') - maxVolDiscr_RGC = IO_floatValue(line,positions,2) + maxVolDiscr_RGC = IO_floatValue(line,positions,2_pInt) case ('voldiscrepancymod_rgc') - volDiscrMod_RGC = IO_floatValue(line,positions,2) + volDiscrMod_RGC = IO_floatValue(line,positions,2_pInt) case ('discrepancypower_rgc') - volDiscrPow_RGC = IO_floatValue(line,positions,2) + volDiscrPow_RGC = IO_floatValue(line,positions,2_pInt) !* spectral parameters case ('err_div_tol') - err_div_tol = IO_floatValue(line,positions,2) + err_div_tol = IO_floatValue(line,positions,2_pInt) case ('err_stress_tolrel') - err_stress_tolrel = IO_floatValue(line,positions,2) + err_stress_tolrel = IO_floatValue(line,positions,2_pInt) case ('itmax') - itmax = IO_intValue(line,positions,2) + itmax = IO_intValue(line,positions,2_pInt) case ('memory_efficient') - memory_efficient = IO_intValue(line,positions,2) > 0_pInt + memory_efficient = IO_intValue(line,positions,2_pInt) > 0_pInt case ('fftw_timelimit') - fftw_timelimit = IO_floatValue(line,positions,2) + fftw_timelimit = IO_floatValue(line,positions,2_pInt) case ('fftw_planner_string') - fftw_planner_string = IO_stringValue(line,positions,2) + fftw_planner_string = IO_stringValue(line,positions,2_pInt) case ('rotation_tol') - rotation_tol = IO_floatValue(line,positions,2) + rotation_tol = IO_floatValue(line,positions,2_pInt) case ('divergence_correction') - divergence_correction = IO_intValue(line,positions,2) > 0_pInt + divergence_correction = IO_intValue(line,positions,2_pInt) > 0_pInt case ('update_gamma') - update_gamma = IO_intValue(line,positions,2) > 0_pInt + update_gamma = IO_intValue(line,positions,2_pInt) > 0_pInt case ('simplified_algorithm') - simplified_algorithm = IO_intValue(line,positions,2) > 0_pInt + simplified_algorithm = IO_intValue(line,positions,2_pInt) > 0_pInt case ('cut_off_value') - cut_off_value = IO_floatValue(line,positions,2) + cut_off_value = IO_floatValue(line,positions,2_pInt) !* Random seeding parameters case ('fixed_seed') - fixedSeed = IO_intValue(line,positions,2) + fixedSeed = IO_intValue(line,positions,2_pInt) endselect enddo 100 close(fileunit) @@ -341,50 +342,50 @@ subroutine numerics_init() !$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt ! sanity check - if (relevantStrain <= 0.0_pReal) call IO_error(260) - if (defgradTolerance <= 0.0_pReal) call IO_error(294) - if (iJacoStiffness < 1_pInt) call IO_error(261) - if (iJacoLpresiduum < 1_pInt) call IO_error(262) - if (pert_Fg <= 0.0_pReal) call IO_error(263) + if (relevantStrain <= 0.0_pReal) call IO_error(260_pInt) + if (defgradTolerance <= 0.0_pReal) call IO_error(294_pInt) + if (iJacoStiffness < 1_pInt) call IO_error(261_pInt) + if (iJacoLpresiduum < 1_pInt) call IO_error(262_pInt) + if (pert_Fg <= 0.0_pReal) call IO_error(263_pInt) if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) & - call IO_error(299) - if (nHomog < 1_pInt) call IO_error(264) - if (nMPstate < 1_pInt) call IO_error(279) !! missing in IO !! - if (nCryst < 1_pInt) call IO_error(265) - if (nState < 1_pInt) call IO_error(266) - if (nStress < 1_pInt) call IO_error(267) - if (subStepMinCryst <= 0.0_pReal) call IO_error(268) - if (subStepSizeCryst <= 0.0_pReal) call IO_error(268) - if (stepIncreaseCryst <= 0.0_pReal) call IO_error(268) - if (subStepMinHomog <= 0.0_pReal) call IO_error(268) - if (subStepSizeHomog <= 0.0_pReal) call IO_error(268) - if (stepIncreaseHomog <= 0.0_pReal) call IO_error(268) - if (rTol_crystalliteState <= 0.0_pReal) call IO_error(269) - if (rTol_crystalliteTemperature <= 0.0_pReal) call IO_error(276) !! oops !! - if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(270) - if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(271) + call IO_error(299_pInt) + if (nHomog < 1_pInt) call IO_error(264_pInt) + if (nMPstate < 1_pInt) call IO_error(279_pInt) !! missing in IO !! + if (nCryst < 1_pInt) call IO_error(265_pInt) + if (nState < 1_pInt) call IO_error(266_pInt) + if (nStress < 1_pInt) call IO_error(267_pInt) + if (subStepMinCryst <= 0.0_pReal) call IO_error(268_pInt) + if (subStepSizeCryst <= 0.0_pReal) call IO_error(268_pInt) + if (stepIncreaseCryst <= 0.0_pReal) call IO_error(268_pInt) + if (subStepMinHomog <= 0.0_pReal) call IO_error(268_pInt) + if (subStepSizeHomog <= 0.0_pReal) call IO_error(268_pInt) + if (stepIncreaseHomog <= 0.0_pReal) call IO_error(268_pInt) + if (rTol_crystalliteState <= 0.0_pReal) call IO_error(269_pInt) + if (rTol_crystalliteTemperature <= 0.0_pReal) call IO_error(276_pInt) !! oops !! + if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(270_pInt) + if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(271_pInt) if (any(numerics_integrator <= 0_pInt) .or. any(numerics_integrator >= 6_pInt)) & - call IO_error(298) + call IO_error(298_pInt) -!* RGC parameters: added <<>> - if (absTol_RGC <= 0.0_pReal) call IO_error(272) - if (relTol_RGC <= 0.0_pReal) call IO_error(273) - if (absMax_RGC <= 0.0_pReal) call IO_error(274) - if (relMax_RGC <= 0.0_pReal) call IO_error(275) - if (pPert_RGC <= 0.0_pReal) call IO_error(276) !! oops !! - if (xSmoo_RGC <= 0.0_pReal) call IO_error(277) - if (viscPower_RGC < 0.0_pReal) call IO_error(278) - if (viscModus_RGC < 0.0_pReal) call IO_error(278) - if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(278) - if (maxdRelax_RGC <= 0.0_pReal) call IO_error(288) - if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(289) - if (volDiscrMod_RGC < 0.0_pReal) call IO_error(289) - if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(289) + + if (absTol_RGC <= 0.0_pReal) call IO_error(272_pInt) + if (relTol_RGC <= 0.0_pReal) call IO_error(273_pInt) + if (absMax_RGC <= 0.0_pReal) call IO_error(274_pInt) + if (relMax_RGC <= 0.0_pReal) call IO_error(275_pInt) + if (pPert_RGC <= 0.0_pReal) call IO_error(276_pInt) !! oops !! + if (xSmoo_RGC <= 0.0_pReal) call IO_error(277_pInt) + if (viscPower_RGC < 0.0_pReal) call IO_error(278_pInt) + if (viscModus_RGC < 0.0_pReal) call IO_error(278_pInt) + if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(278_pInt) + if (maxdRelax_RGC <= 0.0_pReal) call IO_error(288_pInt) + if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(289_pInt) + if (volDiscrMod_RGC < 0.0_pReal) call IO_error(289_pInt) + if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(289_pInt) !* spectral parameters - if (err_div_tol <= 0.0_pReal) call IO_error(49) - if (err_stress_tolrel <= 0.0_pReal) call IO_error(49) - if (itmax <= 1.0_pInt) call IO_error(49) + if (err_div_tol <= 0.0_pReal) call IO_error(49_pInt) + if (err_stress_tolrel <= 0.0_pReal) call IO_error(49_pInt) + if (itmax <= 1.0_pInt) call IO_error(49_pInt) if (fixedSeed <= 0_pInt) then !$OMP CRITICAL (write2out)