From 8d90cfb600ff7d7ad0d83e851b8ec96feb3b2875 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 11 Apr 2019 06:46:31 +0200 Subject: [PATCH 01/59] unused variables --- src/numerics.f90 | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/src/numerics.f90 b/src/numerics.f90 index f7c603c60..2a9920a6d 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -18,7 +18,6 @@ module numerics nCryst = 20_pInt, & !< crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst") nState = 10_pInt, & !< state loop limit nStress = 40_pInt, & !< stress loop limit - pert_method = 1_pInt, & !< method used in perturbation technique for tangent 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) @@ -26,9 +25,7 @@ module numerics 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 :: & - relevantStrain = 1.0e-7_pReal, & !< strain increment considered significant (used by crystallite to determine whether strain inc is considered significant) defgradTolerance = 1.0e-7_pReal, & !< deviation of deformation gradient that is still allowed (used by CPFEM to determine outdated ffn1) - pert_Fg = 1.0e-7_pReal, & !< strain perturbation for FEM Jacobi subStepMinCryst = 1.0e-3_pReal, & !< minimum (relative) size of sub-step allowed during cutback in crystallite subStepMinHomog = 1.0e-3_pReal, & !< minimum (relative) size of sub-step allowed during cutback in homogenization subStepSizeCryst = 0.25_pReal, & !< size of first substep when cutback in crystallite @@ -57,8 +54,7 @@ module numerics charLength = 1.0_pReal, & !< characteristic length scale for gradient problems residualStiffness = 1.0e-6_pReal !< non-zero residual damage logical, protected, public :: & - usePingPong = .true., & - numerics_timeSyncing = .false. !< flag indicating if time synchronization in crystallite is used for nonlocal plasticity + usePingPong = .true. !-------------------------------------------------------------------------------------------------- ! field parameters: @@ -194,18 +190,12 @@ subroutine numerics_init tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) - case ('relevantstrain') - relevantStrain = IO_floatValue(line,chunkPos,2_pInt) case ('defgradtolerance') defgradTolerance = IO_floatValue(line,chunkPos,2_pInt) case ('ijacostiffness') iJacoStiffness = IO_intValue(line,chunkPos,2_pInt) case ('ijacolpresiduum') iJacoLpresiduum = IO_intValue(line,chunkPos,2_pInt) - case ('pert_fg') - pert_Fg = IO_floatValue(line,chunkPos,2_pInt) - case ('pert_method') - pert_method = IO_intValue(line,chunkPos,2_pInt) case ('nmpstate') nMPstate = IO_intValue(line,chunkPos,2_pInt) case ('ncryst') @@ -356,12 +346,9 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! writing parameters to output - write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum - write(6,'(a24,1x,es8.1)') ' pert_Fg: ',pert_Fg - write(6,'(a24,1x,i8)') ' pert_method: ',pert_method write(6,'(a24,1x,i8)') ' nCryst: ',nCryst write(6,'(a24,1x,es8.1)') ' subStepMinCryst: ',subStepMinCryst write(6,'(a24,1x,es8.1)') ' subStepSizeCryst: ',subStepSizeCryst @@ -452,13 +439,9 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! sanity checks - if (relevantStrain <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relevantStrain') 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 (iJacoLpresiduum < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoLpresiduum') - if (pert_Fg <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pert_Fg') - if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) & - call IO_error(301_pInt,ext_msg='pert_method') if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate') if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst') if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState') From 67eb39255ac29a30b02bcfdbb58ef59fbcf04c8f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 11 Apr 2019 07:24:04 +0200 Subject: [PATCH 02/59] keep connected data together - avoids dependencies - easier to read and modify --- src/crystallite.f90 | 73 ++++++++++++++++++++++++++++++--------------- src/numerics.f90 | 32 -------------------- 2 files changed, 49 insertions(+), 56 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 69c7839c7..afaffb07a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -111,6 +111,20 @@ module crystallite end type tOutput type(tOutput), allocatable, dimension(:), private :: output_constituent + type, private :: tNumerics + real(pReal) :: & + subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback + subStepSizeCryst, & !< size of first substep when cutback + subStepSizeLp, & !< size of first substep when cutback in Lp calculation + subStepSizeLi, & !< size of first substep when cutback in Li calculation + stepIncreaseCryst, & !< increase of next substep size when previous substep converged + rTol_crystalliteState, & !< relative tolerance in state loop + rTol_crystalliteStress, & !< relative tolerance in stress loop + aTol_crystalliteStress !< absolute tolerance in stress loop + end type tNumerics + + type(tNumerics) :: num ! numerics parameters. Better name? + procedure(), pointer :: integrateState public :: & @@ -165,6 +179,7 @@ subroutine crystallite_init use config, only: & config_deallocate, & config_crystallite, & + config_numerics, & config_phase, & crystallite_name use constitutive, only: & @@ -242,6 +257,24 @@ subroutine crystallite_init allocate(crystallite_sizePostResults(size(config_crystallite)),source=0) allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & size(config_crystallite)), source=0) + + num%subStepMinCryst = config_numerics%getFloat('subStepMinCryst', defaultVal=1.0e-3_pReal) + num%subStepSizeCryst = config_numerics%getFloat('subStepSizeCryst', defaultVal=0.25_pReal) + num%subStepSizeLp = config_numerics%getFloat('subStepSizeLp', defaultVal=0.5_pReal) + num%subStepSizeLi = config_numerics%getFloat('subStepSizeLi', defaultVal=0.5_pReal) + num%stepIncreaseCryst = config_numerics%getFloat('stepIncreaseCryst', defaultVal=1.5_pReal) + num%rTol_crystalliteState = config_numerics%getFloat('rTol_crystalliteState', defaultVal=1.0e-6_pReal) + num%rTol_crystalliteStress = config_numerics%getFloat('rTol_crystalliteStress',defaultVal=1.0e-6_pReal) + num%aTol_crystalliteStress = config_numerics%getFloat('aTol_crystalliteStress',defaultVal=1.0e-8_pReal) + + if(num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst') + if(num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst') + if(num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst') + if(num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp') + if(num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi') + if(num%rTol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rTol_crystalliteState') + if(num%rTol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rTol_crystalliteStress') + if(num%aTol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='aTol_crystalliteStress') select case(numerics_integrator) case(1) @@ -433,10 +466,6 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) use prec, only: & tol_math_check, & dNeq0 - use numerics, only: & - subStepMinCryst, & - subStepSizeCryst, & - stepIncreaseCryst #ifdef DEBUG use debug, only: & debug_level, & @@ -519,7 +548,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partionedF0(1:3,1:3,c,i,e) crystallite_subS0(1:3,1:3,c,i,e) = crystallite_partionedS0(1:3,1:3,c,i,e) crystallite_subFrac(c,i,e) = 0.0_pReal - crystallite_subStep(c,i,e) = 1.0_pReal/subStepSizeCryst + crystallite_subStep(c,i,e) = 1.0_pReal/num%subStepSizeCryst crystallite_todo(c,i,e) = .true. crystallite_converged(c,i,e) = .false. ! pretend failed step of 1/subStepSizeCryst endif homogenizationRequestsCalculation @@ -554,7 +583,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) formerSubStep = crystallite_subStep(c,i,e) crystallite_subFrac(c,i,e) = crystallite_subFrac(c,i,e) + crystallite_subStep(c,i,e) crystallite_subStep(c,i,e) = min(1.0_pReal - crystallite_subFrac(c,i,e), & - stepIncreaseCryst * crystallite_subStep(c,i,e)) + num%stepIncreaseCryst * crystallite_subStep(c,i,e)) crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > 0.0_pReal ! still time left to integrate on? if (crystallite_todo(c,i,e)) then @@ -584,7 +613,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) else - crystallite_subStep(c,i,e) = subStepSizeCryst * crystallite_subStep(c,i,e) + crystallite_subStep(c,i,e) = num%subStepSizeCryst * crystallite_subStep(c,i,e) crystallite_Fp (1:3,1:3,c,i,e) = crystallite_subFp0(1:3,1:3,c,i,e) crystallite_invFp(1:3,1:3,c,i,e) = math_inv33(crystallite_Fp (1:3,1:3,c,i,e)) crystallite_Fi (1:3,1:3,c,i,e) = crystallite_subFi0(1:3,1:3,c,i,e) @@ -602,7 +631,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) enddo ! cant restore dotState here, since not yet calculated in first cutback after initialization - crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > subStepMinCryst ! still on track or already done (beyond repair) + crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > num%subStepMinCryst ! still on track or already done (beyond repair) #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0 & .and. ((e == debug_e .and. i == debug_i .and. c == debug_g) & @@ -652,7 +681,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) !-------------------------------------------------------------------------------------------------- ! integrate --- requires fully defined state array (basic + dependent state) if (any(crystallite_todo)) call integrateState ! TODO: unroll into proper elementloop to avoid N^2 for single point evaluation - where(.not. crystallite_converged .and. crystallite_subStep > subStepMinCryst) & ! do not try non-converged but fully cutbacked any further + where(.not. crystallite_converged .and. crystallite_subStep > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further crystallite_todo = .true. ! TODO: again unroll this into proper elementloop to avoid N^2 for single point evaluation @@ -1238,11 +1267,7 @@ logical function integrateStress(ipc,ip,el,timeFraction) use prec, only: tol_math_check, & dEq0 use numerics, only: nStress, & - aTol_crystalliteStress, & - rTol_crystalliteStress, & - iJacoLpresiduum, & - subStepSizeLp, & - subStepSizeLi + iJacoLpresiduum #ifdef DEBUG use debug, only: debug_level, & debug_e, & @@ -1442,8 +1467,8 @@ logical function integrateStress(ipc,ip,el,timeFraction) #endif !* update current residuum and check for convergence of loop - aTolLp = max(rTol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error - aTol_crystalliteStress) ! minimum lower cutoff + aTolLp = max(num%rTol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error + num%aTol_crystalliteStress) ! minimum lower cutoff residuumLp = Lpguess - Lp_constitutive if (any(IEEE_is_NaN(residuumLp))) then @@ -1463,7 +1488,7 @@ logical function integrateStress(ipc,ip,el,timeFraction) Lpguess_old = Lpguess steplengthLp = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) else ! not converged and residuum not improved... - steplengthLp = subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction + steplengthLp = num%subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction Lpguess = Lpguess_old + steplengthLp * deltaLp #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0 & @@ -1541,8 +1566,8 @@ logical function integrateStress(ipc,ip,el,timeFraction) #endif !* update current residuum and check for convergence of loop - aTolLi = max(rTol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error - aTol_crystalliteStress) ! minimum lower cutoff + aTolLi = max(num%rTol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error + num%aTol_crystalliteStress) ! minimum lower cutoff residuumLi = Liguess - Li_constitutive if (any(IEEE_is_NaN(residuumLi))) then ! NaN in residuum... #ifdef DEBUG @@ -1561,7 +1586,7 @@ logical function integrateStress(ipc,ip,el,timeFraction) Liguess_old = Liguess steplengthLi = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) else ! not converged and residuum not improved... - steplengthLi = subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction + steplengthLi = num%subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction Liguess = Liguess_old + steplengthLi * deltaLi cycle LiLoop endif @@ -2295,14 +2320,14 @@ end subroutine setConvergenceFlag !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- logical pure function converged(residuum,state,aTol) - use prec, only: & - dEq0 - use numerics, only: & - rTol => rTol_crystalliteState implicit none real(pReal), intent(in), dimension(:) ::& residuum, state, aTol + real(pReal) :: & + rTol + + rTol = num%rTol_crystalliteState converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) diff --git a/src/numerics.f90 b/src/numerics.f90 index 2a9920a6d..a5368a5de 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -26,17 +26,9 @@ module numerics DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive real(pReal), protected, public :: & defgradTolerance = 1.0e-7_pReal, & !< deviation of deformation gradient that is still allowed (used by CPFEM to determine outdated ffn1) - subStepMinCryst = 1.0e-3_pReal, & !< minimum (relative) size of sub-step allowed during cutback in crystallite subStepMinHomog = 1.0e-3_pReal, & !< minimum (relative) size of sub-step allowed during cutback in homogenization - subStepSizeCryst = 0.25_pReal, & !< size of first substep when cutback in crystallite subStepSizeHomog = 0.25_pReal, & !< size of first substep when cutback in homogenization - subStepSizeLp = 0.5_pReal, & !< size of first substep when cutback in Lp calculation - subStepSizeLi = 0.5_pReal, & !< size of first substep when cutback in Li calculation - stepIncreaseCryst = 1.5_pReal, & !< increase of next substep size when previous substep converged in crystallite stepIncreaseHomog = 1.5_pReal, & !< increase of next substep size when previous substep converged in homogenization - rTol_crystalliteState = 1.0e-6_pReal, & !< relative tolerance in crystallite state loop - rTol_crystalliteStress = 1.0e-6_pReal, & !< relative tolerance in crystallite stress loop - aTol_crystalliteStress = 1.0e-8_pReal, & !< absolute tolerance in crystallite stress loop, Default 1.0e-8: residuum is in Lp and hence strain is on this order numerics_unitlength = 1.0_pReal, & !< determines the physical length of one computational length unit absTol_RGC = 1.0e+4_pReal, & !< absolute tolerance of RGC residuum relTol_RGC = 1.0e-3_pReal, & !< relative tolerance of RGC residuum @@ -205,15 +197,10 @@ subroutine numerics_init case ('nstress') nStress = IO_intValue(line,chunkPos,2_pInt) case ('substepmincryst') - subStepMinCryst = IO_floatValue(line,chunkPos,2_pInt) case ('substepsizecryst') - subStepSizeCryst = IO_floatValue(line,chunkPos,2_pInt) case ('stepincreasecryst') - stepIncreaseCryst = IO_floatValue(line,chunkPos,2_pInt) case ('substepsizelp') - subStepSizeLp = IO_floatValue(line,chunkPos,2_pInt) case ('substepsizeli') - subStepSizeLi = IO_floatValue(line,chunkPos,2_pInt) case ('substepminhomog') subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt) case ('substepsizehomog') @@ -221,11 +208,8 @@ subroutine numerics_init case ('stepincreasehomog') stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt) case ('rtol_crystallitestate') - rTol_crystalliteState = IO_floatValue(line,chunkPos,2_pInt) case ('rtol_crystallitestress') - rTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt) case ('atol_crystallitestress') - aTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt) case ('integrator') numerics_integrator = IO_intValue(line,chunkPos,2_pInt) case ('usepingpong') @@ -350,16 +334,8 @@ subroutine numerics_init write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum write(6,'(a24,1x,i8)') ' nCryst: ',nCryst - write(6,'(a24,1x,es8.1)') ' subStepMinCryst: ',subStepMinCryst - write(6,'(a24,1x,es8.1)') ' subStepSizeCryst: ',subStepSizeCryst - write(6,'(a24,1x,es8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst - write(6,'(a24,1x,es8.1)') ' subStepSizeLp: ',subStepSizeLp - write(6,'(a24,1x,es8.1)') ' subStepSizeLi: ',subStepSizeLi write(6,'(a24,1x,i8)') ' nState: ',nState write(6,'(a24,1x,i8)') ' nStress: ',nStress - write(6,'(a24,1x,es8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState - write(6,'(a24,1x,es8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress - write(6,'(a24,1x,es8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress write(6,'(a24,1x,i8)') ' integrator: ',numerics_integrator write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength @@ -446,17 +422,9 @@ subroutine numerics_init if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst') if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState') if (nStress < 1_pInt) call IO_error(301_pInt,ext_msg='nStress') - if (subStepMinCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinCryst') - if (subStepSizeCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeCryst') - if (stepIncreaseCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseCryst') - if (subStepSizeLp <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeLp') - if (subStepSizeLi <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeLi') 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 (rTol_crystalliteState <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteState') - if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteStress') - if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='aTol_crystalliteStress') 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') From 8f7239b75d6d802b532427547768e9a7f45e86fd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 11 Apr 2019 07:35:58 +0200 Subject: [PATCH 03/59] repetition not needed - implicit none at the beginning of the module is enough --- src/crystallite.f90 | 38 ++++++-------------------------------- 1 file changed, 6 insertions(+), 32 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index afaffb07a..5cfb0eb5a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -21,8 +21,7 @@ module crystallite homogenization_Ngrains use future - implicit none - + implicit none private character(len=64), dimension(:,:), allocatable, private :: & crystallite_output !< name of each post result output @@ -186,8 +185,6 @@ subroutine crystallite_init constitutive_initialFi, & constitutive_microstructure ! derived (shortcut) quantities of given state - implicit none - integer, parameter :: FILEUNIT=434 logical, dimension(:,:), allocatable :: devNull integer :: & @@ -492,7 +489,6 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) phase_Nsources, & phaseAt, phasememberAt - implicit none logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress real(pReal), intent(in), optional :: & dummyArgumentToPreventInternalCompilerErrorWithGCC @@ -757,7 +753,6 @@ subroutine crystallite_stressTangent() constitutive_LpAndItsTangents, & constitutive_LiAndItsTangents - implicit none integer :: & c, & !< counter in integration point component loop i, & !< counter in integration point loop @@ -911,7 +906,6 @@ subroutine crystallite_orientations use plastic_nonlocal, only: & plastic_nonlocal_updateCompatibility - implicit none integer & c, & !< counter in integration point component loop i, & !< counter in integration point loop @@ -948,7 +942,6 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33) use material, only: & material_EulerAngles ! ToDo: Why stored? We also have crystallite_orientation0 - implicit none real(pReal), dimension(3,3) :: crystallite_push33ToRef real(pReal), dimension(3,3), intent(in) :: tensor33 real(pReal), dimension(3,3) :: T @@ -993,7 +986,6 @@ function crystallite_postResults(ipc, ip, el) use rotations, only: & rotation - implicit none integer, intent(in):: & el, & !< element index ip, & !< integration point index @@ -1120,7 +1112,6 @@ subroutine crystallite_results use material, only: & material_phase_plasticity_type => phase_plasticity - implicit none integer :: p,o real(pReal), allocatable, dimension(:,:,:) :: selected_tensors type(rotation), allocatable, dimension(:) :: selected_rotations @@ -1292,7 +1283,6 @@ logical function integrateStress(ipc,ip,el,timeFraction) math_33to9, & math_9to33 - implicit none integer, intent(in):: el, & ! element index ip, & ! integration point index ipc ! grain index @@ -1690,7 +1680,7 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateStateFPI() +subroutine integrateStateFPI #ifdef DEBUG use debug, only: debug_level, & debug_e, & @@ -1715,8 +1705,6 @@ subroutine integrateStateFPI() constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState - implicit none - integer :: & NiterationState, & !< number of iterations in state loop e, & !< element index in element loop @@ -1881,7 +1869,6 @@ subroutine integrateStateFPI() !-------------------------------------------------------------------------------------------------- real(pReal) pure function damper(current,previous,previous2) - implicit none real(pReal), dimension(:), intent(in) ::& current, previous, previous2 @@ -1907,8 +1894,6 @@ subroutine integrateStateEuler() use material, only: & plasticState - implicit none - call update_dotState(1.0_pReal) call update_state(1.0_pReal) call update_deltaState @@ -1938,7 +1923,6 @@ subroutine integrateStateAdaptiveEuler() constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState - implicit none integer :: & e, & ! element index in element loop i, & ! integration point index in ip loop @@ -2040,7 +2024,6 @@ subroutine integrateStateRK4() phase_Nsources, & phaseAt, phasememberAt - implicit none real(pReal), dimension(4), parameter :: & TIMESTEPFRACTION = [0.5_pReal, 0.5_pReal, 1.0_pReal, 1.0_pReal] ! factor giving the fraction of the original timestep used for Runge Kutta Integration real(pReal), dimension(4), parameter :: & @@ -2113,7 +2096,6 @@ subroutine integrateStateRKCK45() constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState - implicit none real(pReal), dimension(5,5), parameter :: & A = reshape([& .2_pReal, .075_pReal, .3_pReal, -11.0_pReal/54.0_pReal, 1631.0_pReal/55296.0_pReal, & @@ -2281,9 +2263,7 @@ end subroutine integrateStateRKCK45 !> @brief sets convergence flag for nonlocal calculations !> @detail one non-converged nonlocal sets all other nonlocals to non-converged to trigger cut back !-------------------------------------------------------------------------------------------------- -subroutine nonlocalConvergenceCheck() - - implicit none +subroutine nonlocalConvergenceCheck if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... where( .not. crystallite_localPlasticity) crystallite_converged = .false. @@ -2296,10 +2276,10 @@ end subroutine nonlocalConvergenceCheck ! still .true. is considered as converged !> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria !-------------------------------------------------------------------------------------------------- -subroutine setConvergenceFlag() +subroutine setConvergenceFlag use mesh, only: & mesh_element - implicit none + integer :: & e, & !< element index in element loop i, & !< integration point index in ip loop @@ -2321,7 +2301,6 @@ end subroutine setConvergenceFlag !-------------------------------------------------------------------------------------------------- logical pure function converged(residuum,state,aTol) - implicit none real(pReal), intent(in), dimension(:) ::& residuum, state, aTol real(pReal) :: & @@ -2340,7 +2319,7 @@ end subroutine setConvergenceFlag subroutine update_stress(timeFraction) use mesh, only: & mesh_element - implicit none + real(pReal), intent(in) :: & timeFraction integer :: & @@ -2376,7 +2355,6 @@ subroutine update_dependentState() use constitutive, only: & constitutive_dependentState => constitutive_microstructure - implicit none integer :: e, & ! element index in element loop i, & ! integration point index in ip loop g ! grain index in grain loop @@ -2407,7 +2385,6 @@ subroutine update_state(timeFraction) use mesh, only: & mesh_element - implicit none real(pReal), intent(in) :: & timeFraction integer :: & @@ -2460,7 +2437,6 @@ subroutine update_dotState(timeFraction) use constitutive, only: & constitutive_collectDotState - implicit none real(pReal), intent(in) :: & timeFraction integer :: & @@ -2519,7 +2495,6 @@ subroutine update_deltaState phaseAt, phasememberAt use constitutive, only: & constitutive_collectDeltaState - implicit none integer :: & e, & !< element index in element loop i, & !< integration point index in ip loop @@ -2608,7 +2583,6 @@ logical function stateJump(ipc,ip,el) use constitutive, only: & constitutive_collectDeltaState - implicit none integer, intent(in):: & el, & ! element index ip, & ! integration point index From 52555d8c3c8167992bd01ca734eb993084edcf5e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 11 Apr 2019 11:27:03 +0200 Subject: [PATCH 04/59] key words don't contain small letters moved more variables from numerics to crystallite --- src/crystallite.f90 | 82 ++++++++++++++++++++++++++------------------- src/numerics.f90 | 28 ---------------- 2 files changed, 48 insertions(+), 62 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 5cfb0eb5a..42daa21bb 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -110,7 +110,11 @@ module crystallite end type tOutput type(tOutput), allocatable, dimension(:), private :: output_constituent - type, private :: tNumerics + type, private :: tNumerics + integer :: & + iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp + nState, & !< state loop limit + nStress !< stress loop limit real(pReal) :: & subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback subStepSizeCryst, & !< size of first substep when cutback @@ -255,23 +259,37 @@ subroutine crystallite_init allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & size(config_crystallite)), source=0) - num%subStepMinCryst = config_numerics%getFloat('subStepMinCryst', defaultVal=1.0e-3_pReal) - num%subStepSizeCryst = config_numerics%getFloat('subStepSizeCryst', defaultVal=0.25_pReal) - num%subStepSizeLp = config_numerics%getFloat('subStepSizeLp', defaultVal=0.5_pReal) - num%subStepSizeLi = config_numerics%getFloat('subStepSizeLi', defaultVal=0.5_pReal) - num%stepIncreaseCryst = config_numerics%getFloat('stepIncreaseCryst', defaultVal=1.5_pReal) - num%rTol_crystalliteState = config_numerics%getFloat('rTol_crystalliteState', defaultVal=1.0e-6_pReal) - num%rTol_crystalliteStress = config_numerics%getFloat('rTol_crystalliteStress',defaultVal=1.0e-6_pReal) - num%aTol_crystalliteStress = config_numerics%getFloat('aTol_crystalliteStress',defaultVal=1.0e-8_pReal) + num%subStepMinCryst = config_numerics%getFloat('substepmincryst', defaultVal=1.0e-3_pReal) + num%subStepSizeCryst = config_numerics%getFloat('substepsizecryst', defaultVal=0.25_pReal) + num%stepIncreaseCryst = config_numerics%getFloat('stepincreasecryst', defaultVal=1.5_pReal) - if(num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst') - if(num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst') - if(num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst') - if(num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp') - if(num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi') - if(num%rTol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rTol_crystalliteState') - if(num%rTol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rTol_crystalliteStress') - if(num%aTol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='aTol_crystalliteStress') + num%subStepSizeLp = config_numerics%getFloat('substepsizelp', defaultVal=0.5_pReal) + num%subStepSizeLi = config_numerics%getFloat('substepsizeli', defaultVal=0.5_pReal) + + num%rTol_crystalliteState = config_numerics%getFloat('rtol_crystallitestate', defaultVal=1.0e-6_pReal) + num%rTol_crystalliteStress = config_numerics%getFloat('rtol_crystallitestress',defaultVal=1.0e-6_pReal) + num%aTol_crystalliteStress = config_numerics%getFloat('atol_crystallitestress',defaultVal=1.0e-8_pReal) + + num%iJacoLpresiduum = config_numerics%getInt ('ijacolpresiduum', defaultVal=1) + + num%nState = config_numerics%getInt ('nstate', defaultVal=20) + num%nStress = config_numerics%getInt ('nstress', defaultVal=40) + + if(num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst') + if(num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst') + if(num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst') + + if(num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp') + if(num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi') + + if(num%rTol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rTol_crystalliteState') + if(num%rTol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rTol_crystalliteStress') + if(num%aTol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='aTol_crystalliteStress') + + if(num%iJacoLpresiduum < 1) call IO_error(301,ext_msg='iJacoLpresiduum') + + if(num%nState < 1) call IO_error(301,ext_msg='nState') + if(num%nStress< 1) call IO_error(301,ext_msg='nStress') select case(numerics_integrator) case(1) @@ -727,7 +745,7 @@ end function crystallite_stress !-------------------------------------------------------------------------------------------------- !> @brief calculate tangent (dPdF) !-------------------------------------------------------------------------------------------------- -subroutine crystallite_stressTangent() +subroutine crystallite_stressTangent use prec, only: & tol_math_check, & dNeq0 @@ -1257,8 +1275,6 @@ logical function integrateStress(ipc,ip,el,timeFraction) IEEE_arithmetic use prec, only: tol_math_check, & dEq0 - use numerics, only: nStress, & - iJacoLpresiduum #ifdef DEBUG use debug, only: debug_level, & debug_e, & @@ -1401,10 +1417,10 @@ logical function integrateStress(ipc,ip,el,timeFraction) LiLoop: do NiterationStressLi = NiterationStressLi + 1 - LiLoopLimit: if (NiterationStressLi > nStress) then + LiLoopLimit: if (NiterationStressLi > num%nStress) then #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) & - write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Li loop limit',nStress, & + write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Li loop limit',num%nStress, & ' at el ip ipc ', el,ip,ipc #endif return @@ -1423,10 +1439,10 @@ logical function integrateStress(ipc,ip,el,timeFraction) LpLoop: do NiterationStressLp = NiterationStressLp + 1 - LpLoopLimit: if (NiterationStressLp > nStress) then + LpLoopLimit: if (NiterationStressLp > num%nStress) then #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) & - write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Lp loop limit',nStress, & + write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Lp loop limit',num%nStress, & ' at el ip ipc ', el,ip,ipc #endif return @@ -1492,7 +1508,7 @@ logical function integrateStress(ipc,ip,el,timeFraction) !* calculate Jacobian for correction term - if (mod(jacoCounterLp, iJacoLpresiduum) == 0) then + if (mod(jacoCounterLp, num%iJacoLpresiduum) == 0) then do o=1,3; do p=1,3 dFe_dLp(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) enddo; enddo @@ -1582,7 +1598,7 @@ logical function integrateStress(ipc,ip,el,timeFraction) endif !* calculate Jacobian for correction term - if (mod(jacoCounterLi, iJacoLpresiduum) == 0) then + if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then temp_33 = matmul(matmul(A,B),invFi_current) do o=1,3; do p=1,3 dFe_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) @@ -1691,8 +1707,6 @@ subroutine integrateStateFPI debug_levelExtensive, & debug_levelSelective #endif - use numerics, only: & - nState use mesh, only: & mesh_element use material, only: & @@ -1729,7 +1743,7 @@ subroutine integrateStateFPI NiterationState = 0 doneWithIntegration = .false. - crystalliteLooping: do while (.not. doneWithIntegration .and. NiterationState < nState) + crystalliteLooping: do while (.not. doneWithIntegration .and. NiterationState < num%nState) NiterationState = NiterationState + 1 #ifdef DEBUG @@ -1890,7 +1904,7 @@ end subroutine integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateEuler() +subroutine integrateStateEuler use material, only: & plasticState @@ -1908,7 +1922,7 @@ end subroutine integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -subroutine integrateStateAdaptiveEuler() +subroutine integrateStateAdaptiveEuler use mesh, only: & theMesh, & mesh_element @@ -2014,7 +2028,7 @@ end subroutine integrateStateAdaptiveEuler !> @brief integrate stress, state with 4th order explicit Runge Kutta method ! ToDo: This is totally BROKEN: RK4dotState is never used!!! !-------------------------------------------------------------------------------------------------- -subroutine integrateStateRK4() +subroutine integrateStateRK4 use mesh, only: & mesh_element use material, only: & @@ -2081,7 +2095,7 @@ end subroutine integrateStateRK4 !> @brief integrate stress, state with 5th order Runge-Kutta Cash-Karp method with !> adaptive step size (use 5th order solution to advance = "local extrapolation") !-------------------------------------------------------------------------------------------------- -subroutine integrateStateRKCK45() +subroutine integrateStateRKCK45 use mesh, only: & mesh_element, & theMesh @@ -2349,7 +2363,7 @@ end subroutine update_stress !-------------------------------------------------------------------------------------------------- !> @brief tbd !-------------------------------------------------------------------------------------------------- -subroutine update_dependentState() +subroutine update_dependentState use mesh, only: & mesh_element use constitutive, only: & diff --git a/src/numerics.f90 b/src/numerics.f90 index a5368a5de..77d1c7714 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -13,11 +13,7 @@ module numerics integer(pInt), protected, public :: & iJacoStiffness = 1_pInt, & !< frequency of stiffness update - iJacoLpresiduum = 1_pInt, & !< frequency of Jacobian update of residuum in Lp nMPstate = 10_pInt, & !< materialpoint state loop limit - nCryst = 20_pInt, & !< crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst") - nState = 10_pInt, & !< state loop limit - nStress = 40_pInt, & !< stress 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) @@ -186,30 +182,14 @@ subroutine numerics_init defgradTolerance = IO_floatValue(line,chunkPos,2_pInt) case ('ijacostiffness') iJacoStiffness = IO_intValue(line,chunkPos,2_pInt) - case ('ijacolpresiduum') - iJacoLpresiduum = IO_intValue(line,chunkPos,2_pInt) case ('nmpstate') nMPstate = IO_intValue(line,chunkPos,2_pInt) - case ('ncryst') - nCryst = IO_intValue(line,chunkPos,2_pInt) - case ('nstate') - nState = IO_intValue(line,chunkPos,2_pInt) - case ('nstress') - nStress = IO_intValue(line,chunkPos,2_pInt) - case ('substepmincryst') - case ('substepsizecryst') - case ('stepincreasecryst') - case ('substepsizelp') - case ('substepsizeli') case ('substepminhomog') subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt) case ('substepsizehomog') subStepSizeHomog = IO_floatValue(line,chunkPos,2_pInt) case ('stepincreasehomog') stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt) - case ('rtol_crystallitestate') - case ('rtol_crystallitestress') - case ('atol_crystallitestress') case ('integrator') numerics_integrator = IO_intValue(line,chunkPos,2_pInt) case ('usepingpong') @@ -332,10 +312,6 @@ subroutine numerics_init ! writing parameters to output write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness - write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum - write(6,'(a24,1x,i8)') ' nCryst: ',nCryst - write(6,'(a24,1x,i8)') ' nState: ',nState - write(6,'(a24,1x,i8)') ' nStress: ',nStress write(6,'(a24,1x,i8)') ' integrator: ',numerics_integrator write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength @@ -417,11 +393,7 @@ 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 (iJacoLpresiduum < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoLpresiduum') if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate') - if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst') - if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState') - if (nStress < 1_pInt) call IO_error(301_pInt,ext_msg='nStress') 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') From d8b310e78b85a609af3e3c284c315742cdfa44ed Mon Sep 17 00:00:00 2001 From: Kieran David Nehil-Puleo Date: Thu, 18 Apr 2019 11:13:51 -0400 Subject: [PATCH 05/59] Changed Guessing Scheme --- src/homogenization.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 06da6ab2e..8725c321e 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -528,8 +528,11 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! restore... crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = & crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads + if(materialpoint_subStep(i,e) < 1.0_pReal) then crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads + crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) + endif + ! ...plastic velocity grads crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = & crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads crystallite_Li(1:3,1:3,1:myNgrains,i,e) = & From 04232ea534f66f93e6b7788cb48e32e13e241b6d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 30 Apr 2019 19:17:08 +0200 Subject: [PATCH 06/59] test update for improved guessing --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 212ac3b32..76d367e29 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 212ac3b326f3a15926d71109fec0173d95931b6b +Subproject commit 76d367e297c054de78f5568074470b047427395b From 8286a289df62bb4f8ae2fbcab107356a70ab3eb4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 12 May 2019 09:47:21 +0200 Subject: [PATCH 07/59] try to directly allocate pointers --- src/mesh/FEM_mech.f90 | 66 ++++++++++++++++++------------------------- 1 file changed, 28 insertions(+), 38 deletions(-) diff --git a/src/mesh/FEM_mech.f90 b/src/mesh/FEM_mech.f90 index dd9872110..d3a6e48c1 100644 --- a/src/mesh/FEM_mech.f90 +++ b/src/mesh/FEM_mech.f90 @@ -84,11 +84,9 @@ subroutine FEM_mech_init(fieldBC) PetscDS :: mechDS PetscDualSpace :: mechDualSpace DMLabel :: BCLabel - PetscInt, dimension(:), allocatable, target :: numComp, numDoF, bcField PetscInt, dimension(:), pointer :: pNumComp, pNumDof, pBcField, pBcPoint PetscInt :: numBC, bcSize, nc IS :: bcPoint - IS, allocatable, target :: bcComps(:), bcPoints(:) IS, pointer :: pBcComps(:), pBcPoints(:) PetscSection :: section PetscInt :: field, faceSet, topologDim, nNodalPoints @@ -98,7 +96,7 @@ subroutine FEM_mech_init(fieldBC) PetscScalar, pointer :: px_scal(:) PetscScalar, allocatable, target :: x_scal(:) PetscReal :: detJ - PetscReal, allocatable, target :: v0(:), cellJ(:), invcellJ(:), cellJMat(:,:) + PetscReal, allocatable, target :: cellJMat(:,:) PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) PetscInt :: cellStart, cellEnd, cell, basis character(len=7) :: prefix = 'mechFE_' @@ -139,26 +137,26 @@ subroutine FEM_mech_init(fieldBC) call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr) call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr) - allocate(numComp(1), source=dimPlex); pNumComp => numComp - allocate(numDof(dimPlex+1), source = 0); pNumDof => numDof + allocate(pnumComp(1), source=dimPlex) + allocate(pnumDof(dimPlex+1), source = 0) do topologDim = 0, dimPlex call DMPlexGetDepthStratum(mech_mesh,topologDim,cellStart,cellEnd,ierr) CHKERRQ(ierr) - call PetscSectionGetDof(section,cellStart,numDof(topologDim+1),ierr) + call PetscSectionGetDof(section,cellStart,pnumDof(topologDim+1),ierr) CHKERRQ(ierr) enddo numBC = 0 do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries if (fieldBC%componentBC(field)%Mask(faceSet)) numBC = numBC + 1 enddo; enddo - allocate(bcField(numBC), source=0); pBcField => bcField - allocate(bcComps(numBC)); pBcComps => bcComps - allocate(bcPoints(numBC)); pBcPoints => bcPoints + allocate(pbcField(numBC), source=0) + allocate(pbcComps(numBC)) + allocate(pbcPoints(numBC)) numBC = 0 do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries if (fieldBC%componentBC(field)%Mask(faceSet)) then numBC = numBC + 1 - call ISCreateGeneral(PETSC_COMM_WORLD,1,[field-1],PETSC_COPY_VALUES,bcComps(numBC),ierr) + call ISCreateGeneral(PETSC_COMM_WORLD,1,[field-1],PETSC_COPY_VALUES,pbcComps(numBC),ierr) CHKERRQ(ierr) call DMGetStratumSize(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcSize,ierr) CHKERRQ(ierr) @@ -166,12 +164,12 @@ subroutine FEM_mech_init(fieldBC) call DMGetStratumIS(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcPoint,ierr) CHKERRQ(ierr) call ISGetIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) - call ISCreateGeneral(PETSC_COMM_WORLD,bcSize,pBcPoint,PETSC_COPY_VALUES,bcPoints(numBC),ierr) + call ISCreateGeneral(PETSC_COMM_WORLD,bcSize,pBcPoint,PETSC_COPY_VALUES,pbcPoints(numBC),ierr) CHKERRQ(ierr) call ISRestoreIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) call ISDestroy(bcPoint,ierr); CHKERRQ(ierr) else - call ISCreateGeneral(PETSC_COMM_WORLD,0,[0],PETSC_COPY_VALUES,bcPoints(numBC),ierr) + call ISCreateGeneral(PETSC_COMM_WORLD,0,[0],PETSC_COPY_VALUES,pbcPoints(numBC),ierr) CHKERRQ(ierr) endif endif @@ -182,7 +180,7 @@ subroutine FEM_mech_init(fieldBC) CHKERRQ(ierr) call DMSetSection(mech_mesh,section,ierr); CHKERRQ(ierr) do faceSet = 1, numBC - call ISDestroy(bcPoints(faceSet),ierr); CHKERRQ(ierr) + call ISDestroy(pbcPoints(faceSet),ierr); CHKERRQ(ierr) enddo !-------------------------------------------------------------------------------------------------- @@ -213,13 +211,10 @@ subroutine FEM_mech_init(fieldBC) allocate(nodalWeights(1)) nodalPointsP => nodalPoints nodalWeightsP => nodalWeights - allocate(v0(dimPlex)) - allocate(cellJ(dimPlex*dimPlex)) - allocate(invcellJ(dimPlex*dimPlex)) + allocate(pv0(dimPlex)) + allocate(pcellJ(dimPlex*dimPlex)) + allocate(pinvcellJ(dimPlex*dimPlex)) allocate(cellJMat(dimPlex,dimPlex)) - pV0 => v0 - pCellJ => cellJ - pInvcellJ => invcellJ call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr) call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr) call PetscDSGetDiscretization(mechDS,0,mechFE,ierr) @@ -325,22 +320,19 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) PetscScalar, dimension(:), pointer :: x_scal, pf_scal PetscScalar, target :: f_scal(cellDof) PetscReal :: detJ, IcellJMat(dimPlex,dimPlex) - PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), & - invcellJ(dimPlex*dimPlex) - PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) - PetscReal, pointer :: basisField(:), basisFieldDer(:) + PetscReal, pointer,dimension(:) :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer PetscInt :: cellStart, cellEnd, cell, field, face, & qPt, basis, comp, cidx PetscReal :: detFAvg PetscReal :: BMat(dimPlex*dimPlex,cellDof) - PetscObject :: dummy + PetscObject,intent(in) :: dummy PetscInt :: bcSize IS :: bcPoints PetscErrorCode :: ierr - pV0 => v0 - pCellJ => cellJ - pInvcellJ => invcellJ + allocate(pV0(dimPlex)) + allocate(pcellJ(dimPlex**2)) + allocate(pinvcellJ(dimPlex**2)) call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr) call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) @@ -460,13 +452,11 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) Vec :: x_local, xx_local Mat :: Jac_pre, Jac PetscSection :: section, gSection - PetscReal :: detJ, IcellJMat(dimPlex,dimPlex) - PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), & - invcellJ(dimPlex*dimPlex) + PetscReal :: detJ PetscReal, dimension(:), pointer :: basisField, basisFieldDer, & pV0, pCellJ, pInvcellJ PetscInt :: cellStart, cellEnd, cell, field, face, & - qPt, basis, comp, cidx + qPt, basis, comp, cidx,bcSize PetscScalar,dimension(cellDOF,cellDOF), target :: K_e, & K_eA , & K_eB @@ -477,14 +467,14 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) MatB (1 ,cellDof) PetscScalar, dimension(:), pointer :: pK_e, x_scal PetscReal, dimension(3,3) :: F, FAvg, FInv - PetscObject :: dummy - PetscInt :: bcSize + PetscObject, intent(in) :: dummy IS :: bcPoints PetscErrorCode :: ierr - pV0 => v0 - pCellJ => cellJ - pInvcellJ => invcellJ + allocate(pV0(dimPlex)) + allocate(pcellJ(dimPlex**2)) + allocate(pinvcellJ(dimPlex**2)) + call MatSetOption(Jac,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE,ierr); CHKERRQ(ierr) call MatSetOption(Jac,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE,ierr); CHKERRQ(ierr) call MatZeroEntries(Jac,ierr); CHKERRQ(ierr) @@ -513,7 +503,6 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) CHKERRQ(ierr) call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) CHKERRQ(ierr) - IcellJMat = reshape(pInvcellJ, shape = [dimPlex,dimPlex]) K_eA = 0.0 K_eB = 0.0 MatB = 0.0 @@ -525,7 +514,8 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) do comp = 0, dimPlex-1 cidx = basis*dimPlex+comp BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = & - matmul(IcellJMat,basisFieldDer((((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp )*dimPlex+1: & + matmul( reshape(pInvcellJ, shape = [dimPlex,dimPlex]),& + basisFieldDer((((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp )*dimPlex+1: & (((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex)) enddo enddo From f0f8be7840f618dd758db33ced3b92d2d429f3dc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 12 May 2019 10:05:40 +0200 Subject: [PATCH 08/59] not used --- src/mesh/FEM_utilities.f90 | 17 +---------------- 1 file changed, 1 insertion(+), 16 deletions(-) diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index a2ba2d345..937c46a32 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -24,9 +24,7 @@ use PETScis ! grid related information information real(pReal), public :: wgt !< weighting factor 1/Nelems -!-------------------------------------------------------------------------------------------------- -! output data - Vec, public :: coordinatesVec + !-------------------------------------------------------------------------------------------------- ! field labels information character(len=*), parameter, public :: & @@ -53,7 +51,6 @@ use PETScis type, public :: tSolutionState !< return type of solution from FEM solver variants logical :: converged = .true. logical :: stagConverged = .true. - logical :: regrid = .false. integer(pInt) :: iterationsNeeded = 0_pInt end type tSolutionState @@ -79,18 +76,6 @@ use PETScis integer(pInt), allocatable :: faceID(:) type(tFieldBC), allocatable :: fieldBC(:) end type tLoadCase - - type, public :: tFEMInterpolation - integer(pInt) :: n - real(pReal), dimension(:,:) , allocatable :: shapeFunc, shapeDerivReal, geomShapeDerivIso - real(pReal), dimension(:,:,:), allocatable :: shapeDerivIso - end type tFEMInterpolation - - type, public :: tQuadrature - integer(pInt) :: n - real(pReal), dimension(:) , allocatable :: Weights - real(pReal), dimension(:,:), allocatable :: Points - end type tQuadrature public :: & utilities_init, & From 7d5f5afe01610ad5f5be1c6f839748c63234abeb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 12 May 2019 13:11:30 +0200 Subject: [PATCH 09/59] further cleaning --- src/grid/spectral_utilities.f90 | 7 +------ src/mesh/DAMASK_FEM.f90 | 14 ++++++-------- src/mesh/FEM_utilities.f90 | 23 ++--------------------- 3 files changed, 9 insertions(+), 35 deletions(-) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 4c5dc3169..1d5e42070 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -942,9 +942,6 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& IO_error use numerics, only: & worldrank - use debug, only: & - debug_reset, & - debug_info use math, only: & math_rotate_forward33, & math_det33 @@ -977,7 +974,6 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& materialpoint_F = reshape(F,[3,3,1,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field - call debug_reset() ! this has no effect on rank >0 call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field P = reshape(materialpoint_P, [3,3,grid(1),grid(2),grid3]) @@ -1023,8 +1019,7 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) C_volAvg = C_volAvg * wgt - - call debug_info() ! this has no effect on rank >0 + end subroutine utilities_constitutiveResponse diff --git a/src/mesh/DAMASK_FEM.f90 b/src/mesh/DAMASK_FEM.f90 index 611be46e0..052c30071 100644 --- a/src/mesh/DAMASK_FEM.f90 +++ b/src/mesh/DAMASK_FEM.f90 @@ -28,8 +28,7 @@ program DAMASK_FEM IO_intOut, & IO_warning use math ! need to include the whole module for FFTW - use CPFEM2, only: & - CPFEM_initAll + use CPFEM2 use FEsolving, only: & restartWrite, & restartInc @@ -114,7 +113,7 @@ program DAMASK_FEM write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>' ! reading basic information from load case file and allocate data structure containing load cases - call DMGetDimension(geomMesh,dimPlex,ierr)! CHKERRQ(ierr) !< dimension of mesh (2D or 3D) + call DMGetDimension(geomMesh,dimPlex,ierr); CHKERRA(ierr) !< dimension of mesh (2D or 3D) nActiveFields = 1 allocate(solres(nActiveFields)) @@ -394,8 +393,7 @@ program DAMASK_FEM cutBack = .False. if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found if (cutBackLevel < maxCutBack) then ! do cut back - if (worldrank == 0) & - write(6,'(/,a)') ' cut back detected' + write(6,'(/,a)') ' cut back detected' cutBack = .True. stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator cutBackLevel = cutBackLevel + 1_pInt @@ -403,7 +401,7 @@ program DAMASK_FEM timeinc = timeinc/2.0_pReal else ! default behavior, exit if spectral solver does not converge call IO_warning(850_pInt) - call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written (e.g. for regridding) ! continue from non-converged solution and start guessing after accepted (sub)inc + call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written endif else guess = .true. ! start guessing after first converged (sub)inc @@ -428,7 +426,8 @@ program DAMASK_FEM endif; flush(6) if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency - write(6,'(1/,a)') ' ToDo: ... writing results to file ......................................' + write(6,'(1/,a)') ' ... writing results to file ......................................' + call CPFEM_results(totalIncsCounter,time) endif if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information @@ -452,7 +451,6 @@ program DAMASK_FEM real(convergedCounter, pReal)/& real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!' flush(6) - call MPI_file_close(fileUnit,ierr) close(statUnit) if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 937c46a32..b2f9d35f5 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -104,11 +104,8 @@ subroutine utilities_init use math ! must use the whole module for use of FFTW use mesh, only: & mesh_NcpElemsGlobal, & - mesh_maxNips, & - geomMesh - - implicit none - + mesh_maxNips + character(len=1024) :: petsc_optionsPhysics PetscErrorCode :: ierr @@ -142,35 +139,21 @@ end subroutine utilities_init !> @brief calculates constitutive response !-------------------------------------------------------------------------------------------------- subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) - use math, only: & - math_det33 use FEsolving, only: & restartWrite use homogenization, only: & materialpoint_P, & materialpoint_stressAndItsTangent - implicit none real(pReal), intent(in) :: timeinc !< loading time logical, intent(in) :: forwardData !< age results real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress - logical :: & - age - PetscErrorCode :: ierr write(6,'(/,a)') ' ... evaluating constitutive response ......................................' - age = .False. - if (forwardData) then ! aging results - age = .True. - endif - if (cutBack) then ! restore saved variables - age = .False. - endif - call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field restartWrite = .false. ! reset restartWrite status @@ -187,8 +170,6 @@ end subroutine utilities_constitutiveResponse !-------------------------------------------------------------------------------------------------- subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCValue,BCDotValue,timeinc) - implicit none - Vec :: localVec PetscInt :: field, comp, nBcPoints, point, dof, numDof, numComp, offset PetscSection :: section From 7c22c88df5824de9fc3232587b632fd610440ce9 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 14 May 2019 12:48:23 +0200 Subject: [PATCH 10/59] [skip ci] updated version information after successful test of v2.0.3-282-g387c45d0 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 50693fa6c..416b7cf0c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-261-g99878952 +v2.0.3-282-g387c45d0 From 4c7af713f15026b34acbfd6c00c3fe12009379ac Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 14 May 2019 12:56:24 -0400 Subject: [PATCH 11/59] added explicit method Rotation.fromBasis, which can treat real and reciprocal basis sets --- python/damask/orientation.py | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index b19037b0c..aae96c8d6 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -227,12 +227,17 @@ class Rotation: return cls(ax2qu(ax)) @classmethod - def fromMatrix(cls, - matrix, - containsStretch = False): #ToDo: better name? + def fromBasis(cls, + basis, + orthonormal = True, + reciprocal = False, + ): - om = matrix if isinstance(matrix, np.ndarray) else np.array(matrix).reshape((3,3)) # ToDo: Reshape here or require explicit? - if containsStretch: + om = basis if isinstance(basis, np.ndarray) else np.array(basis).reshape((3,3)) + if reciprocal: + om = np.linalg.inv(om.T/np.pi) # transform reciprocal basis set + orthonormal = False # contains stretch + if not orthonormal: (U,S,Vh) = np.linalg.svd(om) # singular value decomposition om = np.dot(U,Vh) if not np.isclose(np.linalg.det(om),1.0): @@ -244,6 +249,13 @@ class Rotation: return cls(om2qu(om)) + @classmethod + def fromMatrix(cls, + om, + ): + + return cls.fromBasis(om) + @classmethod def fromRodrigues(cls, rodrigues, From f3d8b960fda536df808af6117384537b9ad73d58 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 14 May 2019 19:46:25 +0200 Subject: [PATCH 12/59] included Li in list of protected quantities for fake cutback --- src/homogenization.f90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8725c321e..831e62718 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -526,17 +526,16 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) !-------------------------------------------------------------------------------------------------- ! restore... + if (materialpoint_subStep(i,e) < 1.0_pReal) then ! protect against fake cutback from \Delta t = 2 to 1. Maybe that "trick" is not necessary anymore at all? I.e. start with \Delta t = 1 + crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads + crystallite_Li(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads + endif ! maybe protecting everything from overwriting (not only L) makes even more sense crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = & crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads - if(materialpoint_subStep(i,e) < 1.0_pReal) then - crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) - endif - ! ...plastic velocity grads crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = & crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads - crystallite_Li(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads crystallite_S(1:3,1:3,1:myNgrains,i,e) = & crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress do g = 1, myNgrains From 9249b7f4af0b93d2e54f4feacb91a1e80afddbc1 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 14 May 2019 19:52:48 +0200 Subject: [PATCH 13/59] improved column alignment of indices such as (g,i,e) --- src/homogenization.f90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 831e62718..70b3ff0ab 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -456,45 +456,45 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) steppingNeeded: if (materialpoint_subStep(i,e) > subStepMinHomog) then ! wind forward grain starting point of... - crystallite_partionedF0(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedF0 (1:3,1:3,1:myNgrains,i,e) = & crystallite_partionedF(1:3,1:3,1:myNgrains,i,e) ! ...def grads - crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) = & - crystallite_Fp(1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads + crystallite_partionedFp0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_Fp (1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads - crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) = & - crystallite_Lp(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads + crystallite_partionedLp0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_Lp (1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads - crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) = & - crystallite_Fi(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads + crystallite_partionedFi0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_Fi (1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads - crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) = & - crystallite_Li(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads + crystallite_partionedLi0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_Li (1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads - crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) = & - crystallite_S(1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress + crystallite_partionedS0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_S (1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress do g = 1,myNgrains plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & - plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e)) + plasticState (phaseAt(g,i,e))%state (:,phasememberAt(g,i,e)) do mySource = 1, phase_Nsources(phaseAt(g,i,e)) sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & - sourceState(phaseAt(g,i,e))%p(mySource)%state( :,phasememberAt(g,i,e)) + sourceState(phaseAt(g,i,e))%p(mySource)%state (:,phasememberAt(g,i,e)) enddo enddo forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & homogState(material_homogenizationAt(e))%sizeState > 0) & homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state + homogState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) ! ...internal homogenization state forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & thermalState(material_homogenizationAt(e))%sizeState > 0) & thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) ! ...internal thermal state + thermalState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) ! ...internal thermal state forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & damageState(material_homogenizationAt(e))%sizeState > 0) & damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) ! ...internal damage state + damageState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) ! ...internal damage state materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad endif steppingNeeded From ded288f97f80d27aa2392f69afdbc6116576d102 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 14 May 2019 21:13:38 +0200 Subject: [PATCH 14/59] [skip ci] updated version information after successful test of v2.0.3-284-g4c7af713 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 416b7cf0c..6e0c223d2 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-282-g387c45d0 +v2.0.3-284-g4c7af713 From 51e19048f79f6bf167b268ca9632c2ef72c166f5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 14 May 2019 22:44:38 +0200 Subject: [PATCH 15/59] pInt not needed anymore --- src/DAMASK_marc.f90 | 50 +- src/FEsolving.f90 | 52 +- src/IO.f90 | 550 ++++++++------- src/damage_local.f90 | 40 +- src/damage_nonlocal.f90 | 56 +- src/grid/DAMASK_grid.f90 | 276 ++++---- src/kinematics_cleavage_opening.f90 | 68 +- src/kinematics_slipplane_opening.f90 | 42 +- src/material.f90 | 234 +++---- src/mesh_abaqus.f90 | 971 +++++++++++++-------------- src/mesh_marc.f90 | 750 ++++++++++----------- src/source_damage_anisoBrittle.f90 | 78 +-- src/source_damage_anisoDuctile.f90 | 58 +- src/source_damage_isoBrittle.f90 | 56 +- src/source_damage_isoDuctile.f90 | 50 +- 15 files changed, 1614 insertions(+), 1717 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0ff94f3d7..14a741b3b 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -96,14 +96,12 @@ end subroutine DAMASK_interface_init !> @brief solver job name (no extension) as combination of geometry and load case name !-------------------------------------------------------------------------------------------------- function getSolverJobName() - use prec, only: & - pReal, & - pInt + use prec implicit none character(1024) :: getSolverJobName, inputName character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash - integer(pInt) :: extPos + integer :: extPos getSolverJobName='' inputName='' @@ -133,9 +131,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, & strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, & jtype,lclass,ifr,ifu) - use prec, only: & - pReal, & - pInt + use prec use numerics, only: & !$ DAMASK_NumThreadsInt, & numerics_unitlength, & @@ -180,7 +176,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & implicit none !$ include "omp_lib.h" ! the openMP function library - integer(pInt), intent(in) :: & ! according to MSC.Marc 2012 Manual D + integer, intent(in) :: & ! according to MSC.Marc 2012 Manual D ngens, & !< size of stress-strain law nn, & !< integration point number ndi, & !< number of direct components @@ -193,7 +189,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & jtype, & !< element type ifr, & !< set to 1 if R has been calculated ifu !< set to 1 if stretch has been calculated - integer(pInt), dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D + integer, dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D m, & !< (1) user element number, (2) internal element number matus, & !< (1) user material identification number, (2) internal material identification number kcus, & !< (1) layer number, (2) internal layer number @@ -236,10 +232,10 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & logical :: cutBack real(pReal), dimension(6) :: stress real(pReal), dimension(6,6) :: ddsdde - integer(pInt) :: computationMode, i, cp_en, node, CPnodeID + integer :: computationMode, i, cp_en, node, CPnodeID !$ integer(4) :: defaultNumThreadsInt !< default value set by Marc - if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0_pInt) then + if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0) then write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn write(6,'(a,2(i1))') ' Jacobian: ', ngens,ngens write(6,'(a,i1)') ' Direct stress: ', ndi @@ -260,7 +256,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & !$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution set by DAMASK_NUM_THREADS - computationMode = 0_pInt ! save initialization value, since it does not result in any calculation + computationMode = 0 ! save initialization value, since it does not result in any calculation if (lovl == 4 ) then ! jacobian requested by marc if (timinc < theDelta .and. theInc == inc .and. lastLovl /= lovl) & ! first after cutback computationMode = CPFEM_RESTOREJACOBIAN @@ -307,7 +303,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & if (lastLovl /= lovl) then ! first after ping pong call debug_reset() ! resets debugging outdatedFFN1 = .false. - cycleCounter = cycleCounter + 1_pInt + cycleCounter = cycleCounter + 1 mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates call mesh_build_ipCoordinates() ! update ip coordinates endif @@ -324,7 +320,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & lastIncConverged = .false. ! reset flag endif do node = 1,theMesh%elem%nNodes - CPnodeID = mesh_element(4_pInt+node,cp_en) + CPnodeID = mesh_element(4+node,cp_en) mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node) enddo endif @@ -336,7 +332,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & call debug_info() ! first reports (meaningful) debugging call debug_reset() ! and resets debugging outdatedFFN1 = .false. - cycleCounter = cycleCounter + 1_pInt + cycleCounter = cycleCounter + 1 mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates call mesh_build_ipCoordinates() ! update ip coordinates endif @@ -376,22 +372,20 @@ end subroutine hypela2 !> @brief calculate internal heat generated due to inelastic energy dissipation !-------------------------------------------------------------------------------------------------- subroutine flux(f,ts,n,time) - use prec, only: & - pReal, & - pInt + use prec use thermal_conduction, only: & thermal_conduction_getSourceAndItsTangent use mesh, only: & mesh_FEasCP implicit none - real(pReal), dimension(6), intent(in) :: & + real(pReal), dimension(6), intent(in) :: & ts - integer(pInt), dimension(10), intent(in) :: & + integer, dimension(10), intent(in) :: & n - real(pReal), intent(in) :: & + real(pReal), intent(in) :: & time - real(pReal), dimension(2), intent(out) :: & + real(pReal), dimension(2), intent(out) :: & f call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEasCP('elem',n(1))) @@ -404,9 +398,7 @@ subroutine flux(f,ts,n,time) !> @details select a variable contour plotting (user subroutine). !-------------------------------------------------------------------------------------------------- subroutine uedinc(inc,incsub) - use prec, only: & - pReal, & - pInt + use prec use CPFEM, only: & CPFEM_results @@ -424,9 +416,7 @@ end subroutine uedinc !> @details select a variable contour plotting (user subroutine). !-------------------------------------------------------------------------------------------------- subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd) - use prec, only: & - pReal, & - pInt + use prec use mesh, only: & mesh_FEasCP use IO, only: & @@ -436,7 +426,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd) materialpoint_sizeResults implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & m, & !< element number nn, & !< integration point number layer, & !< layer number @@ -453,7 +443,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd) real(pReal), intent(out) :: & v !< variable - if (jpltcd > materialpoint_sizeResults) call IO_error(700_pInt,jpltcd) ! complain about out of bounds error + if (jpltcd > materialpoint_sizeResults) call IO_error(700,jpltcd) ! complain about out of bounds error v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m)) end subroutine plotv diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 index 8780d2712..be567decc 100644 --- a/src/FEsolving.f90 +++ b/src/FEsolving.f90 @@ -11,8 +11,8 @@ module FEsolving implicit none private - integer(pInt), public :: & - restartInc = 1_pInt !< needs description + integer, public :: & + restartInc = 1 !< needs description logical, public :: & symmetricSolver = .false., & !< use a symmetric FEM solver @@ -20,10 +20,10 @@ module FEsolving restartRead = .false., & !< restart information to continue calculation from saved state terminallyIll = .false. !< at least one material point is terminally ill - integer(pInt), dimension(:,:), allocatable, public :: & + integer, dimension(:,:), allocatable, public :: & FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP - integer(pInt), dimension(2), public :: & + integer, dimension(2), public :: & FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element character(len=1024), public :: & @@ -61,11 +61,11 @@ subroutine FE_init implicit none #if defined(Marc4DAMASK) || defined(Abaqus) - integer(pInt), parameter :: & - FILEUNIT = 222_pInt - integer(pInt) :: j + integer, parameter :: & + FILEUNIT = 222 + integer :: j character(len=65536) :: tag, line - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos #endif write(6,'(/,a)') ' <<<+- FEsolving init -+>>>' @@ -75,35 +75,35 @@ subroutine FE_init #if defined(Grid) || defined(FEM) restartInc = interface_RestartInc - if(restartInc < 0_pInt) then - call IO_warning(warning_ID=34_pInt) - restartInc = 0_pInt + if(restartInc < 0) then + call IO_warning(warning_ID=34) + restartInc = 0 endif - restartRead = restartInc > 0_pInt ! only read in if "true" restart requested + restartRead = restartInc > 0 ! only read in if "true" restart requested #else call IO_open_inputFile(FILEUNIT,modelName) rewind(FILEUNIT) do read (FILEUNIT,'(a1024)',END=100) line 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 ('solver') read (FILEUNIT,'(a1024)',END=100) line ! next line chunkPos = IO_stringPos(line) - symmetricSolver = (IO_intValue(line,chunkPos,2_pInt) /= 1_pInt) + symmetricSolver = (IO_intValue(line,chunkPos,2) /= 1) case ('restart') read (FILEUNIT,'(a1024)',END=100) line ! next line chunkPos = IO_stringPos(line) - restartWrite = iand(IO_intValue(line,chunkPos,1_pInt),1_pInt) > 0_pInt - restartRead = iand(IO_intValue(line,chunkPos,1_pInt),2_pInt) > 0_pInt + restartWrite = iand(IO_intValue(line,chunkPos,1),1) > 0 + restartRead = iand(IO_intValue(line,chunkPos,1),2) > 0 case ('*restart') - do j=2_pInt,chunkPos(1) + do j=2,chunkPos(1) restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite restartRead = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read') .or. restartRead enddo if(restartWrite) then - do j=2_pInt,chunkPos(1) + do j=2,chunkPos(1) restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite enddo endif @@ -118,11 +118,11 @@ subroutine FE_init do read (FILEUNIT,'(a1024)',END=200) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'restart' & - .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'file' & - .and. IO_lc(IO_stringValue(line,chunkPos,3_pInt)) == 'job' & - .and. IO_lc(IO_stringValue(line,chunkPos,4_pInt)) == 'id' ) & - modelName = IO_StringValue(line,chunkPos,6_pInt) + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'restart' & + .and. IO_lc(IO_stringValue(line,chunkPos,2)) == 'file' & + .and. IO_lc(IO_stringValue(line,chunkPos,3)) == 'job' & + .and. IO_lc(IO_stringValue(line,chunkPos,4)) == 'id' ) & + modelName = IO_StringValue(line,chunkPos,6) enddo #else ! QUESTION: is this meaningful for the spectral/FEM case? call IO_open_inputFile(FILEUNIT,modelName) @@ -130,10 +130,10 @@ subroutine FE_init do read (FILEUNIT,'(a1024)',END=200) line chunkPos = IO_stringPos(line) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt))=='*heading') then + if (IO_lc(IO_stringValue(line,chunkPos,1))=='*heading') then read (FILEUNIT,'(a1024)',END=200) line chunkPos = IO_stringPos(line) - modelName = IO_StringValue(line,chunkPos,1_pInt) + modelName = IO_StringValue(line,chunkPos,1) endif enddo #endif @@ -141,7 +141,7 @@ subroutine FE_init endif #endif - if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0_pInt) then + if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0) then write(6,'(a21,l1)') ' restart writing: ', restartWrite write(6,'(a21,l1)') ' restart reading: ', restartRead if (restartRead) write(6,'(a,/)') ' restart Job: '//trim(modelName) diff --git a/src/IO.f90 b/src/IO.f90 index 074e2b0f4..86ff5fe57 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -6,9 +6,8 @@ !> @brief input/output functions, partly depending on chosen solver !-------------------------------------------------------------------------------------------------- module IO - use prec, only: & - pInt, & - pReal + use prec + use DAMASK_interface implicit none private @@ -75,8 +74,6 @@ end subroutine IO_init !> @brief reads a line from a text file. !-------------------------------------------------------------------------------------------------- function IO_read(fileUnit) result(line) - use prec, only: & - pStringLen implicit none integer, intent(in) :: fileUnit !< file unit @@ -93,8 +90,7 @@ function IO_read(fileUnit) result(line) !> @brief reads an entire ASCII file into an array !-------------------------------------------------------------------------------------------------- function IO_read_ASCII(fileName) result(fileContent) - use prec, only: & - pStringLen + implicit none character(len=*), intent(in) :: fileName @@ -181,8 +177,6 @@ end subroutine IO_open_file !> @details replaces an existing file when writing !-------------------------------------------------------------------------------------------------- integer function IO_open_jobFile_binary(extension,mode) - use DAMASK_interface, only: & - getSolverJobName implicit none character(len=*), intent(in) :: extension @@ -236,33 +230,31 @@ end function IO_open_binary !> @brief opens FEM input file for reading located in current working directory to given unit !-------------------------------------------------------------------------------------------------- subroutine IO_open_inputFile(fileUnit,modelName) - use DAMASK_interface, only: & - inputFileExtension implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name + integer, intent(in) :: fileUnit !< file unit + character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name - integer(pInt) :: myStat - character(len=1024) :: path + integer :: myStat + character(len=1024) :: path #if defined(Abaqus) - integer(pInt) :: fileType + integer :: fileType - fileType = 1_pInt ! assume .pes + fileType = 1 ! assume .pes path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') - if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" - fileType = 2_pInt + if(myStat /= 0) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" + fileType = 2 path = trim(modelName)//inputFileExtension(fileType) open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') endif - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) path = trim(modelName)//inputFileExtension(fileType)//'_assembly' open(fileUnit,iostat=myStat,file=path) - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s - close(fileUnit+1_pInt) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) + if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1)) call IO_error(103) ! strip comments and concatenate any "include"s + close(fileUnit+1) contains @@ -273,20 +265,20 @@ subroutine IO_open_inputFile(fileUnit,modelName) recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) implicit none - integer(pInt), intent(in) :: unit1, & - unit2 + integer, intent(in) :: unit1, & + unit2 - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line,fname - logical :: createSuccess,fexist + integer, allocatable, dimension(:) :: chunkPos + character(len=65536) :: line,fname + logical :: createSuccess,fexist do read(unit2,'(A65536)',END=220) line chunkPos = IO_stringPos(line) - if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then + if (IO_lc(IO_StringValue(line,chunkPos,1))=='*include') then fname = trim(line(9+scan(line(9:),'='):)) inquire(file=fname, exist=fexist) if (.not.(fexist)) then @@ -298,7 +290,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) return endif open(unit2+1,err=200,status='old',file=fname) - if (abaqus_assembleInputFile(unit1,unit2+1_pInt)) then + if (abaqus_assembleInputFile(unit1,unit2+1)) then createSuccess=.true. close(unit2+1) else @@ -319,7 +311,7 @@ end function abaqus_assembleInputFile #elif defined(Marc4DAMASK) path = trim(modelName)//inputFileExtension open(fileUnit,status='old',iostat=myStat,file=path) - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) #endif end subroutine IO_open_inputFile @@ -330,19 +322,16 @@ end subroutine IO_open_inputFile !! name and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(fileUnit) - use DAMASK_interface, only: & - getSolverJobName, & - LogFileExtension implicit none - integer(pInt), intent(in) :: fileUnit !< file unit + integer, intent(in) :: fileUnit !< file unit - integer(pInt) :: myStat - character(len=1024) :: path + integer :: myStat + character(len=1024) :: path path = trim(getSolverJobName())//LogFileExtension open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) end subroutine IO_open_logFile #endif @@ -353,19 +342,17 @@ end subroutine IO_open_logFile !! given extension and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobFile(fileUnit,ext) - use DAMASK_interface, only: & - getSolverJobName implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file + integer, intent(in) :: fileUnit !< file unit + character(len=*), intent(in) :: ext !< extension of file - integer(pInt) :: myStat - character(len=1024) :: path + integer :: myStat + character(len=1024) :: path path = trim(getSolverJobName())//'.'//ext open(fileUnit,status='replace',iostat=myStat,file=path) - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) end subroutine IO_write_jobFile @@ -413,7 +400,7 @@ pure function IO_getTag(string,openChar,closeChar) right = scan(string,closeChar) else left = scan(string,openChar) - right = left + merge(scan(string(left+1:),openChar),0_pInt,len(string) > left) + right = left + merge(scan(string(left+1:),openChar),0,len(string) > left) endif if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs @@ -431,13 +418,13 @@ end function IO_getTag pure function IO_stringPos(string) implicit none - integer(pInt), dimension(:), allocatable :: IO_stringPos - character(len=*), intent(in) :: string !< string in which chunk positions are searched for + integer, dimension(:), allocatable :: IO_stringPos + 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) - allocate(IO_stringPos(1), source=0_pInt) + allocate(IO_stringPos(1), source=0) right = 0 do while (verify(string(right+1:),SEP)>0) @@ -445,7 +432,7 @@ pure function IO_stringPos(string) right = left + scan(string(left:),SEP) - 2 if ( string(left:left) == '#' ) exit IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)] - IO_stringPos(1) = IO_stringPos(1)+1_pInt + IO_stringPos(1) = IO_stringPos(1)+1 endOfString: if (right < left) then IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string) exit @@ -461,15 +448,15 @@ end function IO_stringPos function IO_stringValue(string,chunkPos,myChunk,silent) implicit none - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - character(len=:), allocatable :: IO_stringValue + integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + integer, intent(in) :: myChunk !< position number of desired chunk + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + character(len=:), allocatable :: IO_stringValue - logical, optional,intent(in) :: silent !< switch to trigger verbosity - character(len=16), parameter :: MYNAME = 'IO_stringValue: ' + logical, optional,intent(in) :: silent !< switch to trigger verbosity + character(len=16), parameter :: MYNAME = 'IO_stringValue: ' - logical :: warn + logical :: warn if (present(silent)) then warn = silent @@ -478,7 +465,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent) endif IO_stringValue = '' - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then if (warn) call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) else valuePresent IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) @@ -493,15 +480,15 @@ end function IO_stringValue real(pReal) function IO_floatValue (string,chunkPos,myChunk) implicit none - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + integer, intent(in) :: myChunk !< position number of desired chunk + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk character(len=15), parameter :: MYNAME = 'IO_floatValue: ' character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' IO_floatValue = 0.0_pReal - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) else valuePresent IO_floatValue = & @@ -515,18 +502,18 @@ end function IO_floatValue !-------------------------------------------------------------------------------------------------- !> @brief reads integer value at myChunk from string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_intValue(string,chunkPos,myChunk) +integer function IO_intValue(string,chunkPos,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - character(len=13), parameter :: MYNAME = 'IO_intValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer, intent(in) :: myChunk !< position number of desired chunk + integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + character(len=13), parameter :: MYNAME = 'IO_intValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - IO_intValue = 0_pInt + IO_intValue = 0 - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) else valuePresent IO_intValue = IO_verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& @@ -543,27 +530,27 @@ end function IO_intValue real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' - character(len=13), parameter :: VALIDBASE = '0123456789.+-' - character(len=12), parameter :: VALIDEXP = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known ends of each chunk + integer, intent(in) :: myChunk !< position number of desired chunk + integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string + character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' + character(len=13), parameter :: VALIDBASE = '0123456789.+-' + character(len=12), parameter :: VALIDEXP = '0123456789+-' real(pReal) :: base - integer(pInt) :: expon + integer :: expon integer :: pos_exp pos_exp = scan(string(ends(myChunk)+1:ends(myChunk+1)),'+-',back=.true.) hasExponent: if (pos_exp > 1) then - base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk)+pos_exp-1_pInt))),& + base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk)+pos_exp-1))),& VALIDBASE,MYNAME//'(base): ') - expon = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+pos_exp:ends(myChunk+1_pInt)))),& + expon = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+pos_exp:ends(myChunk+1)))),& VALIDEXP,MYNAME//'(exp): ') else hasExponent - base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& + base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),& VALIDBASE,MYNAME//'(base): ') - expon = 0_pInt + expon = 0 endif hasExponent IO_fixedNoEFloatValue = base*10.0_pReal**real(expon,pReal) @@ -573,16 +560,16 @@ end function IO_fixedNoEFloatValue !-------------------------------------------------------------------------------------------------- !> @brief reads integer value at myChunk from fixed format string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_fixedIntValue(string,ends,myChunk) +integer function IO_fixedIntValue(string,ends,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known ends of each chunk + integer, intent(in) :: myChunk !< position number of desired chunk + integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string + character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& + IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),& VALIDCHARACTERS,MYNAME) end function IO_fixedIntValue @@ -618,15 +605,15 @@ end function IO_lc pure function IO_intOut(intToPrint) implicit none - integer(pInt), intent(in) :: intToPrint - character(len=41) :: IO_intOut - integer(pInt) :: N_digits - character(len=19) :: width ! maximum digits for 64 bit integer - character(len=20) :: min_width ! longer for negative values + integer, intent(in) :: intToPrint + character(len=41) :: IO_intOut + integer :: N_digits + character(len=19) :: width ! maximum digits for 64 bit integer + character(len=20) :: min_width ! longer for negative values - N_digits = 1_pInt + int(log10(real(max(abs(intToPrint),1_pInt))),pInt) + N_digits = 1 + int(log10(real(max(abs(intToPrint),1))),pInt) write(width, '(I19.19)') N_digits - write(min_width, '(I20.20)') N_digits + merge(1_pInt,0_pInt,intToPrint < 0_pInt) + write(min_width, '(I20.20)') N_digits + merge(1,0,intToPrint < 0) IO_intOut = 'I'//trim(min_width)//'.'//trim(width) end function IO_intOut @@ -639,8 +626,8 @@ end function IO_intOut subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) implicit none - integer(pInt), intent(in) :: error_ID - integer(pInt), optional, intent(in) :: el,ip,g,instance + integer, intent(in) :: error_ID + integer, optional, intent(in) :: el,ip,g,instance character(len=*), optional, intent(in) :: ext_msg external :: quit @@ -651,218 +638,218 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) !-------------------------------------------------------------------------------------------------- ! internal errors - case (0_pInt) + case (0) msg = 'internal check failed:' !-------------------------------------------------------------------------------------------------- ! file handling errors - case (100_pInt) + case (100) msg = 'could not open file:' - case (101_pInt) + case (101) msg = 'write error for file:' - case (102_pInt) + case (102) msg = 'could not read file:' - case (103_pInt) + case (103) msg = 'could not assemble input files' - case (104_pInt) + case (104) msg = '{input} recursion limit reached' - case (105_pInt) + case (105) msg = 'unknown output:' - case (106_pInt) + case (106) msg = 'working directory does not exist:' - case (107_pInt) + case (107) msg = 'line length exceeds limit of 256' !-------------------------------------------------------------------------------------------------- ! lattice error messages - case (130_pInt) + case (130) msg = 'unknown lattice structure encountered' - case (131_pInt) + case (131) msg = 'hex lattice structure with invalid c/a ratio' - case (132_pInt) + case (132) msg = 'trans_lattice_structure not possible' - case (133_pInt) + case (133) msg = 'transformed hex lattice structure with invalid c/a ratio' - case (135_pInt) + case (135) msg = 'zero entry on stiffness diagonal' - case (136_pInt) + case (136) msg = 'zero entry on stiffness diagonal for transformed phase' - case (137_pInt) + case (137) msg = 'not defined for lattice structure' - case (138_pInt) + case (138) msg = 'not enough interaction parameters given' !-------------------------------------------------------------------------------------------------- ! errors related to the parsing of material.config - case (140_pInt) + case (140) msg = 'key not found' - case (141_pInt) + case (141) msg = 'number of chunks in string differs' - case (142_pInt) + case (142) msg = 'empty list' - case (143_pInt) + case (143) msg = 'no value found for key' - case (144_pInt) + case (144) msg = 'negative number systems requested' - case (145_pInt) + case (145) msg = 'too many systems requested' - case (146_pInt) + case (146) msg = 'number of values does not match' - case (147_pInt) + case (147) msg = 'not supported anymore' !-------------------------------------------------------------------------------------------------- ! material error messages and related messages in mesh - case (150_pInt) + case (150) msg = 'index out of bounds' - case (151_pInt) + case (151) msg = 'microstructure has no constituents' - case (153_pInt) + case (153) msg = 'sum of phase fractions differs from 1' - case (154_pInt) + case (154) msg = 'homogenization index out of bounds' - case (155_pInt) + case (155) msg = 'microstructure index out of bounds' - case (156_pInt) + case (156) msg = 'reading from ODF file' - case (157_pInt) + case (157) msg = 'illegal texture transformation specified' - case (160_pInt) + case (160) msg = 'no entries in config part' - case (161_pInt) + case (161) msg = 'config part found twice' - case (165_pInt) + case (165) msg = 'homogenization configuration' - case (170_pInt) + case (170) msg = 'no homogenization specified via State Variable 2' - case (180_pInt) + case (180) msg = 'no microstructure specified via State Variable 3' - case (190_pInt) + case (190) msg = 'unknown element type:' - case (191_pInt) + case (191) msg = 'mesh consists of more than one element type' !-------------------------------------------------------------------------------------------------- ! plasticity error messages - case (200_pInt) + case (200) msg = 'unknown elasticity specified:' - case (201_pInt) + case (201) msg = 'unknown plasticity specified:' - case (210_pInt) + case (210) msg = 'unknown material parameter:' - case (211_pInt) + case (211) msg = 'material parameter out of bounds:' !-------------------------------------------------------------------------------------------------- ! numerics error messages - case (300_pInt) + case (300) msg = 'unknown numerics parameter:' - case (301_pInt) + case (301) msg = 'numerics parameter out of bounds:' !-------------------------------------------------------------------------------------------------- ! math errors - case (400_pInt) + case (400) msg = 'matrix inversion error' - case (401_pInt) + case (401) msg = 'math_check failed' - case (405_pInt) + case (405) msg = 'I_TO_HALTON-error: an input base BASE is <= 1' - case (406_pInt) + case (406) msg = 'Prime-error: N must be between 0 and PRIME_MAX' - case (407_pInt) + case (407) msg = 'Polar decomposition error' - case (409_pInt) + case (409) msg = 'math_check: R*v == q*v failed' - case (410_pInt) + case (410) msg = 'eigenvalues computation error' !------------------------------------------------------------------------------------------------- ! homogenization errors - case (500_pInt) + case (500) msg = 'unknown homogenization specified' !-------------------------------------------------------------------------------------------------- ! user errors - case (600_pInt) + case (600) msg = 'Ping-Pong not possible when using non-DAMASK elements' - case (601_pInt) + case (601) msg = 'Ping-Pong needed when using non-local plasticity' - case (602_pInt) + case (602) msg = 'invalid selection for debug' !------------------------------------------------------------------------------------------------- ! DAMASK_marc errors - case (700_pInt) + case (700) msg = 'invalid materialpoint result requested' !------------------------------------------------------------------------------------------------- ! errors related to the grid solver - case (809_pInt) + case (809) msg = 'initializing FFTW' - case (810_pInt) + case (810) msg = 'FFTW plan creation' - case (831_pInt) + case (831) msg = 'mask consistency violated in spectral loadcase' - case (832_pInt) + case (832) msg = 'ill-defined L (line partly defined) in spectral loadcase' - case (834_pInt) + case (834) msg = 'negative time increment in spectral loadcase' - case (835_pInt) + case (835) msg = 'non-positive increments in spectral loadcase' - case (836_pInt) + case (836) msg = 'non-positive result frequency in spectral loadcase' - case (837_pInt) + case (837) msg = 'incomplete loadcase' - case (838_pInt) + case (838) msg = 'mixed boundary conditions allow rotation' - case (841_pInt) + case (841) msg = 'missing header length info in spectral mesh' - case (842_pInt) + case (842) msg = 'incomplete information in spectral mesh header' - case (843_pInt) + case (843) msg = 'microstructure count mismatch' - case (846_pInt) + case (846) msg = 'rotation for load case rotation ill-defined (R:RT != I)' - case (880_pInt) + case (880) msg = 'mismatch of microstructure count and a*b*c in geom file' - case (891_pInt) + case (891) msg = 'unknown solver type selected' - case (892_pInt) + case (892) msg = 'unknown filter type selected' - case (893_pInt) + case (893) msg = 'PETSc: SNES_DIVERGED_FNORM_NAN' - case (894_pInt) + case (894) msg = 'MPI error' !------------------------------------------------------------------------------------------------- ! error messages related to parsing of Abaqus input file - case (900_pInt) + case (900) msg = 'improper definition of nodes in input file (Nnodes < 2)' - case (901_pInt) + case (901) msg = 'no elements defined in input file (Nelems = 0)' - case (902_pInt) + case (902) msg = 'no element sets defined in input file (No *Elset exists)' - case (903_pInt) + case (903) msg = 'no materials defined in input file (Look into section assigments)' - case (904_pInt) + case (904) msg = 'no elements could be assigned for Elset: ' - case (905_pInt) + case (905) msg = 'error in mesh_abaqus_map_materials' - case (906_pInt) + case (906) msg = 'error in mesh_abaqus_count_cpElements' - case (907_pInt) + case (907) msg = 'size of mesh_mapFEtoCPelem in mesh_abaqus_map_elements' - case (908_pInt) + case (908) msg = 'size of mesh_mapFEtoCPnode in mesh_abaqus_map_nodes' - case (909_pInt) + case (909) msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes' !------------------------------------------------------------------------------------------------- ! general error messages - case (666_pInt) + case (666) msg = 'memory leak detected' case default msg = 'unknown error number...' @@ -893,7 +880,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) write(0,'(a,69x,a)') ' │', '│' write(0,'(a)') ' └'//IO_DIVIDER//'┘' flush(0) - call quit(9000_pInt+error_ID) + call quit(9000+error_ID) !$OMP END CRITICAL (write2out) end subroutine IO_error @@ -905,55 +892,55 @@ end subroutine IO_error subroutine IO_warning(warning_ID,el,ip,g,ext_msg) implicit none - integer(pInt), intent(in) :: warning_ID - integer(pInt), optional, intent(in) :: el,ip,g + integer, intent(in) :: warning_ID + integer, optional, intent(in) :: el,ip,g character(len=*), optional, intent(in) :: ext_msg character(len=1024) :: msg character(len=1024) :: formatString select case (warning_ID) - case (1_pInt) + case (1) msg = 'unknown key' - case (34_pInt) + case (34) msg = 'invalid restart increment given' - case (35_pInt) + case (35) msg = 'could not get $DAMASK_NUM_THREADS' - case (40_pInt) + case (40) msg = 'found spectral solver parameter' - case (42_pInt) + case (42) msg = 'parameter has no effect' - case (43_pInt) + case (43) msg = 'main diagonal of C66 close to zero' - case (47_pInt) + case (47) msg = 'no valid parameter for FFTW, using FFTW_PATIENT' - case (50_pInt) + case (50) msg = 'not all available slip system families are defined' - case (51_pInt) + case (51) msg = 'not all available twin system families are defined' - case (52_pInt) + case (52) msg = 'not all available parameters are defined' - case (53_pInt) + case (53) msg = 'not all available transformation system families are defined' - case (101_pInt) + case (101) msg = 'crystallite debugging off' - case (201_pInt) + case (201) msg = 'position not found when parsing line' - case (202_pInt) + case (202) msg = 'invalid character in string chunk' - case (203_pInt) + case (203) msg = 'interpretation of string chunk failed' - case (207_pInt) + case (207) msg = 'line truncated' - case (600_pInt) + case (600) msg = 'crystallite responds elastically' - case (601_pInt) + case (601) msg = 'stiffness close to zero' - case (650_pInt) + case (650) msg = 'polar decomposition failed' - case (700_pInt) + case (700) msg = 'unknown crystal symmetry' - case (850_pInt) + case (850) msg = 'max number of cut back exceeded, terminating' case default msg = 'unknown warning number' @@ -1013,27 +1000,27 @@ end function IO_extractValue !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countDataLines(fileUnit) +integer function IO_countDataLines(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle + integer, intent(in) :: fileUnit !< file handle - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp + integer, allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp - IO_countDataLines = 0_pInt + IO_countDataLines = 0 line = '' do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + tmp = IO_lc(IO_stringValue(line,chunkPos,1)) if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword exit else - if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt + if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1 endif enddo backspace(fileUnit) @@ -1046,25 +1033,25 @@ end function IO_countDataLines !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countNumericalDataLines(fileUnit) +integer function IO_countNumericalDataLines(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle + integer, intent(in) :: fileUnit !< file handle - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp + integer, allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp - IO_countNumericalDataLines = 0_pInt + IO_countNumericalDataLines = 0 line = '' do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + tmp = IO_lc(IO_stringValue(line,chunkPos,1)) if (verify(trim(tmp),'0123456789') == 0) then ! numerical values - IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt + IO_countNumericalDataLines = IO_countNumericalDataLines + 1 else exit endif @@ -1080,18 +1067,18 @@ end function IO_countNumericalDataLines subroutine IO_skipChunks(fileUnit,N) implicit none - integer(pInt), intent(in) :: fileUnit, & !< file handle - N !< minimum number of chunks to skip + integer, intent(in) :: fileUnit, & !< file handle + N !< minimum number of chunks to skip - integer(pInt) :: remainingChunks - character(len=65536) :: line + integer :: remainingChunks + character(len=65536) :: line line = '' remainingChunks = N do while (trim(line) /= IO_EOF .and. remainingChunks > 0) line = IO_read(fileUnit) - remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt + remainingChunks = remainingChunks - (size(IO_stringPos(line))-1)/2 enddo end subroutine IO_skipChunks #endif @@ -1102,52 +1089,52 @@ end subroutine IO_skipChunks !> @details Marc: ints concatenated by "c" as last char or range of values a "to" b !> Abaqus: triplet of start,stop,inc !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countContinuousIntValues(fileUnit) +integer function IO_countContinuousIntValues(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit #ifdef Abaqus - integer(pInt) :: l,c + integer :: l,c #endif - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line + integer, allocatable, dimension(:) :: chunkPos + character(len=65536) :: line - IO_countContinuousIntValues = 0_pInt + IO_countContinuousIntValues = 0 line = '' #if defined(Marc4DAMASK) do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) - if (chunkPos(1) < 1_pInt) then ! empty line + if (chunkPos(1) < 1) then ! empty line exit - elseif (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator - IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & - - IO_intValue(line,chunkPos,1_pInt)) + elseif (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to' ) then ! found range indicator + IO_countContinuousIntValues = 1 + abs( IO_intValue(line,chunkPos,3) & + - IO_intValue(line,chunkPos,1)) exit ! only one single range indicator allowed else - IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' + IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1 ! add line's count when assuming 'c' if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value - IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt + IO_countContinuousIntValues = IO_countContinuousIntValues+1 exit ! data ended endif endif enddo #elif defined(Abaqus) c = IO_countDataLines(fileUnit) - do l = 1_pInt,c + do l = 1,c backspace(fileUnit) enddo - l = 1_pInt + l = 1 do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct? - l = l + 1_pInt + l = l + 1 line = IO_read(fileUnit) chunkPos = IO_stringPos(line) - IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation - (IO_intValue(line,chunkPos,2_pInt)-IO_intValue(line,chunkPos,1_pInt))/& - max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) + IO_countContinuousIntValues = IO_countContinuousIntValues + 1 + & ! assuming range generation + (IO_intValue(line,chunkPos,2)-IO_intValue(line,chunkPos,1))/& + max(1,IO_intValue(line,chunkPos,3)) enddo #endif @@ -1163,54 +1150,53 @@ end function IO_countContinuousIntValues function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) implicit none - integer(pInt), intent(in) :: maxN - integer(pInt), dimension(1+maxN) :: IO_continuousIntValues + integer, intent(in) :: maxN + integer, dimension(1+maxN) :: IO_continuousIntValues - integer(pInt), intent(in) :: fileUnit, & + integer, intent(in) :: fileUnit, & lookupMaxN - integer(pInt), dimension(:,:), intent(in) :: lookupMap + integer, dimension(:,:), intent(in) :: lookupMap character(len=64), dimension(:), intent(in) :: lookupName - integer(pInt) :: i,first,last + integer :: i,first,last #ifdef Abaqus - integer(pInt) :: j,l,c + integer :: j,l,c #endif - - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=65536) line logical rangeGeneration - IO_continuousIntValues = 0_pInt + IO_continuousIntValues = 0 rangeGeneration = .false. #if defined(Marc4DAMASK) do read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) - if (chunkPos(1) < 1_pInt) then ! empty line + if (chunkPos(1) < 1) then ! empty line exit - elseif (verify(IO_stringValue(line,chunkPos,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,chunkPos,1_pInt) == lookupName(i)) then ! found matching name + elseif (verify(IO_stringValue(line,chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set name + do i = 1, lookupMaxN ! loop over known set names + if (IO_stringValue(line,chunkPos,1) == lookupName(i)) then ! found matching name IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list exit endif enddo exit - else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator - first = IO_intValue(line,chunkPos,1_pInt) - last = IO_intValue(line,chunkPos,3_pInt) - do i = first, last, sign(1_pInt,last-first) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + else if (chunkPos(1) > 2 .and. IO_lc(IO_stringValue(line,chunkPos,2)) == 'to' ) then ! found range indicator + first = IO_intValue(line,chunkPos,1) + last = IO_intValue(line,chunkPos,3) + do i = first, last, sign(1,last-first) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = i enddo exit else - do i = 1_pInt,chunkPos(1)-1_pInt ! interpret up to second to last value - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + do i = 1,chunkPos(1)-1 ! interpret up to second to last value + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) enddo if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,chunkPos(1)) exit endif @@ -1218,7 +1204,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) enddo #elif defined(Abaqus) c = IO_countDataLines(fileUnit) - do l = 1_pInt,c + do l = 1,c backspace(fileUnit) enddo @@ -1227,34 +1213,34 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) backspace(fileUnit) read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) - do i = 1_pInt,chunkPos(1) + do i = 1,chunkPos(1) if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. enddo - do l = 1_pInt,c + do l = 1,c read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) - if (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line - do i = 1_pInt,chunkPos(1) ! loop over set names in line - do j = 1_pInt,lookupMaxN ! look through known set names + if (verify(IO_stringValue(line,chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line + do i = 1,chunkPos(1) ! loop over set names in line + do j = 1,lookupMaxN ! look through known set names if (IO_stringValue(line,chunkPos,i) == lookupName(j)) then ! found matching name - first = 2_pInt + IO_continuousIntValues(1) ! where to start appending data - last = first + lookupMap(1,j) - 1_pInt ! up to where to append data + first = 2 + IO_continuousIntValues(1) ! where to start appending data + last = first + lookupMap(1,j) - 1 ! up to where to append data IO_continuousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list IO_continuousIntValues(1) = IO_continuousIntValues(1) + lookupMap(1,j) ! count them endif enddo enddo else if (rangeGeneration) then ! range generation - do i = IO_intValue(line,chunkPos,1_pInt),& - IO_intValue(line,chunkPos,2_pInt),& - max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + do i = IO_intValue(line,chunkPos,1),& + IO_intValue(line,chunkPos,2),& + max(1,IO_intValue(line,chunkPos,3)) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = i enddo else ! read individual elem nums - do i = 1_pInt,chunkPos(1) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + do i = 1,chunkPos(1) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1 IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) enddo endif @@ -1270,7 +1256,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) !-------------------------------------------------------------------------------------------------- !> @brief returns verified integer value in given string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_verifyIntValue (string,validChars,myName) +integer function IO_verifyIntValue (string,validChars,myName) implicit none character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 1c4928fac..ab8b1644a 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -9,13 +9,13 @@ module damage_local implicit none private - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & damage_local_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & damage_local_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & + integer, dimension(:), allocatable, target, public :: & damage_local_Noutput !< number of outputs per instance of this damage enum, bind(c) @@ -64,9 +64,9 @@ subroutine damage_local_init implicit none - integer(pInt) :: maxNinstance,homog,instance,o,i - integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog, h + integer :: maxNinstance,homog,instance,o,i + integer :: sizeState + integer :: NofMyHomog, h integer(kind(undefined_ID)) :: & outputID character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -76,13 +76,13 @@ subroutine damage_local_init write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt) - if (maxNinstance == 0_pInt) return + if (maxNinstance == 0) return - allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) + allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) allocate(damage_local_output (maxval(homogenization_Noutput),maxNinstance)) damage_local_output = '' allocate(damage_local_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(damage_local_Noutput (maxNinstance), source=0_pInt) + allocate(damage_local_Noutput (maxNinstance), source=0) allocate(param(maxNinstance)) @@ -116,7 +116,7 @@ subroutine damage_local_init ! allocate state arrays - sizeState = 1_pInt + sizeState = 1 damageState(homog)%sizeState = sizeState damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance)) allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) @@ -148,14 +148,14 @@ function damage_local_updateState(subdt, ip, el) damageState implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & subdt - logical, dimension(2) :: & + logical, dimension(2) :: & damage_local_updateState - integer(pInt) :: & + integer :: & homog, & offset real(pReal) :: & @@ -202,12 +202,12 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el source_damage_anisoductile_getRateAndItsTangent implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & phi - integer(pInt) :: & + integer :: & phase, & grain, & source, & @@ -260,26 +260,26 @@ function damage_local_postResults(ip,el) damage implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point el !< element real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & damage_local_postResults - integer(pInt) :: & + integer :: & instance, homog, offset, o, c homog = material_homogenizationAt(el) offset = damageMapping(homog)%p(ip,el) instance = damage_typeInstance(homog) associate(prm => param(instance)) - c = 0_pInt + c = 0 - outputsLoop: do o = 1_pInt,size(prm%outputID) + outputsLoop: do o = 1,size(prm%outputID) select case(prm%outputID(o)) case (damage_ID) - damage_local_postResults(c+1_pInt) = damage(homog)%p(offset) + damage_local_postResults(c+1) = damage(homog)%p(offset) c = c + 1 end select enddo outputsLoop diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 3a2080e84..dc1036b67 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -4,19 +4,17 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module damage_nonlocal - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & damage_nonlocal_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & damage_nonlocal_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & + integer, dimension(:), allocatable, target, public :: & damage_nonlocal_Noutput !< number of outputs per instance of this damage enum, bind(c) @@ -64,10 +62,10 @@ subroutine damage_nonlocal_init implicit none - integer(pInt) :: maxNinstance,homog,instance,o,i - integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog, h - integer(kind(undefined_ID)) :: & + integer :: maxNinstance,homog,instance,o,i + integer :: sizeState + integer :: NofMyHomog, h + integer(kind(undefined_ID)) :: & outputID character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] character(len=65536), dimension(:), allocatable :: & @@ -75,13 +73,13 @@ subroutine damage_nonlocal_init write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt) - if (maxNinstance == 0_pInt) return + maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID)) + if (maxNinstance == 0) return - allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) + allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance)) damage_nonlocal_output = '' - allocate(damage_nonlocal_Noutput (maxNinstance), source=0_pInt) + allocate(damage_nonlocal_Noutput (maxNinstance), source=0) allocate(param(maxNinstance)) @@ -114,7 +112,7 @@ subroutine damage_nonlocal_init ! allocate state arrays - sizeState = 1_pInt + sizeState = 1 damageState(homog)%sizeState = sizeState damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance)) allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) @@ -155,12 +153,12 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, source_damage_anisoductile_getRateAndItsTangent implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & phi - integer(pInt) :: & + integer :: & phase, & grain, & source, & @@ -218,12 +216,12 @@ function damage_nonlocal_getDiffusion33(ip,el) crystallite_push33ToRef implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), dimension(3,3) :: & damage_nonlocal_getDiffusion33 - integer(pInt) :: & + integer :: & homog, & grain @@ -235,7 +233,7 @@ function damage_nonlocal_getDiffusion33(ip,el) enddo damage_nonlocal_getDiffusion33 = & - charLength**2_pInt*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal) + charLength**2*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal) end function damage_nonlocal_getDiffusion33 @@ -252,10 +250,10 @@ real(pReal) function damage_nonlocal_getMobility(ip,el) homogenization_Ngrains implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number - integer(pInt) :: & + integer :: & ipc damage_nonlocal_getMobility = 0.0_pReal @@ -279,12 +277,12 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) damage implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & phi - integer(pInt) :: & + integer :: & homog, & offset @@ -305,26 +303,26 @@ function damage_nonlocal_postResults(ip,el) damage implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ip, & !< integration point el !< element real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & damage_nonlocal_postResults - integer(pInt) :: & + integer :: & instance, homog, offset, o, c homog = material_homogenizationAt(el) offset = damageMapping(homog)%p(ip,el) instance = damage_typeInstance(homog) associate(prm => param(instance)) - c = 0_pInt + c = 0 - outputsLoop: do o = 1_pInt,size(prm%outputID) + outputsLoop: do o = 1,size(prm%outputID) select case(prm%outputID(o)) case (damage_ID) - damage_nonlocal_postResults(c+1_pInt) = damage(homog)%p(offset) + damage_nonlocal_postResults(c+1) = damage(homog)%p(offset) c = c + 1 end select enddo outputsLoop diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 2adf72f89..d006fc5c2 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -9,69 +9,19 @@ program DAMASK_spectral #include use PETScsys - use prec, only: & - pInt, & - pLongInt, & - pReal, & - tol_math_check, & - dNeq - use DAMASK_interface, only: & - DAMASK_interface_init, & - loadCaseFile, & - geometryFile, & - getSolverJobName, & - interface_restartInc - use IO, only: & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_error, & - IO_lc, & - IO_intOut, & - IO_warning - use config, only: & - config_numerics - use debug, only: & - debug_level, & - debug_spectral, & - debug_levelBasic - use math ! need to include the whole module for FFTW - use mesh, only: & - grid, & - geomSize - use CPFEM2, only: & - CPFEM_initAll, & - CPFEM_results - use FEsolving, only: & - restartWrite, & - restartInc - use numerics, only: & - worldrank, & - worldsize, & - stagItMax, & - maxCutBack, & - continueCalculation - use homogenization, only: & - materialpoint_sizeResults, & - materialpoint_results, & - materialpoint_postResults - use material, only: & - thermal_type, & - damage_type, & - THERMAL_conduction_ID, & - DAMAGE_nonlocal_ID - use spectral_utilities, only: & - utilities_init, & - tSolutionState, & - tLoadCase, & - cutBack, & - nActiveFields, & - FIELD_UNDEFINED_ID, & - FIELD_MECH_ID, & - FIELD_THERMAL_ID, & - FIELD_DAMAGE_ID + use prec + use DAMASK_interface + use IO + use config + use debug + use math + use mesh + use CPFEM2 + use FEsolving + use numerics + use homogenization + use material + use spectral_utilities use grid_mech_spectral_basic use grid_mech_spectral_polarisation use grid_mech_FEM @@ -86,11 +36,11 @@ program DAMASK_spectral ! variables related to information from load case and geom file real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - N_t = 0_pInt, & !< # of time indicators found in load case file - N_n = 0_pInt, & !< # of increment specifiers found in load case file - N_def = 0_pInt !< # of rate of deformation specifiers found in load case file + integer, allocatable, dimension(:) :: chunkPos + integer :: & + N_t = 0, & !< # of time indicators found in load case file + N_n = 0, & !< # of increment specifiers found in load case file + N_def = 0 !< # of rate of deformation specifiers found in load case file character(len=65536) :: & line @@ -99,8 +49,8 @@ program DAMASK_spectral real(pReal), dimension(3,3), parameter :: & ones = 1.0_pReal, & zeros = 0.0_pReal - integer(pInt), parameter :: & - subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0 + integer, parameter :: & + subStepFactor = 2 !< for each substep, divide the last time increment by 2.0 real(pReal) :: & time = 0.0_pReal, & !< elapsed time time0 = 0.0_pReal, & !< begin of interval @@ -110,21 +60,21 @@ program DAMASK_spectral logical :: & guess, & !< guess along former trajectory stagIterate - integer(pInt) :: & + integer :: & i, j, k, l, field, & - errorID = 0_pInt, & - cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ - stepFraction = 0_pInt !< fraction of current time interval - integer(pInt) :: & - currentLoadcase = 0_pInt, & !< current load case + errorID = 0, & + cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ + stepFraction = 0 !< fraction of current time interval + integer :: & + currentLoadcase = 0, & !< current load case inc, & !< current increment in current load case - totalIncsCounter = 0_pInt, & !< total # of increments - convergedCounter = 0_pInt, & !< # of converged increments - notConvergedCounter = 0_pInt, & !< # of non-converged increments - fileUnit = 0_pInt, & !< file unit for reading load case and writing results + totalIncsCounter = 0, & !< total # of increments + convergedCounter = 0, & !< # of converged increments + notConvergedCounter = 0, & !< # of non-converged increments + fileUnit = 0, & !< file unit for reading load case and writing results myStat, & - statUnit = 0_pInt, & !< file unit for statistics output - lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written + statUnit = 0, & !< file unit for statistics output + lastRestartWritten = 0, & !< total increment # at which last restart information was written stagIter character(len=6) :: loadcase_string character(len=1024) :: & @@ -134,8 +84,8 @@ program DAMASK_spectral type(tSolutionState), allocatable, dimension(:) :: solres integer(MPI_OFFSET_KIND) :: fileOffset integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize - integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742 - integer(pInt), parameter :: maxRealOut = maxByteOut/pReal + integer, parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742 + integer, parameter :: maxRealOut = maxByteOut/pReal integer(pLongInt), dimension(2) :: outputIndex PetscErrorCode :: ierr procedure(grid_mech_spectral_basic_init), pointer :: & @@ -174,20 +124,20 @@ program DAMASK_spectral case ('polarisation') if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & - call IO_warning(42_pInt, ext_msg='debug Divergence') + call IO_warning(42, ext_msg='debug Divergence') mech_init => grid_mech_spectral_polarisation_init mech_forward => grid_mech_spectral_polarisation_forward mech_solution => grid_mech_spectral_polarisation_solution case ('fem') if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & - call IO_warning(42_pInt, ext_msg='debug Divergence') + call IO_warning(42, ext_msg='debug Divergence') mech_init => grid_mech_FEM_init mech_forward => grid_mech_FEM_forward mech_solution => grid_mech_FEM_solution case default - call IO_error(error_ID = 891_pInt, ext_msg = config_numerics%getString('spectral_solver')) + call IO_error(error_ID = 891, ext_msg = config_numerics%getString('spectral_solver')) end select @@ -195,27 +145,27 @@ program DAMASK_spectral ! reading information from load case file and to sanity checks allocate (loadCases(0)) ! array of load cases open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read') - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile)) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=trim(loadCaseFile)) do read(fileUnit, '(A)', iostat=myStat) line - if ( myStat /= 0_pInt) exit + if ( myStat /= 0) exit if (IO_isBlank(line)) cycle ! skip empty lines - currentLoadCase = currentLoadCase + 1_pInt + currentLoadCase = currentLoadCase + 1 chunkPos = IO_stringPos(line) - do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase + do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase select case (IO_lc(IO_stringValue(line,chunkPos,i))) case('l','velocitygrad','velgrad','velocitygradient','fdot','dotf','f') - N_def = N_def + 1_pInt + N_def = N_def + 1 case('t','time','delta') - N_t = N_t + 1_pInt + N_t = N_t + 1 case('n','incs','increments','steps','logincs','logincrements','logsteps') - N_n = N_n + 1_pInt + N_n = N_n + 1 end select enddo - if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check - call IO_error(error_ID=837_pInt,el=currentLoadCase,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase + if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1) & ! sanity check + call IO_error(error_ID=837,el=currentLoadCase,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase newLoadCase%stress%myType='stress' field = 1 @@ -229,7 +179,7 @@ program DAMASK_spectral newLoadCase%ID(field) = FIELD_DAMAGE_ID endif damageActive - readIn: do i = 1_pInt, chunkPos(1) + readIn: do i = 1, chunkPos(1) select case (IO_lc(IO_stringValue(line,chunkPos,i))) case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix temp_valueVector = 0.0_pReal @@ -241,7 +191,7 @@ program DAMASK_spectral else newLoadCase%deformation%myType = 'l' endif - do j = 1_pInt, 9_pInt + do j = 1, 9 temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a * if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo @@ -250,7 +200,7 @@ program DAMASK_spectral newLoadCase%deformation%values = math_9to33(temp_valueVector) ! values in 3x3 notation case('p','pk1','piolakirchhoff','stress', 's') temp_valueVector = 0.0_pReal - do j = 1_pInt, 9_pInt + do j = 1, 9 temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo @@ -258,54 +208,54 @@ program DAMASK_spectral newLoadCase%stress%maskFloat = merge(ones,zeros,newLoadCase%stress%maskLogical) newLoadCase%stress%values = math_9to33(temp_valueVector) case('t','time','delta') ! increment time - newLoadCase%time = IO_floatValue(line,chunkPos,i+1_pInt) + newLoadCase%time = IO_floatValue(line,chunkPos,i+1) case('n','incs','increments','steps') ! number of increments - newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%incs = IO_intValue(line,chunkPos,i+1) case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling) - newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt) - newLoadCase%logscale = 1_pInt + newLoadCase%incs = IO_intValue(line,chunkPos,i+1) + newLoadCase%logscale = 1 case('freq','frequency','outputfreq') ! frequency of result writings - newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1) case('r','restart','restartwrite') ! frequency of writing restart information newLoadCase%restartfrequency = & - max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) + max(0,IO_intValue(line,chunkPos,i+1)) case('guessreset','dropguessing') newLoadCase%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory case('euler') ! rotation of load case given in euler angles temp_valueVector = 0.0_pReal - l = 1_pInt ! assuming values given in degrees - k = 1_pInt ! assuming keyword indicating degree/radians present - select case (IO_lc(IO_stringValue(line,chunkPos,i+1_pInt))) + l = 1 ! assuming values given in degrees + k = 1 ! assuming keyword indicating degree/radians present + select case (IO_lc(IO_stringValue(line,chunkPos,i+1))) case('deg','degree') case('rad','radian') ! don't convert from degree to radian - l = 0_pInt + l = 0 case default - k = 0_pInt + k = 0 end select - do j = 1_pInt, 3_pInt + do j = 1, 3 temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j) enddo - if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad + if (l == 1) temp_valueVector(1:3) = temp_valueVector(1:3) * INRAD ! convert to rad newLoadCase%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix case('rotation','rot') ! assign values for the rotation matrix temp_valueVector = 0.0_pReal - do j = 1_pInt, 9_pInt + do j = 1, 9 temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) enddo newLoadCase%rotation = math_9to33(temp_valueVector) end select enddo readIn - newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1_pInt) ! by default, guess from previous load case + newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1) ! by default, guess from previous load case reportAndCheck: if (worldrank == 0) then write (loadcase_string, '(i6)' ) currentLoadCase write(6,'(/,1x,a,i6)') 'load case: ', currentLoadCase if (.not. newLoadCase%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory' if (newLoadCase%deformation%myType == 'l') then - do j = 1_pInt, 3_pInt + do j = 1, 3 if (any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & - any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832_pInt ! each row should be either fully or not at all defined + any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832 ! each row should be either fully or not at all defined enddo write(6,'(2x,a)') 'velocity gradient:' else if (newLoadCase%deformation%myType == 'f') then @@ -313,7 +263,7 @@ program DAMASK_spectral else write(6,'(2x,a)') 'deformation gradient rate:' endif - do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt + do i = 1, 3; do j = 1, 3 if(newLoadCase%deformation%maskLogical(i,j)) then write(6,'(2x,f12.7)',advance='no') newLoadCase%deformation%values(i,j) else @@ -322,13 +272,13 @@ program DAMASK_spectral enddo; write(6,'(/)',advance='no') enddo if (any(newLoadCase%stress%maskLogical .eqv. & - newLoadCase%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only + newLoadCase%deformation%maskLogical)) errorID = 831 ! exclusive or masking only if (any(newLoadCase%stress%maskLogical .and. & transpose(newLoadCase%stress%maskLogical) .and. & reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) & - errorID = 838_pInt ! no rotation is allowed by stress BC + errorID = 838 ! no rotation is allowed by stress BC write(6,'(2x,a)') 'stress / GPa:' - do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt + do i = 1, 3; do j = 1, 3 if(newLoadCase%stress%maskLogical(i,j)) then write(6,'(2x,f12.7)',advance='no') newLoadCase%stress%values(i,j)*1e-9_pReal else @@ -340,18 +290,18 @@ program DAMASK_spectral transpose(newLoadCase%rotation))-math_I3) > & reshape(spread(tol_math_check,1,9),[ 3,3]))& .or. abs(math_det33(newLoadCase%rotation)) > & - 1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain + 1.0_pReal + tol_math_check) errorID = 846 ! given rotation matrix contains strain if (any(dNeq(newLoadCase%rotation, math_I3))) & write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',& transpose(newLoadCase%rotation) - if (newLoadCase%time < 0.0_pReal) errorID = 834_pInt ! negative time increment + if (newLoadCase%time < 0.0_pReal) errorID = 834 ! negative time increment write(6,'(2x,a,f12.6)') 'time: ', newLoadCase%time - if (newLoadCase%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count + if (newLoadCase%incs < 1) errorID = 835 ! non-positive incs count write(6,'(2x,a,i5)') 'increments: ', newLoadCase%incs - if (newLoadCase%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency + if (newLoadCase%outputfrequency < 1) errorID = 836 ! non-positive result frequency write(6,'(2x,a,i5)') 'output frequency: ', newLoadCase%outputfrequency write(6,'(2x,a,i5)') 'restart frequency: ', newLoadCase%restartfrequency - if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message + if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message endif reportAndCheck loadCases = [loadCases,newLoadCase] ! load case is ok, append it enddo @@ -383,7 +333,7 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! write header of output file if (worldrank == 0) then - writeHeader: if (interface_restartInc < 1_pInt) then + writeHeader: if (interface_restartInc < 1) then open(newunit=fileUnit,file=trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE') write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header @@ -417,59 +367,59 @@ program DAMASK_spectral allocate(outputSize(worldsize), source = 0_MPI_OFFSET_KIND) outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND) call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce') + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_allreduce') call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', & MPI_MODE_WRONLY + MPI_MODE_APPEND, & MPI_INFO_NULL, & fileUnit, & ierr) - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_open') - call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_get_position') + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_open') + call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_get_position') fileOffset = fileOffset + sum(outputSize(1:worldrank)) ! offset of my process in file (header + processes before me) call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek') + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_seek') - writeUndeformed: if (interface_restartInc < 1_pInt) then + writeUndeformed: if (interface_restartInc < 1) then write(6,'(1/,a)') ' ... writing initial configuration to file ........................' - call CPFEM_results(0_pInt,0.0_pReal) + call CPFEM_results(0,0.0_pReal) do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output - outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? + outputIndex = int([(i-1)*((maxRealOut)/materialpoint_sizeResults)+1, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), & MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) - if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') + if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_write') enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position endif writeUndeformed - loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) + loadCaseLooping: do currentLoadCase = 1, size(loadCases) time0 = time ! load case start time guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc - incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs - totalIncsCounter = totalIncsCounter + 1_pInt + incLooping: do inc = 1, loadCases(currentLoadCase)%incs + totalIncsCounter = totalIncsCounter + 1 !-------------------------------------------------------------------------------------------------- ! forwarding time timeIncOld = timeinc ! last timeinc that brought former inc to an end - if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale + if (loadCases(currentLoadCase)%logscale == 0) then ! linear scale timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) else - if (currentLoadCase == 1_pInt) then ! 1st load case of logarithmic scale - if (inc == 1_pInt) then ! 1st inc of 1st load case of logarithmic scale - timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd + if (currentLoadCase == 1) then ! 1st load case of logarithmic scale + if (inc == 1) then ! 1st inc of 1st load case of logarithmic scale + timeinc = loadCases(1)%time*(2.0_pReal**real( 1-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd else ! not-1st inc of 1st load case of logarithmic scale - timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal)) + timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1-loadCases(1)%incs ,pReal)) endif else ! not-1st load case of logarithmic scale timeinc = time0 * & ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc ,pReal)/& real(loadCases(currentLoadCase)%incs ,pReal))& - -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1_pInt ,pReal)/& + -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1 ,pReal)/& real(loadCases(currentLoadCase)%incs ,pReal))) endif endif @@ -479,12 +429,12 @@ program DAMASK_spectral time = time + timeinc ! just advance time, skip already performed calculation guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference else skipping - stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel + stepFraction = 0 ! fraction scaled by stepFactor**cutLevel subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel) remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time time = time + timeinc ! forward target time - stepFraction = stepFraction + 1_pInt ! count step + stepFraction = stepFraction + 1 ! count step !-------------------------------------------------------------------------------------------------- ! report begin of new step @@ -524,7 +474,7 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! solve fields - stagIter = 0_pInt + stagIter = 0 stagIterate = .true. do while (stagIterate) do field = 1, nActiveFields @@ -546,7 +496,7 @@ program DAMASK_spectral if (.not. solres(field)%converged) exit ! no solution found enddo - stagIter = stagIter + 1_pInt + stagIter = stagIter + 1 stagIterate = stagIter < stagItMax & .and. all(solres(:)%converged) & .and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration @@ -567,52 +517,52 @@ program DAMASK_spectral endif elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated? cutBack = .true. - stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator - cutBackLevel = cutBackLevel + 1_pInt + stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator + cutBackLevel = cutBackLevel + 1 time = time - timeinc ! rewind time timeinc = timeinc/real(subStepFactor,pReal) ! cut timestep write(6,'(/,a)') ' cutting back ' else ! no more options to continue - call IO_warning(850_pInt) + call IO_warning(850) call MPI_file_close(fileUnit,ierr) close(statUnit) - call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written + call quit(-1*(lastRestartWritten+1)) ! quit and provide information about last restart inc written endif enddo subStepLooping - cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc + cutBackLevel = max(0, cutBackLevel - 1) ! try half number of subincs next inc if (all(solres(:)%converged)) then - convergedCounter = convergedCounter + 1_pInt + convergedCounter = convergedCounter + 1 write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc ' increment ', totalIncsCounter, ' converged' else - notConvergedCounter = notConvergedCounter + 1_pInt + notConvergedCounter = notConvergedCounter + 1 write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc ' increment ', totalIncsCounter, ' NOT converged' endif; flush(6) - if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency + if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency write(6,'(1/,a)') ' ... writing results to file ......................................' flush(6) call materialpoint_postResults() call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) - if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') + if (ierr /= 0) call IO_error(894, ext_msg='MPI_file_seek') do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output - outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & + outputIndex=int([(i-1)*((maxRealOut)/materialpoint_sizeResults)+1, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),& MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write') + if(ierr /=0) call IO_error(894, ext_msg='MPI_file_write') enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position call CPFEM_results(totalIncsCounter,time) endif - if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... - .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information + if ( loadCases(currentLoadCase)%restartFrequency > 0 & ! writing of restart info requested ... + .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then ! ... and at frequency of writing restart information restartWrite = .true. ! set restart parameter for FEsolving lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write? endif @@ -636,7 +586,7 @@ program DAMASK_spectral call MPI_file_close(fileUnit,ierr) close(statUnit) - if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged - call quit(0_pInt) ! no complains ;) + if (notConvergedCounter > 0) call quit(2) ! error if some are not converged + call quit(0) ! no complains ;) end program DAMASK_spectral diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 379327981..2ce058c19 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -5,18 +5,16 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module kinematics_cleavage_opening - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, private :: kinematics_cleavage_opening_instance + integer, dimension(:), allocatable, private :: kinematics_cleavage_opening_instance type, private :: tParameters !< container type for internal constitutive parameters - integer(pInt) :: & + integer :: & totalNcleavage - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & Ncleavage !< active number of cleavage systems per family real(pReal) :: & sdot0, & @@ -27,17 +25,17 @@ module kinematics_cleavage_opening end type ! Begin Deprecated - integer(pInt), dimension(:), allocatable, private :: & - kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems + integer, dimension(:), allocatable, private :: & + kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems - integer(pInt), dimension(:,:), allocatable, private :: & - kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family + integer, dimension(:,:), allocatable, private :: & + kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family - real(pReal), dimension(:), allocatable, private :: & + real(pReal), dimension(:), allocatable, private :: & kinematics_cleavage_opening_sdot_0, & kinematics_cleavage_opening_N - real(pReal), dimension(:,:), allocatable, private :: & + real(pReal), dimension(:,:), allocatable, private :: & kinematics_cleavage_opening_critDisp, & kinematics_cleavage_opening_critLoad ! End Deprecated @@ -71,32 +69,32 @@ subroutine kinematics_cleavage_opening_init() lattice_NcleavageSystem implicit none - integer(pInt), allocatable, dimension(:) :: tempInt + integer, allocatable, dimension(:) :: tempInt real(pReal), allocatable, dimension(:) :: tempFloat - integer(pInt) :: maxNinstance,p,instance,kinematics + integer :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' - maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt) - if (maxNinstance == 0_pInt) return + maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID)) + if (maxNinstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0_pInt) - do p = 1_pInt, size(config_phase) + allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0) + do p = 1, size(config_phase) kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct? enddo allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt) - allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0_pInt) + allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0) + allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0) allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal) allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal) - do p = 1_pInt, size(config_phase) + do p = 1, size(config_phase) if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle instance = kinematics_cleavage_opening_instance(p) kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0') @@ -115,13 +113,13 @@ subroutine kinematics_cleavage_opening_init() kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance)) kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') + call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') + call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') + call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') + call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') enddo end subroutine kinematics_cleavage_opening_init @@ -130,8 +128,6 @@ end subroutine kinematics_cleavage_opening_init !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) - use prec, only: & - tol_math_check use math, only: & math_mul33xx33 use material, only: & @@ -145,7 +141,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i lattice_NcleavageSystem implicit none - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< grain number ip, & !< integration point number el !< element number @@ -155,7 +151,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld !< damage velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) - integer(pInt) :: & + integer :: & instance, phase, & homog, damageOffset, & f, i, index_myFamily, k, l, m, n @@ -170,9 +166,9 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld = 0.0_pReal dLd_dTstar = 0.0_pReal - do f = 1_pInt,lattice_maxNcleavageFamily - index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family + do f = 1,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family + do i = 1,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) @@ -186,7 +182,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase) dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ & max(0.0_pReal, abs(traction_d) - traction_crit) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* & lattice_Scleavage(m,n,1,index_myFamily+i,phase) @@ -200,7 +196,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase) dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ & max(0.0_pReal, abs(traction_t) - traction_crit) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* & lattice_Scleavage(m,n,2,index_myFamily+i,phase) @@ -214,7 +210,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase) dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ & max(0.0_pReal, abs(traction_n) - traction_crit) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* & lattice_Scleavage(m,n,3,index_myFamily+i,phase) diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 880df3dcc..7a0b2fe99 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -5,18 +5,16 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module kinematics_slipplane_opening - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, private :: kinematics_slipplane_opening_instance + integer, dimension(:), allocatable, private :: kinematics_slipplane_opening_instance type, private :: tParameters !< container type for internal constitutive parameters - integer(pInt) :: & + integer :: & totalNslip - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & Nslip !< active number of slip systems per family real(pReal) :: & sdot0, & @@ -58,26 +56,25 @@ subroutine kinematics_slipplane_opening_init() KINEMATICS_slipplane_opening_ID use lattice - implicit none - integer(pInt) :: maxNinstance,p,instance,kinematics + integer :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' maxNinstance = count(phase_kinematics == KINEMATICS_slipplane_opening_ID) if (maxNinstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0_pInt) - do p = 1_pInt, size(config_phase) + allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0) + do p = 1, size(config_phase) kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct? enddo allocate(param(maxNinstance)) - do p = 1_pInt, size(config_phase) + do p = 1, size(config_phase) if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle associate(prm => param(kinematics_slipplane_opening_instance(p)), & config => config_phase(p)) @@ -91,19 +88,19 @@ subroutine kinematics_slipplane_opening_init() prm%critLoad = math_expand(prm%critLoad, prm%Nslip) -prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),& + prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),& + prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& + prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) ! if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')') + ! call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')') ! if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) & - ! call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') + ! call IO_error(211,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') ! if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') + ! call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') end associate enddo @@ -114,8 +111,6 @@ end subroutine kinematics_slipplane_opening_init !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) - use prec, only: & - tol_math_check use math, only: & math_mul33xx33, & math_outer @@ -125,7 +120,6 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, damage, & damageMapping - implicit none integer, intent(in) :: & ipc, & !< grain number ip, & !< integration point number @@ -173,7 +167,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, if (abs(udotd) > tol_math_check) then Ld = Ld + udotd*projection_d dudotd_dt = udotd*prm%n/traction_d - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotd_dt*projection_d(k,l)*projection_d(m,n) endif @@ -185,7 +179,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, if (abs(udott) > tol_math_check) then Ld = Ld + udott*projection_t dudott_dt = udott*prm%n/traction_t - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudott_dt*projection_t(k,l)*projection_t(m,n) endif @@ -197,7 +191,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, if (abs(udotn) > tol_math_check) then Ld = Ld + udotn*projection_n dudotn_dt = udotn*prm%n/traction_n - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotn_dt*projection_n(k,l)*projection_n(m,n) endif diff --git a/src/material.f90 b/src/material.f90 index bb8d6dbff..fd8f52ba9 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -98,10 +98,10 @@ module material integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & homogenization_type !< type of each homogenization - integer(pInt), public, protected :: & + integer, public, protected :: & homogenization_maxNgrains !< max number of grains in any USED homogenization - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & phase_Nsources, & !< number of source mechanisms active in each phase phase_Nkinematics, & !< number of kinematic mechanisms active in each phase phase_NstiffnessDegradations, & !< number of stiffness degradation mechanisms active in each phase @@ -132,7 +132,7 @@ module material ! END NEW MAPPINGS ! DEPRECATED: use material_phaseAt - integer(pInt), dimension(:,:,:), allocatable, public :: & + integer, dimension(:,:,:), allocatable, public :: & material_phase !< phase (index) of each grain,IP,element type(tPlasticState), allocatable, dimension(:), public :: & @@ -144,7 +144,7 @@ module material thermalState, & damageState - integer(pInt), dimension(:,:,:), allocatable, public, protected :: & + integer, dimension(:,:,:), allocatable, public, protected :: & material_texture !< texture (index) of each grain,IP,element real(pReal), dimension(:,:,:,:), allocatable, public, protected :: & @@ -155,15 +155,15 @@ module material microstructure_elemhomo, & !< flag to indicate homogeneous microstructure distribution over element's IPs phase_localPlasticity !< flags phases with local constitutive law - integer(pInt), private :: & + integer, private :: & microstructure_maxNconstituents, & !< max number of constituents in any phase texture_maxNgauss !< max number of Gauss components in any texture - integer(pInt), dimension(:), allocatable, private :: & + integer, dimension(:), allocatable, private :: & microstructure_Nconstituents, & !< number of constituents in each microstructure texture_Ngauss !< number of Gauss components per texture - integer(pInt), dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable, private :: & microstructure_phase, & !< phase IDs of each microstructure microstructure_texture !< texture IDs of each microstructure @@ -178,11 +178,11 @@ module material homogenization_active ! BEGIN DEPRECATED - integer(pInt), dimension(:,:,:), allocatable, public :: phaseAt !< phase ID of every material point (ipc,ip,el) - integer(pInt), dimension(:,:,:), allocatable, public :: phasememberAt !< memberID of given phase at every material point (ipc,ip,el) + integer, dimension(:,:,:), allocatable, public :: phaseAt !< phase ID of every material point (ipc,ip,el) + integer, dimension(:,:,:), allocatable, public :: phasememberAt !< memberID of given phase at every material point (ipc,ip,el) - integer(pInt), dimension(:,:,:), allocatable, public, target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field - integer(pInt), dimension(:,:), allocatable, private, target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field + integer, dimension(:,:,:), allocatable, public, target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field + integer, dimension(:,:), allocatable, private, target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field ! END DEPRECATED type(tHomogMapping), allocatable, dimension(:), public :: & @@ -256,13 +256,13 @@ subroutine material_init use mesh, only: & theMesh - integer(pInt), parameter :: FILEUNIT = 210_pInt - integer(pInt) :: m,c,h, myDebug, myPhase, myHomog - integer(pInt) :: & + integer, parameter :: FILEUNIT = 210 + integer :: m,c,h, myDebug, myPhase, myHomog + integer :: & g, & !< grain number i, & !< integration point number e !< element number - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & CounterPhase, & CounterHomogenization @@ -271,19 +271,19 @@ subroutine material_init write(6,'(/,a)') ' <<<+- material init -+>>>' call material_parsePhase() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6) call material_parseMicrostructure() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6) call material_parseCrystallite() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite parsed'; flush(6) call material_parseHomogenization() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6) call material_parseTexture() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) + if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6) allocate(plasticState (size(config_phase))) allocate(sourceState (size(config_phase))) @@ -303,34 +303,34 @@ subroutine material_init allocate(temperatureRate (size(config_homogenization))) - do m = 1_pInt,size(config_microstructure) - if(microstructure_crystallite(m) < 1_pInt .or. & + do m = 1,size(config_microstructure) + if(microstructure_crystallite(m) < 1 .or. & microstructure_crystallite(m) > size(config_crystallite)) & - call IO_error(150_pInt,m,ext_msg='crystallite') - if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & + call IO_error(150,m,ext_msg='crystallite') + if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1 .or. & maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(config_phase)) & - call IO_error(150_pInt,m,ext_msg='phase') - if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & + call IO_error(150,m,ext_msg='phase') + if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1 .or. & maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > size(config_texture)) & - call IO_error(150_pInt,m,ext_msg='texture') - if(microstructure_Nconstituents(m) < 1_pInt) & - call IO_error(151_pInt,m) + call IO_error(150,m,ext_msg='texture') + if(microstructure_Nconstituents(m) < 1) & + call IO_error(151,m) enddo - debugOut: if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then + debugOut: if (iand(myDebug,debug_levelExtensive) /= 0) then write(6,'(/,a,/)') ' MATERIAL configuration' write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' - do h = 1_pInt,size(config_homogenization) + do h = 1,size(config_homogenization) write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h) enddo write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous' - do m = 1_pInt,size(config_microstructure) + do m = 1,size(config_microstructure) write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), & microstructure_crystallite(m), & microstructure_Nconstituents(m), & microstructure_elemhomo(m) - if (microstructure_Nconstituents(m) > 0_pInt) then - do c = 1_pInt,microstructure_Nconstituents(m) + if (microstructure_Nconstituents(m) > 0) then + do c = 1,microstructure_Nconstituents(m) write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(c,m)),& texture_name(microstructure_texture(c,m)),& microstructure_fraction(c,m) @@ -383,23 +383,23 @@ subroutine material_init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BEGIN DEPRECATED - allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) - allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) - allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) - allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1_pInt) + allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0) + allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0) + allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0) + allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1) CounterHomogenization=0 CounterPhase =0 - do e = 1_pInt,theMesh%Nelems + do e = 1,theMesh%Nelems myHomog = theMesh%homogenizationAt(e) - do i = 1_pInt, theMesh%elem%nIPs - CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt + do i = 1, theMesh%elem%nIPs + CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1 mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)] - do g = 1_pInt,homogenization_Ngrains(myHomog) + do g = 1,homogenization_Ngrains(myHomog) myPhase = material_phase(g,i,e) - CounterPhase(myPhase) = CounterPhase(myPhase)+1_pInt ! not distinguishing between instances of same phase + CounterPhase(myPhase) = CounterPhase(myPhase)+1 ! not distinguishing between instances of same phase phaseAt(g,i,e) = myPhase phasememberAt(g,i,e) = CounterPhase(myPhase) enddo @@ -429,33 +429,33 @@ subroutine material_parseHomogenization use IO, only: & IO_error - integer(pInt) :: h + integer :: h character(len=65536) :: tag allocate(homogenization_type(size(config_homogenization)), source=HOMOGENIZATION_undefined_ID) allocate(thermal_type(size(config_homogenization)), source=THERMAL_isothermal_ID) allocate(damage_type (size(config_homogenization)), source=DAMAGE_none_ID) - allocate(homogenization_typeInstance(size(config_homogenization)), source=0_pInt) - allocate(thermal_typeInstance(size(config_homogenization)), source=0_pInt) - allocate(damage_typeInstance(size(config_homogenization)), source=0_pInt) - allocate(homogenization_Ngrains(size(config_homogenization)), source=0_pInt) - allocate(homogenization_Noutput(size(config_homogenization)), source=0_pInt) + allocate(homogenization_typeInstance(size(config_homogenization)), source=0) + allocate(thermal_typeInstance(size(config_homogenization)), source=0) + allocate(damage_typeInstance(size(config_homogenization)), source=0) + allocate(homogenization_Ngrains(size(config_homogenization)), source=0) + allocate(homogenization_Noutput(size(config_homogenization)), source=0) allocate(homogenization_active(size(config_homogenization)), source=.false.) !!!!!!!!!!!!!!! allocate(thermal_initialT(size(config_homogenization)), source=300.0_pReal) allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal) - forall (h = 1_pInt:size(config_homogenization)) & + forall (h = 1:size(config_homogenization)) & homogenization_active(h) = any(theMesh%homogenizationAt == h) - do h=1_pInt, size(config_homogenization) + do h=1, size(config_homogenization) homogenization_Noutput(h) = config_homogenization(h)%countKeys('(output)') tag = config_homogenization(h)%getString('mech') select case (trim(tag)) case(HOMOGENIZATION_NONE_label) homogenization_type(h) = HOMOGENIZATION_NONE_ID - homogenization_Ngrains(h) = 1_pInt + homogenization_Ngrains(h) = 1 case(HOMOGENIZATION_ISOSTRAIN_label) homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') @@ -463,7 +463,7 @@ subroutine material_parseHomogenization homogenization_type(h) = HOMOGENIZATION_RGC_ID homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') case default - call IO_error(500_pInt,ext_msg=trim(tag)) + call IO_error(500,ext_msg=trim(tag)) end select homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h)) @@ -480,7 +480,7 @@ subroutine material_parseHomogenization case(THERMAL_conduction_label) thermal_type(h) = THERMAL_conduction_ID case default - call IO_error(500_pInt,ext_msg=trim(tag)) + call IO_error(500,ext_msg=trim(tag)) end select endif @@ -497,14 +497,14 @@ subroutine material_parseHomogenization case(DAMAGE_NONLOCAL_label) damage_type(h) = DAMAGE_nonlocal_ID case default - call IO_error(500_pInt,ext_msg=trim(tag)) + call IO_error(500,ext_msg=trim(tag)) end select endif enddo - do h=1_pInt, size(config_homogenization) + do h=1, size(config_homogenization) homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h)) thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h)) damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h)) @@ -530,58 +530,58 @@ subroutine material_parseMicrostructure character(len=65536), dimension(:), allocatable :: & strings - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: e, m, c, i + integer, allocatable, dimension(:) :: chunkPos + integer :: e, m, c, i character(len=65536) :: & tag - allocate(microstructure_crystallite(size(config_microstructure)), source=0_pInt) - allocate(microstructure_Nconstituents(size(config_microstructure)), source=0_pInt) + allocate(microstructure_crystallite(size(config_microstructure)), source=0) + allocate(microstructure_Nconstituents(size(config_microstructure)), source=0) allocate(microstructure_active(size(config_microstructure)), source=.false.) allocate(microstructure_elemhomo(size(config_microstructure)), source=.false.) if(any(theMesh%microstructureAt > size(config_microstructure))) & - call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') + call IO_error(155,ext_msg='More microstructures in geometry than sections in material.config') - forall (e = 1_pInt:theMesh%Nelems) & + forall (e = 1:theMesh%Nelems) & microstructure_active(theMesh%microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements - do m=1_pInt, size(config_microstructure) + do m=1, size(config_microstructure) microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)') microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite') microstructure_elemhomo(m) = config_microstructure(m)%keyExists('/elementhomogeneous/') enddo microstructure_maxNconstituents = maxval(microstructure_Nconstituents) - allocate(microstructure_phase (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt) - allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt) + allocate(microstructure_phase (microstructure_maxNconstituents,size(config_microstructure)),source=0) + allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0) allocate(microstructure_fraction(microstructure_maxNconstituents,size(config_microstructure)),source=0.0_pReal) allocate(strings(1)) ! Intel 16.0 Bug - do m=1_pInt, size(config_microstructure) + do m=1, size(config_microstructure) strings = config_microstructure(m)%getStrings('(constituent)',raw=.true.) - do c = 1_pInt, size(strings) + do c = 1, size(strings) chunkPos = IO_stringPos(strings(c)) - do i = 1_pInt,5_pInt,2_pInt + do i = 1,5,2 tag = IO_stringValue(strings(c),chunkPos,i) select case (tag) case('phase') - microstructure_phase(c,m) = IO_intValue(strings(c),chunkPos,i+1_pInt) + microstructure_phase(c,m) = IO_intValue(strings(c),chunkPos,i+1) case('texture') - microstructure_texture(c,m) = IO_intValue(strings(c),chunkPos,i+1_pInt) + microstructure_texture(c,m) = IO_intValue(strings(c),chunkPos,i+1) case('fraction') - microstructure_fraction(c,m) = IO_floatValue(strings(c),chunkPos,i+1_pInt) + microstructure_fraction(c,m) = IO_floatValue(strings(c),chunkPos,i+1) end select enddo enddo enddo - do m = 1_pInt, size(config_microstructure) + do m = 1, size(config_microstructure) if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) & - call IO_error(153_pInt,ext_msg=microstructure_name(m)) + call IO_error(153,ext_msg=microstructure_name(m)) enddo end subroutine material_parseMicrostructure @@ -592,10 +592,10 @@ end subroutine material_parseMicrostructure !-------------------------------------------------------------------------------------------------- subroutine material_parseCrystallite - integer(pInt) :: c + integer :: c - allocate(crystallite_Noutput(size(config_crystallite)),source=0_pInt) - do c=1_pInt, size(config_crystallite) + allocate(crystallite_Noutput(size(config_crystallite)),source=0) + do c=1, size(config_crystallite) crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)') enddo @@ -611,19 +611,19 @@ subroutine material_parsePhase IO_getTag, & IO_stringValue - integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p + integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p character(len=65536), dimension(:), allocatable :: str allocate(phase_elasticity(size(config_phase)),source=ELASTICITY_undefined_ID) allocate(phase_plasticity(size(config_phase)),source=PLASTICITY_undefined_ID) - allocate(phase_Nsources(size(config_phase)), source=0_pInt) - allocate(phase_Nkinematics(size(config_phase)), source=0_pInt) - allocate(phase_NstiffnessDegradations(size(config_phase)),source=0_pInt) - allocate(phase_Noutput(size(config_phase)), source=0_pInt) + allocate(phase_Nsources(size(config_phase)), source=0) + allocate(phase_Nkinematics(size(config_phase)), source=0) + allocate(phase_NstiffnessDegradations(size(config_phase)),source=0) + allocate(phase_Noutput(size(config_phase)), source=0) allocate(phase_localPlasticity(size(config_phase)), source=.false.) - do p=1_pInt, size(config_phase) + do p=1, size(config_phase) phase_Noutput(p) = config_phase(p)%countKeys('(output)') phase_Nsources(p) = config_phase(p)%countKeys('(source)') phase_Nkinematics(p) = config_phase(p)%countKeys('(kinematics)') @@ -634,7 +634,7 @@ subroutine material_parsePhase case (ELASTICITY_HOOKE_label) phase_elasticity(p) = ELASTICITY_HOOKE_ID case default - call IO_error(200_pInt,ext_msg=trim(config_phase(p)%getString('elasticity'))) + call IO_error(200,ext_msg=trim(config_phase(p)%getString('elasticity'))) end select select case (config_phase(p)%getString('plasticity')) @@ -653,7 +653,7 @@ subroutine material_parsePhase case (PLASTICITY_NONLOCAL_label) phase_plasticity(p) = PLASTICITY_NONLOCAL_ID case default - call IO_error(201_pInt,ext_msg=trim(config_phase(p)%getString('plasticity'))) + call IO_error(201,ext_msg=trim(config_phase(p)%getString('plasticity'))) end select enddo @@ -662,7 +662,7 @@ subroutine material_parsePhase allocate(phase_kinematics(maxval(phase_Nkinematics),size(config_phase)), source=KINEMATICS_undefined_ID) allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(config_phase)), & source=STIFFNESS_DEGRADATION_undefined_ID) - do p=1_pInt, size(config_phase) + do p=1, size(config_phase) #if defined(__GFORTRAN__) || defined(__PGI) str = ['GfortranBug86277'] str = config_phase(p)%getStrings('(source)',defaultVal=str) @@ -670,7 +670,7 @@ subroutine material_parsePhase #else str = config_phase(p)%getStrings('(source)',defaultVal=[character(len=65536)::]) #endif - do sourceCtr = 1_pInt, size(str) + do sourceCtr = 1, size(str) select case (trim(str(sourceCtr))) case (SOURCE_thermal_dissipation_label) phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID @@ -694,7 +694,7 @@ subroutine material_parsePhase #else str = config_phase(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::]) #endif - do kinematicsCtr = 1_pInt, size(str) + do kinematicsCtr = 1, size(str) select case (trim(str(kinematicsCtr))) case (KINEMATICS_cleavage_opening_label) phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID @@ -711,7 +711,7 @@ subroutine material_parsePhase #else str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=65536)::]) #endif - do stiffDegradationCtr = 1_pInt, size(str) + do stiffDegradationCtr = 1, size(str) select case (trim(str(stiffDegradationCtr))) case (STIFFNESS_DEGRADATION_damage_label) phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID @@ -719,10 +719,10 @@ subroutine material_parsePhase enddo enddo - allocate(phase_plasticityInstance(size(config_phase)), source=0_pInt) - allocate(phase_elasticityInstance(size(config_phase)), source=0_pInt) + allocate(phase_plasticityInstance(size(config_phase)), source=0) + allocate(phase_elasticityInstance(size(config_phase)), source=0) - do p=1_pInt, size(config_phase) + do p=1, size(config_phase) phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) enddo @@ -739,13 +739,13 @@ subroutine material_parseTexture IO_floatValue, & IO_stringValue - integer(pInt) :: section, gauss, j, t, i + integer :: section, gauss, j, t, i character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config - integer(pInt), dimension(:), allocatable :: chunkPos + integer, dimension(:), allocatable :: chunkPos - allocate(texture_Ngauss(size(config_texture)), source=0_pInt) + allocate(texture_Ngauss(size(config_texture)), source=0) - do t=1_pInt, size(config_texture) + do t=1, size(config_texture) texture_Ngauss(t) = config_texture(t)%countKeys('(gauss)') if (config_texture(t)%keyExists('symmetry')) call IO_error(147,ext_msg='symmetry') if (config_texture(t)%keyExists('(random)')) call IO_error(147,ext_msg='(random)') @@ -757,13 +757,13 @@ subroutine material_parseTexture allocate(texture_transformation(3,3,size(config_texture)), source=0.0_pReal) texture_transformation = spread(math_I3,3,size(config_texture)) - do t=1_pInt, size(config_texture) + do t=1, size(config_texture) section = t - gauss = 0_pInt + gauss = 0 if (config_texture(t)%keyExists('axes')) then strings = config_texture(t)%getStrings('axes') - do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries + do j = 1, 3 ! look for "x", "y", and "z" entries select case (strings(j)) case('x', '+x') texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis @@ -778,25 +778,25 @@ subroutine material_parseTexture case('-z') texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis case default - call IO_error(157_pInt,t) + call IO_error(157,t) end select enddo - if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157_pInt,t) + if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157,t) endif if (config_texture(t)%keyExists('(gauss)')) then - gauss = gauss + 1_pInt + gauss = gauss + 1 strings = config_texture(t)%getStrings('(gauss)',raw= .true.) - do i = 1_pInt , size(strings) + do i = 1 , size(strings) chunkPos = IO_stringPos(strings(i)) - do j = 1_pInt,9_pInt,2_pInt + do j = 1,9,2 select case (IO_stringValue(strings(i),chunkPos,j)) case('phi1') - texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad case('phi') - texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad case('phi2') - texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad end select enddo enddo @@ -817,7 +817,7 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,& use numerics, only: & numerics_integrator - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & NofMyPhase, & sizeState, & @@ -842,13 +842,13 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,& allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 1_pInt) then + if (numerics_integrator == 1) then allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) endif - if (numerics_integrator == 4_pInt) & + if (numerics_integrator == 4) & allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 5_pInt) & + if (numerics_integrator == 5) & allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) @@ -864,7 +864,7 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,& use numerics, only: & numerics_integrator - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & of, & NofMyPhase, & @@ -882,13 +882,13 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,& allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(of)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 1_pInt) then + if (numerics_integrator == 1) then allocate(sourceState(phase)%p(of)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(of)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) endif - if (numerics_integrator == 4_pInt) & + if (numerics_integrator == 4) & allocate(sourceState(phase)%p(of)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 5_pInt) & + if (numerics_integrator == 5) & allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(of)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) @@ -905,10 +905,10 @@ subroutine material_populateGrains use mesh, only: & theMesh - integer(pInt) :: e,i,c,homog,micro + integer :: e,i,c,homog,micro - allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) - allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0) + allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0) allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal) do e = 1, theMesh%Nelems diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 0467d09aa..5168d4d4b 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -11,7 +11,7 @@ module mesh implicit none private - integer(pInt), public, protected :: & + integer, public, protected :: & mesh_NcpElems, & !< total number of CP elements in local mesh mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) mesh_Nnodes, & !< total number of nodes in mesh @@ -20,17 +20,17 @@ module mesh mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! - integer(pInt), public, protected :: & + integer, public, protected :: & mesh_maxNips, & !< max number of IPs in any CP element mesh_maxNcellnodes !< max number of cell nodes in any CP element !!!! BEGIN DEPRECATED !!!!! - integer(pInt), dimension(:,:), allocatable, public, protected :: & + integer, dimension(:,:), allocatable, public, protected :: & mesh_element, & !DEPRECATED mesh_sharedElem, & !< entryCount and list of elements containing node mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) - integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + integer, dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] real(pReal), public, protected :: & @@ -55,20 +55,20 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) - integer(pInt), private :: & + integer, private :: & mesh_maxNelemInSet, & mesh_Nmaterials - integer(pInt), dimension(2), private :: & - mesh_maxValStateVar = 0_pInt + integer, dimension(2), private :: & + mesh_maxValStateVar = 0 -integer(pInt), dimension(:,:), allocatable, private :: & +integer, dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID - integer(pInt),dimension(:,:,:), allocatable, private :: & + integer,dimension(:,:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell - integer(pInt), dimension(:,:,:), allocatable, private :: & + integer, dimension(:,:,:), allocatable, private :: & FE_nodesAtIP, & !< map IP index to node indices in a specific type of element FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry @@ -77,28 +77,28 @@ integer(pInt), dimension(:,:), allocatable, private :: & real(pReal), dimension(:,:,:), allocatable, private :: & FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes - integer(pInt), dimension(:,:,:,:), allocatable, private :: & + integer, dimension(:,:,:,:), allocatable, private :: & FE_subNodeOnIPFace ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" - integer(pInt), parameter, public :: & - FE_Nelemtypes = 13_pInt, & - FE_Ngeomtypes = 10_pInt, & - FE_Ncelltypes = 4_pInt, & - FE_maxNnodes = 20_pInt, & - FE_maxNips = 27_pInt, & - FE_maxNipNeighbors = 6_pInt, & - FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP - FE_maxNmatchingNodesPerFace = 4_pInt, & - FE_maxNfaces = 6_pInt, & - FE_maxNcellnodes = 64_pInt, & - FE_maxNcellnodesPerCell = 8_pInt, & - FE_maxNcellfaces = 6_pInt, & - FE_maxNcellnodesPerCellface = 4_pInt + integer, parameter, public :: & + FE_Nelemtypes = 13, & + FE_Ngeomtypes = 10, & + FE_Ncelltypes = 4, & + FE_maxNnodes = 20, & + FE_maxNips = 27, & + FE_maxNipNeighbors = 6, & + FE_maxmaxNnodesAtIP = 8, & !< max number of (equivalent) nodes attached to an IP + FE_maxNmatchingNodesPerFace = 4, & + FE_maxNfaces = 6, & + FE_maxNcellnodes = 64, & + FE_maxNcellnodesPerCell = 8, & + FE_maxNcellfaces = 6, & + FE_maxNcellnodesPerCellface = 4 - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type + integer, dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type int([ & 1, & ! element 6 (2D 3node 1ip) 2, & ! element 125 (2D 6node 3ip) @@ -115,7 +115,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 10 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type + integer, dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type int([ & 1, & ! element 6 (2D 3node 1ip) 2, & ! element 125 (2D 6node 3ip) @@ -129,7 +129,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type + integer, dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type int([ & 2, & ! element 6 (2D 3node 1ip) 2, & ! element 125 (2D 6node 3ip) @@ -143,7 +143,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 3 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element + integer, dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element int([ & 3, & ! element 6 (2D 3node 1ip) 6, & ! element 125 (2D 6node 3ip) @@ -160,7 +160,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 20 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nfaces = & !< number of faces of a specific type of element geometry + integer, dimension(FE_Ngeomtypes), parameter, public :: FE_Nfaces = & !< number of faces of a specific type of element geometry int([ & 3, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -174,7 +174,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 6 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry int([ & 3, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -188,8 +188,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & - FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry + integer, dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry reshape(int([ & 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) 2,2,2,0,0,0, & ! element 125 (2D 6node 3ip) @@ -203,7 +202,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4,4,4,4,4,4 & ! element 21 (3D 20node 27ip) ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) - integer(pInt), dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & + integer, dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & parameter, private :: FE_face = & !< List of node indices on each face of a specific type of element geometry reshape(int([& 1,2,0,0 , & ! element 6 (2D 3node 1ip) @@ -268,7 +267,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8,7,6,5 & ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type int([ & 3, & ! element 6 (2D 3node 1ip) 7, & ! element 125 (2D 6node 3ip) @@ -282,7 +281,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 64 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type int([ & 3, & ! (2D 3node) 4, & ! (2D 4node) @@ -290,7 +289,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type int([& 2, & ! (2D 3node) 2, & ! (2D 4node) @@ -298,7 +297,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element + integer, dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element int([ & 1, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -312,7 +311,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 27 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type int([& 3, & ! (2D 3node) 4, & ! (2D 4node) @@ -320,7 +319,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 6 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element int([ & 3, & ! element 6 (2D 3node 1ip) 1, & ! element 125 (2D 6node 3ip) @@ -334,7 +333,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), private :: & + integer, private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets @@ -342,9 +341,9 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_nameElemSet, & !< names of elementSet mesh_nameMaterial, & !< names of material in solid section mesh_mapMaterial !< name of elementSet for material - integer(pInt), dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable, private :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(:,:), allocatable, target, private :: & + integer, dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information @@ -381,7 +380,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & type, public, extends(tMesh) :: tMesh_abaqus - integer(pInt):: & + integer:: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets, & @@ -391,7 +390,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_nameElemSet, & !< names of elementSet mesh_nameMaterial, & !< names of material in solid section mesh_mapMaterial !< name of elementSet for material - integer(pInt), dimension(:,:), allocatable :: & + integer, dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information @@ -409,7 +408,7 @@ subroutine tMesh_abaqus_init(self,elemType,nodes) implicit none class(tMesh_abaqus) :: self real(pReal), dimension(:,:), intent(in) :: nodes - integer(pInt), intent(in) :: elemType + integer, intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) @@ -440,16 +439,16 @@ subroutine mesh_init(ip,el) FEsolving_execIP implicit none - integer(pInt), parameter :: FILEUNIT = 222_pInt - integer(pInt), intent(in), optional :: el, ip - integer(pInt) :: j + integer, parameter :: FILEUNIT = 222 + integer, intent(in), optional :: el, ip + integer :: j logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh - myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0) call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) @@ -502,14 +501,14 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & - call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements + call IO_error(600) ! ping-pong must be disabled when having non-DAMASK elements if (debug_e < 1 .or. debug_e > mesh_NcpElems) & - call IO_error(602_pInt,ext_msg='element') ! selected element does not exist - if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & - call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP - FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements - allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... - forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element + call IO_error(602,ext_msg='element') ! selected element does not exist + if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2,debug_e)))) & + call IO_error(602,ext_msg='IP') ! selected element does not have requested IP + FEsolving_execElem = [ 1,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2,mesh_NcpElems), source=1) ! parallel loop bounds set to comprise from first IP... + forall (j = 1:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element allocate(calcMode(mesh_maxNips,mesh_NcpElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" @@ -532,9 +531,9 @@ logical function hasNoPart(fileUnit) IO_lc implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=65536) :: line hasNoPart = .true. @@ -543,7 +542,7 @@ logical function hasNoPart(fileUnit) do read(fileUnit,'(a65536)',END=620) line chunkPos = IO_stringPos(line) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then + if (IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) then hasNoPart = .false. exit endif @@ -573,15 +572,15 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt + mesh_Nnodes = 0 + mesh_Nelems = 0 inPart = .false. myStat = 0 @@ -589,25 +588,25 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if (inPart .or. noPart) then - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) + select case ( IO_lc(IO_stringValue(line,chunkPos,1))) case('*node') if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' & ) & mesh_Nnodes = mesh_Nnodes + IO_countDataLines(fileUnit) case('*element') if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' & ) then mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) endif @@ -615,8 +614,8 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) endif enddo - if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) - if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) + if (mesh_Nnodes < 2) call IO_error(error_ID=900) + if (mesh_Nelems == 0) call IO_error(error_ID=901) end subroutine mesh_abaqus_count_nodesAndElements @@ -633,14 +632,14 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - mesh_NelemSets = 0_pInt + mesh_NelemSets = 0 mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons inPart = .false. @@ -649,15 +648,15 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & - mesh_NelemSets = mesh_NelemSets + 1_pInt + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1)) == '*elset' ) & + mesh_NelemSets = mesh_NelemSets + 1 enddo - if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) + if (mesh_NelemSets == 0) call IO_error(error_ID=902) end subroutine mesh_abaqus_count_elementSets @@ -675,14 +674,14 @@ subroutine mesh_abaqus_count_materials(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - mesh_Nmaterials = 0_pInt + mesh_Nmaterials = 0 inPart = .false. myStat = 0 @@ -690,17 +689,17 @@ subroutine mesh_abaqus_count_materials(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) & - mesh_Nmaterials = mesh_Nmaterials + 1_pInt + IO_lc(IO_StringValue(line,chunkPos,1)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2)) == 'section' ) & + mesh_Nmaterials = mesh_Nmaterials + 1 enddo - if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + if (mesh_Nmaterials == 0) call IO_error(error_ID=903) end subroutine mesh_abaqus_count_materials @@ -720,39 +719,39 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: elemSet,i + integer :: elemSet,i allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + allocate (mesh_mapElemSet(1+mesh_maxNelemInSet,mesh_NelemSets),source=0) - elemSet = 0_pInt + elemSet = 0 inPart = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then - elemSet = elemSet + 1_pInt - mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1)) == '*elset' ) then + elemSet = elemSet + 1 + mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'elset')) mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& - mesh_mapElemSet,elemSet-1_pInt) + mesh_mapElemSet,elemSet-1) endif enddo - do i = 1_pInt,elemSet - if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) + do i = 1,elemSet + if (mesh_mapElemSet(1,i) == 0) call IO_error(error_ID=904,ext_msg=mesh_nameElemSet(i)) enddo end subroutine mesh_abaqus_map_elementSets @@ -772,37 +771,37 @@ subroutine mesh_abaqus_map_materials(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: i,c + integer :: i,c character(len=64) :: elemSetName,materialName allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' - c = 0_pInt + c = 0 inPart = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then + IO_lc(IO_StringValue(line,chunkPos,1)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2)) == 'section' ) then elemSetName = '' materialName = '' - do i = 3_pInt,chunkPos(1_pInt) + do i = 3,chunkPos(1) if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset') /= '') & elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset')) if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material') /= '') & @@ -810,16 +809,16 @@ subroutine mesh_abaqus_map_materials(fileUnit) enddo if (elemSetName /= '' .and. materialName /= '') then - c = c + 1_pInt + c = c + 1 mesh_nameMaterial(c) = materialName ! name of material used for this section mesh_mapMaterial(c) = elemSetName ! mapped to respective element set endif endif enddo - if (c==0_pInt) call IO_error(error_ID=905_pInt) - do i=1_pInt,c - if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905_pInt) + if (c==0) call IO_error(error_ID=905) + do i=1,c + if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905) enddo end subroutine mesh_abaqus_map_materials @@ -837,32 +836,32 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) IO_extractValue implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: materialFound - integer(pInt) :: i,k + integer :: i,k character(len=64) ::materialName,elemSetName - mesh_NcpElems = 0_pInt + mesh_NcpElems = 0 materialFound = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + select case ( IO_lc(IO_stringValue(line,chunkPos,1)) ) case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'name')) ! extract name=value materialFound = materialName /= '' ! valid name? case('*user') - if (IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (IO_lc(IO_StringValue(line,chunkPos,2)) == 'material' .and. materialFound) then + do i = 1,mesh_Nmaterials ! look thru material names if (materialName == mesh_nameMaterial(i)) then ! found one elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + do k = 1,mesh_NelemSets ! look thru all elemSet definitions if (elemSetName == mesh_nameElemSet(k)) & ! matched? mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count enddo @@ -873,7 +872,7 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) endselect enddo - if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + if (mesh_NcpElems == 0) call IO_error(error_ID=906) end subroutine mesh_abaqus_count_cpElements @@ -892,38 +891,38 @@ subroutine mesh_abaqus_map_elements(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: materialFound - integer(pInt) ::i,j,k,cpElem + integer ::i,j,k,cpElem character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0) - cpElem = 0_pInt + cpElem = 0 materialFound = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + select case ( IO_lc(IO_stringValue(line,chunkPos,1)) ) case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'name')) ! extract name=value materialFound = materialName /= '' ! valid name? case('*user') - if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'material' .and. materialFound) then + do i = 1,mesh_Nmaterials ! look thru material names if (materialName == mesh_nameMaterial(i)) then ! found one elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + do k = 1,mesh_NelemSets ! look thru all elemSet definitions if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) - cpElem = cpElem + 1_pInt - mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1_pInt+j,k) ! store FE id + do j = 1,mesh_mapElemSet(1,k) + cpElem = cpElem + 1 + mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1+j,k) ! store FE id mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id enddo endif @@ -935,9 +934,9 @@ subroutine mesh_abaqus_map_elements(fileUnit) endselect enddo - call math_sort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + call math_sort(mesh_mapFEtoCPelem,1,int(size(mesh_mapFEtoCPelem,2),pInt)) ! should be mesh_NcpElems - if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) + if (int(size(mesh_mapFEtoCPelem),pInt) < 2) call IO_error(error_ID=907) end subroutine mesh_abaqus_map_elements @@ -957,51 +956,51 @@ subroutine mesh_abaqus_map_nodes(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: i,c,cpNode + integer :: i,c,cpNode - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) + allocate (mesh_mapFEtoCPnode(2,mesh_Nnodes), source=0) - cpNode = 0_pInt + cpNode = 0 inPart = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' ) & ) then c = IO_countDataLines(fileUnit) - do i = 1_pInt,c + do i = 1,c backspace(fileUnit) enddo - do i = 1_pInt,c + do i = 1,c read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) - cpNode = cpNode + 1_pInt - mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) - mesh_mapFEtoCPnode(2_pInt,cpNode) = cpNode + cpNode = cpNode + 1 + mesh_mapFEtoCPnode(1,cpNode) = IO_intValue(line,chunkPos,1) + mesh_mapFEtoCPnode(2,cpNode) = cpNode enddo endif enddo - call math_sort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + call math_sort(mesh_mapFEtoCPnode,1,int(size(mesh_mapFEtoCPnode,2),pInt)) - if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) + if (int(size(mesh_mapFEtoCPnode),pInt) == 0) call IO_error(error_ID=908) end subroutine mesh_abaqus_map_nodes @@ -1021,13 +1020,13 @@ subroutine mesh_abaqus_build_nodes(fileUnit) IO_intValue implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: i,j,m,c + integer :: i,j,m,c allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) @@ -1038,33 +1037,33 @@ subroutine mesh_abaqus_build_nodes(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' ) & ) then c = IO_countDataLines(fileUnit) ! how many nodes are defined here? - do i = 1_pInt,c + do i = 1,c backspace(fileUnit) ! rewind to first entry enddo - do i = 1_pInt,c + do i = 1,c read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) - m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) - do j=1_pInt, 3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) + m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1)) + do j=1, 3 + mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1) enddo enddo endif enddo - if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + if (int(size(mesh_node0,2),pInt) /= mesh_Nnodes) call IO_error(error_ID=909) mesh_node = mesh_node0 end subroutine mesh_abaqus_build_nodes @@ -1086,18 +1085,18 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) IO_intValue implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart - integer(pInt) :: i,c,t,g + integer :: i,c,t,g - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt + mesh_maxNnodes = 0 + mesh_maxNips = 0 + mesh_maxNipNeighbors = 0 + mesh_maxNcellnodes = 0 inPart = .false. @@ -1106,17 +1105,17 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' ) & ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'type')) ! remember elem type g = FE_geomtype(t) c = FE_celltype(g) mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) @@ -1145,17 +1144,17 @@ subroutine mesh_abaqus_build_elements(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat logical :: inPart, materialFound - integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead + integer :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead character (len=64) :: materialName,elemSetName - allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt + allocate(mesh_element (4+mesh_maxNnodes,mesh_NcpElems), source=0) + mesh_elemType = -1 inPart = .false. myStat = 0 @@ -1163,41 +1162,41 @@ subroutine mesh_abaqus_build_elements(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2)) /= 'response' ) & ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2)),'type')) ! remember elem type c = IO_countDataLines(fileUnit) - do i = 1_pInt,c + do i = 1,c backspace(fileUnit) enddo - do i = 1_pInt,c + do i = 1,c read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) ! limit to 64 nodes max - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1)) + if (e /= 0) then ! disregard non CP elems + mesh_element(1,e) = -1 ! DEPRECATED + if (mesh_elemType /= t .and. mesh_elemType /= -1) & call IO_error(191,el=t,ip=mesh_elemType) mesh_elemType = t mesh_element(2,e) = t ! elem type - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-1_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt+j)) ! put CP ids of nodes to position 5: + nNodesAlreadyRead = 0 + do j = 1,chunkPos(1)-1 + mesh_element(4+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1+j)) ! put CP ids of nodes to position 5: enddo - nNodesAlreadyRead = chunkPos(1) - 1_pInt + nNodesAlreadyRead = chunkPos(1) - 1 do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + do j = 1,chunkPos(1) + mesh_element(4+nNodesAlreadyRead+j,e) & = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes enddo nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) @@ -1216,23 +1215,23 @@ subroutine mesh_abaqus_build_elements(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) + select case ( IO_lc(IO_StringValue(line,chunkPos,1))) case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2)),'name')) ! extract name=value materialFound = materialName /= '' ! valid name? case('*user') - if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & + if ( IO_lc(IO_StringValue(line,chunkPos,2)) == 'material' .and. & materialFound ) then read (fileUnit,'(a300)') line ! read homogenization and microstructure chunkPos = IO_stringPos(line) - homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) - micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) - do i = 1_pInt,mesh_Nmaterials ! look thru material names + homog = nint(IO_floatValue(line,chunkPos,1),pInt) + micro = nint(IO_floatValue(line,chunkPos,2),pInt) + do i = 1,mesh_Nmaterials ! look thru material names if (materialName == mesh_nameMaterial(i)) then ! found one elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + do k = 1,mesh_NelemSets ! look thru all elemSet definitions if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) + do j = 1,mesh_mapElemSet(1,k) e = mesh_FEasCP('elem',mesh_mapElemSet(1+j,k)) mesh_element(3,e) = homog ! store homogenization mesh_element(4,e) = micro ! store microstructure @@ -1262,12 +1261,12 @@ use IO, only: & IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - integer(pInt) :: chunk, Nchunks + integer :: chunk, Nchunks character(len=300) :: v logical, dimension(3) :: periodic_surface @@ -1279,10 +1278,10 @@ use IO, only: & read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '**damask' .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + if (IO_lc(IO_stringValue(line,chunkPos,1)) == '**damask' .and. Nchunks > 1) then ! found keyword for damask option and there is at least one more chunk to read + select case(IO_lc(IO_stringValue(line,chunkPos,2))) case('periodic') ! damask Option that allows to specify periodic fluxes - do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) + do chunk = 3,Nchunks ! loop through chunks (skipping the keyword) v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' @@ -1305,49 +1304,49 @@ end subroutine mesh_get_damaskOptions subroutine mesh_build_cellconnectivity implicit none - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & matchingNode2cellnode - integer(pInt), dimension(:,:), allocatable :: & + integer, dimension(:,:), allocatable :: & cellnodeParent - integer(pInt), dimension(mesh_maxNcellnodes) :: & + integer, dimension(mesh_maxNcellnodes) :: & localCellnode2globalCellnode - integer(pInt) :: & + integer :: & e,t,g,c,n,i, & matchingNodeID, & localCellnodeID - allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) - allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) + allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0) + allocate(matchingNode2cellnode(mesh_Nnodes), source=0) + allocate(cellnodeParent(2,mesh_maxNcellnodes*mesh_NcpElems), source=0) !-------------------------------------------------------------------------------------------------- ! Count cell nodes (including duplicates) and generate cell connectivity list - mesh_Ncellnodes = 0_pInt - mesh_Ncells = 0_pInt - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + mesh_Ncellnodes = 0 + mesh_Ncells = 0 + do e = 1,mesh_NcpElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type - localCellnode2globalCellnode = 0_pInt + localCellnode2globalCellnode = 0 mesh_Ncells = mesh_Ncells + FE_Nips(g) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do i = 1,FE_Nips(g) ! loop over ips=cells in this element + do n = 1,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell localCellnodeID = FE_cell(n,i,g) if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node - matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) - if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNodeID = mesh_element(4+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1 ! ... count it as cell node ... matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + cellnodeParent(1,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2,mesh_Ncellnodes) = localCellnodeID endif mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) else ! this cell node is no matching node - if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + if (localCellnode2globalCellnode(localCellnodeID) == 0) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1 ! ... count it as cell node ... localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + cellnodeParent(1,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2,mesh_Ncellnodes) = localCellnodeID endif mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) endif @@ -1355,9 +1354,9 @@ subroutine mesh_build_cellconnectivity enddo enddo - allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) - allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) - forall(n = 1_pInt:mesh_Ncellnodes) + allocate(mesh_cellnodeParent(2,mesh_Ncellnodes)) + allocate(mesh_cellnode(3,mesh_Ncellnodes)) + forall(n = 1:mesh_Ncellnodes) mesh_cellnodeParent(1,n) = cellnodeParent(1,n) mesh_cellnodeParent(2,n) = cellnodeParent(2,n) endforall @@ -1373,11 +1372,11 @@ end subroutine mesh_build_cellconnectivity function mesh_build_cellnodes(nodes,Ncellnodes) implicit none - integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + integer, intent(in) :: Ncellnodes !< requested number of cellnodes real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes - integer(pInt) :: & + integer :: & e,t,n,m, & localCellnodeID real(pReal), dimension(3) :: & @@ -1385,13 +1384,13 @@ function mesh_build_cellnodes(nodes,Ncellnodes) mesh_build_cellnodes = 0.0_pReal !$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) - do n = 1_pInt,Ncellnodes ! loop over cell nodes + do n = 1,Ncellnodes ! loop over cell nodes e = mesh_cellnodeParent(1,n) localCellnodeID = mesh_cellnodeParent(2,n) t = mesh_element(2,e) ! get element type myCoords = 0.0_pReal - do m = 1_pInt,FE_Nnodes(t) - myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + do m = 1,FE_Nnodes(t) + myCoords = myCoords + nodes(1:3,mesh_element(4+m,e)) & * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) enddo mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) @@ -1416,26 +1415,26 @@ subroutine mesh_build_ipVolumes math_areaTriangle implicit none - integer(pInt) :: e,t,g,c,i,m,f,n + integer :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,mesh_NcpElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type select case (c) - case (1_pInt) ! 2D 3node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + case (1) ! 2D 3node + forall (i = 1:FE_Nips(g)) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) - case (2_pInt) ! 2D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + case (2) ! 2D 4node + forall (i = 1:FE_Nips(g)) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) & @@ -1443,18 +1442,18 @@ subroutine mesh_build_ipVolumes mesh_cellnode(1:3,mesh_cell(4,i,e)), & mesh_cellnode(1:3,mesh_cell(1,i,e))) - case (3_pInt) ! 3D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + case (3) ! 3D 4node + forall (i = 1:FE_Nips(g)) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e)), & mesh_cellnode(1:3,mesh_cell(4,i,e))) - case (4_pInt) ! 3D 8node + case (4) ! 3D 8node m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1,FE_Nips(g) ! loop over ips=cells in this element subvolume = 0.0_pReal - forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + forall(f = 1:FE_NipNeighbors(c), n = 1:FE_NcellnodesPerCellface(c)) & subvolume(n,f) = math_volTetrahedron(& mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & @@ -1485,20 +1484,20 @@ end subroutine mesh_build_ipVolumes subroutine mesh_build_ipCoordinates implicit none - integer(pInt) :: e,t,g,c,i,n + integer :: e,t,g,c,i,n real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,mesh_NcpElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1,FE_Nips(g) ! loop over ips=cells in this element myCoords = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do n = 1,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e)) enddo mesh_ipCoordinates(1:3,i,e) = myCoords / real(FE_NcellnodesPerCell(c),pReal) @@ -1515,16 +1514,16 @@ end subroutine mesh_build_ipCoordinates pure function mesh_cellCenterCoordinates(ip,el) implicit none - integer(pInt), intent(in) :: el, & !< element number + integer, intent(in) :: el, & !< element number ip !< integration point number real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell - integer(pInt) :: t,g,c,n + integer :: t,g,c,n - t = mesh_element(2_pInt,el) ! get element type + t = mesh_element(2,el) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type mesh_cellCenterCoordinates = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do n = 1,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) enddo mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) @@ -1544,24 +1543,24 @@ subroutine mesh_build_ipAreas math_cross implicit none - integer(pInt) :: e,t,g,c,i,f,n,m + integer :: e,t,g,c,i,f,n,m real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,mesh_NcpElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type select case (c) - case (1_pInt,2_pInt) ! 2D 3 or 4 node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + case (1,2) ! 2D 3 or 4 node + do i = 1,FE_Nips(g) ! loop over ips=cells in this element + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) normal(1) = nodePos(2,2) - nodePos(2,1) ! x_normal = y_connectingVector normal(2) = -(nodePos(1,2) - nodePos(1,1)) ! y_normal = -x_connectingVector @@ -1571,10 +1570,10 @@ subroutine mesh_build_ipAreas enddo enddo - case (3_pInt) ! 3D 4node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + case (3) ! 3D 4node + do i = 1,FE_Nips(g) ! loop over ips=cells in this element + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) normal = math_cross(nodePos(1:3,2) - nodePos(1:3,1), & nodePos(1:3,3) - nodePos(1:3,1)) @@ -1583,17 +1582,17 @@ subroutine mesh_build_ipAreas enddo enddo - case (4_pInt) ! 3D 8node + case (4) ! 3D 8node ! for this cell type we get the normal of the quadrilateral face as an average of ! four normals of triangular subfaces; since the face consists only of two triangles, ! the sum has to be divided by two; this whole prcedure tries to compensate for ! probable non-planar cell surfaces m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + do i = 1,FE_Nips(g) ! loop over ips=cells in this element + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + forall(n = 1:FE_NcellnodesPerCellface(c)) & normals(1:3,n) = 0.5_pReal & * math_cross(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) @@ -1616,41 +1615,41 @@ end subroutine mesh_build_ipAreas subroutine mesh_build_nodeTwins implicit none - integer(pInt) dir, & ! direction of periodicity + integer dir, & ! direction of periodicity node, & minimumNode, & maximumNode, & n1, & n2 - integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes + integer, dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension tolerance ! tolerance below which positions are assumed identical real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates logical, dimension(mesh_Nnodes) :: unpaired allocate(mesh_nodeTwins(3,mesh_Nnodes)) - mesh_nodeTwins = 0_pInt + mesh_nodeTwins = 0 tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal - do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z + do dir = 1,3 ! check periodicity in directions of x,y,z if (mesh_periodicSurface(dir)) then ! only if periodicity is requested !*** find out which nodes sit on the surface !*** and have a minimum or maximum position in this dimension - minimumNodes = 0_pInt - maximumNodes = 0_pInt + minimumNodes = 0 + maximumNodes = 0 minCoord = minval(mesh_node0(dir,:)) maxCoord = maxval(mesh_node0(dir,:)) - do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes + do node = 1,mesh_Nnodes ! loop through all nodes and find surface nodes if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then - minimumNodes(1) = minimumNodes(1) + 1_pInt - minimumNodes(minimumNodes(1)+1_pInt) = node + minimumNodes(1) = minimumNodes(1) + 1 + minimumNodes(minimumNodes(1)+1) = node elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then - maximumNodes(1) = maximumNodes(1) + 1_pInt - maximumNodes(maximumNodes(1)+1_pInt) = node + maximumNodes(1) = maximumNodes(1) + 1 + maximumNodes(maximumNodes(1)+1) = node endif enddo @@ -1658,11 +1657,11 @@ subroutine mesh_build_nodeTwins !*** find the corresponding node on the other side with the same position in this dimension unpaired = .true. - do n1 = 1_pInt,minimumNodes(1) - minimumNode = minimumNodes(n1+1_pInt) + do n1 = 1,minimumNodes(1) + minimumNode = minimumNodes(n1+1) if (unpaired(minimumNode)) then - do n2 = 1_pInt,maximumNodes(1) - maximumNode = maximumNodes(n2+1_pInt) + do n2 = 1,maximumNodes(1) + maximumNode = maximumNodes(n2+1) distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode)) if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance) mesh_nodeTwins(dir,minimumNode) = maximumNode @@ -1693,24 +1692,24 @@ subroutine mesh_build_sharedElems n, & ! node index per element myDim, & ! dimension index nodeTwin ! node twin in the specified dimension - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt), dimension(:), allocatable :: node_seen + integer, dimension (mesh_Nnodes) :: node_count + integer, dimension(:), allocatable :: node_seen allocate(node_seen(maxval(FE_NmatchingNodes))) - node_count = 0_pInt + node_count = 0 - do e = 1_pInt,mesh_NcpElems + do e = 1,mesh_NcpElems g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType - node_seen = 0_pInt ! reset node duplicates - do n = 1_pInt,FE_NmatchingNodes(g) ! check each node of element + node_seen = 0 ! reset node duplicates + do n = 1,FE_NmatchingNodes(g) ! check each node of element node = mesh_element(4+n,e) if (all(node_seen /= node)) then - node_count(node) = node_count(node) + 1_pInt ! if FE node not yet encountered -> count it - do myDim = 1_pInt,3_pInt ! check in each dimension... + node_count(node) = node_count(node) + 1 ! if FE node not yet encountered -> count it + do myDim = 1,3 ! check in each dimension... nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) & ! if I am a twin of some node... - node_count(nodeTwin) = node_count(nodeTwin) + 1_pInt ! -> count me again for the twin node + if (nodeTwin > 0) & ! if I am a twin of some node... + node_count(nodeTwin) = node_count(nodeTwin) + 1 ! -> count me again for the twin node enddo endif node_seen(n) = node ! remember this node to be counted already @@ -1719,20 +1718,20 @@ subroutine mesh_build_sharedElems mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node - allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0) - do e = 1_pInt,mesh_NcpElems + do e = 1,mesh_NcpElems g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType - node_seen = 0_pInt - do n = 1_pInt,FE_NmatchingNodes(g) - node = mesh_element(4_pInt+n,e) + node_seen = 0 + do n = 1,FE_NmatchingNodes(g) + node = mesh_element(4+n,e) if (all(node_seen /= node)) then - mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1_pInt ! count for each node the connected elements - mesh_sharedElem(mesh_sharedElem(1,node)+1_pInt,node) = e ! store the respective element id - do myDim = 1_pInt,3_pInt ! check in each dimension... + mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1 ! count for each node the connected elements + mesh_sharedElem(mesh_sharedElem(1,node)+1,node) = e ! store the respective element id + do myDim = 1,3 ! check in each dimension... nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) then ! if i am a twin of some node... - mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1_pInt ! ...count me again for the twin + if (nodeTwin > 0) then ! if i am a twin of some node... + mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1 ! ...count me again for the twin mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id endif enddo @@ -1752,7 +1751,7 @@ subroutine mesh_build_ipNeighborhood math_mul3x3 implicit none - integer(pInt) :: myElem, & ! my CP element index + integer :: myElem, & ! my CP element index myIP, & myType, & ! my element type myFace, & @@ -1770,26 +1769,26 @@ subroutine mesh_build_ipNeighborhood neighboringIP, & neighboringElem, & pointingToMe - integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & - linkedNodes = 0_pInt, & + integer, dimension(FE_maxmaxNnodesAtIP) :: & + linkedNodes = 0, & matchingNodes logical checkTwins allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) - mesh_ipNeighborhood = 0_pInt + mesh_ipNeighborhood = 0 - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + do myElem = 1,mesh_NcpElems ! loop over cpElems myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + do myIP = 1,FE_Nips(myType) ! loop over IPs of elem - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + do neighbor = 1,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) !*** if the key is positive, the neighbor is inside the element !*** that means, we have already found our neighboring IP - if (neighboringIPkey > 0_pInt) then + if (neighboringIPkey > 0) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey @@ -1797,33 +1796,33 @@ subroutine mesh_build_ipNeighborhood !*** if the key is negative, the neighbor resides in a neighboring element !*** that means, we have to look through the face indicated by the key and see which element is behind that face - elseif (neighboringIPkey < 0_pInt) then ! neighboring element's IP + elseif (neighboringIPkey < 0) then ! neighboring element's IP myFace = -neighboringIPkey call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match - if (matchingElem > 0_pInt) then ! found match? + if (matchingElem > 0) then ! found match? neighboringType = FE_geomtype(mesh_element(2,matchingElem)) !*** trivial solution if neighbor has only one IP - if (FE_Nips(neighboringType) == 1_pInt) then + if (FE_Nips(neighboringType) == 1) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1 cycle endif !*** find those nodes which build the link to the neighbor - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face + NlinkedNodes = 0 + linkedNodes = 0 + do a = 1,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face anchor = FE_nodesAtIP(a,myIP,myType) - if (anchor /= 0_pInt) then ! valid anchor node + if (anchor /= 0) then ! valid anchor node if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? - NlinkedNodes = NlinkedNodes + 1_pInt - linkedNodes(NlinkedNodes) = mesh_element(4_pInt+anchor,myElem) ! CP id of anchor node + NlinkedNodes = NlinkedNodes + 1 + linkedNodes(NlinkedNodes) = mesh_element(4+anchor,myElem) ! CP id of anchor node else ! something went wrong with the linkage, since not all anchors sit on my face - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt + NlinkedNodes = 0 + linkedNodes = 0 exit endif endif @@ -1833,18 +1832,18 @@ subroutine mesh_build_ipNeighborhood !*** and try to find an ip with matching nodes !*** also try to match with node twins - checkCandidateIP: do candidateIP = 1_pInt,FE_Nips(neighboringType) - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip + checkCandidateIP: do candidateIP = 1,FE_Nips(neighboringType) + NmatchingNodes = 0 + matchingNodes = 0 + do a = 1,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip anchor = FE_nodesAtIP(a,candidateIP,neighboringType) - if (anchor /= 0_pInt) then ! valid anchor node + if (anchor /= 0) then ! valid anchor node if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? - NmatchingNodes = NmatchingNodes + 1_pInt + NmatchingNodes = NmatchingNodes + 1 matchingNodes(NmatchingNodes) = mesh_element(4+anchor,matchingElem) ! CP id of neighbor's anchor node else ! no matching, because not all nodes sit on the matching face - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt + NmatchingNodes = 0 + matchingNodes = 0 exit endif endif @@ -1856,7 +1855,7 @@ subroutine mesh_build_ipNeighborhood !*** check "normal" nodes whether they match or not checkTwins = .false. - do a = 1_pInt,NlinkedNodes + do a = 1,NlinkedNodes if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode checkTwins = .true. exit ! no need to search further @@ -1867,9 +1866,9 @@ subroutine mesh_build_ipNeighborhood if(checkTwins) then dir = int(maxloc(abs(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem)),1),pInt) ! check for twins only in direction of the surface normal - do a = 1_pInt,NlinkedNodes + do a = 1,NlinkedNodes twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) - if (twin_of_linkedNode == 0_pInt .or. & ! twin of linkedNode does not exist... + if (twin_of_linkedNode == 0 .or. & ! twin of linkedNode does not exist... all(matchingNodes /= twin_of_linkedNode)) then ! ... or it does not match any matchingNode cycle checkCandidateIP ! ... then check next candidateIP endif @@ -1887,15 +1886,15 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + do myElem = 1,mesh_NcpElems ! loop over cpElems myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + do myIP = 1,FE_Nips(myType) ! loop over IPs of elem + do neighbor = 1,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP neighboringElem = mesh_ipNeighborhood(1,neighbor,myIP,myElem) neighboringIP = mesh_ipNeighborhood(2,neighbor,myIP,myElem) - if (neighboringElem > 0_pInt .and. neighboringIP > 0_pInt) then ! if neighbor exists ... + if (neighboringElem > 0 .and. neighboringIP > 0) then ! if neighbor exists ... neighboringType = FE_geomtype(mesh_element(2,neighboringElem)) - do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! find neighboring index that points from my neighbor to myself + do pointingToMe = 1,FE_NipNeighbors(FE_celltype(neighboringType)) ! find neighboring index that points from my neighbor to myself if ( myElem == mesh_ipNeighborhood(1,pointingToMe,neighboringIP,neighboringElem) & .and. myIP == mesh_ipNeighborhood(2,pointingToMe,neighboringIP,neighboringElem)) then ! possible candidate if (math_mul3x3(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem),& @@ -1917,34 +1916,34 @@ subroutine mesh_build_ipNeighborhood subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) implicit none -integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID +integer, intent(out) :: matchingElem, & ! matching CP element ID matchingFace ! matching face ID -integer(pInt), intent(in) :: face, & ! face ID +integer, intent(in) :: face, & ! face ID elem ! CP elem ID -integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & +integer, dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & myFaceNodes ! global node ids on my face -integer(pInt) :: myType, & +integer :: myType, & candidateType, & candidateElem, & candidateFace, & candidateFaceNode, & minNsharedElems, & NsharedElems, & - lonelyNode = 0_pInt, & + lonelyNode = 0, & i, & n, & dir ! periodicity direction -integer(pInt), dimension(:), allocatable :: element_seen +integer, dimension(:), allocatable :: element_seen logical checkTwins -matchingElem = 0_pInt -matchingFace = 0_pInt -minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case -myType = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType +matchingElem = 0 +matchingFace = 0 +minNsharedElems = mesh_maxNsharedElems + 1 ! init to worst case +myType = FE_geomtype(mesh_element(2,elem)) ! figure elemGeomType -do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face - myFaceNodes(n) = mesh_element(4_pInt+FE_face(n,face,myType),elem) ! CP id of face node - NsharedElems = mesh_sharedElem(1_pInt,myFaceNodes(n)) ! figure # shared elements for this node +do n = 1,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face + myFaceNodes(n) = mesh_element(4+FE_face(n,face,myType),elem) ! CP id of face node + NsharedElems = mesh_sharedElem(1,myFaceNodes(n)) ! figure # shared elements for this node if (NsharedElems < minNsharedElems) then minNsharedElems = NsharedElems ! remember min # shared elems lonelyNode = n ! remember most lonely node @@ -1952,33 +1951,33 @@ do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) enddo allocate(element_seen(minNsharedElems)) -element_seen = 0_pInt +element_seen = 0 -checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements - candidateElem = mesh_sharedElem(1_pInt+i,myFaceNodes(lonelyNode)) ! present candidate elem +checkCandidate: do i = 1,minNsharedElems ! iterate over lonelyNode's shared elements + candidateElem = mesh_sharedElem(1+i,myFaceNodes(lonelyNode)) ! present candidate elem if (all(element_seen /= candidateElem)) then ! element seen for the first time? element_seen(i) = candidateElem - candidateType = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate -checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate + candidateType = FE_geomtype(mesh_element(2,candidateElem)) ! figure elemGeomType of candidate +checkCandidateFace: do candidateFace = 1,FE_maxNipNeighbors ! check each face of candidate if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face .or. (candidateElem == elem .and. candidateFace == face)) then ! this is my face cycle checkCandidateFace endif checkTwins = .false. - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face - candidateFaceNode = mesh_element(4_pInt+FE_face(n,candidateFace,candidateType),candidateElem) + do n = 1,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) if (all(myFaceNodes /= candidateFaceNode)) then ! candidate node does not match any of my face nodes checkTwins = .true. ! perhaps the twin nodes do match exit endif enddo if(checkTwins) then -checkCandidateFaceTwins: do dir = 1_pInt,3_pInt - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face +checkCandidateFaceTwins: do dir = 1,3 + do n = 1,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) if (all(myFaceNodes /= mesh_nodeTwins(dir,candidateFaceNode))) then ! node twin does not match either - if (dir == 3_pInt) then + if (dir == 3) then cycle checkCandidateFace else cycle checkCandidateFaceTwins ! try twins in next dimension @@ -2003,7 +2002,7 @@ end subroutine mesh_build_ipNeighborhood !-------------------------------------------------------------------------------------------------- !> @brief mapping of FE element types to internal representation !-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) +integer function FE_mapElemtype(what) use IO, only: IO_lc, IO_error implicit none @@ -2012,30 +2011,30 @@ integer(pInt) function FE_mapElemtype(what) select case (IO_lc(what)) case ( 'cpe4', & 'cpe4t') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + FE_mapElemtype = 3 ! Arbitrary Quadrilateral Plane-strain case ( 'cpe8', & 'cpe8t') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + FE_mapElemtype = 4 ! Plane Strain, Eight-node Distorted Quadrilateral case ( 'c3d4', & 'c3d4t') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + FE_mapElemtype = 6 ! Three-dimensional Four-node Tetrahedron case ( 'c3d6', & 'c3d6t') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + FE_mapElemtype = 9 ! Three-dimensional Arbitrarily Distorted Pentahedral case ( 'c3d8r', & 'c3d8rt') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + FE_mapElemtype = 10 ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration case ( 'c3d8', & 'c3d8t') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + FE_mapElemtype = 11 ! Three-dimensional Arbitrarily Distorted Brick case ( 'c3d20r', & 'c3d20rt') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + FE_mapElemtype = 12 ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration case ( 'c3d20', & 'c3d20t') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + FE_mapElemtype = 13 ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + call IO_error(error_ID=190,ext_msg=IO_lc(what)) end select end function FE_mapElemtype @@ -2051,25 +2050,25 @@ end function FE_mapElemtype subroutine mesh_build_FEdata implicit none - integer(pInt) :: me - allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + integer :: me + allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0) + allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0) + allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0) allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) - allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0) !*** fill FE_nodesAtIP with data *** - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) reshape(int([& 1,2,3 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) reshape(int([& 1, & @@ -2077,7 +2076,7 @@ subroutine mesh_build_FEdata 3 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) reshape(int([& 1, & @@ -2086,7 +2085,7 @@ subroutine mesh_build_FEdata 3 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) reshape(int([& 1,0, & @@ -2100,13 +2099,13 @@ subroutine mesh_build_FEdata 3,0 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) reshape(int([& 1,2,3,4 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) reshape(int([& 1, & @@ -2115,7 +2114,7 @@ subroutine mesh_build_FEdata 4 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) reshape(int([& 1, & @@ -2126,13 +2125,13 @@ subroutine mesh_build_FEdata 6 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) reshape(int([& 1,2,3,4,5,6,7,8 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) reshape(int([& 1, & @@ -2145,7 +2144,7 @@ subroutine mesh_build_FEdata 7 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) reshape(int([& 1,0, 0,0, & @@ -2183,15 +2182,15 @@ subroutine mesh_build_FEdata ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. ! Positive integers denote an intra-FE IP identifier. ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) reshape(int([& -2,-3,-1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) reshape(int([& 2,-3, 3,-1, & @@ -2199,7 +2198,7 @@ subroutine mesh_build_FEdata 2,-3,-2, 1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) reshape(int([& 2,-4, 3,-1, & @@ -2208,7 +2207,7 @@ subroutine mesh_build_FEdata -2, 3,-3, 2 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) reshape(int([& 2,-4, 4,-1, & @@ -2222,13 +2221,13 @@ subroutine mesh_build_FEdata -2, 8,-3, 6 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) reshape(int([& -1,-2,-3,-4 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) reshape(int([& 2,-4, 3,-2, 4,-1, & @@ -2237,7 +2236,7 @@ subroutine mesh_build_FEdata 2,-4, 3,-2,-3, 1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) reshape(int([& 2,-4, 3,-2, 4,-1, & @@ -2248,13 +2247,13 @@ subroutine mesh_build_FEdata 5,-4,-3, 4,-5, 3 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) reshape(int([& -3,-5,-4,-2,-6,-1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) reshape(int([& 2,-5, 3,-2, 5,-1, & @@ -2267,7 +2266,7 @@ subroutine mesh_build_FEdata -3, 7,-4, 6,-6, 4 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) reshape(int([& 2,-5, 4,-2,10,-1, & @@ -2301,15 +2300,15 @@ subroutine mesh_build_FEdata ! *** FE_cell *** - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) reshape(int([& 1,2,3 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) reshape(int([& 1, 4, 7, 6, & @@ -2317,7 +2316,7 @@ subroutine mesh_build_FEdata 3, 6, 7, 5 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) reshape(int([& 1, 5, 9, 8, & @@ -2326,7 +2325,7 @@ subroutine mesh_build_FEdata 9, 6, 3, 7 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) reshape(int([& 1, 5,13,12, & @@ -2340,13 +2339,13 @@ subroutine mesh_build_FEdata 15, 8, 3, 9 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) reshape(int([& 1, 2, 3, 4 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) reshape(int([& 1, 5,11, 7, 8,12,15,14, & @@ -2355,7 +2354,7 @@ subroutine mesh_build_FEdata 8,12,15, 4, 4, 9,13,10 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) reshape(int([& 1, 7,16, 9,10,17,21,19, & @@ -2366,13 +2365,13 @@ subroutine mesh_build_FEdata 19,21,18,12,15,20,14, 6 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) reshape(int([& 1, 2, 3, 4, 5, 6, 7, 8 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) reshape(int([& 1, 9,21,12,13,22,27,25, & @@ -2385,7 +2384,7 @@ subroutine mesh_build_FEdata 27,23,15,24,26,18, 7,19 & ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - me = me + 1_pInt + me = me + 1 FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) reshape(int([& 1, 9,33,16,17,37,57,44, & @@ -2424,9 +2423,9 @@ subroutine mesh_build_FEdata ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, ! e.g., an 8 node element, would be encoded: ! 1, 1, 0, 0, 1, 1, 0, 0 - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) reshape(real([& 1, 0, 0, & @@ -2434,7 +2433,7 @@ subroutine mesh_build_FEdata 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) reshape(real([& 1, 0, 0, 0, 0, 0, & @@ -2446,7 +2445,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 2, 2, 2 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) reshape(real([& 1, 0, 0, 0, & @@ -2460,7 +2459,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, & @@ -2481,7 +2480,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 4, 2, 2, 8, 8 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, & @@ -2495,7 +2494,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 1, 2, 2, 2, 2 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) reshape(real([& 1, 0, 0, 0, & @@ -2504,7 +2503,7 @@ subroutine mesh_build_FEdata 0, 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) reshape(real([& 1, 0, 0, 0, 0, & @@ -2524,7 +2523,7 @@ subroutine mesh_build_FEdata 0, 0, 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & @@ -2544,7 +2543,7 @@ subroutine mesh_build_FEdata 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) reshape(real([& 1, 0, 0, 0, 0, 0, & @@ -2570,7 +2569,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 1, 1, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, & @@ -2583,7 +2582,7 @@ subroutine mesh_build_FEdata 0, 0, 0, 0, 0, 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, & ! @@ -2615,7 +2614,7 @@ subroutine mesh_build_FEdata 1, 1, 1, 1, 1, 1, 1, 1 & ! ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! @@ -2647,7 +2646,7 @@ subroutine mesh_build_FEdata 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - me = me + 1_pInt + me = me + 1 FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! @@ -2719,9 +2718,9 @@ subroutine mesh_build_FEdata ! *** FE_cellface *** - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) reshape(int([& 2,3, & @@ -2729,7 +2728,7 @@ subroutine mesh_build_FEdata 1,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) reshape(int([& 2,3, & @@ -2738,7 +2737,7 @@ subroutine mesh_build_FEdata 1,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) reshape(int([& 1,3,2, & @@ -2747,7 +2746,7 @@ subroutine mesh_build_FEdata 1,4,3 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) reshape(int([& 2,3,7,6, & @@ -2766,18 +2765,18 @@ end subroutine mesh_build_FEdata !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) +integer function mesh_FEasCP(what,myID) use IO, only: & IO_lc implicit none character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID + integer, intent(in) :: myID - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center + integer, dimension(:,:), pointer :: lookupMap + integer :: lower,upper,center - mesh_FEasCP = 0_pInt + mesh_FEasCP = 0 select case(IO_lc(what(1:4))) case('elem') lookupMap => mesh_mapFEtoCPelem @@ -2787,24 +2786,24 @@ integer(pInt) function mesh_FEasCP(what,myID) return endselect - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) + lower = 1 + upper = int(size(lookupMap,2),pInt) - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) + if (lookupMap(1,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2,lower) return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) + elseif (lookupMap(1,upper) == myID) then + mesh_FEasCP = lookupMap(2,upper) return endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then + binarySearch: do while (upper-lower > 1) + center = (lower+upper)/2 + if (lookupMap(1,center) < myID) then lower = center - elseif (lookupMap(1_pInt,center) > myID) then + elseif (lookupMap(1,center) > myID) then upper = center else - mesh_FEasCP = lookupMap(2_pInt,center) + mesh_FEasCP = lookupMap(2,center) exit endif enddo binarySearch diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 79718c37f..7338c88f3 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -11,19 +11,19 @@ module mesh implicit none private - integer(pInt), public, protected :: & + integer, public, protected :: & mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh mesh_maxNsharedElems !< max number of CP elements sharing a node - integer(pInt), dimension(:,:), allocatable, public, protected :: & + integer, dimension(:,:), allocatable, public, protected :: & mesh_element, & !DEPRECATED mesh_sharedElem, & !< entryCount and list of elements containing node mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) - integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + integer, dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] real(pReal), public, protected :: & @@ -49,34 +49,34 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) -integer(pInt), dimension(:,:), allocatable, private :: & +integer, dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID - integer(pInt),dimension(:,:,:), allocatable, private :: & + integer,dimension(:,:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell - integer(pInt), dimension(:,:,:), allocatable, private :: & + integer, dimension(:,:,:), allocatable, private :: & FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" - integer(pInt), parameter, public :: & - FE_Nelemtypes = 13_pInt, & - FE_Ngeomtypes = 10_pInt, & - FE_Ncelltypes = 4_pInt, & - FE_maxNipNeighbors = 6_pInt, & - FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP - FE_maxNmatchingNodesPerFace = 4_pInt, & - FE_maxNfaces = 6_pInt, & - FE_maxNcellnodes = 64_pInt, & - FE_maxNcellnodesPerCell = 8_pInt, & - FE_maxNcellfaces = 6_pInt, & - FE_maxNcellnodesPerCellface = 4_pInt + integer, parameter, public :: & + FE_Nelemtypes = 13, & + FE_Ngeomtypes = 10, & + FE_Ncelltypes = 4, & + FE_maxNipNeighbors = 6, & + FE_maxmaxNnodesAtIP = 8, & !< max number of (equivalent) nodes attached to an IP + FE_maxNmatchingNodesPerFace = 4, & + FE_maxNfaces = 6, & + FE_maxNcellnodes = 64, & + FE_maxNcellnodesPerCell = 8, & + FE_maxNcellfaces = 6, & + FE_maxNcellnodesPerCellface = 4 - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Nfaces = & !< number of faces of a specific type of element geometry + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_Nfaces = & !< number of faces of a specific type of element geometry int([ & 3, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -90,7 +90,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 6 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry + integer, dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry int([ & 3, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -104,7 +104,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & + integer, dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry reshape(int([ & 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) @@ -119,7 +119,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4,4,4,4,4,4 & ! element 21 (3D 20node 27ip) ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) - integer(pInt), dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & + integer, dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & parameter, private :: FE_face = & !< List of node indices on each face of a specific type of element geometry reshape(int([& 1,2,0,0 , & ! element 6 (2D 3node 1ip) @@ -185,7 +185,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) - integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type int([& 2, & ! (2D 3node) 2, & ! (2D 4node) @@ -193,7 +193,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + integer, dimension(FE_Ncelltypes), parameter, private :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type int([& 3, & ! (2D 3node) 4, & ! (2D 4node) @@ -202,24 +202,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],pInt) - integer(pInt), private :: & + integer, private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_NelemSets character(len=64), dimension(:), allocatable, private :: & mesh_nameElemSet - integer(pInt), dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable, private :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(:,:), allocatable, target, private :: & + integer, dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] - integer(pInt), private :: & + integer, private :: & MarcVersion, & !< Version of input file format (Marc only) hypoelasticTableStyle, & !< Table style (Marc only) initialcondTableStyle !< Table style (Marc only) - integer(pInt), dimension(:), allocatable, private :: & + integer, dimension(:), allocatable, private :: & Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) public :: & @@ -268,7 +268,7 @@ subroutine tMesh_marc_init(self,elemType,nodes) implicit none class(tMesh_marc) :: self real(pReal), dimension(:,:), intent(in) :: nodes - integer(pInt), intent(in) :: elemType + integer, intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) @@ -300,11 +300,11 @@ subroutine mesh_init(ip,el) FEsolving_execIP implicit none - integer(pInt), intent(in) :: el, ip + integer, intent(in) :: el, ip - integer(pInt), parameter :: FILEUNIT = 222_pInt - integer(pInt) :: j, fileFormatVersion, elemType - integer(pInt) :: & + integer, parameter :: FILEUNIT = 222 + integer :: j, fileFormatVersion, elemType + integer :: & mesh_maxNelemInSet, & mesh_NcpElems logical :: myDebug @@ -313,7 +313,7 @@ subroutine mesh_init(ip,el) mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh - myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0) call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) @@ -337,18 +337,18 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) allocate(mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = 'n/a' - allocate(mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + allocate(mesh_mapElemSet(1+mesh_maxNelemInSet,mesh_NelemSets),source=0) call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) mesh_NcpElems = mesh_nElems if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0) call mesh_marc_map_elements(hypoelasticTableStyle,mesh_nameElemSet,mesh_mapElemSet,mesh_NcpElems,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + allocate (mesh_mapFEtoCPnode(2,mesh_Nnodes),source=0) call mesh_marc_map_nodes(mesh_Nnodes,FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) @@ -390,14 +390,14 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) if (usePingPong .and. (mesh_Nelems /= theMesh%nElems)) & - call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements + call IO_error(600) ! ping-pong must be disabled when having non-DAMASK elements if (debug_e < 1 .or. debug_e > theMesh%nElems) & - call IO_error(602_pInt,ext_msg='element') ! selected element does not exist + call IO_error(602,ext_msg='element') ! selected element does not exist if (debug_i < 1 .or. debug_i > theMesh%elem%nIPs) & - call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP + call IO_error(602,ext_msg='IP') ! selected element does not have requested IP - FEsolving_execElem = [ 1_pInt,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements - allocate(FEsolving_execIP(2_pInt,theMesh%nElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... + FEsolving_execElem = [ 1,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2,theMesh%nElems), source=1) ! parallel loop bounds set to comprise from first IP... FEsolving_execIP(2,:) = theMesh%elem%nIPs allocate(calcMode(theMesh%elem%nIPs,theMesh%nElems)) @@ -413,7 +413,7 @@ end subroutine mesh_init !-------------------------------------------------------------------------------------------------- !> @brief Figures out version of Marc input file format !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_marc_get_fileFormat(fileUnit) +integer function mesh_marc_get_fileFormat(fileUnit) use IO, only: & IO_lc, & IO_intValue, & @@ -421,9 +421,9 @@ integer(pInt) function mesh_marc_get_fileFormat(fileUnit) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line @@ -432,8 +432,8 @@ integer(pInt) function mesh_marc_get_fileFormat(fileUnit) read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - mesh_marc_get_fileFormat = IO_intValue(line,chunkPos,2_pInt) + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'version') then + mesh_marc_get_fileFormat = IO_intValue(line,chunkPos,2) exit endif enddo @@ -452,23 +452,23 @@ subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) IO_stringPos implicit none - integer(pInt), intent(out) :: initialcond, hypoelastic - integer(pInt), intent(in) :: fileUnit + integer, intent(out) :: initialcond, hypoelastic + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line - initialcond = 0_pInt - hypoelastic = 0_pInt + initialcond = 0 + hypoelastic = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcond = IO_intValue(line,chunkPos,4_pInt) - hypoelastic = IO_intValue(line,chunkPos,5_pInt) + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'table' .and. chunkPos(1) > 5) then + initialcond = IO_intValue(line,chunkPos,4) + hypoelastic = IO_intValue(line,chunkPos,5) exit endif enddo @@ -487,33 +487,33 @@ function mesh_marc_get_matNumber(fileUnit,tableStyle) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit, tableStyle - integer(pInt), dimension(:), allocatable :: mesh_marc_get_matNumber + integer, intent(in) :: fileUnit, tableStyle + integer, dimension(:), allocatable :: mesh_marc_get_matNumber - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, j, data_blocks + integer, allocatable, dimension(:) :: chunkPos + integer :: i, j, data_blocks character(len=300) line rewind(fileUnit) - data_blocks = 1_pInt + data_blocks = 1 do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'hypoelastic') then read (fileUnit,'(A300)',END=620) line - if (len(trim(line))/=0_pInt) then + if (len(trim(line))/=0) then chunkPos = IO_stringPos(line) - data_blocks = IO_intValue(line,chunkPos,1_pInt) + data_blocks = IO_intValue(line,chunkPos,1) endif - allocate(mesh_marc_get_matNumber(data_blocks), source = 0_pInt) - do i=1_pInt,data_blocks ! read all data blocks + allocate(mesh_marc_get_matNumber(data_blocks), source = 0) + do i=1,data_blocks ! read all data blocks read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - mesh_marc_get_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + tableStyle ! read 2 or 3 remaining lines of data block + mesh_marc_get_matNumber(i) = IO_intValue(line,chunkPos,1) + do j=1_pint,2 + tableStyle ! read 2 or 3 remaining lines of data block read (fileUnit,'(A300)') line enddo enddo @@ -535,26 +535,26 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) IO_IntValue implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), intent(out) :: nNodes, nElems + integer, intent(in) :: fileUnit + integer, intent(out) :: nNodes, nElems - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line - nNodes = 0_pInt - nElems = 0_pInt + nNodes = 0 + nElems = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - nElems = IO_IntValue (line,chunkPos,3_pInt) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then + if ( IO_lc(IO_StringValue(line,chunkPos,1)) == 'sizing') & + nElems = IO_IntValue (line,chunkPos,3) + if ( IO_lc(IO_StringValue(line,chunkPos,1)) == 'coordinates') then read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) - nNodes = IO_IntValue (line,chunkPos,2_pInt) + nNodes = IO_IntValue (line,chunkPos,2) exit ! assumes that "coordinates" comes later in file endif enddo @@ -573,23 +573,23 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) IO_countContinuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), intent(out) :: nElemSets, maxNelemInSet + integer, intent(in) :: fileUnit + integer, intent(out) :: nElemSets, maxNelemInSet - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line - nElemSets = 0_pInt - maxNelemInSet = 0_pInt + nElemSets = 0 + maxNelemInSet = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then - nElemSets = nElemSets + 1_pInt + if ( IO_lc(IO_StringValue(line,chunkPos,1)) == 'define' .and. & + IO_lc(IO_StringValue(line,chunkPos,2)) == 'element' ) then + nElemSets = nElemSets + 1 maxNelemInSet = max(maxNelemInSet, IO_countContinuousIntValues(fileUnit)) endif enddo @@ -608,26 +608,26 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit character(len=64), dimension(:), intent(out) :: & nameElemSet - integer(pInt), dimension(:,:), intent(out) :: & + integer, dimension(:,:), intent(out) :: & mapElemSet - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: elemSet + integer :: elemSet - elemSet = 0_pInt + elemSet = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=640) line chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then - elemSet = elemSet+1_pInt - nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + if( (IO_lc(IO_stringValue(line,chunkPos,1)) == 'define' ) .and. & + (IO_lc(IO_stringValue(line,chunkPos,2)) == 'element' ) ) then + elemSet = elemSet+1 + nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4)) mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,size(mapElemSet,1)-1,nameElemSet,mapElemSet,size(nameElemSet)) endif enddo @@ -648,27 +648,27 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileU IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,tableStyle,nElems + integer, intent(in) :: fileUnit,tableStyle,nElems character(len=64), intent(in), dimension(:) :: nameElemSet - integer(pInt), dimension(:,:), intent(in) :: & + integer, dimension(:,:), intent(in) :: & mapElemSet - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line, & tmp - integer(pInt), dimension (1_pInt+nElems) :: contInts - integer(pInt) :: i,cpElem + integer, dimension (1+nElems) :: contInts + integer :: i,cpElem - cpElem = 0_pInt - contInts = 0_pInt + cpElem = 0 + contInts = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) if (MarcVersion < 13) then ! Marc 2016 or earlier - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then - do i=1_pInt,3_pInt+TableStyle ! skip three (or four if new table style!) lines + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'hypoelastic' ) then + do i=1,3+TableStyle ! skip three (or four if new table style!) lines read (fileUnit,'(A300)') line enddo contInts = IO_continuousIntValues(fileUnit,nElems,nameElemSet,& @@ -676,18 +676,18 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileU exit endif else ! Marc2017 and later - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'connectivity') then read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) - if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6))) then do read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + tmp = IO_lc(IO_stringValue(line,chunkPos,1)) if (verify(trim(tmp),"0123456789")/=0) then ! found keyword exit else - contInts(1) = contInts(1) + 1_pInt + contInts(1) = contInts(1) + 1 read (tmp,*) contInts(contInts(1)+1) endif enddo @@ -695,13 +695,13 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileU endif endif enddo -660 do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) +660 do i = 1,contInts(1) + cpElem = cpElem+1 + mesh_mapFEtoCPelem(1,cpElem) = contInts(1+i) mesh_mapFEtoCPelem(2,cpElem) = cpElem enddo -call math_sort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems +call math_sort(mesh_mapFEtoCPelem,1,int(size(mesh_mapFEtoCPelem,2),pInt)) ! should be mesh_NcpElems end subroutine mesh_marc_map_elements @@ -718,32 +718,32 @@ subroutine mesh_marc_map_nodes(nNodes,fileUnit) IO_fixedIntValue implicit none - integer(pInt), intent(in) :: fileUnit, nNodes + integer, intent(in) :: fileUnit, nNodes - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension (nNodes) :: node_count - integer(pInt) :: i + integer, dimension (nNodes) :: node_count + integer :: i - node_count = 0_pInt + node_count = 0 rewind(fileUnit) do read (fileUnit,'(A300)',END=650) line chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'coordinates' ) then read (fileUnit,'(A300)') line ! skip crap line - do i = 1_pInt,nNodes + do i = 1,nNodes read (fileUnit,'(A300)') line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[0_pInt,10_pInt],1_pInt) - mesh_mapFEtoCPnode(2_pInt,i) = i + mesh_mapFEtoCPnode(1,i) = IO_fixedIntValue (line,[0,10],1) + mesh_mapFEtoCPnode(2,i) = i enddo exit endif enddo -650 call math_sort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) +650 call math_sort(mesh_mapFEtoCPnode,1,int(size(mesh_mapFEtoCPnode,2),pInt)) end subroutine mesh_marc_map_nodes @@ -761,12 +761,12 @@ subroutine mesh_marc_build_nodes(fileUnit) IO_fixedNoEFloatValue implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,j,m + integer :: i,j,m allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) @@ -774,13 +774,13 @@ subroutine mesh_marc_build_nodes(fileUnit) do read (fileUnit,'(A300)',END=670) line chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'coordinates' ) then read (fileUnit,'(A300)') line ! skip crap line - do i=1_pInt,mesh_Nnodes + do i=1,mesh_Nnodes read (fileUnit,'(A300)') line - m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) - do j = 1_pInt,3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) + m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1)) + do j = 1,3 + mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1) enddo enddo exit @@ -797,7 +797,7 @@ end subroutine mesh_marc_build_nodes !! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', !! and 'mesh_maxNcellnodes' !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_marc_count_cpSizes(fileUnit) +integer function mesh_marc_count_cpSizes(fileUnit) use IO, only: IO_lc, & IO_error, & @@ -808,32 +808,32 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) use element implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit type(tElement) :: tempEl - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,t,g,e,c + integer :: i,t,g,e,c - t = -1_pInt + t = -1 rewind(fileUnit) do read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'connectivity' ) then read (fileUnit,'(A300)') line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements + do i=1,mesh_Nelems ! read all elements read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) ! limit to id and type - if (t == -1_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + if (t == -1) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2)) call tempEl%init(t) mesh_marc_count_cpSizes = t else - if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message + if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2))) call IO_error(0) !ToDo: error message endif - call IO_skipChunks(fileUnit,tempEl%nNodes-(chunkPos(1_pInt)-2_pInt)) + call IO_skipChunks(fileUnit,tempEl%nNodes-(chunkPos(1)-2)) enddo exit endif @@ -858,45 +858,45 @@ subroutine mesh_marc_build_elements(fileUnit) IO_error implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension(1_pInt+theMesh%nElems) :: contInts - integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead + integer, dimension(1+theMesh%nElems) :: contInts + integer :: i,j,t,sv,myVal,e,nNodesAlreadyRead - allocate(mesh_element(4_pInt+theMesh%elem%nNodes,theMesh%nElems), source=0_pInt) - mesh_elemType = -1_pInt + allocate(mesh_element(4+theMesh%elem%nNodes,theMesh%nElems), source=0) + mesh_elemType = -1 rewind(fileUnit) do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + if( IO_lc(IO_stringValue(line,chunkPos,1)) == 'connectivity' ) then read (fileUnit,'(A300)',END=620) line ! garbage line - do i = 1_pInt,mesh_Nelems + do i = 1,mesh_Nelems read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1)) + if (e /= 0) then ! disregard non CP elems + mesh_element(1,e) = -1 ! DEPRECATED + t = FE_mapElemtype(IO_StringValue(line,chunkPos,2)) ! elem type + if (mesh_elemType /= t .and. mesh_elemType /= -1) & call IO_error(191,el=t,ip=mesh_elemType) mesh_elemType = t mesh_element(2,e) = t - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-2_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes + nNodesAlreadyRead = 0 + do j = 1,chunkPos(1)-2 + mesh_element(4+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2)) ! CP ids of nodes enddo - nNodesAlreadyRead = chunkPos(1) - 2_pInt + nNodesAlreadyRead = chunkPos(1) - 2 do while(nNodesAlreadyRead < theMesh%elem%nNodes) ! read on if not all nodes in one line read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + do j = 1,chunkPos(1) + mesh_element(4+nNodesAlreadyRead+j,e) & = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes enddo nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) @@ -911,28 +911,28 @@ subroutine mesh_marc_build_elements(fileUnit) read (fileUnit,'(A300)',END=630) line do chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then - if (initialcondTableStyle == 2_pInt) read (fileUnit,'(A300)',END=630) line ! read extra line for new style + if( (IO_lc(IO_stringValue(line,chunkPos,1)) == 'initial') .and. & + (IO_lc(IO_stringValue(line,chunkPos,2)) == 'state') ) then + if (initialcondTableStyle == 2) read (fileUnit,'(A300)',END=630) line ! read extra line for new style read (fileUnit,'(A300)',END=630) line ! read line with index of state var chunkPos = IO_stringPos(line) - sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index - if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest + sv = IO_IntValue(line,chunkPos,1) ! figure state variable index + if( (sv == 2).or.(sv == 3) ) then ! only state vars 2 and 3 of interest read (fileUnit,'(A300)',END=630) line ! read line with value of state var chunkPos = IO_stringPos(line) - do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? - myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value - if (initialcondTableStyle == 2_pInt) then + do while (scan(IO_stringValue(line,chunkPos,1),'+-',back=.true.)>1) ! is noEfloat value? + myVal = nint(IO_fixedNoEFloatValue(line,[0,20],1),pInt) ! state var's value + if (initialcondTableStyle == 2) then read (fileUnit,'(A300)',END=630) line ! read extra line read (fileUnit,'(A300)',END=630) line ! read extra line endif contInts = IO_continuousIntValues& ! get affected elements (fileUnit,theMesh%nElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - do i = 1_pInt,contInts(1) - e = mesh_FEasCP('elem',contInts(1_pInt+i)) - mesh_element(1_pInt+sv,e) = myVal + do i = 1,contInts(1) + e = mesh_FEasCP('elem',contInts(1+i)) + mesh_element(1+sv,e) = myVal enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=630) line ! ignore IP range for old table style + if (initialcondTableStyle == 0) read (fileUnit,'(A300)',END=630) line ! ignore IP range for old table style read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo @@ -956,12 +956,12 @@ use IO, only: & IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer, intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + integer, allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - integer(pInt) :: chunk, Nchunks + integer :: chunk, Nchunks character(len=300) :: v logical, dimension(3) :: periodic_surface @@ -973,10 +973,10 @@ use IO, only: & read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '$damask' .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + if (IO_lc(IO_stringValue(line,chunkPos,1)) == '$damask' .and. Nchunks > 1) then ! found keyword for damask option and there is at least one more chunk to read + select case(IO_lc(IO_stringValue(line,chunkPos,2))) case('periodic') ! damask Option that allows to specify periodic fluxes - do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) + do chunk = 3,Nchunks ! loop through chunks (skipping the keyword) v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' @@ -998,46 +998,46 @@ end subroutine mesh_get_damaskOptions subroutine mesh_build_cellconnectivity implicit none - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & matchingNode2cellnode - integer(pInt), dimension(:,:), allocatable :: & + integer, dimension(:,:), allocatable :: & cellnodeParent - integer(pInt), dimension(theMesh%elem%Ncellnodes) :: & + integer, dimension(theMesh%elem%Ncellnodes) :: & localCellnode2globalCellnode - integer(pInt) :: & + integer :: & e,n,i, & matchingNodeID, & localCellnodeID - allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,theMesh%nElems), source=0_pInt) - allocate(matchingNode2cellnode(theMesh%nNodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,theMesh%elem%Ncellnodes*theMesh%nElems), source=0_pInt) + allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,theMesh%nElems), source=0) + allocate(matchingNode2cellnode(theMesh%nNodes), source=0) + allocate(cellnodeParent(2,theMesh%elem%Ncellnodes*theMesh%nElems), source=0) mesh_Ncells = theMesh%nElems*theMesh%elem%nIPs !-------------------------------------------------------------------------------------------------- ! Count cell nodes (including duplicates) and generate cell connectivity list - mesh_Ncellnodes = 0_pInt + mesh_Ncellnodes = 0 - do e = 1_pInt,theMesh%nElems - localCellnode2globalCellnode = 0_pInt - do i = 1_pInt,theMesh%elem%nIPs - do n = 1_pInt,theMesh%elem%NcellnodesPerCell + do e = 1,theMesh%nElems + localCellnode2globalCellnode = 0 + do i = 1,theMesh%elem%nIPs + do n = 1,theMesh%elem%NcellnodesPerCell localCellnodeID = theMesh%elem%cell(n,i) if (localCellnodeID <= FE_NmatchingNodes(theMesh%elem%geomType)) then ! this cell node is a matching node - matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) - if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNodeID = mesh_element(4+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1 ! ... count it as cell node ... matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + cellnodeParent(1,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2,mesh_Ncellnodes) = localCellnodeID endif mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) else ! this cell node is no matching node - if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + if (localCellnode2globalCellnode(localCellnodeID) == 0) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1 ! ... count it as cell node ... localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + cellnodeParent(1,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2,mesh_Ncellnodes) = localCellnodeID endif mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) endif @@ -1045,10 +1045,10 @@ subroutine mesh_build_cellconnectivity enddo enddo - allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) - allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnodeParent(2,mesh_Ncellnodes)) + allocate(mesh_cellnode(3,mesh_Ncellnodes)) - forall(n = 1_pInt:mesh_Ncellnodes) + forall(n = 1:mesh_Ncellnodes) mesh_cellnodeParent(1,n) = cellnodeParent(1,n) mesh_cellnodeParent(2,n) = cellnodeParent(2,n) endforall @@ -1064,11 +1064,11 @@ end subroutine mesh_build_cellconnectivity function mesh_build_cellnodes(nodes,Ncellnodes) implicit none - integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + integer, intent(in) :: Ncellnodes !< requested number of cellnodes real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes - integer(pInt) :: & + integer :: & e,n,m, & localCellnodeID real(pReal), dimension(3) :: & @@ -1076,12 +1076,12 @@ function mesh_build_cellnodes(nodes,Ncellnodes) mesh_build_cellnodes = 0.0_pReal !$OMP PARALLEL DO PRIVATE(e,localCellnodeID,myCoords) - do n = 1_pInt,Ncellnodes ! loop over cell nodes + do n = 1,Ncellnodes ! loop over cell nodes e = mesh_cellnodeParent(1,n) localCellnodeID = mesh_cellnodeParent(2,n) myCoords = 0.0_pReal - do m = 1_pInt,theMesh%elem%nNodes - myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + do m = 1,theMesh%elem%nNodes + myCoords = myCoords + nodes(1:3,mesh_element(4+m,e)) & * theMesh%elem%cellNodeParentNodeWeights(m,localCellnodeID) enddo mesh_build_cellnodes(1:3,n) = myCoords / sum(theMesh%elem%cellNodeParentNodeWeights(:,localCellnodeID)) @@ -1106,26 +1106,26 @@ subroutine mesh_build_ipVolumes math_areaTriangle implicit none - integer(pInt) :: e,t,g,c,i,m,f,n + integer :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume allocate(mesh_ipVolume(theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) - do e = 1_pInt,theMesh%nElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,theMesh%nElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = theMesh%elem%geomType c = theMesh%elem%cellType select case (c) - case (1_pInt) ! 2D 3node - forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + case (1) ! 2D 3node + forall (i = 1:theMesh%elem%nIPs) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) - case (2_pInt) ! 2D 4node - forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + case (2) ! 2D 4node + forall (i = 1:theMesh%elem%nIPs) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) & @@ -1133,18 +1133,18 @@ subroutine mesh_build_ipVolumes mesh_cellnode(1:3,mesh_cell(4,i,e)), & mesh_cellnode(1:3,mesh_cell(1,i,e))) - case (3_pInt) ! 3D 4node - forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + case (3) ! 3D 4node + forall (i = 1:theMesh%elem%nIPs) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e)), & mesh_cellnode(1:3,mesh_cell(4,i,e))) - case (4_pInt) ! 3D 8node + case (4) ! 3D 8node m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + do i = 1,theMesh%elem%nIPs ! loop over ips=cells in this element subvolume = 0.0_pReal - forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + forall(f = 1:FE_NipNeighbors(c), n = 1:FE_NcellnodesPerCellface(c)) & subvolume(n,f) = math_volTetrahedron(& mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & @@ -1175,20 +1175,20 @@ end subroutine mesh_build_ipVolumes subroutine mesh_build_ipCoordinates implicit none - integer(pInt) :: e,t,g,c,i,n + integer :: e,t,g,c,i,n real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) - do e = 1_pInt,theMesh%nElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,theMesh%nElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = theMesh%elem%geomType c = theMesh%elem%cellType - do i = 1_pInt,theMesh%elem%nIPs + do i = 1,theMesh%elem%nIPs myCoords = 0.0_pReal - do n = 1_pInt,theMesh%elem%nCellnodesPerCell + do n = 1,theMesh%elem%nCellnodesPerCell myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e)) enddo mesh_ipCoordinates(1:3,i,e) = myCoords / real(theMesh%elem%nCellnodesPerCell,pReal) @@ -1205,16 +1205,16 @@ end subroutine mesh_build_ipCoordinates pure function mesh_cellCenterCoordinates(ip,el) implicit none - integer(pInt), intent(in) :: el, & !< element number + integer, intent(in) :: el, & !< element number ip !< integration point number real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell - integer(pInt) :: t,g,c,n + integer :: t,g,c,n - t = mesh_element(2_pInt,el) ! get element type + t = mesh_element(2,el) ! get element type g = theMesh%elem%geomType c = theMesh%elem%cellType mesh_cellCenterCoordinates = 0.0_pReal - do n = 1_pInt,theMesh%elem%nCellnodesPerCell + do n = 1,theMesh%elem%nCellnodesPerCell mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) enddo mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(theMesh%elem%nCellnodesPerCell,pReal) @@ -1233,24 +1233,24 @@ subroutine mesh_build_ipAreas math_cross implicit none - integer(pInt) :: e,t,g,c,i,f,n,m + integer :: e,t,g,c,i,f,n,m real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal allocate(mesh_ipArea(theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) - do e = 1_pInt,theMesh%nElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type + do e = 1,theMesh%nElems ! loop over cpElems + t = mesh_element(2,e) ! get element type g = theMesh%elem%geomType c = theMesh%elem%cellType select case (c) - case (1_pInt,2_pInt) ! 2D 3 or 4 node - do i = 1_pInt,theMesh%elem%nIPs - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + case (1,2) ! 2D 3 or 4 node + do i = 1,theMesh%elem%nIPs + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) normal(1) = nodePos(2,2) - nodePos(2,1) ! x_normal = y_connectingVector normal(2) = -(nodePos(1,2) - nodePos(1,1)) ! y_normal = -x_connectingVector @@ -1260,10 +1260,10 @@ subroutine mesh_build_ipAreas enddo enddo - case (3_pInt) ! 3D 4node - do i = 1_pInt,theMesh%elem%nIPs - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + case (3) ! 3D 4node + do i = 1,theMesh%elem%nIPs + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) normal = math_cross(nodePos(1:3,2) - nodePos(1:3,1), & nodePos(1:3,3) - nodePos(1:3,1)) @@ -1272,17 +1272,17 @@ subroutine mesh_build_ipAreas enddo enddo - case (4_pInt) ! 3D 8node + case (4) ! 3D 8node ! for this cell type we get the normal of the quadrilateral face as an average of ! four normals of triangular subfaces; since the face consists only of two triangles, ! the sum has to be divided by two; this whole prcedure tries to compensate for ! probable non-planar cell surfaces m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,theMesh%elem%nIPs - do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + do i = 1,theMesh%elem%nIPs + do f = 1,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) - forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + forall(n = 1:FE_NcellnodesPerCellface(c)) & normals(1:3,n) = 0.5_pReal & * math_cross(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) @@ -1305,41 +1305,41 @@ end subroutine mesh_build_ipAreas subroutine mesh_build_nodeTwins implicit none - integer(pInt) dir, & ! direction of periodicity + integer dir, & ! direction of periodicity node, & minimumNode, & maximumNode, & n1, & n2 - integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes + integer, dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension tolerance ! tolerance below which positions are assumed identical real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates logical, dimension(mesh_Nnodes) :: unpaired allocate(mesh_nodeTwins(3,mesh_Nnodes)) - mesh_nodeTwins = 0_pInt + mesh_nodeTwins = 0 tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal - do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z + do dir = 1,3 ! check periodicity in directions of x,y,z if (mesh_periodicSurface(dir)) then ! only if periodicity is requested !*** find out which nodes sit on the surface !*** and have a minimum or maximum position in this dimension - minimumNodes = 0_pInt - maximumNodes = 0_pInt + minimumNodes = 0 + maximumNodes = 0 minCoord = minval(mesh_node0(dir,:)) maxCoord = maxval(mesh_node0(dir,:)) - do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes + do node = 1,mesh_Nnodes ! loop through all nodes and find surface nodes if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then - minimumNodes(1) = minimumNodes(1) + 1_pInt - minimumNodes(minimumNodes(1)+1_pInt) = node + minimumNodes(1) = minimumNodes(1) + 1 + minimumNodes(minimumNodes(1)+1) = node elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then - maximumNodes(1) = maximumNodes(1) + 1_pInt - maximumNodes(maximumNodes(1)+1_pInt) = node + maximumNodes(1) = maximumNodes(1) + 1 + maximumNodes(maximumNodes(1)+1) = node endif enddo @@ -1347,11 +1347,11 @@ subroutine mesh_build_nodeTwins !*** find the corresponding node on the other side with the same position in this dimension unpaired = .true. - do n1 = 1_pInt,minimumNodes(1) - minimumNode = minimumNodes(n1+1_pInt) + do n1 = 1,minimumNodes(1) + minimumNode = minimumNodes(n1+1) if (unpaired(minimumNode)) then - do n2 = 1_pInt,maximumNodes(1) - maximumNode = maximumNodes(n2+1_pInt) + do n2 = 1,maximumNodes(1) + maximumNode = maximumNodes(n2+1) distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode)) if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance) mesh_nodeTwins(dir,minimumNode) = maximumNode @@ -1382,24 +1382,24 @@ subroutine mesh_build_sharedElems n, & ! node index per element myDim, & ! dimension index nodeTwin ! node twin in the specified dimension - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt), dimension(:), allocatable :: node_seen + integer, dimension (mesh_Nnodes) :: node_count + integer, dimension(:), allocatable :: node_seen allocate(node_seen(maxval(FE_NmatchingNodes))) - node_count = 0_pInt + node_count = 0 - do e = 1_pInt,theMesh%nElems + do e = 1,theMesh%nElems g = theMesh%elem%geomType - node_seen = 0_pInt ! reset node duplicates - do n = 1_pInt,FE_NmatchingNodes(g) ! check each node of element + node_seen = 0 ! reset node duplicates + do n = 1,FE_NmatchingNodes(g) ! check each node of element node = mesh_element(4+n,e) if (all(node_seen /= node)) then - node_count(node) = node_count(node) + 1_pInt ! if FE node not yet encountered -> count it - do myDim = 1_pInt,3_pInt ! check in each dimension... + node_count(node) = node_count(node) + 1 ! if FE node not yet encountered -> count it + do myDim = 1,3 ! check in each dimension... nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) & ! if I am a twin of some node... - node_count(nodeTwin) = node_count(nodeTwin) + 1_pInt ! -> count me again for the twin node + if (nodeTwin > 0) & ! if I am a twin of some node... + node_count(nodeTwin) = node_count(nodeTwin) + 1 ! -> count me again for the twin node enddo endif node_seen(n) = node ! remember this node to be counted already @@ -1408,20 +1408,20 @@ subroutine mesh_build_sharedElems mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node - allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0) - do e = 1_pInt,theMesh%nElems + do e = 1,theMesh%nElems g = theMesh%elem%geomType - node_seen = 0_pInt - do n = 1_pInt,FE_NmatchingNodes(g) - node = mesh_element(4_pInt+n,e) + node_seen = 0 + do n = 1,FE_NmatchingNodes(g) + node = mesh_element(4+n,e) if (all(node_seen /= node)) then - mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1_pInt ! count for each node the connected elements - mesh_sharedElem(mesh_sharedElem(1,node)+1_pInt,node) = e ! store the respective element id - do myDim = 1_pInt,3_pInt ! check in each dimension... + mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1 ! count for each node the connected elements + mesh_sharedElem(mesh_sharedElem(1,node)+1,node) = e ! store the respective element id + do myDim = 1,3 ! check in each dimension... nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) then ! if i am a twin of some node... - mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1_pInt ! ...count me again for the twin + if (nodeTwin > 0) then ! if i am a twin of some node... + mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1 ! ...count me again for the twin mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id endif enddo @@ -1441,7 +1441,7 @@ subroutine mesh_build_ipNeighborhood math_mul3x3 implicit none - integer(pInt) :: myElem, & ! my CP element index + integer :: myElem, & ! my CP element index myIP, & myType, & ! my element type myFace, & @@ -1459,26 +1459,26 @@ subroutine mesh_build_ipNeighborhood neighboringIP, & neighboringElem, & pointingToMe - integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & - linkedNodes = 0_pInt, & + integer, dimension(FE_maxmaxNnodesAtIP) :: & + linkedNodes = 0, & matchingNodes logical checkTwins allocate(mesh_ipNeighborhood(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems)) - mesh_ipNeighborhood = 0_pInt + mesh_ipNeighborhood = 0 - do myElem = 1_pInt,theMesh%nElems ! loop over cpElems + do myElem = 1,theMesh%nElems ! loop over cpElems myType = theMesh%elem%geomType - do myIP = 1_pInt,theMesh%elem%nIPs + do myIP = 1,theMesh%elem%nIPs - do neighbor = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP + do neighbor = 1,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP neighboringIPkey = theMesh%elem%IPneighbor(neighbor,myIP) !*** if the key is positive, the neighbor is inside the element !*** that means, we have already found our neighboring IP - if (neighboringIPkey > 0_pInt) then + if (neighboringIPkey > 0) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey @@ -1486,33 +1486,33 @@ subroutine mesh_build_ipNeighborhood !*** if the key is negative, the neighbor resides in a neighboring element !*** that means, we have to look through the face indicated by the key and see which element is behind that face - elseif (neighboringIPkey < 0_pInt) then ! neighboring element's IP + elseif (neighboringIPkey < 0) then ! neighboring element's IP myFace = -neighboringIPkey call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match - if (matchingElem > 0_pInt) then ! found match? + if (matchingElem > 0) then ! found match? neighboringType = theMesh%elem%geomType !*** trivial solution if neighbor has only one IP - if (theMesh%elem%nIPs == 1_pInt) then + if (theMesh%elem%nIPs == 1) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1 cycle endif !*** find those nodes which build the link to the neighbor - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt - do a = 1_pInt,theMesh%elem%maxNnodeAtIP + NlinkedNodes = 0 + linkedNodes = 0 + do a = 1,theMesh%elem%maxNnodeAtIP anchor = theMesh%elem%NnodeAtIP(a,myIP) - if (anchor /= 0_pInt) then ! valid anchor node + if (anchor /= 0) then ! valid anchor node if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? - NlinkedNodes = NlinkedNodes + 1_pInt - linkedNodes(NlinkedNodes) = mesh_element(4_pInt+anchor,myElem) ! CP id of anchor node + NlinkedNodes = NlinkedNodes + 1 + linkedNodes(NlinkedNodes) = mesh_element(4+anchor,myElem) ! CP id of anchor node else ! something went wrong with the linkage, since not all anchors sit on my face - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt + NlinkedNodes = 0 + linkedNodes = 0 exit endif endif @@ -1522,18 +1522,18 @@ subroutine mesh_build_ipNeighborhood !*** and try to find an ip with matching nodes !*** also try to match with node twins - checkCandidateIP: do candidateIP = 1_pInt,theMesh%elem%nIPs - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt - do a = 1_pInt,theMesh%elem%maxNnodeAtIP + checkCandidateIP: do candidateIP = 1,theMesh%elem%nIPs + NmatchingNodes = 0 + matchingNodes = 0 + do a = 1,theMesh%elem%maxNnodeAtIP anchor = theMesh%elem%NnodeAtIP(a,candidateIP) - if (anchor /= 0_pInt) then ! valid anchor node + if (anchor /= 0) then ! valid anchor node if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? - NmatchingNodes = NmatchingNodes + 1_pInt + NmatchingNodes = NmatchingNodes + 1 matchingNodes(NmatchingNodes) = mesh_element(4+anchor,matchingElem) ! CP id of neighbor's anchor node else ! no matching, because not all nodes sit on the matching face - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt + NmatchingNodes = 0 + matchingNodes = 0 exit endif endif @@ -1545,7 +1545,7 @@ subroutine mesh_build_ipNeighborhood !*** check "normal" nodes whether they match or not checkTwins = .false. - do a = 1_pInt,NlinkedNodes + do a = 1,NlinkedNodes if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode checkTwins = .true. exit ! no need to search further @@ -1556,9 +1556,9 @@ subroutine mesh_build_ipNeighborhood if(checkTwins) then dir = int(maxloc(abs(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem)),1),pInt) ! check for twins only in direction of the surface normal - do a = 1_pInt,NlinkedNodes + do a = 1,NlinkedNodes twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) - if (twin_of_linkedNode == 0_pInt .or. & ! twin of linkedNode does not exist... + if (twin_of_linkedNode == 0 .or. & ! twin of linkedNode does not exist... all(matchingNodes /= twin_of_linkedNode)) then ! ... or it does not match any matchingNode cycle checkCandidateIP ! ... then check next candidateIP endif @@ -1576,15 +1576,15 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - do myElem = 1_pInt,theMesh%nElems ! loop over cpElems + do myElem = 1,theMesh%nElems ! loop over cpElems myType = theMesh%elem%geomType - do myIP = 1_pInt,theMesh%elem%nIPs - do neighbor = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP + do myIP = 1,theMesh%elem%nIPs + do neighbor = 1,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP neighboringElem = mesh_ipNeighborhood(1,neighbor,myIP,myElem) neighboringIP = mesh_ipNeighborhood(2,neighbor,myIP,myElem) - if (neighboringElem > 0_pInt .and. neighboringIP > 0_pInt) then ! if neighbor exists ... + if (neighboringElem > 0 .and. neighboringIP > 0) then ! if neighbor exists ... neighboringType = theMesh%elem%geomType - do pointingToMe = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! find neighboring index that points from my neighbor to myself + do pointingToMe = 1,FE_NipNeighbors(theMesh%elem%cellType) ! find neighboring index that points from my neighbor to myself if ( myElem == mesh_ipNeighborhood(1,pointingToMe,neighboringIP,neighboringElem) & .and. myIP == mesh_ipNeighborhood(2,pointingToMe,neighboringIP,neighboringElem)) then ! possible candidate if (math_mul3x3(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem),& @@ -1607,34 +1607,34 @@ subroutine mesh_build_ipNeighborhood subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) implicit none -integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID +integer, intent(out) :: matchingElem, & ! matching CP element ID matchingFace ! matching face ID -integer(pInt), intent(in) :: face, & ! face ID +integer, intent(in) :: face, & ! face ID elem ! CP elem ID -integer(pInt), dimension(FE_NmatchingNodesPerFace(face,theMesh%elem%geomType)) :: & +integer, dimension(FE_NmatchingNodesPerFace(face,theMesh%elem%geomType)) :: & myFaceNodes ! global node ids on my face -integer(pInt) :: myType, & +integer :: myType, & candidateType, & candidateElem, & candidateFace, & candidateFaceNode, & minNsharedElems, & NsharedElems, & - lonelyNode = 0_pInt, & + lonelyNode = 0, & i, & n, & dir ! periodicity direction -integer(pInt), dimension(:), allocatable :: element_seen +integer, dimension(:), allocatable :: element_seen logical checkTwins -matchingElem = 0_pInt -matchingFace = 0_pInt -minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case +matchingElem = 0 +matchingFace = 0 +minNsharedElems = mesh_maxNsharedElems + 1 ! init to worst case myType =theMesh%elem%geomType -do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face - myFaceNodes(n) = mesh_element(4_pInt+FE_face(n,face,myType),elem) ! CP id of face node - NsharedElems = mesh_sharedElem(1_pInt,myFaceNodes(n)) ! figure # shared elements for this node +do n = 1,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face + myFaceNodes(n) = mesh_element(4+FE_face(n,face,myType),elem) ! CP id of face node + NsharedElems = mesh_sharedElem(1,myFaceNodes(n)) ! figure # shared elements for this node if (NsharedElems < minNsharedElems) then minNsharedElems = NsharedElems ! remember min # shared elems lonelyNode = n ! remember most lonely node @@ -1642,33 +1642,33 @@ do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) enddo allocate(element_seen(minNsharedElems)) -element_seen = 0_pInt +element_seen = 0 -checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements - candidateElem = mesh_sharedElem(1_pInt+i,myFaceNodes(lonelyNode)) ! present candidate elem +checkCandidate: do i = 1,minNsharedElems ! iterate over lonelyNode's shared elements + candidateElem = mesh_sharedElem(1+i,myFaceNodes(lonelyNode)) ! present candidate elem if (all(element_seen /= candidateElem)) then ! element seen for the first time? element_seen(i) = candidateElem candidateType = theMesh%elem%geomType -checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate +checkCandidateFace: do candidateFace = 1,FE_maxNipNeighbors ! check each face of candidate if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face .or. (candidateElem == elem .and. candidateFace == face)) then ! this is my face cycle checkCandidateFace endif checkTwins = .false. - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face - candidateFaceNode = mesh_element(4_pInt+FE_face(n,candidateFace,candidateType),candidateElem) + do n = 1,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) if (all(myFaceNodes /= candidateFaceNode)) then ! candidate node does not match any of my face nodes checkTwins = .true. ! perhaps the twin nodes do match exit endif enddo if(checkTwins) then -checkCandidateFaceTwins: do dir = 1_pInt,3_pInt - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face +checkCandidateFaceTwins: do dir = 1,3 + do n = 1,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) if (all(myFaceNodes /= mesh_nodeTwins(dir,candidateFaceNode))) then ! node twin does not match either - if (dir == 3_pInt) then + if (dir == 3) then cycle checkCandidateFace else cycle checkCandidateFaceTwins ! try twins in next dimension @@ -1693,7 +1693,7 @@ end subroutine mesh_build_ipNeighborhood !-------------------------------------------------------------------------------------------------- !> @brief mapping of FE element types to internal representation !-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) +integer function FE_mapElemtype(what) use IO, only: IO_lc, IO_error implicit none @@ -1701,36 +1701,36 @@ integer(pInt) function FE_mapElemtype(what) select case (IO_lc(what)) case ( '6') - FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle + FE_mapElemtype = 1 ! Two-dimensional Plane Strain Triangle case ( '155', & '125', & '128') - FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) + FE_mapElemtype = 2 ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) case ( '11') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + FE_mapElemtype = 3 ! Arbitrary Quadrilateral Plane-strain case ( '27') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + FE_mapElemtype = 4 ! Plane Strain, Eight-node Distorted Quadrilateral case ( '54') - FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration + FE_mapElemtype = 5 ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration case ( '134') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + FE_mapElemtype = 6 ! Three-dimensional Four-node Tetrahedron case ( '157') - FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations + FE_mapElemtype = 7 ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations case ( '127') - FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron + FE_mapElemtype = 8 ! Three-dimensional Ten-node Tetrahedron case ( '136') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + FE_mapElemtype = 9 ! Three-dimensional Arbitrarily Distorted Pentahedral case ( '117', & '123') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + FE_mapElemtype = 10 ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration case ( '7') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + FE_mapElemtype = 11 ! Three-dimensional Arbitrarily Distorted Brick case ( '57') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + FE_mapElemtype = 12 ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration case ( '21') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + FE_mapElemtype = 13 ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + call IO_error(error_ID=190,ext_msg=IO_lc(what)) end select end function FE_mapElemtype @@ -1743,13 +1743,13 @@ end function FE_mapElemtype subroutine mesh_build_FEdata implicit none - integer(pInt) :: me - allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + integer :: me + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0) ! *** FE_cellface *** - me = 0_pInt + me = 0 - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) reshape(int([& 2,3, & @@ -1757,7 +1757,7 @@ subroutine mesh_build_FEdata 1,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) reshape(int([& 2,3, & @@ -1766,7 +1766,7 @@ subroutine mesh_build_FEdata 1,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) reshape(int([& 1,3,2, & @@ -1775,7 +1775,7 @@ subroutine mesh_build_FEdata 1,4,3 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - me = me + 1_pInt + me = me + 1 FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) reshape(int([& 2,3,7,6, & @@ -1794,18 +1794,18 @@ end subroutine mesh_build_FEdata !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) +integer function mesh_FEasCP(what,myID) use IO, only: & IO_lc implicit none character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID + integer, intent(in) :: myID - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center + integer, dimension(:,:), pointer :: lookupMap + integer :: lower,upper,center - mesh_FEasCP = 0_pInt + mesh_FEasCP = 0 select case(IO_lc(what(1:4))) case('elem') lookupMap => mesh_mapFEtoCPelem @@ -1815,24 +1815,24 @@ integer(pInt) function mesh_FEasCP(what,myID) return endselect - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) + lower = 1 + upper = int(size(lookupMap,2),pInt) - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) + if (lookupMap(1,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2,lower) return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) + elseif (lookupMap(1,upper) == myID) then + mesh_FEasCP = lookupMap(2,upper) return endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then + binarySearch: do while (upper-lower > 1) + center = (lower+upper)/2 + if (lookupMap(1,center) < myID) then lower = center - elseif (lookupMap(1_pInt,center) > myID) then + elseif (lookupMap(1,center) > myID) then upper = center else - mesh_FEasCP = lookupMap(2_pInt,center) + mesh_FEasCP = lookupMap(2,center) exit endif enddo binarySearch diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index da00db2b2..494bbc6f0 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -5,23 +5,21 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_anisoBrittle - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? source_damage_anisoBrittle_instance !< instance of source mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & source_damage_anisoBrittle_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_anisoBrittle_output !< name of each post result output - integer(pInt), dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family enum, bind(c) @@ -40,9 +38,9 @@ module source_damage_anisoBrittle critLoad real(pReal), dimension(:,:,:,:), allocatable :: & cleavage_systems - integer(pInt) :: & + integer :: & totalNcleavage - integer(pInt), dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & Ncleavage integer(kind(undefined_ID)), allocatable, dimension(:) :: & outputID !< ID of each post result output @@ -65,8 +63,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoBrittle_init - use prec, only: & - pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -91,10 +87,10 @@ subroutine source_damage_anisoBrittle_init lattice_SchmidMatrix_cleavage, & lattice_maxNcleavageFamily - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset - integer(pInt) :: NofMyPhase,p ,i - integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p ,i + integer, dimension(0), parameter :: emptyIntArray = [integer::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -105,14 +101,14 @@ subroutine source_damage_anisoBrittle_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' - Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) - if (Ninstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID)) + if (Ninstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0_pInt) - allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0_pInt) + allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0) + allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0) do phase = 1, material_Nphase source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID) do source = 1, phase_Nsources(phase) @@ -121,11 +117,11 @@ subroutine source_damage_anisoBrittle_init enddo enddo - allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0) allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0) allocate(param(Ninstance)) @@ -162,18 +158,18 @@ subroutine source_damage_anisoBrittle_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & - call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) + do i=1, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('anisobrittle_drivingforce') - source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1_pInt + source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1 source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i) prm%outputID = [prm%outputID, damage_drivingforce_ID] @@ -189,7 +185,7 @@ subroutine source_damage_anisoBrittle_init sourceOffset = source_damage_anisoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol @@ -217,13 +213,13 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) lattice_maxNcleavageFamily, & lattice_NcleavageSystem - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & S - integer(pInt) :: & + integer :: & phase, & constituent, & instance, & @@ -243,10 +239,10 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal - index = 1_pInt - do f = 1_pInt,lattice_maxNcleavageFamily - index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family + index = 1 + do f = 1,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family + do i = 1,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) @@ -263,7 +259,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ & param(instance)%critDisp(index) - index = index + 1_pInt + index = index + 1 enddo enddo @@ -276,7 +272,7 @@ subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalph use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), intent(in) :: & @@ -284,7 +280,7 @@ subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalph real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi - integer(pInt) :: & + integer :: & sourceOffset sourceOffset = source_damage_anisoBrittle_offset(phase) @@ -303,27 +299,27 @@ function source_damage_anisoBrittle_postResults(phase, constituent) use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, & source_damage_anisoBrittle_instance(phase)))) :: & source_damage_anisoBrittle_postResults - integer(pInt) :: & + integer :: & instance, sourceOffset, o, c instance = source_damage_anisoBrittle_instance(phase) sourceOffset = source_damage_anisoBrittle_offset(phase) - c = 0_pInt + c = 0 - do o = 1_pInt,size(param(instance)%outputID) + do o = 1,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) - source_damage_anisoBrittle_postResults(c+1_pInt) = & + source_damage_anisoBrittle_postResults(c+1) = & sourceState(phase)%p(sourceOffset)%state(1,constituent) - c = c + 1_pInt + c = c + 1 end select enddo diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 8f6d68a88..c83f61a9d 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -5,20 +5,18 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_anisoDuctile - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? source_damage_anisoDuctile_instance !< instance of damage source mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & source_damage_anisoDuctile_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_anisoDuctile_output !< name of each post result output @@ -59,8 +57,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoDuctile_init - use prec, only: & - pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -82,11 +78,11 @@ subroutine source_damage_anisoDuctile_init config_phase - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset - integer(pInt) :: NofMyPhase,p ,i + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p ,i - integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer, dimension(0), parameter :: emptyIntArray = [integer::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -98,13 +94,13 @@ subroutine source_damage_anisoDuctile_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' Ninstance = count(phase_source == SOURCE_damage_anisoDuctile_ID) - if (Ninstance == 0_pInt) return + if (Ninstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0_pInt) - allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0_pInt) + allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0) + allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0) do phase = 1, size(config_phase) source_damage_anisoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoDuctile_ID) do source = 1, phase_Nsources(phase) @@ -113,7 +109,7 @@ subroutine source_damage_anisoDuctile_init enddo enddo - allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoDuctile_output = '' @@ -146,18 +142,18 @@ subroutine source_damage_anisoDuctile_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & - call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')') + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) + do i=1, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('anisoductile_drivingforce') - source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1_pInt + source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1 source_damage_anisoDuctile_output(i,source_damage_anisoDuctile_instance(p)) = outputs(i) prm%outputID = [prm%outputID, damage_drivingforce_ID] @@ -173,7 +169,7 @@ subroutine source_damage_anisoDuctile_init instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol @@ -193,11 +189,11 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) damage, & damageMapping - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element - integer(pInt) :: & + integer :: & phase, & constituent, & sourceOffset, & @@ -229,7 +225,7 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), intent(in) :: & @@ -237,7 +233,7 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi - integer(pInt) :: & + integer :: & sourceOffset sourceOffset = source_damage_anisoDuctile_offset(phase) @@ -256,27 +252,27 @@ function source_damage_anisoDuctile_postResults(phase, constituent) use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), dimension(sum(source_damage_anisoDuctile_sizePostResult(:, & source_damage_anisoDuctile_instance(phase)))) :: & source_damage_anisoDuctile_postResults - integer(pInt) :: & + integer :: & instance, sourceOffset, o, c instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) - c = 0_pInt + c = 0 - do o = 1_pInt,size(param(instance)%outputID) + do o = 1,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) - source_damage_anisoDuctile_postResults(c+1_pInt) = & + source_damage_anisoDuctile_postResults(c+1) = & sourceState(phase)%p(sourceOffset)%state(1,constituent) - c = c + 1_pInt + c = c + 1 end select enddo diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index b60218458..90aa5089f 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -5,20 +5,18 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_isoBrittle - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & source_damage_isoBrittle_offset, & !< which source is my current damage mechanism? source_damage_isoBrittle_instance !< instance of damage source mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & source_damage_isoBrittle_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_isoBrittle_output !< name of each post result output enum, bind(c) @@ -53,8 +51,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_isoBrittle_init - use prec, only: & - pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -75,9 +71,9 @@ subroutine source_damage_isoBrittle_init material_Nphase - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset - integer(pInt) :: NofMyPhase,p,i - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p,i + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -88,14 +84,14 @@ subroutine source_damage_isoBrittle_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' - Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) - if (Ninstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID)) + if (Ninstance == 0) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(source_damage_isoBrittle_offset(material_Nphase), source=0_pInt) - allocate(source_damage_isoBrittle_instance(material_Nphase), source=0_pInt) + allocate(source_damage_isoBrittle_offset(material_Nphase), source=0) + allocate(source_damage_isoBrittle_instance(material_Nphase), source=0) do phase = 1, material_Nphase source_damage_isoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoBrittle_ID) do source = 1, phase_Nsources(phase) @@ -104,7 +100,7 @@ subroutine source_damage_isoBrittle_init enddo enddo - allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_isoBrittle_output = '' @@ -129,18 +125,18 @@ subroutine source_damage_isoBrittle_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & - call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')') + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) + do i=1, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('isobrittle_drivingforce') - source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1_pInt + source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1 source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i) prm%outputID = [prm%outputID, damage_drivingforce_ID] @@ -156,7 +152,7 @@ subroutine source_damage_isoBrittle_init instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,1_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,1) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol @@ -175,7 +171,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) math_sym33to6, & math_I3 - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element @@ -183,7 +179,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) Fe real(pReal), intent(in), dimension(6,6) :: & C - integer(pInt) :: & + integer :: & phase, constituent, instance, sourceOffset real(pReal) :: & strain(6), & @@ -219,7 +215,7 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), intent(in) :: & @@ -227,7 +223,7 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi - integer(pInt) :: & + integer :: & instance, sourceOffset instance = source_damage_isoBrittle_instance(phase) @@ -248,25 +244,25 @@ function source_damage_isoBrittle_postResults(phase, constituent) use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, & source_damage_isoBrittle_instance(phase)))) :: & source_damage_isoBrittle_postResults - integer(pInt) :: & + integer :: & instance, sourceOffset, o, c instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) - c = 0_pInt + c = 0 - do o = 1_pInt,size(param(instance)%outputID) + do o = 1,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) - source_damage_isoBrittle_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent) + source_damage_isoBrittle_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent) c = c + 1 end select diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 149803693..9cd4e5d26 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -5,20 +5,18 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_isoDuctile - use prec, only: & - pReal, & - pInt + use prec implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & + integer, dimension(:), allocatable, public, protected :: & source_damage_isoDuctile_offset, & !< which source is my current damage mechanism? source_damage_isoDuctile_instance !< instance of damage source mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & + integer, dimension(:,:), allocatable, target, public :: & source_damage_isoDuctile_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & + character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_isoDuctile_output !< name of each post result output @@ -53,8 +51,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_isoDuctile_init - use prec, only: & - pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -75,8 +71,8 @@ subroutine source_damage_isoDuctile_init material_Nphase - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset - integer(pInt) :: NofMyPhase,p,i + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p,i character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -89,13 +85,13 @@ subroutine source_damage_isoDuctile_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>' Ninstance = count(phase_source == SOURCE_damage_isoDuctile_ID) - if (Ninstance == 0_pInt) return + if (Ninstance == 0) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(source_damage_isoDuctile_offset(material_Nphase), source=0_pInt) - allocate(source_damage_isoDuctile_instance(material_Nphase), source=0_pInt) + allocate(source_damage_isoDuctile_offset(material_Nphase), source=0) + allocate(source_damage_isoDuctile_instance(material_Nphase), source=0) do phase = 1, material_Nphase source_damage_isoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoDuctile_ID) do source = 1, phase_Nsources(phase) @@ -104,7 +100,7 @@ subroutine source_damage_isoDuctile_init enddo enddo - allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_isoDuctile_output = '' @@ -129,18 +125,18 @@ subroutine source_damage_isoDuctile_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & - call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')') + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) + do i=1, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('isoductile_drivingforce') - source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1_pInt + source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1 source_damage_isoDuctile_output(i,source_damage_isoDuctile_instance(p)) = outputs(i) prm%outputID = [prm%outputID, damage_drivingforce_ID] @@ -155,7 +151,7 @@ subroutine source_damage_isoDuctile_init instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol @@ -176,11 +172,11 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) damage, & damageMapping - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element - integer(pInt) :: & + integer :: & phase, constituent, instance, homog, sourceOffset, damageOffset phase = phaseAt(ipc,ip,el) @@ -204,7 +200,7 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), intent(in) :: & @@ -212,7 +208,7 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi - integer(pInt) :: & + integer :: & sourceOffset sourceOffset = source_damage_isoDuctile_offset(phase) @@ -231,25 +227,25 @@ function source_damage_isoDuctile_postResults(phase, constituent) use material, only: & sourceState - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & constituent real(pReal), dimension(sum(source_damage_isoDuctile_sizePostResult(:, & source_damage_isoDuctile_instance(phase)))) :: & source_damage_isoDuctile_postResults - integer(pInt) :: & + integer :: & instance, sourceOffset, o, c instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) - c = 0_pInt + c = 0 - do o = 1_pInt,size(param(instance)%outputID) + do o = 1,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) - source_damage_isoDuctile_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent) + source_damage_isoDuctile_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent) c = c + 1 end select From 346c7c4a7f7b7862280483e15d8679639ef1c781 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 14 May 2019 23:12:32 +0200 Subject: [PATCH 16/59] one implicit none is enough --- src/CPFEM.f90 | 12 +----- src/CPFEM2.f90 | 43 ++++++++------------ src/FEsolving.f90 | 7 +--- src/IO.f90 | 33 +--------------- src/config.f90 | 19 +++------ src/damage_local.f90 | 8 +--- src/damage_none.f90 | 3 +- src/damage_nonlocal.f90 | 6 --- src/element.f90 | 4 +- src/homogenization.f90 | 10 +---- src/homogenization_mech_RGC.f90 | 25 +----------- src/homogenization_mech_isostrain.f90 | 7 +--- src/homogenization_mech_none.f90 | 1 - src/kinematics_cleavage_opening.f90 | 2 - src/kinematics_thermal_expansion.f90 | 7 +--- src/mesh_abaqus.f90 | 57 +++++++++++++-------------- src/mesh_base.f90 | 12 ++---- src/mesh_marc.f90 | 56 +++++++++++++------------- src/numerics.f90 | 7 +--- 19 files changed, 95 insertions(+), 224 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index a1e562c24..3c9632787 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -4,9 +4,7 @@ !> @brief CPFEM engine !-------------------------------------------------------------------------------------------------- module CPFEM - use prec, only: & - pReal, & - pInt + use prec implicit none private @@ -57,8 +55,6 @@ contains !> @brief call (thread safe) all module initializations !-------------------------------------------------------------------------------------------------- subroutine CPFEM_initAll(el,ip) - use prec, only: & - prec_init use numerics, only: & numerics_init use debug, only: & @@ -91,7 +87,6 @@ subroutine CPFEM_initAll(el,ip) IO_init use DAMASK_interface - implicit none integer(pInt), intent(in) :: el, & !< FE el number ip !< FE integration point number @@ -155,7 +150,6 @@ subroutine CPFEM_init crystallite_Li0, & crystallite_S0 - implicit none integer :: k,l,m,ph,homog write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' @@ -325,7 +319,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt IO_warning use DAMASK_interface - implicit none integer(pInt), intent(in) :: elFE, & !< FE element number ip !< integration point number real(pReal), intent(in) :: dt !< time increment @@ -639,8 +632,6 @@ end subroutine CPFEM_general !> @brief triggers writing of the results !-------------------------------------------------------------------------------------------------- subroutine CPFEM_results(inc,time) - use prec, only: & - pInt #ifdef DAMASK_HDF5 use results use HDF5_utilities @@ -650,7 +641,6 @@ subroutine CPFEM_results(inc,time) use crystallite, only: & crystallite_results - implicit none integer(pInt), intent(in) :: inc real(pReal), intent(in) :: time diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 38229d050..465521fb6 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -12,6 +12,7 @@ module CPFEM2 CPFEM_age, & CPFEM_initAll, & CPFEM_results + contains @@ -20,7 +21,6 @@ contains !-------------------------------------------------------------------------------------------------- subroutine CPFEM_initAll() use prec, only: & - pInt, & prec_init use numerics, only: & numerics_init @@ -57,8 +57,6 @@ subroutine CPFEM_initAll() FEM_Zoo_init #endif - implicit none - call DAMASK_interface_init ! Spectral and FEM interface to commandline call prec_init call IO_init @@ -87,8 +85,6 @@ end subroutine CPFEM_initAll !> @brief allocate the arrays defined in module CPFEM and initialize them !-------------------------------------------------------------------------------------------------- subroutine CPFEM_init - use prec, only: & - pInt, pReal use IO, only: & IO_error use numerics, only: & @@ -124,8 +120,8 @@ subroutine CPFEM_init use DAMASK_interface, only: & getSolverJobName - implicit none - integer(pInt) :: ph,homog + + integer :: ph,homog character(len=1024) :: rankStr, PlasticItem, HomogItem integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID @@ -134,7 +130,7 @@ subroutine CPFEM_init ! *** restore the last converged values of each essential variable from the binary file if (restartRead) then - if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then + if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0) then write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from hdf5 file' flush(6) endif @@ -152,14 +148,14 @@ subroutine CPFEM_init call HDF5_read(fileHandle,crystallite_S0, 'convergedS') groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases') - do ph = 1_pInt,size(phase_plasticity) + do ph = 1,size(phase_plasticity) write(PlasticItem,*) ph,'_' call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst') enddo call HDF5_closeGroup(groupPlasticID) groupHomogID = HDF5_openGroup(fileHandle,'HomogStates') - do homog = 1_pInt, material_Nhomogenization + do homog = 1, material_Nhomogenization write(HomogItem,*) homog,'_' call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog') enddo @@ -178,8 +174,7 @@ end subroutine CPFEM_init !-------------------------------------------------------------------------------------------------- subroutine CPFEM_age() use prec, only: & - pReal, & - pInt + pReal use numerics, only: & worldrank use debug, only: & @@ -223,13 +218,12 @@ subroutine CPFEM_age() use hdf5 use DAMASK_interface, only: & getSolverJobName - - implicit none - integer(pInt) :: i, ph, homog, mySource + + integer :: i, ph, homog, mySource character(len=32) :: rankStr, PlasticItem, HomogItem integer(HID_T) :: fileHandle, groupPlastic, groupHomog - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) & write(6,'(a)') '<< CPFEM >> aging states' crystallite_F0 = crystallite_partionedF @@ -246,14 +240,14 @@ subroutine CPFEM_age() do mySource = 1,phase_Nsources(i) sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state enddo; enddo - do homog = 1_pInt, material_Nhomogenization + do homog = 1, material_Nhomogenization homogState (homog)%state0 = homogState (homog)%state thermalState (homog)%state0 = thermalState (homog)%state damageState (homog)%state0 = damageState (homog)%state enddo if (restartWrite) then - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) & write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file' write(rankStr,'(a1,i0)')'_',worldrank @@ -268,14 +262,14 @@ subroutine CPFEM_age() call HDF5_write(fileHandle,crystallite_S0, 'convergedS') groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases') - do ph = 1_pInt,size(phase_plasticity) + do ph = 1,size(phase_plasticity) write(PlasticItem,*) ph,'_' call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst') enddo call HDF5_closeGroup(groupPlastic) groupHomog = HDF5_addGroup(fileHandle,'HomogStates') - do homog = 1_pInt, material_Nhomogenization + do homog = 1, material_Nhomogenization write(HomogItem,*) homog,'_' call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog') enddo @@ -285,7 +279,7 @@ subroutine CPFEM_age() restartWrite = .false. endif - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) & write(6,'(a)') '<< CPFEM >> done aging states' end subroutine CPFEM_age @@ -295,8 +289,6 @@ end subroutine CPFEM_age !> @brief triggers writing of the results !-------------------------------------------------------------------------------------------------- subroutine CPFEM_results(inc,time) - use prec, only: & - pInt use results use HDF5_utilities use homogenization, only: & @@ -305,9 +297,8 @@ subroutine CPFEM_results(inc,time) constitutive_results use crystallite, only: & crystallite_results - - implicit none - integer(pInt), intent(in) :: inc + + integer, intent(in) :: inc real(pReal), intent(in) :: time call results_openJobFile diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 index be567decc..c188e66e2 100644 --- a/src/FEsolving.f90 +++ b/src/FEsolving.f90 @@ -5,10 +5,8 @@ !> @todo Descriptions for public variables needed !-------------------------------------------------------------------------------------------------- module FEsolving - use prec, only: & - pInt, & - pReal - + use prec + implicit none private integer, public :: & @@ -59,7 +57,6 @@ subroutine FE_init IO_warning use DAMASK_interface - implicit none #if defined(Marc4DAMASK) || defined(Abaqus) integer, parameter :: & FILEUNIT = 222 diff --git a/src/IO.f90 b/src/IO.f90 index 86ff5fe57..d3bed09df 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -8,7 +8,7 @@ module IO use prec use DAMASK_interface - + implicit none private character(len=5), parameter, public :: & @@ -63,8 +63,6 @@ contains !-------------------------------------------------------------------------------------------------- subroutine IO_init - implicit none - write(6,'(/,a)') ' <<<+- IO init -+>>>' end subroutine IO_init @@ -75,7 +73,6 @@ end subroutine IO_init !-------------------------------------------------------------------------------------------------- function IO_read(fileUnit) result(line) - implicit none integer, intent(in) :: fileUnit !< file unit character(len=pStringLen) :: line @@ -91,7 +88,6 @@ function IO_read(fileUnit) result(line) !-------------------------------------------------------------------------------------------------- function IO_read_ASCII(fileName) result(fileContent) - implicit none character(len=*), intent(in) :: fileName character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines @@ -160,7 +156,6 @@ end function IO_read_ASCII !-------------------------------------------------------------------------------------------------- subroutine IO_open_file(fileUnit,path) - implicit none integer, intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: path !< relative path from working directory @@ -178,7 +173,6 @@ end subroutine IO_open_file !-------------------------------------------------------------------------------------------------- integer function IO_open_jobFile_binary(extension,mode) - implicit none character(len=*), intent(in) :: extension character, intent(in), optional :: mode @@ -197,7 +191,6 @@ end function IO_open_jobFile_binary !-------------------------------------------------------------------------------------------------- integer function IO_open_binary(fileName,mode) - implicit none character(len=*), intent(in) :: fileName character, intent(in), optional :: mode @@ -231,7 +224,6 @@ end function IO_open_binary !-------------------------------------------------------------------------------------------------- subroutine IO_open_inputFile(fileUnit,modelName) - implicit none integer, intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name @@ -264,7 +256,6 @@ subroutine IO_open_inputFile(fileUnit,modelName) !-------------------------------------------------------------------------------------------------- recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) - implicit none integer, intent(in) :: unit1, & unit2 @@ -323,7 +314,6 @@ end subroutine IO_open_inputFile !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(fileUnit) - implicit none integer, intent(in) :: fileUnit !< file unit integer :: myStat @@ -343,7 +333,6 @@ end subroutine IO_open_logFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobFile(fileUnit,ext) - implicit none integer, intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext !< extension of file @@ -362,7 +351,6 @@ end subroutine IO_write_jobFile !-------------------------------------------------------------------------------------------------- logical pure function IO_isBlank(string) - implicit none character(len=*), intent(in) :: string !< string to check for content character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces @@ -382,7 +370,6 @@ end function IO_isBlank !-------------------------------------------------------------------------------------------------- pure function IO_getTag(string,openChar,closeChar) - implicit none character(len=*), intent(in) :: string !< string to check for tag character(len=len_trim(string)) :: IO_getTag @@ -417,7 +404,6 @@ end function IO_getTag !-------------------------------------------------------------------------------------------------- pure function IO_stringPos(string) - implicit none integer, dimension(:), allocatable :: IO_stringPos character(len=*), intent(in) :: string !< string in which chunk positions are searched for @@ -447,7 +433,6 @@ end function IO_stringPos !-------------------------------------------------------------------------------------------------- function IO_stringValue(string,chunkPos,myChunk,silent) - implicit none integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer, intent(in) :: myChunk !< position number of desired chunk character(len=*), intent(in) :: string !< raw input with known start and end of each chunk @@ -479,7 +464,6 @@ end function IO_stringValue !-------------------------------------------------------------------------------------------------- real(pReal) function IO_floatValue (string,chunkPos,myChunk) - implicit none integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer, intent(in) :: myChunk !< position number of desired chunk character(len=*), intent(in) :: string !< raw input with known start and end of each chunk @@ -504,7 +488,6 @@ end function IO_floatValue !-------------------------------------------------------------------------------------------------- integer function IO_intValue(string,chunkPos,myChunk) - implicit none character(len=*), intent(in) :: string !< raw input with known start and end of each chunk integer, intent(in) :: myChunk !< position number of desired chunk integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string @@ -529,7 +512,6 @@ end function IO_intValue !-------------------------------------------------------------------------------------------------- real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) - implicit none character(len=*), intent(in) :: string !< raw input with known ends of each chunk integer, intent(in) :: myChunk !< position number of desired chunk integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string @@ -562,7 +544,6 @@ end function IO_fixedNoEFloatValue !-------------------------------------------------------------------------------------------------- integer function IO_fixedIntValue(string,ends,myChunk) - implicit none character(len=*), intent(in) :: string !< raw input with known ends of each chunk integer, intent(in) :: myChunk !< position number of desired chunk integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string @@ -581,7 +562,6 @@ end function IO_fixedIntValue !-------------------------------------------------------------------------------------------------- pure function IO_lc(string) - implicit none character(len=*), intent(in) :: string !< string to convert character(len=len(string)) :: IO_lc @@ -604,7 +584,6 @@ end function IO_lc !-------------------------------------------------------------------------------------------------- pure function IO_intOut(intToPrint) - implicit none integer, intent(in) :: intToPrint character(len=41) :: IO_intOut integer :: N_digits @@ -625,7 +604,6 @@ end function IO_intOut !-------------------------------------------------------------------------------------------------- subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) - implicit none integer, intent(in) :: error_ID integer, optional, intent(in) :: el,ip,g,instance character(len=*), optional, intent(in) :: ext_msg @@ -891,7 +869,6 @@ end subroutine IO_error !-------------------------------------------------------------------------------------------------- subroutine IO_warning(warning_ID,el,ip,g,ext_msg) - implicit none integer, intent(in) :: warning_ID integer, optional, intent(in) :: el,ip,g character(len=*), optional, intent(in) :: ext_msg @@ -981,7 +958,6 @@ end subroutine IO_warning !-------------------------------------------------------------------------------------------------- character(len=300) pure function IO_extractValue(pair,key) - implicit none character(len=*), intent(in) :: pair, & !< key=value pair key !< key to be expected @@ -1002,7 +978,6 @@ end function IO_extractValue !-------------------------------------------------------------------------------------------------- integer function IO_countDataLines(fileUnit) - implicit none integer, intent(in) :: fileUnit !< file handle @@ -1035,7 +1010,6 @@ end function IO_countDataLines !-------------------------------------------------------------------------------------------------- integer function IO_countNumericalDataLines(fileUnit) - implicit none integer, intent(in) :: fileUnit !< file handle @@ -1066,7 +1040,6 @@ end function IO_countNumericalDataLines !-------------------------------------------------------------------------------------------------- subroutine IO_skipChunks(fileUnit,N) - implicit none integer, intent(in) :: fileUnit, & !< file handle N !< minimum number of chunks to skip @@ -1091,7 +1064,6 @@ end subroutine IO_skipChunks !-------------------------------------------------------------------------------------------------- integer function IO_countContinuousIntValues(fileUnit) - implicit none integer, intent(in) :: fileUnit #ifdef Abaqus @@ -1149,7 +1121,6 @@ end function IO_countContinuousIntValues !-------------------------------------------------------------------------------------------------- function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) - implicit none integer, intent(in) :: maxN integer, dimension(1+maxN) :: IO_continuousIntValues @@ -1258,7 +1229,6 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) !-------------------------------------------------------------------------------------------------- integer function IO_verifyIntValue (string,validChars,myName) - implicit none character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! validChars, & !< valid characters in string myName !< name of caller function (for debugging) @@ -1286,7 +1256,6 @@ end function IO_verifyIntValue !-------------------------------------------------------------------------------------------------- real(pReal) function IO_verifyFloatValue (string,validChars,myName) - implicit none character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! validChars, & !< valid characters in string myName !< name of caller function (for debugging) diff --git a/src/config.f90 b/src/config.f90 index f86057b25..6bc9e9c0b 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -6,13 +6,11 @@ !! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture' !-------------------------------------------------------------------------------------------------- module config - use prec, only: & - pReal - use list, only: & - tPartitionedStringList + use prec + use list implicit none - + private type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & config_phase, & config_microstructure, & @@ -47,8 +45,6 @@ contains !> @brief reads material.config and stores its content per part !-------------------------------------------------------------------------------------------------- subroutine config_init - use prec, only: & - pStringLen use DAMASK_interface, only: & getSolverJobName use IO, only: & @@ -61,7 +57,6 @@ subroutine config_init debug_material, & debug_levelBasic - implicit none integer :: myDebug,i character(len=pStringLen) :: & @@ -149,7 +144,6 @@ recursive function read_materialConfig(fileName,cnt) result(fileContent) use IO, only: & IO_warning - implicit none character(len=*), intent(in) :: fileName integer, intent(in), optional :: cnt !< recursion counter character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines @@ -231,12 +225,10 @@ end function read_materialConfig !-------------------------------------------------------------------------------------------------- subroutine parse_materialConfig(sectionNames,part,line, & fileContent) - use prec, only: & - pStringLen + use IO, only: & IO_intOut - implicit none character(len=64), allocatable, dimension(:), intent(out) :: sectionNames type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part character(len=pStringLen), intent(inout) :: line @@ -288,7 +280,7 @@ end subroutine parse_materialConfig !-------------------------------------------------------------------------------------------------- subroutine parse_debugAndNumericsConfig(config_list, & fileContent) - implicit none + type(tPartitionedStringList), intent(out) :: config_list character(len=pStringLen), dimension(:), intent(in) :: fileContent integer :: i @@ -309,7 +301,6 @@ subroutine config_deallocate(what) use IO, only: & IO_error - implicit none character(len=*), intent(in) :: what select case(trim(what)) diff --git a/src/damage_local.f90 b/src/damage_local.f90 index ab8b1644a..1ec42f863 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -3,9 +3,7 @@ !> @brief material subroutine for locally evolving damage field !-------------------------------------------------------------------------------------------------- module damage_local - use prec, only: & - pReal, & - pInt + use prec implicit none private @@ -62,7 +60,6 @@ subroutine damage_local_init use config, only: & config_homogenization - implicit none integer :: maxNinstance,homog,instance,o,i integer :: sizeState @@ -147,7 +144,6 @@ function damage_local_updateState(subdt, ip, el) mappingHomogenization, & damageState - implicit none integer, intent(in) :: & ip, & !< integration point number el !< element number @@ -201,7 +197,6 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el use source_damage_anisoDuctile, only: & source_damage_anisoductile_getRateAndItsTangent - implicit none integer, intent(in) :: & ip, & !< integration point number el !< element number @@ -259,7 +254,6 @@ function damage_local_postResults(ip,el) damageMapping, & damage - implicit none integer, intent(in) :: & ip, & !< integration point el !< element diff --git a/src/damage_none.f90 b/src/damage_none.f90 index ffe6cd9a1..aa2995ef5 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -26,8 +26,7 @@ subroutine damage_none_init() damageState, & DAMAGE_NONE_LABEL, & DAMAGE_NONE_ID - - implicit none + integer :: & homog, & NofMyHomog diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index dc1036b67..9398b328a 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -60,7 +60,6 @@ subroutine damage_nonlocal_init use config, only: & config_homogenization - implicit none integer :: maxNinstance,homog,instance,o,i integer :: sizeState @@ -152,7 +151,6 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, use source_damage_anisoDuctile, only: & source_damage_anisoductile_getRateAndItsTangent - implicit none integer, intent(in) :: & ip, & !< integration point number el !< element number @@ -215,7 +213,6 @@ function damage_nonlocal_getDiffusion33(ip,el) use crystallite, only: & crystallite_push33ToRef - implicit none integer, intent(in) :: & ip, & !< integration point number el !< element number @@ -249,7 +246,6 @@ real(pReal) function damage_nonlocal_getMobility(ip,el) material_phase, & homogenization_Ngrains - implicit none integer, intent(in) :: & ip, & !< integration point number el !< element number @@ -276,7 +272,6 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) damageMapping, & damage - implicit none integer, intent(in) :: & ip, & !< integration point number el !< element number @@ -302,7 +297,6 @@ function damage_nonlocal_postResults(ip,el) damageMapping, & damage - implicit none integer, intent(in) :: & ip, & !< integration point el !< element diff --git a/src/element.f90 b/src/element.f90 index bbce2154a..c250d3923 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -3,8 +3,7 @@ !> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH !-------------------------------------------------------------------------------------------------- module element - use prec, only: & - pReal + use prec implicit none private @@ -802,7 +801,6 @@ module element use IO, only: & IO_error - implicit none class(tElement) :: self integer, intent(in) :: elemType self%elemType = elemType diff --git a/src/homogenization.f90 b/src/homogenization.f90 index fe15364b8..c7a99318c 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -5,8 +5,7 @@ !> @brief homogenization manager, organizing deformation partitioning and stress homogenization !-------------------------------------------------------------------------------------------------- module homogenization - use prec, only: & - pReal + use prec use material !-------------------------------------------------------------------------------------------------- @@ -113,7 +112,6 @@ subroutine homogenization_init use numerics, only: & worldrank - implicit none integer, parameter :: FILEUNIT = 200 integer :: e,i,p integer, dimension(:,:), pointer :: thisSize @@ -351,7 +349,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) debug_i #endif - implicit none real(pReal), intent(in) :: dt !< time increment logical, intent(in) :: updateJaco !< initiating Jacobian update integer :: & @@ -651,7 +648,6 @@ subroutine materialpoint_postResults crystallite_sizePostResults, & crystallite_postResults - implicit none integer :: & thePos, & theSize, & @@ -707,7 +703,6 @@ subroutine partitionDeformation(ip,el) use homogenization_mech_RGC, only: & homogenization_RGC_partitionDeformation - implicit none integer, intent(in) :: & ip, & !< integration point el !< element number @@ -752,7 +747,6 @@ function updateState(ip,el) use damage_local, only: & damage_local_updateState - implicit none integer, intent(in) :: & ip, & !< integration point el !< element number @@ -805,7 +799,6 @@ subroutine averageStressAndItsTangent(ip,el) use homogenization_mech_RGC, only: & homogenization_RGC_averageStressAndItsTangent - implicit none integer, intent(in) :: & ip, & !< integration point el !< element number @@ -853,7 +846,6 @@ function postResults(ip,el) use damage_nonlocal, only: & damage_nonlocal_postResults - implicit none integer, intent(in) :: & ip, & !< integration point el !< element number diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 27a52432e..d3feac1eb 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -7,8 +7,7 @@ !> Nconstituents is defined as p x q x r (cluster) !-------------------------------------------------------------------------------------------------- module homogenization_mech_RGC - use prec, only: & - pReal + use prec use material implicit none @@ -109,7 +108,6 @@ subroutine homogenization_RGC_init() use config, only: & config_homogenization - implicit none integer :: & Ninstance, & h, i, & @@ -251,7 +249,6 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) debug_levelExtensive #endif - implicit none real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain real(pReal), dimension (:,:), intent(in) :: avgF !< averaged F @@ -302,8 +299,6 @@ end subroutine homogenization_RGC_partitionDeformation ! "happy" with result !-------------------------------------------------------------------------------------------------- function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) - use prec, only: & - dEq0 #ifdef DEBUG use debug, only: & debug_level, & @@ -323,8 +318,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) viscModus_RGC, & refRelaxRate_RGC - implicit none - real(pReal), dimension(:,:,:), intent(in) :: & P,& !< array of P F,& !< array of F @@ -747,8 +740,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) math_civita use numerics, only: & xSmoo_RGC - - implicit none + real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch @@ -868,7 +860,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) volDiscrMod_RGC,& volDiscrPow_RGC - implicit none real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume real(pReal), intent(out) :: vDiscrep ! total volume discrepancy @@ -919,7 +910,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) use math, only: & math_invert33 - implicit none real(pReal), dimension(3) :: surfaceCorrection real(pReal), dimension(3,3), intent(in) :: avgF !< average F @@ -953,7 +943,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) use constitutive, only: & constitutive_homogenizedC - implicit none real(pReal), dimension(2) :: equivalentModuli integer, intent(in) :: & @@ -989,7 +978,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- subroutine grainDeformation(F, avgF, instance, of) - implicit none real(pReal), dimension(:,:,:), intent(out) :: F !< partioned F per grain real(pReal), dimension(:,:), intent(in) :: avgF !< averaged F @@ -1032,7 +1020,6 @@ end function homogenization_RGC_updateState !-------------------------------------------------------------------------------------------------- subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) - implicit none real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point @@ -1051,7 +1038,6 @@ end subroutine homogenization_RGC_averageStressAndItsTangent !-------------------------------------------------------------------------------------------------- pure function homogenization_RGC_postResults(instance,of) result(postResults) - implicit none integer, intent(in) :: & instance, & of @@ -1148,7 +1134,6 @@ end subroutine mech_RGC_results !-------------------------------------------------------------------------------------------------- pure function relaxationVector(intFace,instance,of) - implicit none real(pReal), dimension (3) :: relaxationVector integer, intent(in) :: instance,of @@ -1176,7 +1161,6 @@ end function relaxationVector !-------------------------------------------------------------------------------------------------- pure function interfaceNormal(intFace,instance,of) - implicit none real(pReal), dimension(3) :: interfaceNormal integer, dimension(4), intent(in) :: intFace !< interface ID in 4D array (normal and position) @@ -1202,7 +1186,6 @@ end function interfaceNormal !-------------------------------------------------------------------------------------------------- pure function getInterface(iFace,iGrain3) - implicit none integer, dimension(4) :: getInterface integer, dimension(3), intent(in) :: iGrain3 !< grain ID in 3D array @@ -1227,7 +1210,6 @@ end function getInterface !-------------------------------------------------------------------------------------------------- pure function grain1to3(grain1,nGDim) - implicit none integer, dimension(3) :: grain1to3 integer, intent(in) :: grain1 !< grain ID in 1D array @@ -1245,7 +1227,6 @@ end function grain1to3 !-------------------------------------------------------------------------------------------------- integer pure function grain3to1(grain3,nGDim) - implicit none integer, dimension(3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) integer, dimension(3), intent(in) :: nGDim @@ -1261,7 +1242,6 @@ end function grain3to1 !-------------------------------------------------------------------------------------------------- integer pure function interface4to1(iFace4D, nGDim) - implicit none integer, dimension(4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) integer, dimension(3), intent(in) :: nGDim @@ -1308,7 +1288,6 @@ end function interface4to1 !-------------------------------------------------------------------------------------------------- pure function interface1to4(iFace1D, nGDim) - implicit none integer, dimension(4) :: interface1to4 integer, intent(in) :: iFace1D !< interface ID in 1D array diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mech_isostrain.f90 index 39ed3a8c6..7dd7bad7d 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -38,8 +38,7 @@ module subroutine mech_isostrain_init IO_error use config, only: & config_homogenization - - implicit none + integer :: & Ninstance, & h, & @@ -91,7 +90,6 @@ end subroutine mech_isostrain_init !-------------------------------------------------------------------------------------------------- module subroutine mech_isostrain_partitionDeformation(F,avgF) - implicit none real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point @@ -105,8 +103,7 @@ end subroutine mech_isostrain_partitionDeformation !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) - - implicit none + real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index 8300acce6..e7a5a12e6 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -21,7 +21,6 @@ module subroutine mech_none_init use config, only: & config_homogenization - implicit none integer :: & Ninstance, & h, & diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 2ce058c19..349551d4d 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -68,7 +68,6 @@ subroutine kinematics_cleavage_opening_init() lattice_maxNcleavageFamily, & lattice_NcleavageSystem - implicit none integer, allocatable, dimension(:) :: tempInt real(pReal), allocatable, dimension(:) :: tempFloat @@ -140,7 +139,6 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i lattice_maxNcleavageFamily, & lattice_NcleavageSystem - implicit none integer, intent(in) :: & ipc, & !< grain number ip, & !< integration point number diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index c6e29e346..86932ea69 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -4,9 +4,7 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module kinematics_thermal_expansion - use prec, only: & - pReal, & - pInt + use prec implicit none private @@ -42,7 +40,6 @@ subroutine kinematics_thermal_expansion_init() use config, only: & config_phase - implicit none integer(pInt) :: & Ninstance, & p, i @@ -87,7 +84,6 @@ pure function kinematics_thermal_expansion_initialStrain(homog,phase,offset) lattice_thermalExpansion33, & lattice_referenceTemperature - implicit none integer(pInt), intent(in) :: & phase, & homog, offset @@ -120,7 +116,6 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, lattice_thermalExpansion33, & lattice_referenceTemperature - implicit none integer(pInt), intent(in) :: & ipc, & !< grain number ip, & !< integration point number diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 5168d4d4b..0404ee4ae 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -6,7 +6,7 @@ !> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver !-------------------------------------------------------------------------------------------------- module mesh - use prec, only: pReal, pInt + use prec use mesh_base implicit none @@ -405,7 +405,7 @@ contains subroutine tMesh_abaqus_init(self,elemType,nodes) - implicit none + class(tMesh_abaqus) :: self real(pReal), dimension(:,:), intent(in) :: nodes integer, intent(in) :: elemType @@ -438,7 +438,7 @@ subroutine mesh_init(ip,el) calcMode, & FEsolving_execElem, & FEsolving_execIP - implicit none + integer, parameter :: FILEUNIT = 222 integer, intent(in), optional :: el, ip integer :: j @@ -530,7 +530,7 @@ logical function hasNoPart(fileUnit) IO_stringValue, & IO_lc - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -571,7 +571,7 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) IO_countDataLines, & IO_error - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -631,7 +631,7 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) IO_stringPos, & IO_error - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -673,7 +673,7 @@ subroutine mesh_abaqus_count_materials(fileUnit) IO_stringPos, & IO_error - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -718,7 +718,7 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) IO_continuousIntValues, & IO_error - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -770,7 +770,7 @@ subroutine mesh_abaqus_map_materials(fileUnit) IO_extractValue, & IO_error - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -835,7 +835,7 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) IO_error, & IO_extractValue - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -890,7 +890,7 @@ subroutine mesh_abaqus_map_elements(fileUnit) IO_extractValue, & IO_error - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -955,7 +955,7 @@ subroutine mesh_abaqus_map_nodes(fileUnit) IO_intValue, & IO_error - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -1019,7 +1019,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) IO_countDataLines, & IO_intValue - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -1084,7 +1084,7 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) IO_countDataLines, & IO_intValue - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -1143,7 +1143,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) IO_countDataLines, & IO_error - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -1260,7 +1260,7 @@ use IO, only: & IO_stringValue, & IO_stringPos - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -1303,7 +1303,7 @@ end subroutine mesh_get_damaskOptions !-------------------------------------------------------------------------------------------------- subroutine mesh_build_cellconnectivity - implicit none + integer, dimension(:), allocatable :: & matchingNode2cellnode integer, dimension(:,:), allocatable :: & @@ -1371,7 +1371,7 @@ end subroutine mesh_build_cellconnectivity !-------------------------------------------------------------------------------------------------- function mesh_build_cellnodes(nodes,Ncellnodes) - implicit none + integer, intent(in) :: Ncellnodes !< requested number of cellnodes real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes @@ -1414,7 +1414,7 @@ subroutine mesh_build_ipVolumes math_volTetrahedron, & math_areaTriangle - implicit none + integer :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume @@ -1483,7 +1483,7 @@ end subroutine mesh_build_ipVolumes !-------------------------------------------------------------------------------------------------- subroutine mesh_build_ipCoordinates - implicit none + integer :: e,t,g,c,i,n real(pReal), dimension(3) :: myCoords @@ -1513,7 +1513,7 @@ end subroutine mesh_build_ipCoordinates !-------------------------------------------------------------------------------------------------- pure function mesh_cellCenterCoordinates(ip,el) - implicit none + integer, intent(in) :: el, & !< element number ip !< integration point number real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell @@ -1542,7 +1542,7 @@ subroutine mesh_build_ipAreas use math, only: & math_cross - implicit none + integer :: e,t,g,c,i,f,n,m real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal @@ -1614,7 +1614,7 @@ end subroutine mesh_build_ipAreas !-------------------------------------------------------------------------------------------------- subroutine mesh_build_nodeTwins - implicit none + integer dir, & ! direction of periodicity node, & minimumNode, & @@ -1685,7 +1685,7 @@ end subroutine mesh_build_nodeTwins !-------------------------------------------------------------------------------------------------- subroutine mesh_build_sharedElems - implicit none + integer(pint) e, & ! element index g, & ! element type node, & ! CP node index @@ -1750,7 +1750,7 @@ subroutine mesh_build_ipNeighborhood use math, only: & math_mul3x3 - implicit none + integer :: myElem, & ! my CP element index myIP, & myType, & ! my element type @@ -1915,7 +1915,7 @@ subroutine mesh_build_ipNeighborhood !-------------------------------------------------------------------------------------------------- subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) -implicit none + integer, intent(out) :: matchingElem, & ! matching CP element ID matchingFace ! matching face ID integer, intent(in) :: face, & ! face ID @@ -2005,7 +2005,7 @@ end subroutine mesh_build_ipNeighborhood integer function FE_mapElemtype(what) use IO, only: IO_lc, IO_error - implicit none + character(len=*), intent(in) :: what select case (IO_lc(what)) @@ -2049,7 +2049,7 @@ end function FE_mapElemtype !-------------------------------------------------------------------------------------------------- subroutine mesh_build_FEdata - implicit none + integer :: me allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0) allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0) @@ -2769,7 +2769,6 @@ integer function mesh_FEasCP(what,myID) use IO, only: & IO_lc - implicit none character(len=*), intent(in) :: what integer, intent(in) :: myID diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index fae228bc0..2ee9905dd 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -9,12 +9,8 @@ module mesh_base use, intrinsic :: iso_c_binding - use prec, only: & - pStringLen, & - pReal, & - pInt - use element, only: & - tElement + use prec + use element use future implicit none @@ -54,7 +50,6 @@ module mesh_base contains subroutine tMesh_base_init(self,meshType,elemType,nodes) - implicit none class(tMesh) :: self character(len=*), intent(in) :: meshType integer(pInt), intent(in) :: elemType @@ -74,8 +69,7 @@ end subroutine tMesh_base_init subroutine tMesh_base_setNelems(self,Nelems) - - implicit none + class(tMesh) :: self integer(pInt), intent(in) :: Nelems diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 7338c88f3..f1a3ff768 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -6,7 +6,7 @@ !> @brief Sets up the mesh for the solver MSC.Marc !-------------------------------------------------------------------------------------------------- module mesh - use prec, only: pReal, pInt + use prec use mesh_base implicit none @@ -265,7 +265,7 @@ contains subroutine tMesh_marc_init(self,elemType,nodes) - implicit none + class(tMesh_marc) :: self real(pReal), dimension(:,:), intent(in) :: nodes integer, intent(in) :: elemType @@ -299,7 +299,7 @@ subroutine mesh_init(ip,el) FEsolving_execElem, & FEsolving_execIP - implicit none + integer, intent(in) :: el, ip integer, parameter :: FILEUNIT = 222 @@ -420,7 +420,7 @@ integer function mesh_marc_get_fileFormat(fileUnit) IO_stringValue, & IO_stringPos - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -451,7 +451,7 @@ subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) IO_stringValue, & IO_stringPos - implicit none + integer, intent(out) :: initialcond, hypoelastic integer, intent(in) :: fileUnit @@ -486,7 +486,7 @@ function mesh_marc_get_matNumber(fileUnit,tableStyle) IO_stringValue, & IO_stringPos - implicit none + integer, intent(in) :: fileUnit, tableStyle integer, dimension(:), allocatable :: mesh_marc_get_matNumber @@ -534,7 +534,7 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) IO_stringPos, & IO_IntValue - implicit none + integer, intent(in) :: fileUnit integer, intent(out) :: nNodes, nElems @@ -572,7 +572,7 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) IO_stringPos, & IO_countContinuousIntValues - implicit none + integer, intent(in) :: fileUnit integer, intent(out) :: nElemSets, maxNelemInSet @@ -607,7 +607,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) IO_stringPos, & IO_continuousIntValues - implicit none + integer, intent(in) :: fileUnit character(len=64), dimension(:), intent(out) :: & nameElemSet @@ -647,7 +647,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileU IO_stringPos, & IO_continuousIntValues - implicit none + integer, intent(in) :: fileUnit,tableStyle,nElems character(len=64), intent(in), dimension(:) :: nameElemSet integer, dimension(:,:), intent(in) :: & @@ -717,7 +717,7 @@ subroutine mesh_marc_map_nodes(nNodes,fileUnit) IO_stringPos, & IO_fixedIntValue - implicit none + integer, intent(in) :: fileUnit, nNodes integer, allocatable, dimension(:) :: chunkPos @@ -760,7 +760,7 @@ subroutine mesh_marc_build_nodes(fileUnit) IO_fixedIntValue, & IO_fixedNoEFloatValue - implicit none + integer, intent(in) :: fileUnit integer, dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) @@ -807,7 +807,7 @@ integer function mesh_marc_count_cpSizes(fileUnit) IO_skipChunks use element - implicit none + integer, intent(in) :: fileUnit type(tElement) :: tempEl @@ -857,7 +857,7 @@ subroutine mesh_marc_build_elements(fileUnit) IO_continuousIntValues, & IO_error - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -955,7 +955,7 @@ use IO, only: & IO_stringValue, & IO_stringPos - implicit none + integer, intent(in) :: fileUnit integer, allocatable, dimension(:) :: chunkPos @@ -997,7 +997,7 @@ end subroutine mesh_get_damaskOptions !-------------------------------------------------------------------------------------------------- subroutine mesh_build_cellconnectivity - implicit none + integer, dimension(:), allocatable :: & matchingNode2cellnode integer, dimension(:,:), allocatable :: & @@ -1063,7 +1063,7 @@ end subroutine mesh_build_cellconnectivity !-------------------------------------------------------------------------------------------------- function mesh_build_cellnodes(nodes,Ncellnodes) - implicit none + integer, intent(in) :: Ncellnodes !< requested number of cellnodes real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes @@ -1105,7 +1105,7 @@ subroutine mesh_build_ipVolumes math_volTetrahedron, & math_areaTriangle - implicit none + integer :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume @@ -1174,7 +1174,7 @@ end subroutine mesh_build_ipVolumes !-------------------------------------------------------------------------------------------------- subroutine mesh_build_ipCoordinates - implicit none + integer :: e,t,g,c,i,n real(pReal), dimension(3) :: myCoords @@ -1204,7 +1204,7 @@ end subroutine mesh_build_ipCoordinates !-------------------------------------------------------------------------------------------------- pure function mesh_cellCenterCoordinates(ip,el) - implicit none + integer, intent(in) :: el, & !< element number ip !< integration point number real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell @@ -1232,7 +1232,7 @@ subroutine mesh_build_ipAreas use math, only: & math_cross - implicit none + integer :: e,t,g,c,i,f,n,m real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal @@ -1304,7 +1304,7 @@ end subroutine mesh_build_ipAreas !-------------------------------------------------------------------------------------------------- subroutine mesh_build_nodeTwins - implicit none + integer dir, & ! direction of periodicity node, & minimumNode, & @@ -1375,7 +1375,7 @@ end subroutine mesh_build_nodeTwins !-------------------------------------------------------------------------------------------------- subroutine mesh_build_sharedElems - implicit none + integer(pint) e, & ! element index g, & ! element type node, & ! CP node index @@ -1440,7 +1440,7 @@ subroutine mesh_build_ipNeighborhood use math, only: & math_mul3x3 - implicit none + integer :: myElem, & ! my CP element index myIP, & myType, & ! my element type @@ -1606,7 +1606,7 @@ subroutine mesh_build_ipNeighborhood !-------------------------------------------------------------------------------------------------- subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) -implicit none + integer, intent(out) :: matchingElem, & ! matching CP element ID matchingFace ! matching face ID integer, intent(in) :: face, & ! face ID @@ -1696,7 +1696,7 @@ end subroutine mesh_build_ipNeighborhood integer function FE_mapElemtype(what) use IO, only: IO_lc, IO_error - implicit none + character(len=*), intent(in) :: what select case (IO_lc(what)) @@ -1742,7 +1742,7 @@ end function FE_mapElemtype !-------------------------------------------------------------------------------------------------- subroutine mesh_build_FEdata - implicit none + integer :: me allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0) @@ -1798,7 +1798,7 @@ integer function mesh_FEasCP(what,myID) use IO, only: & IO_lc - implicit none + character(len=*), intent(in) :: what integer, intent(in) :: myID diff --git a/src/numerics.f90 b/src/numerics.f90 index f7c603c60..30ece7520 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -4,9 +4,7 @@ !> @brief Managing of parameters related to numerics !-------------------------------------------------------------------------------------------------- module numerics - use prec, only: & - pInt, & - pReal + use prec implicit none private @@ -131,8 +129,6 @@ contains ! a sanity check !-------------------------------------------------------------------------------------------------- subroutine numerics_init - use prec, only: & - pStringLen use IO, only: & IO_read_ASCII, & IO_error, & @@ -148,7 +144,6 @@ subroutine numerics_init use petscsys #endif !$ use OMP_LIB, only: omp_set_num_threads - implicit none !$ integer :: gotDAMASK_NUM_THREADS = 1 integer :: i,j, ierr ! no pInt integer(pInt), allocatable, dimension(:) :: chunkPos From ae084bb2aae2dbcc8cc73f99a3e3adeb7a86cd88 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 15 May 2019 09:35:02 +0200 Subject: [PATCH 17/59] avoid test failure for nonlocal --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 183d7a3a3..d96bfb329 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 183d7a3a3bafa0a308c3eac858ca03c08fc03d50 +Subproject commit d96bfb32920c96a8a43958f76a209d34c6bd841a From 880bc330f09594f4435f400621c8e3fb70a9349b Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 15 May 2019 13:27:18 +0200 Subject: [PATCH 18/59] [skip ci] updated version information after successful test of v2.0.3-297-gae084bb2 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6e0c223d2..acf2aa8dc 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-284-g4c7af713 +v2.0.3-297-gae084bb2 From c6863a612407b2e746ee54bb5638e27706b8b6fa Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 15 May 2019 23:32:23 +0200 Subject: [PATCH 19/59] also consider homogenization/materialpoint results --- python/damask/dadf5.py | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/python/damask/dadf5.py b/python/damask/dadf5.py index 841029af8..eed5907e5 100644 --- a/python/damask/dadf5.py +++ b/python/damask/dadf5.py @@ -48,16 +48,24 @@ class DADF5(): for o in f['inc{:05}/constituent/{}'.format(self.increments[0]['inc'],c)].keys(): self.c_output_types.append(o) self.c_output_types = list(set(self.c_output_types)) # make unique + + self.m_output_types = [] + for m in self.materialpoints: + for o in f['inc{:05}/materialpoint/{}'.format(self.increments[0]['inc'],m)].keys(): + self.m_output_types.append(o) + self.m_output_types = list(set(self.m_output_types)) # make unique self.active= {'increments': self.increments, 'constituents': self.constituents, 'materialpoints': self.materialpoints, 'constituent': self.Nconstituents, - 'c_output_types': self.c_output_types} + 'c_output_types': self.c_output_types, + 'm_output_types': self.m_output_types} self.filename = filename self.mode = mode - + + def list_data(self): """Shows information on all datasets in the file""" with h5py.File(self.filename,'r') as f: @@ -73,6 +81,17 @@ class DADF5(): print(' {} ({})'.format(x,f[group_output_types+'/'+x].attrs['Description'].decode())) except: pass + for m in self.active['materialpoints']: + print('\n'+m) + group_materialpoint = group_inc+'/materialpoint/'+m + for t in self.active['m_output_types']: + print(' {}'.format(t)) + group_output_types = group_materialpoint+'/'+t + try: + for x in f[group_output_types].keys(): + print(' {} ({})'.format(x,f[group_output_types+'/'+x].attrs['Description'].decode())) + except: + pass def get_dataset_location(self,label): From e49e3a5d579e1c9beb2dea36f44ecdc1d36f5853 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 15 May 2019 23:51:29 +0200 Subject: [PATCH 20/59] [skip ci] updated version information after successful test of v2.0.3-301-g789420c9 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index acf2aa8dc..69faed072 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-297-gae084bb2 +v2.0.3-301-g789420c9 From 3c0c0a2cd10d38c472b92d84cb687f2268653b02 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 00:27:06 +0200 Subject: [PATCH 21/59] more flexible in selecting data --- processing/post/DADF5_postResults.py | 28 ++++++++++++++++++++++++---- processing/post/DADF5_vtk_cells.py | 9 +++++++-- python/damask/dadf5.py | 26 +++++++++++++++++++++----- 3 files changed, 52 insertions(+), 11 deletions(-) diff --git a/processing/post/DADF5_postResults.py b/processing/post/DADF5_postResults.py index caf09d536..5ad49604b 100755 --- a/processing/post/DADF5_postResults.py +++ b/processing/post/DADF5_postResults.py @@ -22,10 +22,15 @@ parser.add_argument('filenames', nargs='+', help='DADF5 files') parser.add_argument('-d','--dir', dest='dir',default='postProc',metavar='string', help='name of subdirectory to hold output') +parser.add_argument('--mat', nargs='+', + help='labels for materialpoint/homogenization',dest='mat') +parser.add_argument('--con', nargs='+', + help='labels for constituent/crystallite/constitutive',dest='con') options = parser.parse_args() -options.labels = ['Fe','Fp','xi_sl'] +if options.mat is None: options.mat=[] +if options.con is None: options.con=[] # --- loop over input files ------------------------------------------------------------------------ @@ -57,7 +62,7 @@ for filename in options.filenames: header+=' 1_pos 2_pos 3_pos' results.active['increments'] = [inc] - for label in options.labels: + for label in options.con: for o in results.c_output_types: results.active['c_output_types'] = [o] for c in results.constituents: @@ -67,12 +72,27 @@ for filename in options.filenames: continue label = x[0].split('/')[-1] array = results.read_dataset(x,0) - d = np.product(np.shape(array)[1:]) + d = int(np.product(np.shape(array)[1:])) + array = np.reshape(array,[np.product(results.grid),d]) + data = np.concatenate((data,array),1) + + header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) + + for label in options.mat: + for o in results.m_output_types: + results.active['m_output_types'] = [o] + for m in results.materialpoints: + results.active['materialpoints'] = [m] + x = results.get_dataset_location(label) + if len(x) == 0: + continue + label = x[0].split('/')[-1] + array = results.read_dataset(x,0) + d = int(np.product(np.shape(array)[1:])) array = np.reshape(array,[np.product(results.grid),d]) data = np.concatenate((data,array),1) header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) - dirname = os.path.abspath(os.path.join(os.path.dirname(filename),options.dir)) try: diff --git a/processing/post/DADF5_vtk_cells.py b/processing/post/DADF5_vtk_cells.py index dc1177488..0e79209e2 100755 --- a/processing/post/DADF5_vtk_cells.py +++ b/processing/post/DADF5_vtk_cells.py @@ -23,10 +23,15 @@ parser.add_argument('filenames', nargs='+', help='DADF5 files') parser.add_argument('-d','--dir', dest='dir',default='postProc',metavar='string', help='name of subdirectory to hold output') +parser.add_argument('--mat', nargs='+', + help='labels for materialpoint/homogenization',dest='mat') +parser.add_argument('--con', nargs='+', + help='labels for constituent/crystallite/constitutive',dest='con') options = parser.parse_args() -options.labels = ['Fe','Fp','xi_sl'] +if options.mat is None: options.mat=[] +if options.con is None: options.con=[] # --- loop over input files ------------------------------------------------------------------------ @@ -54,7 +59,7 @@ for filename in options.filenames: print('Output step {}/{}'.format(i+1,len(results.increments))) vtk_data = [] results.active['increments'] = [inc] - for label in options.labels: + for label in options.con: for o in results.c_output_types: results.active['c_output_types'] = [o] if o != 'generic': diff --git a/python/damask/dadf5.py b/python/damask/dadf5.py index eed5907e5..56082a1f4 100644 --- a/python/damask/dadf5.py +++ b/python/damask/dadf5.py @@ -82,7 +82,6 @@ class DADF5(): except: pass for m in self.active['materialpoints']: - print('\n'+m) group_materialpoint = group_inc+'/materialpoint/'+m for t in self.active['m_output_types']: print(' {}'.format(t)) @@ -108,6 +107,14 @@ class DADF5(): path.append(group_constituent+'/'+t+'/'+label) except: pass + for m in self.active['materialpoints']: + group_materialpoint = group_inc+'/materialpoint/'+m + for t in self.active['m_output_types']: + try: + f[group_materialpoint+'/'+t+'/'+label] + path.append(group_materialpoint+'/'+t+'/'+label) + except: + pass return path @@ -122,10 +129,19 @@ class DADF5(): dataset = np.full(shape,np.nan) for pa in path: label = pa.split('/')[2] - p = np.where(f['mapping/cellResults/constituent'][:,c]['Name'] == str.encode(label))[0] - u = (f['mapping/cellResults/constituent'][p,c]['Position']) - dataset[p,:] = f[pa][u,:] - + try: + p = np.where(f['mapping/cellResults/constituent'][:,c]['Name'] == str.encode(label))[0] + u = (f['mapping/cellResults/constituent'][p,c]['Position']) + dataset[p,:] = f[pa][u,:] # does not work for scalar datasets + except: + pass + try: + p = np.where(f['mapping/cellResults/materialpoint']['Name'] == str.encode(label))[0] + u = (f['mapping/cellResults/materialpoint'][p.tolist()]['Position']) + dataset[p,:] = f[pa][u,:] # does not work for scalar datasets + except: + pass + return dataset From 4599d1c34e219d9c1ab3d49971d4d37ab65049e3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 00:42:22 +0200 Subject: [PATCH 22/59] does not match node does not make sense, is weirdly numbered --- processing/post/DADF5_postResults.py | 3 --- 1 file changed, 3 deletions(-) diff --git a/processing/post/DADF5_postResults.py b/processing/post/DADF5_postResults.py index 5ad49604b..b918388d9 100755 --- a/processing/post/DADF5_postResults.py +++ b/processing/post/DADF5_postResults.py @@ -53,9 +53,6 @@ for filename in options.filenames: data = np.array([inc['inc'] for j in range(np.product(results.grid))]).reshape([np.product(results.grid),1]) header+= 'inc' - - data = np.concatenate((data,np.array([j+1 for j in range(np.product(results.grid))]).reshape([np.product(results.grid),1])),1) - header+=' node' coords = coords.reshape([np.product(results.grid),3]) data = np.concatenate((data,coords),1) From 9f7fa5393a8af1d784433262dfbbe8bebded5ab0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 09:31:13 +0200 Subject: [PATCH 23/59] fix for scalar datasets --- processing/post/DADF5_postResults.py | 12 +++++++++--- python/damask/dadf5.py | 11 +++++++++-- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/processing/post/DADF5_postResults.py b/processing/post/DADF5_postResults.py index b918388d9..1af8c2aa9 100755 --- a/processing/post/DADF5_postResults.py +++ b/processing/post/DADF5_postResults.py @@ -73,8 +73,11 @@ for filename in options.filenames: array = np.reshape(array,[np.product(results.grid),d]) data = np.concatenate((data,array),1) - header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) - + if d>1: + header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) + else: + header+=' '+label + for label in options.mat: for o in results.m_output_types: results.active['m_output_types'] = [o] @@ -89,7 +92,10 @@ for filename in options.filenames: array = np.reshape(array,[np.product(results.grid),d]) data = np.concatenate((data,array),1) - header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) + if d>1: + header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) + else: + header+=' '+label dirname = os.path.abspath(os.path.join(os.path.dirname(filename),options.dir)) try: diff --git a/python/damask/dadf5.py b/python/damask/dadf5.py index 56082a1f4..0abde662b 100644 --- a/python/damask/dadf5.py +++ b/python/damask/dadf5.py @@ -126,19 +126,26 @@ class DADF5(): """ with h5py.File(self.filename,'r') as f: shape = (self.Nmaterialpoints,) + np.shape(f[path[0]])[1:] + if len(shape) == 1: shape = shape +(1,) dataset = np.full(shape,np.nan) for pa in path: label = pa.split('/')[2] try: p = np.where(f['mapping/cellResults/constituent'][:,c]['Name'] == str.encode(label))[0] u = (f['mapping/cellResults/constituent'][p,c]['Position']) - dataset[p,:] = f[pa][u,:] # does not work for scalar datasets + a = np.array(f[pa]) + if len(a.shape) == 1: + a=a.reshape([a.shape[0],1]) + dataset except: pass try: p = np.where(f['mapping/cellResults/materialpoint']['Name'] == str.encode(label))[0] u = (f['mapping/cellResults/materialpoint'][p.tolist()]['Position']) - dataset[p,:] = f[pa][u,:] # does not work for scalar datasets + a = np.array(f[pa]) + if len(a.shape) == 1: + a=a.reshape([a.shape[0],1]) + dataset[p,:] = a[u,:] except: pass From f2268d055ff9889e11aeafbc8d0a6c34e247a75f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 09:42:37 +0200 Subject: [PATCH 24/59] first test relying on DADF5 --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index d96bfb329..df0b7cc97 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit d96bfb32920c96a8a43958f76a209d34c6bd841a +Subproject commit df0b7cc97963cd712f6e33397937b187635c99f4 From 84a82d0878f442067ac6c3fba30276c0c7523f21 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 09:46:50 +0200 Subject: [PATCH 25/59] rely on working HDF5 output for RGC homog --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index df0b7cc97..8cec21296 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit df0b7cc97963cd712f6e33397937b187635c99f4 +Subproject commit 8cec2129617f4a206193671e0e1070965c7c2e53 From 0958c4bb88bc441e598a460eb785344ca9edf9dd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 09:48:30 +0200 Subject: [PATCH 26/59] phase out postResults --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 8cec21296..639c6f4a5 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 8cec2129617f4a206193671e0e1070965c7c2e53 +Subproject commit 639c6f4a5eafc893c83c740c57f417eaaabc45ae From 39a75c201545327d62a37df8f3b8f89b21cf3a32 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 10:23:23 +0200 Subject: [PATCH 27/59] phasing out postResults starting with RGC because it is rarely used and removing it here allows to go ahead with the submodule structure for homogenization --- src/homogenization.f90 | 44 +---------------- src/homogenization_mech_RGC.f90 | 88 +++------------------------------ 2 files changed, 10 insertions(+), 122 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 77a2e004f..1ff036c3a 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -120,7 +120,6 @@ subroutine homogenization_init character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready logical :: valid - if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call homogenization_RGC_init @@ -139,35 +138,9 @@ subroutine homogenization_init call IO_write_jobFile(FILEUNIT,'outputHomogenization') do p = 1,size(config_homogenization) if (any(material_homogenizationAt == p)) then - i = homogenization_typeInstance(p) ! which instance of this homogenization type - valid = .true. ! assume valid - select case(homogenization_type(p)) ! split per homogenization type - case (HOMOGENIZATION_NONE_ID) - outputName = HOMOGENIZATION_NONE_label - thisOutput => null() - thisSize => null() - case (HOMOGENIZATION_ISOSTRAIN_ID) - outputName = HOMOGENIZATION_ISOSTRAIN_label - thisOutput => null() - thisSize => null() - case (HOMOGENIZATION_RGC_ID) - outputName = HOMOGENIZATION_RGC_label - thisOutput => homogenization_RGC_output - thisSize => homogenization_RGC_sizePostResult - case default - valid = .false. - end select write(FILEUNIT,'(/,a,/)') '['//trim(homogenization_name(p))//']' - if (valid) then - write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName) - write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) - if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID .and. & - homogenization_type(p) /= HOMOGENIZATION_ISOSTRAIN_ID) then - do e = 1,size(thisOutput(:,i)) - write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) - enddo - endif - endif + write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) + i = thermal_typeInstance(p) ! which instance of this thermal type valid = .true. ! assume valid select case(thermal_type(p)) ! split per thermal type @@ -837,8 +810,6 @@ end subroutine averageStressAndItsTangent function postResults(ip,el) use mesh, only: & mesh_element - use homogenization_mech_RGC, only: & - homogenization_RGC_postResults use thermal_adiabatic, only: & thermal_adiabatic_postResults use thermal_conduction, only: & @@ -861,17 +832,6 @@ function postResults(ip,el) postResults = 0.0_pReal - startPos = 1 - endPos = homogState(material_homogenizationAt(el))%sizePostResults - chosenHomogenization: select case (homogenization_type(mesh_element(3,el))) - - case (HOMOGENIZATION_RGC_ID) chosenHomogenization - instance = homogenization_typeInstance(material_homogenizationAt(el)) - of = mappingHomogenization(1,ip,el) - postResults(startPos:endPos) = homogenization_RGC_postResults(instance,of) - - end select chosenHomogenization - startPos = endPos + 1 endPos = endPos + thermalState(material_homogenizationAt(el))%sizePostResults chosenThermal: select case (thermal_type(mesh_element(3,el))) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index d3feac1eb..d7b1b31bf 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -12,10 +12,6 @@ module homogenization_mech_RGC implicit none private - integer, dimension(:,:), allocatable,target, public :: & - homogenization_RGC_sizePostResult - character(len=64), dimension(:,:), allocatable,target, public :: & - homogenization_RGC_output ! name of each post result output enum, bind(c) enumerator :: & @@ -28,7 +24,7 @@ module homogenization_mech_RGC magnitudemismatch_ID end enum - type, private :: tParameters + type :: tParameters integer, dimension(:), allocatable :: & Nconstituents real(pReal) :: & @@ -43,7 +39,7 @@ module homogenization_mech_RGC outputID end type tParameters - type, private :: tRGCstate + type :: tRGCstate real(pReal), pointer, dimension(:) :: & work, & penaltyEnergy @@ -51,7 +47,7 @@ module homogenization_mech_RGC relaxationVector end type tRGCstate - type, private :: tRGCdependentState + type :: tRGCdependentState real(pReal), allocatable, dimension(:) :: & volumeDiscrepancy, & relaxationRate_avg, & @@ -62,12 +58,12 @@ module homogenization_mech_RGC orientation end type tRGCdependentState - type(tparameters), dimension(:), allocatable, private :: & + type(tparameters), dimension(:), allocatable :: & param - type(tRGCstate), dimension(:), allocatable, private :: & + type(tRGCstate), dimension(:), allocatable :: & state, & state0 - type(tRGCdependentState), dimension(:), allocatable, private :: & + type(tRGCdependentState), dimension(:), allocatable :: & dependentState public :: & @@ -75,16 +71,7 @@ module homogenization_mech_RGC homogenization_RGC_partitionDeformation, & homogenization_RGC_averageStressAndItsTangent, & homogenization_RGC_updateState, & - homogenization_RGC_postResults, & mech_RGC_results ! name suited for planned submodule situation - private :: & - relaxationVector, & - interfaceNormal, & - getInterface, & - grain1to3, & - grain3to1, & - interface4to1, & - interface1to4 contains @@ -111,7 +98,7 @@ subroutine homogenization_RGC_init() integer :: & Ninstance, & h, i, & - NofMyHomog, outputSize, & + NofMyHomog, & sizeState, nIntFaceTot character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -139,9 +126,6 @@ subroutine homogenization_RGC_init() allocate(state0(Ninstance)) allocate(dependentState(Ninstance)) - allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),Ninstance),source=0) - allocate(homogenization_RGC_output(maxval(homogenization_Noutput),Ninstance)) - homogenization_RGC_output='' do h = 1, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle @@ -176,28 +160,20 @@ subroutine homogenization_RGC_init() case('constitutivework') outputID = constitutivework_ID - outputSize = 1 case('penaltyenergy') outputID = penaltyenergy_ID - outputSize = 1 case('volumediscrepancy') outputID = volumediscrepancy_ID - outputSize = 1 case('averagerelaxrate') outputID = averagerelaxrate_ID - outputSize = 1 case('maximumrelaxrate') outputID = maximumrelaxrate_ID - outputSize = 1 case('magnitudemismatch') outputID = magnitudemismatch_ID - outputSize = 3 end select if (outputID /= undefined_ID) then - homogenization_RGC_output(i,homogenization_typeInstance(h)) = outputs(i) - homogenization_RGC_sizePostResult(i,homogenization_typeInstance(h)) = outputSize prm%outputID = [prm%outputID , outputID] endif @@ -211,7 +187,7 @@ subroutine homogenization_RGC_init() + size(['avg constitutive work ','average penalty energy']) homogState(h)%sizeState = sizeState - homogState(h)%sizePostResults = sum(homogenization_RGC_sizePostResult(:,homogenization_typeInstance(h))) + homogState(h)%sizePostResults = 0 allocate(homogState(h)%state0 (sizeState,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%subState0(sizeState,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%state (sizeState,NofMyHomog), source=0.0_pReal) @@ -1033,54 +1009,6 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF, end subroutine homogenization_RGC_averageStressAndItsTangent -!-------------------------------------------------------------------------------------------------- -!> @brief return array of homogenization results for post file inclusion -!-------------------------------------------------------------------------------------------------- -pure function homogenization_RGC_postResults(instance,of) result(postResults) - - integer, intent(in) :: & - instance, & - of - - integer :: & - o,c - real(pReal), dimension(sum(homogenization_RGC_sizePostResult(:,instance))) :: & - postResults - - associate(stt => state(instance), dst => dependentState(instance), prm => param(instance)) - - c = 0 - - outputsLoop: do o = 1,size(prm%outputID) - select case(prm%outputID(o)) - - case (constitutivework_ID) - postResults(c+1) = stt%work(of) - c = c + 1 - case (magnitudemismatch_ID) - postResults(c+1:c+3) = dst%mismatch(1:3,of) - c = c + 3 - case (penaltyenergy_ID) - postResults(c+1) = stt%penaltyEnergy(of) - c = c + 1 - case (volumediscrepancy_ID) - postResults(c+1) = dst%volumeDiscrepancy(of) - c = c + 1 - case (averagerelaxrate_ID) - postResults(c+1) = dst%relaxationrate_avg(of) - c = c + 1 - case (maximumrelaxrate_ID) - postResults(c+1) = dst%relaxationrate_max(of) - c = c + 1 - end select - - enddo outputsLoop - - end associate - -end function homogenization_RGC_postResults - - !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file ! ToDo: check wheter units are correct From 339b86f784bdb31c1359b486203e12d1e1d0717a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 11:44:03 +0200 Subject: [PATCH 28/59] bugfix + more verbose reporting --- processing/post/DADF5_postResults.py | 2 +- processing/post/DADF5_vtk_cells.py | 2 ++ python/damask/dadf5.py | 23 +++++++++++++---------- 3 files changed, 16 insertions(+), 11 deletions(-) diff --git a/processing/post/DADF5_postResults.py b/processing/post/DADF5_postResults.py index 1af8c2aa9..fa47805bb 100755 --- a/processing/post/DADF5_postResults.py +++ b/processing/post/DADF5_postResults.py @@ -78,7 +78,7 @@ for filename in options.filenames: else: header+=' '+label - for label in options.mat: + for label in options.mat: for o in results.m_output_types: results.active['m_output_types'] = [o] for m in results.materialpoints: diff --git a/processing/post/DADF5_vtk_cells.py b/processing/post/DADF5_vtk_cells.py index 0e79209e2..ef27a973c 100755 --- a/processing/post/DADF5_vtk_cells.py +++ b/processing/post/DADF5_vtk_cells.py @@ -59,7 +59,9 @@ for filename in options.filenames: print('Output step {}/{}'.format(i+1,len(results.increments))) vtk_data = [] results.active['increments'] = [inc] + for label in options.con: + for o in results.c_output_types: results.active['c_output_types'] = [o] if o != 'generic': diff --git a/python/damask/dadf5.py b/python/damask/dadf5.py index 0abde662b..4aa31ec56 100644 --- a/python/damask/dadf5.py +++ b/python/damask/dadf5.py @@ -99,22 +99,25 @@ class DADF5(): with h5py.File(self.filename,'r') as f: for i in self.active['increments']: group_inc = 'inc{:05}'.format(i['inc']) + for c in self.active['constituents']: group_constituent = group_inc+'/constituent/'+c for t in self.active['c_output_types']: try: f[group_constituent+'/'+t+'/'+label] path.append(group_constituent+'/'+t+'/'+label) - except: - pass - for m in self.active['materialpoints']: + except Exception as e: + print('unable to locate constituents dataset: '+ str(e)) + + for m in []: #self.active['materialpoints']: group_materialpoint = group_inc+'/materialpoint/'+m for t in self.active['m_output_types']: try: f[group_materialpoint+'/'+t+'/'+label] path.append(group_materialpoint+'/'+t+'/'+label) - except: - pass + except Exception as e: + print('unable to locate materialpoints dataset: '+ str(e)) + return path @@ -136,9 +139,9 @@ class DADF5(): a = np.array(f[pa]) if len(a.shape) == 1: a=a.reshape([a.shape[0],1]) - dataset - except: - pass + dataset[p,:] = a[u,:] + except Exception as e: + print('unable to read constituent: '+ str(e)) try: p = np.where(f['mapping/cellResults/materialpoint']['Name'] == str.encode(label))[0] u = (f['mapping/cellResults/materialpoint'][p.tolist()]['Position']) @@ -146,8 +149,8 @@ class DADF5(): if len(a.shape) == 1: a=a.reshape([a.shape[0],1]) dataset[p,:] = a[u,:] - except: - pass + except Exception as e: + print('unable to read materialpoint: '+ str(e)) return dataset From f8b335a3a485a1269e93670cd51e8f5db46d5c78 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 18:24:54 +0200 Subject: [PATCH 29/59] loop (forall) over integration points wrong this was done for each integration point, but this was not detected for the forall loop --- src/homogenization.f90 | 119 ++++++++++++++++++++--------------------- 1 file changed, 59 insertions(+), 60 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 77a2e004f..605cf5094 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -375,43 +375,46 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! initialize restoration points of ... do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Ngrains(mesh_element(3,e)) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do g = 1,myNgrains + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); + do g = 1,myNgrains + + plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & + plasticState (phaseAt(g,i,e))%state0( :,phasememberAt(g,i,e)) + do mySource = 1, phase_Nsources(phaseAt(g,i,e)) + sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & + sourceState(phaseAt(g,i,e))%p(mySource)%state0( :,phasememberAt(g,i,e)) + enddo + + crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) + crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) + crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) + crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) + crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) + crystallite_partionedS0(1:3,1:3,g,i,e) = crystallite_S0(1:3,1:3,g,i,e) - plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & - plasticState (phaseAt(g,i,e))%state0( :,phasememberAt(g,i,e)) - do mySource = 1, phase_Nsources(phaseAt(g,i,e)) - sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & - sourceState(phaseAt(g,i,e))%p(mySource)%state0( :,phasememberAt(g,i,e)) enddo - crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) ! ...plastic def grads - crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) ! ...plastic velocity grads - crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) ! ...intermediate def grads - crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) ! ...intermediate velocity grads - crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) ! ...def grads - crystallite_partionedS0(1:3,1:3,g,i,e) = crystallite_S0(1:3,1:3,g,i,e) ! ...2nd PK stress - enddo; enddo - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e)) - materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e) ! ...def grad + materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e) materialpoint_subFrac(i,e) = 0.0_pReal materialpoint_subStep(i,e) = 1.0_pReal/subStepSizeHomog ! <> materialpoint_converged(i,e) = .false. ! pretend failed step of twice the required size materialpoint_requested(i,e) = .true. ! everybody requires calculation - endforall - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - homogState(material_homogenizationAt(e))%sizeState > 0) & - homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - thermalState(material_homogenizationAt(e))%sizeState > 0) & - thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - damageState(material_homogenizationAt(e))%sizeState > 0) & - damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state + + if (homogState(material_homogenizationAt(e))%sizeState > 0) & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + homogState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state + + if (thermalState(material_homogenizationAt(e))%sizeState > 0) & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + thermalState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state + + if (damageState(material_homogenizationAt(e))%sizeState > 0) & + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + damageState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state + enddo enddo + NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. & @@ -422,7 +425,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) myNgrains = homogenization_Ngrains(mesh_element(3,e)) IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - converged: if ( materialpoint_converged(i,e) ) then + converged: if (materialpoint_converged(i,e)) then #ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 & .and. ((e == debug_e .and. i == debug_i) & @@ -443,22 +446,22 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! wind forward grain starting point of... crystallite_partionedF0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedF(1:3,1:3,1:myNgrains,i,e) ! ...def grads + crystallite_partionedF(1:3,1:3,1:myNgrains,i,e) crystallite_partionedFp0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Fp (1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads + crystallite_Fp (1:3,1:3,1:myNgrains,i,e) crystallite_partionedLp0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Lp (1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads + crystallite_Lp (1:3,1:3,1:myNgrains,i,e) crystallite_partionedFi0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Fi (1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads + crystallite_Fi (1:3,1:3,1:myNgrains,i,e) crystallite_partionedLi0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Li (1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads + crystallite_Li (1:3,1:3,1:myNgrains,i,e) crystallite_partionedS0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_S (1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress + crystallite_S (1:3,1:3,1:myNgrains,i,e) do g = 1,myNgrains plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & @@ -469,23 +472,22 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) enddo enddo - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - homogState(material_homogenizationAt(e))%sizeState > 0) & + if(homogState(material_homogenizationAt(e))%sizeState > 0) & homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) ! ...internal homogenization state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - thermalState(material_homogenizationAt(e))%sizeState > 0) & + homogState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) + if(thermalState(material_homogenizationAt(e))%sizeState > 0) & thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) ! ...internal thermal state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - damageState(material_homogenizationAt(e))%sizeState > 0) & + thermalState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) + if(damageState(material_homogenizationAt(e))%sizeState > 0) & damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) ! ...internal damage state - materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad + damageState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) + + materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) + endif steppingNeeded else converged - if ( (myNgrains == 1 .and. materialpoint_subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + if ( (myNgrains == 1 .and. materialpoint_subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite subStepSizeHomog * materialpoint_subStep(i,e) <= subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense !$OMP FLUSH(terminallyIll) @@ -514,16 +516,16 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! restore... if (materialpoint_subStep(i,e) < 1.0_pReal) then ! protect against fake cutback from \Delta t = 2 to 1. Maybe that "trick" is not necessary anymore at all? I.e. start with \Delta t = 1 crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads + crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) crystallite_Li(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads + crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) endif ! maybe protecting everything from overwriting (not only L) makes even more sense crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads + crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads + crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) crystallite_S(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress + crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) do g = 1, myNgrains plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e)) = & plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) @@ -532,18 +534,15 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) enddo enddo - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - homogState(material_homogenizationAt(e))%sizeState > 0) & + if(homogState(material_homogenizationAt(e))%sizeState > 0) & homogState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal homogenization state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - thermalState(material_homogenizationAt(e))%sizeState > 0) & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) + if(thermalState(material_homogenizationAt(e))%sizeState > 0) & thermalState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal thermal state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - damageState(material_homogenizationAt(e))%sizeState > 0) & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) + if(damageState(material_homogenizationAt(e))%sizeState > 0) & damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) endif endif converged From 6df563624dc858ed5204c7181006fcddeb0b956a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 21:57:20 +0200 Subject: [PATCH 30/59] type needed for postResults --- src/homogenization.f90 | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 1ff036c3a..426b37cb8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -138,9 +138,23 @@ subroutine homogenization_init call IO_write_jobFile(FILEUNIT,'outputHomogenization') do p = 1,size(config_homogenization) if (any(material_homogenizationAt == p)) then + i = homogenization_typeInstance(p) ! which instance of this homogenization type + valid = .true. ! assume valid + select case(homogenization_type(p)) ! split per homogenization type + case (HOMOGENIZATION_NONE_ID) + outputName = HOMOGENIZATION_NONE_label + case (HOMOGENIZATION_ISOSTRAIN_ID) + outputName = HOMOGENIZATION_ISOSTRAIN_label + case (HOMOGENIZATION_RGC_ID) + outputName = HOMOGENIZATION_RGC_label + case default + valid = .false. + end select write(FILEUNIT,'(/,a,/)') '['//trim(homogenization_name(p))//']' - write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) - + if (valid) then + write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName) + write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) + endif i = thermal_typeInstance(p) ! which instance of this thermal type valid = .true. ! assume valid select case(thermal_type(p)) ! split per thermal type From 118c74a268ef9417903576fd7f886d2b4ab569c1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 22:01:12 +0200 Subject: [PATCH 31/59] enable materialpoint output again accidently lost during a former commit --- python/damask/dadf5.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/damask/dadf5.py b/python/damask/dadf5.py index 4aa31ec56..f5fc81b16 100644 --- a/python/damask/dadf5.py +++ b/python/damask/dadf5.py @@ -109,7 +109,7 @@ class DADF5(): except Exception as e: print('unable to locate constituents dataset: '+ str(e)) - for m in []: #self.active['materialpoints']: + for m in self.active['materialpoints']: group_materialpoint = group_inc+'/materialpoint/'+m for t in self.active['m_output_types']: try: From 028bdcff22aed5717f70f63a07a8ee8f5fa3716d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 22:24:42 +0200 Subject: [PATCH 32/59] less compiler complaints --- src/crystallite.f90 | 5 ----- src/damage_local.f90 | 2 +- src/kinematics_cleavage_opening.f90 | 2 +- src/kinematics_slipplane_opening.f90 | 2 +- src/thermal_adiabatic.f90 | 1 - 5 files changed, 3 insertions(+), 9 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 3116345b6..dce93695a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1125,9 +1125,6 @@ subroutine crystallite_results use config, only: & config_name_phase => phase_name ! anticipate logical name - use material, only: & - material_phase_plasticity_type => phase_plasticity - integer :: p,o real(pReal), allocatable, dimension(:,:,:) :: selected_tensors type(rotation), allocatable, dimension(:) :: selected_rotations @@ -2588,8 +2585,6 @@ logical function stateJump(ipc,ip,el) sourceState, & phase_Nsources, & phaseAt, phasememberAt - use mesh, only: & - mesh_element use constitutive, only: & constitutive_collectDeltaState diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 1ec42f863..2db8cccc1 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -61,7 +61,7 @@ subroutine damage_local_init config_homogenization - integer :: maxNinstance,homog,instance,o,i + integer :: maxNinstance,homog,instance,i integer :: sizeState integer :: NofMyHomog, h integer(kind(undefined_ID)) :: & diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 349551d4d..a79dc4042 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -71,7 +71,7 @@ subroutine kinematics_cleavage_opening_init() integer, allocatable, dimension(:) :: tempInt real(pReal), allocatable, dimension(:) :: tempFloat - integer :: maxNinstance,p,instance,kinematics + integer :: maxNinstance,p,instance write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 7a0b2fe99..f29c0e252 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -57,7 +57,7 @@ subroutine kinematics_slipplane_opening_init() use lattice - integer :: maxNinstance,p,instance,kinematics + integer :: maxNinstance,p,instance write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index bfc34d1c4..bfd5633d1 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -163,7 +163,6 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) use material, only: & homogenization_Ngrains, & material_homogenizationAt, & - mappingHomogenization, & phaseAt, & phasememberAt, & thermal_typeInstance, & From 01e3b646c288e1e35535491981cd8304e21f19dd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 22:56:48 +0200 Subject: [PATCH 33/59] don't clutter the code with useless stuff we only need to be more strict about prefixing functions/subroutines/variables to see in which module they reside --- src/Lambert.f90 | 17 +- src/config.f90 | 42 ++-- src/crystallite.f90 | 323 +++-------------------------- src/lattice.f90 | 208 +++++-------------- src/plastic_dislotwin.f90 | 103 ++------- src/plastic_isotropic.f90 | 63 ++---- src/plastic_kinematichardening.f90 | 62 ++---- src/plastic_none.f90 | 7 +- src/plastic_phenopowerlaw.f90 | 50 ++--- src/quaternions.f90 | 5 +- src/rotations.f90 | 86 +------- 11 files changed, 184 insertions(+), 782 deletions(-) diff --git a/src/Lambert.f90 b/src/Lambert.f90 index c7b2c0d49..601cf9984 100644 --- a/src/Lambert.f90 +++ b/src/Lambert.f90 @@ -42,7 +42,8 @@ module Lambert implicit none private - real(pReal), parameter, private :: & + + real(pReal), parameter :: & SPI = sqrt(PI), & PREF = sqrt(6.0_pReal/PI), & A = PI**(5.0_pReal/6.0_pReal)/6.0_pReal**(1.0_pReal/6.0_pReal), & @@ -55,10 +56,8 @@ module Lambert PREK = R1 * 2.0_pReal**(1.0_pReal/4.0_pReal)/BETA public :: & - LambertCubeToBall, & - LambertBallToCube - private :: & - GetPyramidOrder + Lambert_CubeToBall, & + Lambert_BallToCube contains @@ -68,7 +67,7 @@ contains !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief map from 3D cubic grid to 3D ball !-------------------------------------------------------------------------- -function LambertCubeToBall(cube) result(ball) +function Lambert_CubeToBall(cube) result(ball) real(pReal), intent(in), dimension(3) :: cube real(pReal), dimension(3) :: ball, LamXYZ, XYZ @@ -116,7 +115,7 @@ function LambertCubeToBall(cube) result(ball) endif center -end function LambertCubeToBall +end function Lambert_CubeToBall !-------------------------------------------------------------------------- @@ -124,7 +123,7 @@ end function LambertCubeToBall !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief map from 3D ball to 3D cubic grid !-------------------------------------------------------------------------- -pure function LambertBallToCube(xyz) result(cube) +pure function Lambert_BallToCube(xyz) result(cube) real(pReal), intent(in), dimension(3) :: xyz real(pReal), dimension(3) :: cube, xyz1, xyz3 @@ -170,7 +169,7 @@ pure function LambertBallToCube(xyz) result(cube) endif center -end function LambertBallToCube +end function Lambert_BallToCube !-------------------------------------------------------------------------- diff --git a/src/config.f90 b/src/config.f90 index 6bc9e9c0b..8729014ce 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -7,21 +7,26 @@ !-------------------------------------------------------------------------------------------------- module config use prec + use DAMASK_interface + use IO + use debug use list implicit none private - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & + + type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & config_phase, & config_microstructure, & config_homogenization, & config_texture, & config_crystallite - type(tPartitionedStringList), public, protected :: & + type(tPartitionedStringList), public, protected :: & config_numerics, & config_debug + !ToDo: bad names (how should one know that those variables are defined in config?) character(len=64), dimension(:), allocatable, public, protected :: & phase_name, & !< name of each phase homogenization_name, & !< name of each homogenization @@ -45,19 +50,9 @@ contains !> @brief reads material.config and stores its content per part !-------------------------------------------------------------------------------------------------- subroutine config_init - use DAMASK_interface, only: & - getSolverJobName - use IO, only: & - IO_read_ASCII, & - IO_error, & - IO_lc, & - IO_getTag - use debug, only: & - debug_level, & - debug_material, & - debug_levelBasic - integer :: myDebug,i + integer :: i + logical :: verbose character(len=pStringLen) :: & line, & @@ -67,7 +62,7 @@ subroutine config_init write(6,'(/,a)') ' <<<+- config init -+>>>' - myDebug = debug_level(debug_material) + verbose = iand(debug_level(debug_material),debug_levelBasic) /= 0 inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists) if(fileExists) then @@ -87,23 +82,23 @@ subroutine config_init case (trim('phase')) call parse_materialConfig(phase_name,config_phase,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6) + if (verbose) write(6,'(a)') ' Phase parsed'; flush(6) case (trim('microstructure')) call parse_materialConfig(microstructure_name,config_microstructure,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6) + if (verbose) write(6,'(a)') ' Microstructure parsed'; flush(6) case (trim('crystallite')) call parse_materialConfig(crystallite_name,config_crystallite,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite parsed'; flush(6) + if (verbose) write(6,'(a)') ' Crystallite parsed'; flush(6) case (trim('homogenization')) call parse_materialConfig(homogenization_name,config_homogenization,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6) + if (verbose) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim('texture')) call parse_materialConfig(texture_name,config_texture,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6) + if (verbose) write(6,'(a)') ' Texture parsed'; flush(6) end select @@ -141,8 +136,6 @@ contains !! Recursion is triggered by "{path/to/inputfile}" in a line !-------------------------------------------------------------------------------------------------- recursive function read_materialConfig(fileName,cnt) result(fileContent) - use IO, only: & - IO_warning character(len=*), intent(in) :: fileName integer, intent(in), optional :: cnt !< recursion counter @@ -226,9 +219,6 @@ end function read_materialConfig subroutine parse_materialConfig(sectionNames,part,line, & fileContent) - use IO, only: & - IO_intOut - character(len=64), allocatable, dimension(:), intent(out) :: sectionNames type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part character(len=pStringLen), intent(inout) :: line @@ -298,8 +288,6 @@ end subroutine config_init !> @brief deallocates the linked lists that store the content of the configuration files !-------------------------------------------------------------------------------------------------- subroutine config_deallocate(what) - use IO, only: & - IO_error character(len=*), intent(in) :: what diff --git a/src/crystallite.f90 b/src/crystallite.f90 index dce93695a..31c859e30 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -9,36 +9,43 @@ !-------------------------------------------------------------------------------------------------- module crystallite - use prec, only: & - pReal, & - pStringLen - use rotations, only: & - rotation - use FEsolving, only: & - FEsolving_execElem, & - FEsolving_execIP - use material, only: & - homogenization_Ngrains + use prec + use IO + use config + use debug + use numerics + use rotations + use math + use mesh + use FEsolving + use material + use constitutive + use lattice use future + use plastic_nonlocal +#if defined(PETSc) || defined(DAMASK_HDF5) + use HDF5_utilities + use results +#endif implicit none private - character(len=64), dimension(:,:), allocatable, private :: & + character(len=64), dimension(:,:), allocatable :: & crystallite_output !< name of each post result output integer, public, protected :: & crystallite_maxSizePostResults !< description not available integer, dimension(:), allocatable, public, protected :: & crystallite_sizePostResults !< description not available - integer, dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable :: & crystallite_sizePostResult !< description not available real(pReal), dimension(:,:,:), allocatable, public :: & crystallite_dt !< requested time increment of each grain - real(pReal), dimension(:,:,:), allocatable, private :: & + real(pReal), dimension(:,:,:), allocatable :: & crystallite_subdt, & !< substepped time increment of each grain crystallite_subFrac, & !< already calculated fraction of increment crystallite_subStep !< size of next integration step - type(rotation), dimension(:,:,:), allocatable, private :: & + type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation, & !< orientation crystallite_orientation0 !< initial orientation real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & @@ -63,7 +70,7 @@ module crystallite crystallite_Li, & !< current intermediate velocitiy grad (end of converged time step) crystallite_Li0, & !< intermediate velocitiy grad at start of FE inc crystallite_partionedLi0 !< intermediate velocity grad at start of homog inc - real(pReal), dimension(:,:,:,:,:), allocatable, private :: & + real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_subS0, & !< 2nd Piola-Kirchhoff stress vector at start of crystallite inc crystallite_invFp, & !< inverse of current plastic def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc @@ -77,7 +84,7 @@ module crystallite crystallite_dPdF !< current individual dPdF per grain (end of converged time step) logical, dimension(:,:,:), allocatable, public :: & crystallite_requested !< used by upper level (homogenization) to request crystallite calculation - logical, dimension(:,:,:), allocatable, private :: & + logical, dimension(:,:,:), allocatable :: & crystallite_converged, & !< convergence flag crystallite_todo, & !< flag to indicate need for further computation crystallite_localPlasticity !< indicates this grain to have purely local constitutive law @@ -101,16 +108,16 @@ module crystallite neighboringip_ID, & neighboringelement_ID end enum - integer(kind(undefined_ID)),dimension(:,:), allocatable, private :: & + integer(kind(undefined_ID)),dimension(:,:), allocatable :: & crystallite_outputID !< ID of each post result output - type, private :: tOutput !< new requested output (per phase) + type :: tOutput !< new requested output (per phase) character(len=65536), allocatable, dimension(:) :: & label end type tOutput - type(tOutput), allocatable, dimension(:), private :: output_constituent + type(tOutput), allocatable, dimension(:) :: output_constituent - type, private :: tNumerics + type :: tNumerics integer :: & iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp nState, & !< state loop limit @@ -138,15 +145,6 @@ module crystallite crystallite_push33ToRef, & crystallite_postResults, & crystallite_results - private :: & - integrateStress, & - integrateState, & - integrateStateFPI, & - integrateStateEuler, & - integrateStateAdaptiveEuler, & - integrateStateRK4, & - integrateStateRKCK45, & - stateJump contains @@ -155,39 +153,6 @@ contains !> @brief allocates and initialize per grain variables !-------------------------------------------------------------------------------------------------- subroutine crystallite_init -#ifdef DEBUG - use debug, only: & - debug_info, & - debug_reset, & - debug_level, & - debug_crystallite, & - debug_levelBasic -#endif - use numerics, only: & - numerics_integrator, & - worldrank, & - usePingPong - use math, only: & - math_I3, & - math_EulerToR, & - math_inv33 - use mesh, only: & - theMesh, & - mesh_element - use IO, only: & - IO_stringValue, & - IO_write_jobFile, & - IO_error - use material - use config, only: & - config_deallocate, & - config_crystallite, & - config_numerics, & - config_phase, & - crystallite_name - use constitutive, only: & - constitutive_initialFi, & - constitutive_microstructure ! derived (shortcut) quantities of given state integer, parameter :: FILEUNIT=434 logical, dimension(:,:), allocatable :: devNull @@ -478,34 +443,6 @@ end subroutine crystallite_init !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) - use prec, only: & - tol_math_check, & - dNeq0 -#ifdef DEBUG - use debug, only: & - debug_level, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective, & - debug_e, & - debug_i, & - debug_g -#endif - use IO, only: & - IO_warning, & - IO_error - use math, only: & - math_inv33 - use mesh, only: & - theMesh, & - mesh_element - use material, only: & - homogenization_Ngrains, & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress real(pReal), intent(in), optional :: & @@ -746,30 +683,6 @@ end function crystallite_stress !> @brief calculate tangent (dPdF) !-------------------------------------------------------------------------------------------------- subroutine crystallite_stressTangent - use prec, only: & - tol_math_check, & - dNeq0 - use IO, only: & - IO_warning, & - IO_error - use math, only: & - math_inv33, & - math_identity2nd, & - math_3333to99, & - math_99to3333, & - math_I3, & - math_mul3333xx3333, & - math_mul33xx33, & - math_invert2, & - math_det33 - use mesh, only: & - mesh_element - use material, only: & - homogenization_Ngrains - use constitutive, only: & - constitutive_SandItsTangents, & - constitutive_LpAndItsTangents, & - constitutive_LiAndItsTangents integer :: & c, & !< counter in integration point component loop @@ -910,19 +823,6 @@ end subroutine crystallite_stressTangent !> @brief calculates orientations !-------------------------------------------------------------------------------------------------- subroutine crystallite_orientations - use math, only: & - math_rotationalPart33, & - math_RtoQ - use material, only: & - plasticState, & - material_phase, & - homogenization_Ngrains - use mesh, only: & - mesh_element - use lattice, only: & - lattice_qDisorientation - use plastic_nonlocal, only: & - plastic_nonlocal_updateCompatibility integer & c, & !< counter in integration point component loop @@ -979,28 +879,6 @@ end function crystallite_push33ToRef !> @brief return results of particular grain !-------------------------------------------------------------------------------------------------- function crystallite_postResults(ipc, ip, el) - use math, only: & - math_det33, & - math_I3, & - inDeg - use mesh, only: & - theMesh, & - mesh_element, & - mesh_ipVolume, & - mesh_ipNeighborhood - use material, only: & - plasticState, & - sourceState, & - microstructure_crystallite, & - crystallite_Noutput, & - material_phase, & - material_texture, & - homogenization_Ngrains - use constitutive, only: & - constitutive_homogenizedC, & - constitutive_postResults - use rotations, only: & - rotation integer, intent(in):: & el, & !< element index @@ -1118,10 +996,6 @@ end function crystallite_postResults !-------------------------------------------------------------------------------------------------- subroutine crystallite_results #if defined(PETSc) || defined(DAMASK_HDF5) - use lattice - use results - use HDF5_utilities - use rotations use config, only: & config_name_phase => phase_name ! anticipate logical name @@ -1264,33 +1138,6 @@ end subroutine crystallite_results !> intermediate acceleration of the Newton-Raphson correction !-------------------------------------------------------------------------------------------------- logical function integrateStress(ipc,ip,el,timeFraction) - use, intrinsic :: & - IEEE_arithmetic - use prec, only: tol_math_check, & - dEq0 -#ifdef DEBUG - use debug, only: debug_level, & - debug_e, & - debug_i, & - debug_g, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif - - use constitutive, only: constitutive_LpAndItsTangents, & - constitutive_LiAndItsTangents, & - constitutive_SandItsTangents - use math, only: math_mul33xx33, & - math_mul3333xx3333, & - math_inv33, & - math_det33, & - math_I3, & - math_identity2nd, & - math_3333to99, & - math_33to9, & - math_9to33 integer, intent(in):: el, & ! element index ip, & ! integration point index @@ -1690,27 +1537,6 @@ end function integrateStress !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- subroutine integrateStateFPI -#ifdef DEBUG - use debug, only: debug_level, & - debug_e, & - debug_i, & - debug_g, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif - use mesh, only: & - mesh_element - use material, only: & - plasticState, & - sourceState, & - phaseAt, phasememberAt, & - phase_Nsources, & - homogenization_Ngrains - use constitutive, only: & - constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizeDotState integer :: & NiterationState, & !< number of iterations in state loop @@ -1898,8 +1724,6 @@ end subroutine integrateStateFPI !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- subroutine integrateStateEuler - use material, only: & - plasticState call update_dotState(1.0_pReal) call update_state(1.0_pReal) @@ -1916,19 +1740,6 @@ end subroutine integrateStateEuler !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler - use mesh, only: & - theMesh, & - mesh_element - use material, only: & - homogenization_Ngrains, & - plasticState, & - sourceState, & - phaseAt, phasememberAt, & - phase_Nsources, & - homogenization_maxNgrains - use constitutive, only: & - constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizeDotState integer :: & e, & ! element index in element loop @@ -2022,14 +1833,6 @@ end subroutine integrateStateAdaptiveEuler ! ToDo: This is totally BROKEN: RK4dotState is never used!!! !-------------------------------------------------------------------------------------------------- subroutine integrateStateRK4 - use mesh, only: & - mesh_element - use material, only: & - homogenization_Ngrains, & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt real(pReal), dimension(4), parameter :: & TIMESTEPFRACTION = [0.5_pReal, 0.5_pReal, 1.0_pReal, 1.0_pReal] ! factor giving the fraction of the original timestep used for Runge Kutta Integration @@ -2089,19 +1892,6 @@ end subroutine integrateStateRK4 !> adaptive step size (use 5th order solution to advance = "local extrapolation") !-------------------------------------------------------------------------------------------------- subroutine integrateStateRKCK45 - use mesh, only: & - mesh_element, & - theMesh - use material, only: & - homogenization_Ngrains, & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt, & - homogenization_maxNgrains - use constitutive, only: & - constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizeDotState real(pReal), dimension(5,5), parameter :: & A = reshape([& @@ -2284,8 +2074,6 @@ end subroutine nonlocalConvergenceCheck !> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria !-------------------------------------------------------------------------------------------------- subroutine setConvergenceFlag - use mesh, only: & - mesh_element integer :: & e, & !< element index in element loop @@ -2324,8 +2112,6 @@ end subroutine setConvergenceFlag !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- subroutine update_stress(timeFraction) - use mesh, only: & - mesh_element real(pReal), intent(in) :: & timeFraction @@ -2357,8 +2143,6 @@ end subroutine update_stress !> @brief tbd !-------------------------------------------------------------------------------------------------- subroutine update_dependentState - use mesh, only: & - mesh_element use constitutive, only: & constitutive_dependentState => constitutive_microstructure @@ -2384,13 +2168,6 @@ end subroutine update_dependentState !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- subroutine update_state(timeFraction) - use material, only: & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt - use mesh, only: & - mesh_element real(pReal), intent(in) :: & timeFraction @@ -2432,17 +2209,6 @@ end subroutine update_state !> if NaN occurs, crystallite_todo is set to FALSE. Any NaN in a nonlocal propagates to all others !-------------------------------------------------------------------------------------------------- subroutine update_dotState(timeFraction) - use, intrinsic :: & - IEEE_arithmetic - use material, only: & - plasticState, & - sourceState, & - phaseAt, phasememberAt, & - phase_Nsources - use mesh, only: & - mesh_element - use constitutive, only: & - constitutive_collectDotState real(pReal), intent(in) :: & timeFraction @@ -2489,19 +2255,7 @@ end subroutine update_DotState subroutine update_deltaState - use, intrinsic :: & - IEEE_arithmetic - use prec, only: & - dNeq0 - use mesh, only: & - mesh_element - use material, only: & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt - use constitutive, only: & - constitutive_collectDeltaState + integer :: & e, & !< element index in element loop i, & !< integration point index in ip loop @@ -2566,27 +2320,6 @@ end subroutine update_deltaState !> returns true, if state jump was successfull or not needed. false indicates NaN in delta state !-------------------------------------------------------------------------------------------------- logical function stateJump(ipc,ip,el) - use, intrinsic :: & - IEEE_arithmetic - use prec, only: & - dNeq0 -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelExtensive, & - debug_levelSelective -#endif - use material, only: & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt - use constitutive, only: & - constitutive_collectDeltaState integer, intent(in):: & el, & ! element index diff --git a/src/lattice.f90 b/src/lattice.f90 index 1a7508984..43fc25530 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -7,8 +7,10 @@ ! and cleavage as well as interaction among the various systems !-------------------------------------------------------------------------------------------------- module lattice - use prec, only: & - pReal + use prec + use IO + use config + use math use future implicit none @@ -28,25 +30,25 @@ module lattice !-------------------------------------------------------------------------------------------------- ! face centered cubic - integer, dimension(2), parameter, private :: & + integer, dimension(2), parameter :: & LATTICE_FCC_NSLIPSYSTEM = [12, 6] !< # of slip systems per family for fcc - integer, dimension(1), parameter, private :: & + integer, dimension(1), parameter :: & LATTICE_FCC_NTWINSYSTEM = [12] !< # of twin systems per family for fcc - integer, dimension(1), parameter, private :: & + integer, dimension(1), parameter :: & LATTICE_FCC_NTRANSSYSTEM = [12] !< # of transformation systems per family for fcc - integer, dimension(2), parameter, private :: & + integer, dimension(2), parameter :: & LATTICE_FCC_NCLEAVAGESYSTEM = [3, 4] !< # of cleavage systems per family for fcc - integer, parameter, private :: & + integer, parameter :: & LATTICE_FCC_NSLIP = sum(LATTICE_FCC_NSLIPSYSTEM), & !< total # of slip systems for fcc LATTICE_FCC_NTWIN = sum(LATTICE_FCC_NTWINSYSTEM), & !< total # of twin systems for fcc LATTICE_FCC_NTRANS = sum(LATTICE_FCC_NTRANSSYSTEM), & !< total # of transformation systems for fcc LATTICE_FCC_NCLEAVAGE = sum(LATTICE_FCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for fcc - real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter :: & LATTICE_FCC_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! SCHMID-BOAS notation 0, 1,-1, 1, 1, 1, & ! B2 @@ -70,11 +72,11 @@ module lattice 0, 1,-1, 0, 1, 1 & ],pReal),shape(LATTICE_FCC_SYSTEMSLIP)) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli - character(len=*), dimension(2), parameter, private :: LATTICE_FCC_SLIPFAMILY_NAME = & + character(len=*), dimension(2), parameter :: LATTICE_FCC_SLIPFAMILY_NAME = & ['<0 1 -1>{1 1 1}', & '<0 1 -1>{0 1 1}'] - real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter :: & LATTICE_FCC_SYSTEMTWIN = reshape(real( [& -2, 1, 1, 1, 1, 1, & 1,-2, 1, 1, 1, 1, & @@ -90,7 +92,7 @@ module lattice -1, 1, 2, -1, 1,-1 & ],pReal),shape(LATTICE_FCC_SYSTEMTWIN)) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli - character(len=*), dimension(1), parameter, private :: LATTICE_FCC_TWINFAMILY_NAME = & + character(len=*), dimension(1), parameter :: LATTICE_FCC_TWINFAMILY_NAME = & ['<-2 1 1>{1 1 1}'] @@ -110,7 +112,7 @@ module lattice 10,11 & ],shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) - real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter :: & LATTICE_FCC_SYSTEMCLEAVAGE = reshape(real([& ! Cleavage direction Plane normal 0, 1, 0, 1, 0, 0, & @@ -124,21 +126,21 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered cubic - integer, dimension(2), parameter, private :: & + integer, dimension(2), parameter :: & LATTICE_BCC_NSLIPSYSTEM = [12, 12] !< # of slip systems per family for bcc - integer, dimension(1), parameter, private :: & + integer, dimension(1), parameter :: & LATTICE_BCC_NTWINSYSTEM = [12] !< # of twin systems per family for bcc - integer, dimension(2), parameter, private :: & + integer, dimension(2), parameter :: & LATTICE_BCC_NCLEAVAGESYSTEM = [3, 6] !< # of cleavage systems per family for bcc - integer, parameter, private :: & + integer, parameter :: & LATTICE_BCC_NSLIP = sum(LATTICE_BCC_NSLIPSYSTEM), & !< total # of slip systems for bcc LATTICE_BCC_NTWIN = sum(LATTICE_BCC_NTWINSYSTEM), & !< total # of twin systems for bcc LATTICE_BCC_NCLEAVAGE = sum(LATTICE_BCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for bcc - real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter :: & LATTICE_BCC_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! Slip system <111>{110} @@ -169,11 +171,11 @@ module lattice 1, 1, 1, 1, 1,-2 & ],pReal),shape(LATTICE_BCC_SYSTEMSLIP)) - character(len=*), dimension(2), parameter, private :: LATTICE_BCC_SLIPFAMILY_NAME = & + character(len=*), dimension(2), parameter :: LATTICE_BCC_SLIPFAMILY_NAME = & ['<1 -1 1>{0 1 1}', & '<1 -1 1>{2 1 1}'] - real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter :: & LATTICE_BCC_SYSTEMTWIN = reshape(real([& ! Twin system <111>{112} -1, 1, 1, 2, 1, 1, & @@ -190,10 +192,10 @@ module lattice 1, 1, 1, 1, 1,-2 & ],pReal),shape(LATTICE_BCC_SYSTEMTWIN)) - character(len=*), dimension(1), parameter, private :: LATTICE_BCC_TWINFAMILY_NAME = & + character(len=*), dimension(1), parameter :: LATTICE_BCC_TWINFAMILY_NAME = & ['<1 1 1>{2 1 1}'] - real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter :: & LATTICE_BCC_SYSTEMCLEAVAGE = reshape(real([& ! Cleavage direction Plane normal 0, 1, 0, 1, 0, 0, & @@ -209,21 +211,21 @@ module lattice !-------------------------------------------------------------------------------------------------- ! hexagonal - integer, dimension(6), parameter, private :: & + integer, dimension(6), parameter :: & LATTICE_HEX_NSLIPSYSTEM = [3, 3, 3, 6, 12, 6] !< # of slip systems per family for hex - integer, dimension(4), parameter, private :: & + integer, dimension(4), parameter :: & LATTICE_HEX_NTWINSYSTEM = [6, 6, 6, 6] !< # of slip systems per family for hex - integer, dimension(1), parameter, private :: & + integer, dimension(1), parameter :: & LATTICE_HEX_NCLEAVAGESYSTEM = [3] !< # of cleavage systems per family for hex - integer, parameter, private :: & + integer, parameter :: & LATTICE_HEX_NSLIP = sum(LATTICE_HEX_NSLIPSYSTEM), & !< total # of slip systems for hex LATTICE_HEX_NTWIN = sum(LATTICE_HEX_NTWINSYSTEM), & !< total # of twin systems for hex LATTICE_HEX_NCLEAVAGE = sum(LATTICE_HEX_NCLEAVAGESYSTEM) !< total # of cleavage systems for hex - real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: & + real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter :: & LATTICE_HEX_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! Basal systems <11.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base)) @@ -267,7 +269,7 @@ module lattice 1, 1, -2, 3, -1, -1, 2, 2 & ],pReal),shape(LATTICE_HEX_SYSTEMSLIP)) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr - character(len=*), dimension(6), parameter, private :: LATTICE_HEX_SLIPFAMILY_NAME = & + character(len=*), dimension(6), parameter :: LATTICE_HEX_SLIPFAMILY_NAME = & ['<1 1 . 1>{0 0 . 1} ', & '<1 1 . 1>{1 0 . 0} ', & '<1 0 . 0>{1 1 . 0} ', & @@ -275,7 +277,7 @@ module lattice '<1 1 . 3>{-1 0 . 1} ', & '<1 1 . 3>{-1 -1 . 2}'] - real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter, private :: & + real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter :: & LATTICE_HEX_SYSTEMTWIN = reshape(real([& ! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981) 1, -1, 0, 1, -1, 1, 0, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a) @@ -307,13 +309,13 @@ module lattice 1, 1, -2, -3, 1, 1, -2, 2 & ],pReal),shape(LATTICE_HEX_SYSTEMTWIN)) !< twin systems for hex, order follows Prof. Tom Bieler's scheme - character(len=*), dimension(4), parameter, private :: LATTICE_HEX_TWINFAMILY_NAME = & + character(len=*), dimension(4), parameter :: LATTICE_HEX_TWINFAMILY_NAME = & ['<-1 0 . 1>{1 0 . 2} ', & '<1 1 . 6>{-1 -1 . 1}', & '<1 0 . -2>{1 0 . 1} ', & '<1 1 . -3>{1 1 . 2} '] - real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter, private :: & + real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter :: & LATTICE_HEX_SYSTEMCLEAVAGE = reshape(real([& ! Cleavage direction Plane normal 2,-1,-1, 0, 0, 0, 0, 1, & @@ -324,13 +326,13 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered tetragonal - integer, dimension(13), parameter, private :: & + integer, dimension(13), parameter :: & LATTICE_BCT_NSLIPSYSTEM = [2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ] !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009 - integer, parameter, private :: & + integer, parameter :: & LATTICE_BCT_NSLIP = sum(LATTICE_BCT_NSLIPSYSTEM) !< total # of slip systems for bct - real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter :: & LATTICE_BCT_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! Slip family 1 {100)<001] (Bravais notation {hkl) @brief Module initialization !-------------------------------------------------------------------------------------------------- subroutine lattice_init - use IO, only: & - IO_error - use config, only: & - config_phase integer :: Nphases character(len=65536) :: & @@ -654,15 +652,7 @@ end subroutine lattice_init !> @brief !!!!!!!DEPRECTATED!!!!!! !-------------------------------------------------------------------------------------------------- subroutine lattice_initializeStructure(myPhase,CoverA) - use prec, only: & - tol_math_check - use math, only: & - math_sym3333to66, & - math_Voigt66to3333, & - math_cross - use IO, only: & - IO_error - + integer, intent(in) :: myPhase real(pReal), intent(in) :: & CoverA @@ -690,9 +680,10 @@ subroutine lattice_initializeStructure(myPhase,CoverA) call IO_error(135,el=i,ip=myPhase,ext_msg='matrix diagonal "el"ement of phase "ip"') enddo - forall (i = 1:3) & + do i = 1,3 lattice_thermalExpansion33 (1:3,1:3,i,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_thermalExpansion33 (1:3,1:3,i,myPhase)) + enddo lattice_thermalConductivity33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_thermalConductivity33 (1:3,1:3,myPhase)) @@ -763,17 +754,17 @@ pure function lattice_symmetrizeC66(struct,C66) select case(struct) case (LATTICE_iso_ID) - forall(k=1:3) + do k=1,3 forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2) lattice_symmetrizeC66(k,k) = C66(1,1) lattice_symmetrizeC66(k+3,k+3) = 0.5_pReal*(C66(1,1)-C66(1,2)) - end forall + enddo case (LATTICE_fcc_ID,LATTICE_bcc_ID) - forall(k=1:3) + do k=1,3 forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2) lattice_symmetrizeC66(k,k) = C66(1,1) lattice_symmetrizeC66(k+3,k+3) = C66(4,4) - end forall + enddo case (LATTICE_hex_ID) lattice_symmetrizeC66(1,1) = C66(1,1) lattice_symmetrizeC66(2,2) = C66(1,1) @@ -834,7 +825,9 @@ pure function lattice_symmetrize33(struct,T33) select case(struct) case (LATTICE_iso_ID,LATTICE_fcc_ID,LATTICE_bcc_ID) - forall(k=1:3) lattice_symmetrize33(k,k) = T33(1,1) + do k=1,3 + lattice_symmetrize33(k,k) = T33(1,1) + enddo case (LATTICE_hex_ID) lattice_symmetrize33(1,1) = T33(1,1) lattice_symmetrize33(2,2) = T33(1,1) @@ -854,10 +847,6 @@ end function lattice_symmetrize33 !> @brief figures whether unit quat falls into stereographic standard triangle !-------------------------------------------------------------------------------------------------- logical pure function lattice_qInSST(Q, struct) - use, intrinsic :: & - IEEE_arithmetic - use math, only: & - math_qToRodrig real(pReal), dimension(4), intent(in) :: Q ! orientation integer(kind(LATTICE_undefined_ID)), intent(in) :: struct ! lattice structure @@ -888,11 +877,6 @@ end function lattice_qInSST !> @brief calculates the disorientation for 2 unit quaternions !-------------------------------------------------------------------------------------------------- pure function lattice_qDisorientation(Q1, Q2, struct) - use prec, only: & - tol_math_check - use math, only: & - math_qMul, & - math_qConj real(pReal), dimension(4) :: lattice_qDisorientation real(pReal), dimension(4), intent(in) :: & @@ -998,8 +982,6 @@ end function lattice_qDisorientation !> @brief Characteristic shear for twinning !-------------------------------------------------------------------------------------------------- function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(characteristicShear) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -1077,14 +1059,6 @@ end function lattice_characteristicShear_Twin !> @brief Rotated elasticity matrices for twinning in 66-vector notation !-------------------------------------------------------------------------------------------------- function lattice_C66_twin(Ntwin,C66,structure,CoverA) - use IO, only: & - IO_error - use math, only: & - PI, & - math_axisAngleToR, & - math_sym3333to66, & - math_66toSym3333, & - math_rotate_forward3333 integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -1125,17 +1099,6 @@ end function lattice_C66_twin !-------------------------------------------------------------------------------------------------- function lattice_C66_trans(Ntrans,C_parent66,structure_target, & CoverA_trans,a_bcc,a_fcc) - use prec, only: & - tol_math_check - use IO, only: & - IO_error - use math, only: & - INRAD, & - MATH_I3, & - math_axisAngleToR, & - math_sym3333to66, & - math_66toSym3333, & - math_rotate_forward3333 integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family character(len=*), intent(in) :: structure_target !< lattice structure @@ -1196,13 +1159,6 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_target, & ! Gröger et al. 2008, Acta Materialia 56 (2008) 5412–5425, table 1 !-------------------------------------------------------------------------------------------------- function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix) - use IO, only: & - IO_error - use math, only: & - INRAD, & - math_outer, & - math_cross, & - math_axisAngleToR integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections @@ -1246,9 +1202,7 @@ end function lattice_nonSchmidMatrix !> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipBySlip(Nslip,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction character(len=*), intent(in) :: structure !< lattice structure @@ -1468,8 +1422,6 @@ end function lattice_interaction_SlipBySlip !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TwinByTwin(Ntwin,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction @@ -1571,8 +1523,6 @@ end function lattice_interaction_TwinByTwin !> details only active trans systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TransByTrans(Ntrans,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntrans !< number of active trans systems per family real(pReal), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction @@ -1618,8 +1568,6 @@ end function lattice_interaction_TransByTrans !> details only active slip and twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family Ntwin !< number of active twin systems per family @@ -1760,8 +1708,6 @@ end function lattice_interaction_SlipByTwin !> details only active slip and trans systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family Ntrans !< number of active trans systems per family @@ -1818,8 +1764,6 @@ function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structur !> details only active twin and slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family Nslip !< number of active slip systems per family @@ -1898,13 +1842,6 @@ end function lattice_interaction_TwinBySlip !> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) - use prec, only: & - tol_math_check - use IO, only: & - IO_error - use math, only: & - math_trace33, & - math_outer integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -1957,13 +1894,6 @@ end function lattice_SchmidMatrix_slip !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) - use prec, only: & - tol_math_check - use IO, only: & - IO_error - use math, only: & - math_trace33, & - math_outer integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -2013,8 +1943,6 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family real(pReal), intent(in) :: cOverA !< c/a ratio @@ -2041,11 +1969,7 @@ end function lattice_SchmidMatrix_trans !> details only active cleavage systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix) - use math, only: & - math_outer - use IO, only: & - IO_error - + integer, dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family character(len=*), intent(in) :: structure !< lattice structure real(pReal), intent(in) :: cOverA !< c/a ratio @@ -2154,8 +2078,6 @@ end function lattice_slip_transverse !> @details: This projection is used to calculate forest hardening for edge dislocations !-------------------------------------------------------------------------------------------------- function slipProjection_transverse(Nslip,structure,cOverA) result(projection) - use math, only: & - math_inner integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -2179,8 +2101,6 @@ end function slipProjection_transverse !> @details: This projection is used to calculate forest hardening for screw dislocations !-------------------------------------------------------------------------------------------------- function slipProjection_direction(Nslip,structure,cOverA) result(projection) - use math, only: & - math_inner integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -2204,9 +2124,7 @@ end function slipProjection_direction !> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- function coordinateSystem_slip(Nslip,structure,cOverA) result(coordinateSystem) - use IO, only: & - IO_error - + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family character(len=*), intent(in) :: structure !< lattice structure real(pReal), intent(in) :: cOverA !< c/a ratio @@ -2249,8 +2167,6 @@ end function coordinateSystem_slip !> @brief Populates reduced interaction matrix !-------------------------------------------------------------------------------------------------- function buildInteraction(reacting_used,acting_used,reacting_max,acting_max,values,matrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: & reacting_used, & !< # of reacting systems per family as specified in material.config @@ -2295,10 +2211,6 @@ end function buildInteraction !> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- function buildCoordinateSystem(active,complete,system,structure,cOverA) - use IO, only: & - IO_error - use math, only: & - math_cross integer, dimension(:), intent(in) :: & active, & @@ -2370,16 +2282,6 @@ end function buildCoordinateSystem ! set a_bcc = 0.0 for fcc -> hex transformation !-------------------------------------------------------------------------------------------------- subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) - use prec, only: & - dEq0 - use math, only: & - math_cross, & - math_outer, & - math_axisAngleToR, & - INRAD, & - MATH_I3 - use IO, only: & - IO_error integer, dimension(:), intent(in) :: & Ntrans diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 7db1f5f7f..fd5d8b787 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -8,17 +8,26 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module plastic_dislotwin - use prec, only: & - pReal + use prec + use debug + use math + use IO + use material + use config + use lattice +#if defined(PETSc) || defined(DAMASK_HDF5) + use results +#endif implicit none private + integer, dimension(:,:), allocatable, target, public :: & plastic_dislotwin_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & plastic_dislotwin_output !< name of each post result output - real(pReal), parameter, private :: & + real(pReal), parameter :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin enum, bind(c) @@ -39,7 +48,7 @@ module plastic_dislotwin f_tr_ID end enum - type, private :: tParameters + type :: tParameters real(pReal) :: & mu, & nu, & @@ -119,7 +128,7 @@ module plastic_dislotwin dipoleFormation !< flag indicating consideration of dipole formation end type !< container type for internal constitutive parameters - type, private :: tDislotwinState + type :: tDislotwinState real(pReal), dimension(:,:), pointer :: & rho_mob, & rho_dip, & @@ -128,7 +137,7 @@ module plastic_dislotwin f_tr end type tDislotwinState - type, private :: tDislotwinMicrostructure + type :: tDislotwinMicrostructure real(pReal), dimension(:,:), allocatable :: & Lambda_sl, & !* mean free path between 2 obstacles seen by a moving dislocation Lambda_tw, & !* mean free path between 2 obstacles seen by a growing twin @@ -144,11 +153,11 @@ module plastic_dislotwin !-------------------------------------------------------------------------------------------------- ! containers for parameters and state - type(tParameters), allocatable, dimension(:), private :: param - type(tDislotwinState), allocatable, dimension(:), private :: & + type(tParameters), allocatable, dimension(:) :: param + type(tDislotwinState), allocatable, dimension(:) :: & dotState, & state - type(tDislotwinMicrostructure), allocatable, dimension(:), private :: dependentState + type(tDislotwinMicrostructure), allocatable, dimension(:) :: dependentState public :: & plastic_dislotwin_init, & @@ -158,10 +167,6 @@ module plastic_dislotwin plastic_dislotwin_dotState, & plastic_dislotwin_postResults, & plastic_dislotwin_results - private :: & - kinetics_slip, & - kinetics_twin, & - kinetics_trans contains @@ -171,24 +176,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_init - use prec, only: & - pStringLen, & - dEq0, & - dNeq0, & - dNeq - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use math, only: & - math_expand,& - PI - use IO, only: & - IO_error - use material - use config, only: & - config_phase - use lattice integer :: & Ninstance, & @@ -591,10 +578,6 @@ end subroutine plastic_dislotwin_init !> @brief returns the homogenized elasticity matrix !-------------------------------------------------------------------------------------------------- function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) - use material, only: & - material_phase, & - phase_plasticityInstance, & - phasememberAt real(pReal), dimension(6,6) :: & homogenizedC @@ -634,14 +617,6 @@ end function plastic_dislotwin_homogenizedC !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) - use prec, only: & - tol_math_check, & - dNeq0 - use math, only: & - math_eigenValuesVectorsSym, & - math_outer, & - math_symmetric33, & - math_mul33xx33 real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp @@ -757,13 +732,6 @@ end subroutine plastic_dislotwin_LpAndItsTangent !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_dotState(Mp,T,instance,of) - use prec, only: & - tol_math_check, & - dEq0 - use math, only: & - math_clip, & - math_mul33xx33, & - PI real(pReal), dimension(3,3), intent(in):: & Mp !< Mandel stress @@ -854,8 +822,6 @@ end subroutine plastic_dislotwin_dotState !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_dependentState(T,instance,of) - use math, only: & - PI integer, intent(in) :: & instance, & @@ -868,13 +834,13 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) real(pReal) :: & sumf_twin,SFE,sumf_trans real(pReal), dimension(param(instance)%sum_N_sl) :: & - inv_lambda_sl_sl, & !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation - inv_lambda_sl_tw, & !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation - inv_lambda_sl_tr !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation + inv_lambda_sl_sl, & !< 1/mean free distance between 2 forest dislocations seen by a moving dislocation + inv_lambda_sl_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation + inv_lambda_sl_tr !< 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation real(pReal), dimension(param(instance)%sum_N_tw) :: & - inv_lambda_tw_tw !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin + inv_lambda_tw_tw !< 1/mean free distance between 2 twin stacks from different systems seen by a growing twin real(pReal), dimension(param(instance)%sum_N_tr) :: & - inv_lambda_tr_tr !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans) + inv_lambda_tr_tr !< 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite real(pReal), dimension(:), allocatable :: & x0, & @@ -967,12 +933,6 @@ end subroutine plastic_dislotwin_dependentState !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- function plastic_dislotwin_postResults(Mp,T,instance,of) result(postResults) - use prec, only: & - tol_math_check, & - dEq0 - use math, only: & - PI, & - math_mul33xx33 real(pReal), dimension(3,3),intent(in) :: & Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation @@ -1050,8 +1010,6 @@ end function plastic_dislotwin_postResults !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) - use results, only: & - results_writeDataset integer, intent(in) :: instance character(len=*) :: group @@ -1112,11 +1070,6 @@ end subroutine plastic_dislotwin_results !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_slip(Mp,T,instance,of, & dot_gamma_sl,ddot_gamma_dtau_slip,tau_slip) - use prec, only: & - tol_math_check, & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -1190,11 +1143,6 @@ end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& dot_gamma_twin,ddot_gamma_dtau_twin) - use prec, only: & - tol_math_check, & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -1261,11 +1209,6 @@ end subroutine kinetics_twin !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& dot_gamma_tr,ddot_gamma_dtau_trans) - use prec, only: & - tol_math_check, & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index c572f0ded..46d0905dc 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -8,11 +8,19 @@ !! untextured polycrystal !-------------------------------------------------------------------------------------------------- module plastic_isotropic - use prec, only: & - pReal + use prec + use debug + use math + use IO + use material + use config +#if defined(PETSc) || defined(DAMASK_HDF5) + use results +#endif implicit none private + integer, dimension(:,:), allocatable, target, public :: & plastic_isotropic_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & @@ -25,7 +33,7 @@ module plastic_isotropic dot_gamma_ID end enum - type, private :: tParameters + type :: tParameters real(pReal) :: & M, & !< Taylor factor xi_0, & !< initial critical stress @@ -49,7 +57,7 @@ module plastic_isotropic dilatation end type tParameters - type, private :: tIsotropicState + type :: tIsotropicState real(pReal), pointer, dimension(:) :: & xi, & gamma @@ -57,8 +65,8 @@ module plastic_isotropic !-------------------------------------------------------------------------------------------------- ! containers for parameters and state - type(tParameters), allocatable, dimension(:), private :: param - type(tIsotropicState), allocatable, dimension(:), private :: & + type(tParameters), allocatable, dimension(:) :: param + type(tIsotropicState), allocatable, dimension(:) :: & dotState, & state @@ -77,25 +85,7 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_init - use prec, only: & - pStringLen - use debug, only: & -#ifdef DEBUG - debug_e, & - debug_i, & - debug_g, & - debug_levelExtensive, & -#endif - debug_level, & - debug_constitutive, & - debug_levelBasic - use IO, only: & - IO_error - use material - use config, only: & - config_phase - use lattice - + integer :: & Ninstance, & p, i, & @@ -235,16 +225,6 @@ end subroutine plastic_isotropic_init !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) -#ifdef DEBUG - use debug, only: & - debug_level, & - debug_constitutive,& - debug_levelExtensive, & - debug_levelSelective -#endif - use math, only: & - math_deviatoric33, & - math_mul33xx33 real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -307,10 +287,6 @@ end subroutine plastic_isotropic_LpAndItsTangent ! ToDo: Rename Tstar to Mi? !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of) - use math, only: & - math_I3, & - math_spherical33, & - math_mul33xx33 real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient @@ -362,11 +338,6 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of) !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_dotState(Mp,instance,of) - use prec, only: & - dEq0 - use math, only: & - math_mul33xx33, & - math_deviatoric33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -416,9 +387,6 @@ end subroutine plastic_isotropic_dotState !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- function plastic_isotropic_postResults(Mp,instance,of) result(postResults) - use math, only: & - math_mul33xx33, & - math_deviatoric33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -468,7 +436,6 @@ end function plastic_isotropic_postResults !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_results(instance,group) #if defined(PETSc) || defined(DAMASKHDF5) - use results integer, intent(in) :: instance character(len=*), intent(in) :: group diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 861b98da3..ab68eb176 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -6,11 +6,20 @@ !! and a Voce-type kinematic hardening rule !-------------------------------------------------------------------------------------------------- module plastic_kinehardening - use prec, only: & - pReal + use prec + use debug + use math + use IO + use material + use config + use lattice +#if defined(PETSc) || defined(DAMASK_HDF5) + use results +#endif implicit none private + integer, dimension(:,:), allocatable, target, public :: & plastic_kinehardening_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & @@ -29,7 +38,7 @@ module plastic_kinehardening resolvedstress_ID end enum - type, private :: tParameters + type :: tParameters real(pReal) :: & gdot0, & !< reference shear strain rate for slip n, & !< stress exponent for slip @@ -59,7 +68,7 @@ module plastic_kinehardening outputID !< ID of each post result output end type tParameters - type, private :: tKinehardeningState + type :: tKinehardeningState real(pReal), pointer, dimension(:,:) :: & !< vectors along NipcMyInstance crss, & !< critical resolved stress crss_back, & !< critical resolved back stress @@ -71,8 +80,8 @@ module plastic_kinehardening !-------------------------------------------------------------------------------------------------- ! containers for parameters and state - type(tParameters), allocatable, dimension(:), private :: param - type(tKinehardeningState), allocatable, dimension(:), private :: & + type(tParameters), allocatable, dimension(:) :: param + type(tKinehardeningState), allocatable, dimension(:) :: & dotState, & deltaState, & state @@ -84,8 +93,6 @@ module plastic_kinehardening plastic_kinehardening_deltaState, & plastic_kinehardening_postResults, & plastic_kinehardening_results - private :: & - kinetics contains @@ -95,27 +102,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_kinehardening_init - use prec, only: & - dEq0, & - pStringLen - use debug, only: & -#ifdef DEBUG - debug_e, & - debug_i, & - debug_g, & - debug_levelExtensive, & -#endif - debug_level, & - debug_constitutive,& - debug_levelBasic - use math, only: & - math_expand - use IO, only: & - IO_error - use material - use config, only: & - config_phase - use lattice integer :: & Ninstance, & @@ -417,16 +403,6 @@ end subroutine plastic_kinehardening_dotState !> @brief calculates (instantaneous) incremental change of microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_kinehardening_deltaState(Mp,instance,of) - use prec, only: & - dNeq, & - dEq0 -#ifdef DEBUG - use debug, only: & - debug_level, & - debug_constitutive,& - debug_levelExtensive, & - debug_levelSelective -#endif real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -475,8 +451,6 @@ end subroutine plastic_kinehardening_deltaState !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- function plastic_kinehardening_postResults(Mp,instance,of) result(postResults) - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -535,8 +509,6 @@ end function plastic_kinehardening_postResults !-------------------------------------------------------------------------------------------------- subroutine plastic_kinehardening_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) - use results, only: & - results_writeDataset integer, intent(in) :: instance character(len=*) :: group @@ -585,10 +557,6 @@ end subroutine plastic_kinehardening_results !-------------------------------------------------------------------------------------------------- pure subroutine kinetics(Mp,instance,of, & gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) - use prec, only: & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index 4b14266f1..894cc9a40 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -5,6 +5,8 @@ !> @brief Dummy plasticity for purely elastic material !-------------------------------------------------------------------------------------------------- module plastic_none + use material + use debug implicit none private @@ -19,11 +21,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_none_init - use debug, only: & - debug_level, & - debug_constitutive, & - debug_levelBasic - use material integer :: & Ninstance, & diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 196129f64..a31891573 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -5,11 +5,20 @@ !> @brief phenomenological crystal plasticity formulation using a powerlaw fitting !-------------------------------------------------------------------------------------------------- module plastic_phenopowerlaw - use prec, only: & - pReal + use prec + use debug + use math + use IO + use material + use config + use lattice +#if defined(PETSc) || defined(DAMASK_HDF5) + use results +#endif implicit none private + integer, dimension(:,:), allocatable, target, public :: & plastic_phenopowerlaw_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & @@ -28,7 +37,7 @@ module plastic_phenopowerlaw resolvedstress_twin_ID end enum - type, private :: tParameters + type :: tParameters real(pReal) :: & gdot0_slip, & !< reference shear strain rate for slip gdot0_twin, & !< reference shear strain rate for twin @@ -73,7 +82,7 @@ module plastic_phenopowerlaw outputID !< ID of each post result output end type tParameters - type, private :: tPhenopowerlawState + type :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & xi_slip, & xi_twin, & @@ -83,8 +92,8 @@ module plastic_phenopowerlaw !-------------------------------------------------------------------------------------------------- ! containers for parameters and state - type(tParameters), allocatable, dimension(:), private :: param - type(tPhenopowerlawState), allocatable, dimension(:), private :: & + type(tParameters), allocatable, dimension(:) :: param + type(tPhenopowerlawState), allocatable, dimension(:) :: & dotState, & state @@ -94,9 +103,6 @@ module plastic_phenopowerlaw plastic_phenopowerlaw_dotState, & plastic_phenopowerlaw_postResults, & plastic_phenopowerlaw_results - private :: & - kinetics_slip, & - kinetics_twin contains @@ -106,20 +112,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_init - use prec, only: & - pStringLen - use debug, only: & - debug_level, & - debug_constitutive,& - debug_levelBasic - use math, only: & - math_expand - use IO, only: & - IO_error - use material - use config, only: & - config_phase - use lattice integer :: & Ninstance, & @@ -484,8 +476,6 @@ end subroutine plastic_phenopowerlaw_dotState !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults) - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -552,8 +542,6 @@ end function plastic_phenopowerlaw_postResults !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) - use results, only: & - results_writeDataset integer, intent(in) :: instance character(len=*), intent(in) :: group @@ -598,10 +586,6 @@ end subroutine plastic_phenopowerlaw_results !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_slip(Mp,instance,of, & gdot_slip_pos,gdot_slip_neg,dgdot_dtau_slip_pos,dgdot_dtau_slip_neg) - use prec, only: & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -674,10 +658,6 @@ end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_twin(Mp,instance,of,& gdot_twin,dgdot_dtau_twin) - use prec, only: & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress diff --git a/src/quaternions.f90 b/src/quaternions.f90 index fa9c13f38..47490daba 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -34,8 +34,7 @@ !> @details w is the real part, (x, y, z) are the imaginary parts. !--------------------------------------------------------------------------------------------------- module quaternions - use prec, only: & - pReal + use prec use future implicit none @@ -286,8 +285,6 @@ end function div_scal__ !> equality of two quaternions !--------------------------------------------------------------------------------------------------- logical elemental function eq__(self,other) - use prec, only: & - dEq class(quaternion), intent(in) :: self,other diff --git a/src/rotations.f90 b/src/rotations.f90 index 69529ed24..3a64f27b9 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -46,12 +46,15 @@ !--------------------------------------------------------------------------------------------------- module rotations - use prec, only: & - pReal + use prec + use IO + use math + use Lambert use quaternions implicit none private + type, public :: rotation type(quaternion), private :: q contains @@ -148,8 +151,6 @@ end subroutine !> @details: rotation is based on unit quaternion or rotation matrix (fallback) !--------------------------------------------------------------------------------------------------- function rotVector(self,v,active) - use prec, only: & - dEq real(pReal), dimension(3) :: rotVector class(rotation), intent(in) :: self @@ -260,10 +261,6 @@ end function qu2om !> @brief convert unit quaternion to Euler angles !--------------------------------------------------------------------------------------------------- pure function qu2eu(qu) result(eu) - use prec, only: & - dEq0 - use math, only: & - PI type(quaternion), intent(in) :: qu real(pReal), dimension(3) :: eu @@ -294,12 +291,6 @@ end function qu2eu !> @brief convert unit quaternion to axis angle pair !--------------------------------------------------------------------------------------------------- pure function qu2ax(qu) result(ax) - use prec, only: & - dEq0, & - dNeq0 - use math, only: & - PI, & - math_clip type(quaternion), intent(in) :: qu real(pReal), dimension(4) :: ax @@ -324,13 +315,6 @@ end function qu2ax !> @brief convert unit quaternion to Rodrigues vector !--------------------------------------------------------------------------------------------------- pure function qu2ro(qu) result(ro) - use, intrinsic :: IEEE_ARITHMETIC, only: & - IEEE_value, & - IEEE_positive_inf - use prec, only: & - dEq0 - use math, only: & - math_clip type(quaternion), intent(in) :: qu real(pReal), dimension(4) :: ro @@ -358,10 +342,6 @@ end function qu2ro !> @brief convert unit quaternion to homochoric !--------------------------------------------------------------------------------------------------- pure function qu2ho(qu) result(ho) - use prec, only: & - dEq0 - use math, only: & - math_clip type(quaternion), intent(in) :: qu real(pReal), dimension(3) :: ho @@ -415,8 +395,6 @@ end function om2qu !> @brief orientation matrix to Euler angles !--------------------------------------------------------------------------------------------------- pure function om2eu(om) result(eu) - use math, only: & - PI real(pReal), intent(in), dimension(3,3) :: om real(pReal), dimension(3) :: eu @@ -441,15 +419,6 @@ end function om2eu !> @brief convert orientation matrix to axis angle pair !--------------------------------------------------------------------------------------------------- function om2ax(om) result(ax) - use prec, only: & - dEq0, & - cEq, & - dNeq0 - use IO, only: & - IO_error - use math, only: & - math_clip, & - math_trace33 real(pReal), intent(in) :: om(3,3) real(pReal) :: ax(4) @@ -560,8 +529,6 @@ end function eu2qu !> @brief Euler angles to orientation matrix !--------------------------------------------------------------------------------------------------- pure function eu2om(eu) result(om) - use prec, only: & - dEq0 real(pReal), intent(in), dimension(3) :: eu real(pReal), dimension(3,3) :: om @@ -591,11 +558,6 @@ end function eu2om !> @brief convert euler to axis angle !--------------------------------------------------------------------------------------------------- pure function eu2ax(eu) result(ax) - use prec, only: & - dEq0, & - dEq - use math, only: & - PI real(pReal), intent(in), dimension(3) :: eu real(pReal), dimension(4) :: ax @@ -625,13 +587,6 @@ end function eu2ax !> @brief Euler angles to Rodrigues vector !--------------------------------------------------------------------------------------------------- pure function eu2ro(eu) result(ro) - use prec, only: & - dEq0 - use, intrinsic :: IEEE_ARITHMETIC, only: & - IEEE_value, & - IEEE_positive_inf - use math, only: & - PI real(pReal), intent(in), dimension(3) :: eu real(pReal), dimension(4) :: ro @@ -681,8 +636,6 @@ end function eu2cu !> @brief convert axis angle pair to quaternion !--------------------------------------------------------------------------------------------------- pure function ax2qu(ax) result(qu) - use prec, only: & - dEq0 real(pReal), intent(in), dimension(4) :: ax type(quaternion) :: qu @@ -755,13 +708,6 @@ end function ax2eu !> @brief convert axis angle pair to Rodrigues vector !--------------------------------------------------------------------------------------------------- pure function ax2ro(ax) result(ro) - use, intrinsic :: IEEE_ARITHMETIC, only: & - IEEE_value, & - IEEE_positive_inf - use prec, only: & - dEq0 - use math, only: & - PI real(pReal), intent(in), dimension(4) :: ax real(pReal), dimension(4) :: ro @@ -858,12 +804,6 @@ end function ro2eu !> @brief convert Rodrigues vector to axis angle pair !--------------------------------------------------------------------------------------------------- pure function ro2ax(ro) result(ax) - use, intrinsic :: IEEE_ARITHMETIC, only: & - IEEE_is_finite - use prec, only: & - dEq0 - use math, only: & - PI real(pReal), intent(in), dimension(4) :: ro real(pReal), dimension(4) :: ax @@ -890,12 +830,6 @@ end function ro2ax !> @brief convert Rodrigues vector to homochoric !--------------------------------------------------------------------------------------------------- pure function ro2ho(ro) result(ho) - use, intrinsic :: IEEE_ARITHMETIC, only: & - IEEE_is_finite - use prec, only: & - dEq0 - use math, only: & - PI real(pReal), intent(in), dimension(4) :: ro real(pReal), dimension(3) :: ho @@ -973,8 +907,6 @@ end function ho2eu !> @brief convert homochoric to axis angle pair !--------------------------------------------------------------------------------------------------- pure function ho2ax(ho) result(ax) - use prec, only: & - dEq0 real(pReal), intent(in), dimension(3) :: ho real(pReal), dimension(4) :: ax @@ -1029,13 +961,11 @@ end function ho2ro !> @brief convert homochoric to cubochoric !--------------------------------------------------------------------------------------------------- function ho2cu(ho) result(cu) - use Lambert, only: & - LambertBallToCube real(pReal), intent(in), dimension(3) :: ho real(pReal), dimension(3) :: cu - cu = LambertBallToCube(ho) + cu = Lambert_BallToCube(ho) end function ho2cu @@ -1115,13 +1045,11 @@ end function cu2ro !> @brief convert cubochoric to homochoric !--------------------------------------------------------------------------------------------------- function cu2ho(cu) result(ho) - use Lambert, only: & - LambertCubeToBall real(pReal), intent(in), dimension(3) :: cu real(pReal), dimension(3) :: ho - ho = LambertCubeToBall(cu) + ho = Lambert_CubeToBall(cu) end function cu2ho From 3df9a8d58c7741851517289ca158c0dcf9f3b245 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 23:14:47 +0200 Subject: [PATCH 34/59] focus on the physics --- src/damage_local.f90 | 55 ++++----------------- src/damage_none.f90 | 16 ++----- src/damage_nonlocal.f90 | 71 ++++++---------------------- src/kinematics_cleavage_opening.f90 | 51 +++++++------------- src/kinematics_slipplane_opening.f90 | 42 +++++----------- src/kinematics_thermal_expansion.f90 | 50 +++++++------------- src/source_damage_anisoBrittle.f90 | 2 +- src/source_damage_isoBrittle.f90 | 2 +- 8 files changed, 76 insertions(+), 213 deletions(-) diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 2db8cccc1..bd71ae95b 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -4,9 +4,13 @@ !-------------------------------------------------------------------------------------------------- module damage_local use prec + use material + use numerics + use config implicit none private + integer, dimension(:,:), allocatable, target, public :: & damage_local_sizePostResult !< size of each post result output @@ -20,23 +24,22 @@ module damage_local enumerator :: undefined_ID, & damage_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + integer(kind(undefined_ID)), dimension(:,:), allocatable :: & damage_local_outputID !< ID of each post result output - type, private :: tParameters + type :: tParameters integer(kind(undefined_ID)), dimension(:), allocatable :: & outputID end type tParameters - type(tparameters), dimension(:), allocatable, private :: & + type(tparameters), dimension(:), allocatable :: & param public :: & damage_local_init, & damage_local_updateState, & damage_local_postResults - private :: & - damage_local_getSourceAndItsTangent + contains @@ -45,21 +48,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine damage_local_init - use material, only: & - damage_type, & - damage_typeInstance, & - homogenization_Noutput, & - DAMAGE_local_label, & - DAMAGE_local_ID, & - material_homogenizationAt, & - mappingHomogenization, & - damageState, & - damageMapping, & - damage, & - damage_initialPhi - use config, only: & - config_homogenization - integer :: maxNinstance,homog,instance,i integer :: sizeState @@ -72,7 +60,7 @@ subroutine damage_local_init write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' - maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt) + maxNinstance = count(damage_type == DAMAGE_local_ID) if (maxNinstance == 0) return allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) @@ -135,14 +123,6 @@ end subroutine damage_local_init !> @brief calculates local change in damage field !-------------------------------------------------------------------------------------------------- function damage_local_updateState(subdt, ip, el) - use numerics, only: & - residualStiffness, & - err_damage_tolAbs, & - err_damage_tolRel - use material, only: & - material_homogenizationAt, & - mappingHomogenization, & - damageState integer, intent(in) :: & ip, & !< integration point number @@ -177,17 +157,6 @@ end function damage_local_updateState !> @brief calculates homogenized local damage driving forces !-------------------------------------------------------------------------------------------------- subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) - use material, only: & - homogenization_Ngrains, & - material_homogenizationAt, & - phaseAt, & - phasememberAt, & - phase_source, & - phase_Nsources, & - SOURCE_damage_isoBrittle_ID, & - SOURCE_damage_isoDuctile_ID, & - SOURCE_damage_anisoBrittle_ID, & - SOURCE_damage_anisoDuctile_ID use source_damage_isoBrittle, only: & source_damage_isobrittle_getRateAndItsTangent use source_damage_isoDuctile, only: & @@ -244,15 +213,11 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el end subroutine damage_local_getSourceAndItsTangent + !-------------------------------------------------------------------------------------------------- !> @brief return array of damage results !-------------------------------------------------------------------------------------------------- function damage_local_postResults(ip,el) - use material, only: & - material_homogenizationAt, & - damage_typeInstance, & - damageMapping, & - damage integer, intent(in) :: & ip, & !< integration point diff --git a/src/damage_none.f90 b/src/damage_none.f90 index aa2995ef5..5ffdba030 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -3,6 +3,8 @@ !> @brief material subroutine for constant damage field !-------------------------------------------------------------------------------------------------- module damage_none + use config + use material implicit none private @@ -15,18 +17,8 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -subroutine damage_none_init() - use config, only: & - config_homogenization - use material, only: & - damage_initialPhi, & - damage, & - damage_type, & - material_homogenizationAt, & - damageState, & - DAMAGE_NONE_LABEL, & - DAMAGE_NONE_ID - +subroutine damage_none_init + integer :: & homog, & NofMyHomog diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 9398b328a..81117e0eb 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -5,9 +5,16 @@ !-------------------------------------------------------------------------------------------------- module damage_nonlocal use prec + use material + use numerics + use config + use crystallite + use lattice + use mesh implicit none private + integer, dimension(:,:), allocatable, target, public :: & damage_nonlocal_sizePostResult !< size of each post result output @@ -22,12 +29,12 @@ module damage_nonlocal damage_ID end enum - type, private :: tParameters + type :: tParameters integer(kind(undefined_ID)), dimension(:), allocatable :: & outputID end type tParameters - type(tparameters), dimension(:), allocatable, private :: & + type(tparameters), dimension(:), allocatable :: & param public :: & @@ -45,21 +52,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_init - use material, only: & - damage_type, & - damage_typeInstance, & - homogenization_Noutput, & - DAMAGE_nonlocal_label, & - DAMAGE_nonlocal_ID, & - material_homogenizationAt, & - mappingHomogenization, & - damageState, & - damageMapping, & - damage, & - damage_initialPhi - use config, only: & - config_homogenization - integer :: maxNinstance,homog,instance,o,i integer :: sizeState @@ -72,7 +64,7 @@ subroutine damage_nonlocal_init write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID)) + maxNinstance = count(damage_type == DAMAGE_nonlocal_ID) if (maxNinstance == 0) return allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) @@ -131,17 +123,6 @@ end subroutine damage_nonlocal_init !> @brief calculates homogenized damage driving forces !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) - use material, only: & - homogenization_Ngrains, & - material_homogenizationAt, & - phaseAt, & - phasememberAt, & - phase_source, & - phase_Nsources, & - SOURCE_damage_isoBrittle_ID, & - SOURCE_damage_isoDuctile_ID, & - SOURCE_damage_anisoBrittle_ID, & - SOURCE_damage_anisoDuctile_ID use source_damage_isoBrittle, only: & source_damage_isobrittle_getRateAndItsTangent use source_damage_isoDuctile, only: & @@ -198,20 +179,11 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, end subroutine damage_nonlocal_getSourceAndItsTangent + !-------------------------------------------------------------------------------------------------- !> @brief returns homogenized non local damage diffusion tensor in reference configuration !-------------------------------------------------------------------------------------------------- function damage_nonlocal_getDiffusion33(ip,el) - use numerics, only: & - charLength - use lattice, only: & - lattice_DamageDiffusion33 - use material, only: & - homogenization_Ngrains, & - material_phase, & - material_homogenizationAt - use crystallite, only: & - crystallite_push33ToRef integer, intent(in) :: & ip, & !< integration point number @@ -234,17 +206,11 @@ function damage_nonlocal_getDiffusion33(ip,el) end function damage_nonlocal_getDiffusion33 + !-------------------------------------------------------------------------------------------------- !> @brief Returns homogenized nonlocal damage mobility !-------------------------------------------------------------------------------------------------- real(pReal) function damage_nonlocal_getMobility(ip,el) - use mesh, only: & - mesh_element - use lattice, only: & - lattice_damageMobility - use material, only: & - material_phase, & - homogenization_Ngrains integer, intent(in) :: & ip, & !< integration point number @@ -263,14 +229,11 @@ real(pReal) function damage_nonlocal_getMobility(ip,el) end function damage_nonlocal_getMobility + !-------------------------------------------------------------------------------------------------- !> @brief updated nonlocal damage field with solution from damage phase field PDE !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) - use material, only: & - material_homogenizationAt, & - damageMapping, & - damage integer, intent(in) :: & ip, & !< integration point number @@ -286,16 +249,12 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) damage(homog)%p(offset) = phi end subroutine damage_nonlocal_putNonLocalDamage - + + !-------------------------------------------------------------------------------------------------- !> @brief return array of damage results !-------------------------------------------------------------------------------------------------- function damage_nonlocal_postResults(ip,el) - use material, only: & - material_homogenizationAt, & - damage_typeInstance, & - damageMapping, & - damage integer, intent(in) :: & ip, & !< integration point diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index a79dc4042..60d9cb500 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -5,13 +5,20 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module kinematics_cleavage_opening - use prec + use prec + use IO + use config + use debug + use math + use lattice + use material implicit none private - integer, dimension(:), allocatable, private :: kinematics_cleavage_opening_instance - type, private :: tParameters !< container type for internal constitutive parameters + integer, dimension(:), allocatable :: kinematics_cleavage_opening_instance + + type :: tParameters !< container type for internal constitutive parameters integer :: & totalNcleavage integer, dimension(:), allocatable :: & @@ -25,17 +32,17 @@ module kinematics_cleavage_opening end type ! Begin Deprecated - integer, dimension(:), allocatable, private :: & + integer, dimension(:), allocatable :: & kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems - integer, dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable :: & kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family - real(pReal), dimension(:), allocatable, private :: & + real(pReal), dimension(:), allocatable :: & kinematics_cleavage_opening_sdot_0, & kinematics_cleavage_opening_N - real(pReal), dimension(:,:), allocatable, private :: & + real(pReal), dimension(:,:), allocatable :: & kinematics_cleavage_opening_critDisp, & kinematics_cleavage_opening_critLoad ! End Deprecated @@ -51,22 +58,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_cleavage_opening_init() - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use config, only: & - config_phase - use IO, only: & - IO_error - use material, only: & - phase_kinematics, & - KINEMATICS_cleavage_opening_label, & - KINEMATICS_cleavage_opening_ID - use lattice, only: & - lattice_maxNcleavageFamily, & - lattice_NcleavageSystem +subroutine kinematics_cleavage_opening_init integer, allocatable, dimension(:) :: tempInt real(pReal), allocatable, dimension(:) :: tempFloat @@ -75,7 +67,7 @@ subroutine kinematics_cleavage_opening_init() write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' - maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID)) + maxNinstance = count(phase_kinematics == KINEMATICS_cleavage_opening_ID) if (maxNinstance == 0) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & @@ -127,17 +119,6 @@ end subroutine kinematics_cleavage_opening_init !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) - use math, only: & - math_mul33xx33 - use material, only: & - material_phase, & - material_homogenizationAt, & - damage, & - damageMapping - use lattice, only: & - lattice_Scleavage, & - lattice_maxNcleavageFamily, & - lattice_NcleavageSystem integer, intent(in) :: & ipc, & !< grain number diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index f29c0e252..3e37e4c0d 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -6,12 +6,19 @@ !-------------------------------------------------------------------------------------------------- module kinematics_slipplane_opening use prec + use config + use IO + use debug + use math + use lattice + use material implicit none private - integer, dimension(:), allocatable, private :: kinematics_slipplane_opening_instance + + integer, dimension(:), allocatable :: kinematics_slipplane_opening_instance - type, private :: tParameters !< container type for internal constitutive parameters + type :: tParameters !< container type for internal constitutive parameters integer :: & totalNslip integer, dimension(:), allocatable :: & @@ -19,7 +26,7 @@ module kinematics_slipplane_opening real(pReal) :: & sdot0, & n - real(pReal), dimension(:), allocatable :: & + real(pReal), dimension(:), allocatable :: & critLoad real(pReal), dimension(:,:), allocatable :: & slip_direction, & @@ -27,7 +34,8 @@ module kinematics_slipplane_opening slip_transverse end type tParameters - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) + public :: & kinematics_slipplane_opening_init, & kinematics_slipplane_opening_LiAndItsTangent @@ -39,23 +47,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_slipplane_opening_init() - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use config, only: & - config_phase - use IO, only: & - IO_error - use math, only: & - math_expand - use material, only: & - phase_kinematics, & - KINEMATICS_slipplane_opening_label, & - KINEMATICS_slipplane_opening_ID - use lattice - +subroutine kinematics_slipplane_opening_init integer :: maxNinstance,p,instance @@ -111,14 +103,6 @@ end subroutine kinematics_slipplane_opening_init !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) - use math, only: & - math_mul33xx33, & - math_outer - use material, only: & - material_phase, & - material_homogenizationAt, & - damage, & - damageMapping integer, intent(in) :: & ipc, & !< grain number diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 86932ea69..b4f23dfa7 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -5,11 +5,17 @@ !-------------------------------------------------------------------------------------------------- module kinematics_thermal_expansion use prec - + use IO + use config + use debug + use math + use lattice + use material + implicit none private - type, private :: tParameters + type :: tParameters real(pReal), allocatable, dimension(:,:,:) :: & expansion end type tParameters @@ -28,19 +34,9 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_thermal_expansion_init() - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use material, only: & - phase_kinematics, & - KINEMATICS_thermal_expansion_label, & - KINEMATICS_thermal_expansion_ID - use config, only: & - config_phase +subroutine kinematics_thermal_expansion_init - integer(pInt) :: & + integer :: & Ninstance, & p, i real(pReal), dimension(:), allocatable :: & @@ -48,14 +44,14 @@ subroutine kinematics_thermal_expansion_init() write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' - Ninstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) + Ninstance = count(phase_kinematics == KINEMATICS_thermal_expansion_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(param(Ninstance)) - do p = 1_pInt, size(phase_kinematics) + do p = 1, size(phase_kinematics) if (all(phase_kinematics(:,p) /= KINEMATICS_thermal_expansion_ID)) cycle ! ToDo: Here we need to decide how to extend the concept of instances to @@ -78,13 +74,8 @@ end subroutine kinematics_thermal_expansion_init !> @brief report initial thermal strain based on current temperature deviation from reference !-------------------------------------------------------------------------------------------------- pure function kinematics_thermal_expansion_initialStrain(homog,phase,offset) - use material, only: & - temperature - use lattice, only: & - lattice_thermalExpansion33, & - lattice_referenceTemperature - integer(pInt), intent(in) :: & + integer, intent(in) :: & phase, & homog, offset real(pReal), dimension(3,3) :: & @@ -106,17 +97,8 @@ end function kinematics_thermal_expansion_initialStrain !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el) - use material, only: & - material_phase, & - material_homogenizationAt, & - temperature, & - temperatureRate, & - thermalMapping - use lattice, only: & - lattice_thermalExpansion33, & - lattice_referenceTemperature - integer(pInt), intent(in) :: & + integer, intent(in) :: & ipc, & !< grain number ip, & !< integration point number el !< element number @@ -124,7 +106,7 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, Li !< thermal velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) - integer(pInt) :: & + integer :: & phase, & homog, offset real(pReal) :: & diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 494bbc6f0..2f5fc119f 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -101,7 +101,7 @@ subroutine source_damage_anisoBrittle_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' - Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID)) + Ninstance = count(phase_source == SOURCE_damage_anisoBrittle_ID) if (Ninstance == 0) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 90aa5089f..3e0e94f82 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -84,7 +84,7 @@ subroutine source_damage_isoBrittle_init write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' - Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID)) + Ninstance = count(phase_source == SOURCE_damage_isoBrittle_ID) if (Ninstance == 0) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & From dce4775c17abed2b2ca09dd8b1acd53a8e477ccb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 17 May 2019 06:36:30 +0200 Subject: [PATCH 35/59] removal of RGC out led to undefined variable --- src/homogenization.f90 | 30 +++++++++--------------------- 1 file changed, 9 insertions(+), 21 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 426b37cb8..c83322f26 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -134,27 +134,14 @@ subroutine homogenization_init !-------------------------------------------------------------------------------------------------- ! write description file for homogenization output - mainProcess2: if (worldrank == 0) then + mainProcess: if (worldrank == 0) then call IO_write_jobFile(FILEUNIT,'outputHomogenization') do p = 1,size(config_homogenization) if (any(material_homogenizationAt == p)) then - i = homogenization_typeInstance(p) ! which instance of this homogenization type - valid = .true. ! assume valid - select case(homogenization_type(p)) ! split per homogenization type - case (HOMOGENIZATION_NONE_ID) - outputName = HOMOGENIZATION_NONE_label - case (HOMOGENIZATION_ISOSTRAIN_ID) - outputName = HOMOGENIZATION_ISOSTRAIN_label - case (HOMOGENIZATION_RGC_ID) - outputName = HOMOGENIZATION_RGC_label - case default - valid = .false. - end select write(FILEUNIT,'(/,a,/)') '['//trim(homogenization_name(p))//']' - if (valid) then - write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName) - write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) - endif + write(FILEUNIT,'(a)') '(type) n/a' + write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) + i = thermal_typeInstance(p) ! which instance of this thermal type valid = .true. ! assume valid select case(thermal_type(p)) ! split per thermal type @@ -184,6 +171,7 @@ subroutine homogenization_init enddo endif endif + i = damage_typeInstance(p) ! which instance of this damage type valid = .true. ! assume valid select case(damage_type(p)) ! split per damage type @@ -216,7 +204,7 @@ subroutine homogenization_init endif enddo close(FILEUNIT) - endif mainProcess2 + endif mainProcess call config_deallocate('material.config/homogenization') @@ -842,12 +830,12 @@ function postResults(ip,el) postResults integer :: & startPos, endPos ,& - of, instance, homog + homog postResults = 0.0_pReal - startPos = endPos + 1 - endPos = endPos + thermalState(material_homogenizationAt(el))%sizePostResults + startPos = 1 + endPos = thermalState(material_homogenizationAt(el))%sizePostResults chosenThermal: select case (thermal_type(mesh_element(3,el))) case (THERMAL_adiabatic_ID) chosenThermal From 7b620e3ce92f5c2d9ba322069e5205eb4cc11904 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 17 May 2019 06:49:25 +0200 Subject: [PATCH 36/59] [skip ci] consistent with rest of the module --- src/math.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/math.f90 b/src/math.f90 index 1740ebdb7..f2c0303da 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -274,6 +274,7 @@ pure function math_identity2nd(dimen) end function math_identity2nd + !-------------------------------------------------------------------------------------------------- !> @brief symmetric fourth rank identity tensor of specified dimension ! from http://en.wikipedia.org/wiki/Tensor_derivative_(continuum_mechanics)#Derivative_of_a_second-order_tensor_with_respect_to_itself @@ -626,6 +627,7 @@ pure function math_skew33(m) end function math_skew33 + !-------------------------------------------------------------------------------------------------- !> @brief hydrostatic part of a 33 matrix !-------------------------------------------------------------------------------------------------- From 68d2d1dd5e23f765dae80269634ed343256378f4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 17 May 2019 05:12:01 +0000 Subject: [PATCH 37/59] less complaints from the Intel compiler --- cmake/Compiler-Intel.cmake | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cmake/Compiler-Intel.cmake b/cmake/Compiler-Intel.cmake index 998f60326..60ed46cbc 100644 --- a/cmake/Compiler-Intel.cmake +++ b/cmake/Compiler-Intel.cmake @@ -32,6 +32,8 @@ # disables warnings ... set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268") # ... the text exceeds right hand column allowed on the line (we have only comments there) + set (COMPILE_FLAGS "${COMPILE_FLAGS},7624") + # ... about deprecated forall (has nice syntax and most likely a performance advantage) set (COMPILE_FLAGS "${COMPILE_FLAGS} -warn") # enables warnings ... From 7ac0013271e31a3267ec60417e1beef4c2f30a91 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 17 May 2019 05:24:01 +0000 Subject: [PATCH 38/59] more consistent private/public declarations --- src/Lambert.f90 | 1 + src/math.f90 | 27 ++++++++++++++++++--------- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/src/Lambert.f90 b/src/Lambert.f90 index 601cf9984..a528ea8b0 100644 --- a/src/Lambert.f90 +++ b/src/Lambert.f90 @@ -38,6 +38,7 @@ !> Modeling and Simulations in Materials Science and Engineering 22, 075013 (2014). !-------------------------------------------------------------------------- module Lambert + use prec use math implicit none diff --git a/src/math.f90 b/src/math.f90 index f2c0303da..4a32be274 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -10,12 +10,20 @@ module math use future implicit none - real(pReal), parameter, public :: PI = acos(-1.0_pReal) !< ratio of a circle's circumference to its diameter - real(pReal), parameter, public :: INDEG = 180.0_pReal/PI !< conversion from radian into degree - real(pReal), parameter, public :: INRAD = PI/180.0_pReal !< conversion from degree into radian - complex(pReal), parameter, public :: TWOPIIMG = cmplx(0.0_pReal,2.0_pReal*PI) !< Re(0.0), Im(2xPi) + public +#if __INTEL_COMPILER >= 1900 + ! do not make use associated entities available to other modules + private :: & + prec, & + future +#endif - real(pReal), dimension(3,3), parameter, public :: & + real(pReal), parameter :: PI = acos(-1.0_pReal) !< ratio of a circle's circumference to its diameter + real(pReal), parameter :: INDEG = 180.0_pReal/PI !< conversion from radian into degree + real(pReal), parameter :: INRAD = PI/180.0_pReal !< conversion from degree into radian + complex(pReal), parameter :: TWOPIIMG = cmplx(0.0_pReal,2.0_pReal*PI) !< Re(0.0), Im(2xPi) + + real(pReal), dimension(3,3), parameter :: & MATH_I3 = reshape([& 1.0_pReal,0.0_pReal,0.0_pReal, & 0.0_pReal,1.0_pReal,0.0_pReal, & @@ -75,7 +83,7 @@ module math !--------------------------------------------------------------------------------------------------- private :: & - math_check + unitTest contains @@ -116,14 +124,15 @@ subroutine math_init write(6,'(a,4(/,26x,f17.14),/)') ' start of random sequence: ', randTest call random_seed(put = randInit) - call math_check + call unitTest end subroutine math_init + !-------------------------------------------------------------------------------------------------- !> @brief check correctness of (some) math functions !-------------------------------------------------------------------------------------------------- -subroutine math_check +subroutine unitTest use IO, only: IO_error character(len=64) :: error_msg @@ -145,7 +154,7 @@ subroutine math_check call IO_error(401,ext_msg=error_msg) endif -end subroutine math_check +end subroutine unitTest !-------------------------------------------------------------------------------------------------- From 0fe43c50abcee7a76982a07e7815b22192c23a51 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 17 May 2019 09:06:28 +0200 Subject: [PATCH 39/59] [skip ci] updated version information after successful test of v2.0.3-304-g7b14263c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 69faed072..2d8c83361 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-301-g789420c9 +v2.0.3-304-g7b14263c From ed8af98d695a670f3a8df0e66975d804d0851723 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 May 2019 06:54:45 +0200 Subject: [PATCH 40/59] don't clutter with use statements --- src/homogenization.f90 | 111 +++----------------------- src/homogenization_mech_RGC.f90 | 75 +++-------------- src/homogenization_mech_isostrain.f90 | 13 +-- src/homogenization_mech_none.f90 | 8 +- 4 files changed, 29 insertions(+), 178 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index c83322f26..d7b5b3fdc 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -6,7 +6,20 @@ !-------------------------------------------------------------------------------------------------- module homogenization use prec + use IO + use config + use debug + use math use material + use numerics + use constitutive + use crystallite + use mesh + use FEsolving +#if defined(PETSc) || defined(DAMASK_HDF5) + use results + use HDF5_utilities +#endif !-------------------------------------------------------------------------------------------------- ! General variables for the homogenization at a material point @@ -81,26 +94,6 @@ contains !> @brief module initialization !-------------------------------------------------------------------------------------------------- subroutine homogenization_init - use math, only: & - math_I3 - use debug, only: & - debug_level, & - debug_homogenization, & - debug_levelBasic, & - debug_e, & - debug_g - use mesh, only: & - theMesh, & - mesh_element - use constitutive, only: & - constitutive_plasticity_maxSizePostResults, & - constitutive_source_maxSizePostResults - use crystallite, only: & - crystallite_maxSizePostResults - use config, only: & - config_deallocate, & - config_homogenization, & - homogenization_name use homogenization_mech_RGC use thermal_isothermal use thermal_adiabatic @@ -108,9 +101,6 @@ subroutine homogenization_init use damage_none use damage_local use damage_nonlocal - use IO - use numerics, only: & - worldrank integer, parameter :: FILEUNIT = 200 integer :: e,i,p @@ -278,51 +268,6 @@ end subroutine homogenization_init !> @brief parallelized calculation of stress and corresponding tangent at material points !-------------------------------------------------------------------------------------------------- subroutine materialpoint_stressAndItsTangent(updateJaco,dt) - use numerics, only: & - subStepMinHomog, & - subStepSizeHomog, & - stepIncreaseHomog, & - nMPstate - use FEsolving, only: & - FEsolving_execElem, & - FEsolving_execIP, & - terminallyIll - use mesh, only: & - mesh_element - use crystallite, only: & - crystallite_F0, & - crystallite_Fp0, & - crystallite_Fp, & - crystallite_Fi0, & - crystallite_Fi, & - crystallite_Lp0, & - crystallite_Lp, & - crystallite_Li0, & - crystallite_Li, & - crystallite_S0, & - crystallite_S, & - crystallite_partionedF0, & - crystallite_partionedF, & - crystallite_partionedFp0, & - crystallite_partionedLp0, & - crystallite_partionedFi0, & - crystallite_partionedLi0, & - crystallite_partionedS0, & - crystallite_dt, & - crystallite_requested, & - crystallite_stress, & - crystallite_stressTangent, & - crystallite_orientations -#ifdef DEBUG - use debug, only: & - debug_level, & - debug_homogenization, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective, & - debug_e, & - debug_i -#endif real(pReal), intent(in) :: dt !< time increment logical, intent(in) :: updateJaco !< initiating Jacobian update @@ -616,14 +561,6 @@ end subroutine materialpoint_stressAndItsTangent !> @brief parallelized calculation of result array at material points !-------------------------------------------------------------------------------------------------- subroutine materialpoint_postResults - use FEsolving, only: & - FEsolving_execElem, & - FEsolving_execIP - use mesh, only: & - mesh_element - use crystallite, only: & - crystallite_sizePostResults, & - crystallite_postResults integer :: & thePos, & @@ -673,10 +610,6 @@ end subroutine materialpoint_postResults !> @brief partition material point def grad onto constituents !-------------------------------------------------------------------------------------------------- subroutine partitionDeformation(ip,el) - use mesh, only: & - mesh_element - use crystallite, only: & - crystallite_partionedF use homogenization_mech_RGC, only: & homogenization_RGC_partitionDeformation @@ -710,13 +643,6 @@ end subroutine partitionDeformation !> "happy" with result !-------------------------------------------------------------------------------------------------- function updateState(ip,el) - use mesh, only: & - mesh_element - use crystallite, only: & - crystallite_P, & - crystallite_dPdF, & - crystallite_partionedF,& - crystallite_partionedF0 use homogenization_mech_RGC, only: & homogenization_RGC_updateState use thermal_adiabatic, only: & @@ -769,10 +695,6 @@ end function updateState !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- subroutine averageStressAndItsTangent(ip,el) - use mesh, only: & - mesh_element - use crystallite, only: & - crystallite_P,crystallite_dPdF use homogenization_mech_RGC, only: & homogenization_RGC_averageStressAndItsTangent @@ -810,8 +732,6 @@ end subroutine averageStressAndItsTangent !> if homogenization_sizePostResults(i,e) > 0 !! !-------------------------------------------------------------------------------------------------- function postResults(ip,el) - use mesh, only: & - mesh_element use thermal_adiabatic, only: & thermal_adiabatic_postResults use thermal_conduction, only: & @@ -868,14 +788,9 @@ end function postResults !-------------------------------------------------------------------------------------------------- subroutine homogenization_results #if defined(PETSc) || defined(DAMASK_HDF5) - use results - use homogenization_mech_RGC - use HDF5_utilities use config, only: & config_name_homogenization => homogenization_name ! anticipate logical name - use material, only: & - homogenization_typeInstance, & material_homogenization_type => homogenization_type integer :: p diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index d7b1b31bf..f27733eb5 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -8,10 +8,18 @@ !-------------------------------------------------------------------------------------------------- module homogenization_mech_RGC use prec + use IO + use config + use debug + use math use material + use numerics + use constitutive +#if defined(PETSc) || defined(DAMASK_HDF5) + use results +#endif implicit none - private enum, bind(c) enumerator :: & @@ -66,34 +74,12 @@ module homogenization_mech_RGC type(tRGCdependentState), dimension(:), allocatable :: & dependentState - public :: & - homogenization_RGC_init, & - homogenization_RGC_partitionDeformation, & - homogenization_RGC_averageStressAndItsTangent, & - homogenization_RGC_updateState, & - mech_RGC_results ! name suited for planned submodule situation - contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_init() - use debug, only: & -#ifdef DEBUG - debug_i, & - debug_e, & -#endif - debug_level, & - debug_homogenization, & - debug_levelBasic - use math, only: & - math_EulerToR, & - INRAD - use IO, only: & - IO_error - use config, only: & - config_homogenization +subroutine homogenization_RGC_init integer :: & Ninstance, & @@ -218,12 +204,6 @@ end subroutine homogenization_RGC_init !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) -#ifdef DEBUG - use debug, only: & - debug_level, & - debug_homogenization, & - debug_levelExtensive -#endif real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain @@ -275,24 +255,6 @@ end subroutine homogenization_RGC_partitionDeformation ! "happy" with result !-------------------------------------------------------------------------------------------------- function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) -#ifdef DEBUG - use debug, only: & - debug_level, & - debug_homogenization,& - debug_levelExtensive -#endif - use math, only: & - math_invert2 - use numerics, only: & - absTol_RGC, & - relTol_RGC, & - absMax_RGC, & - relMax_RGC, & - pPert_RGC, & - maxdRelax_RGC, & - viscPower_RGC, & - viscModus_RGC, & - refRelaxRate_RGC real(pReal), dimension(:,:,:), intent(in) :: & P,& !< array of P @@ -712,10 +674,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !> @brief calculate stress-like penalty due to deformation mismatch !-------------------------------------------------------------------------------------------------- subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of) - use math, only: & - math_civita - use numerics, only: & - xSmoo_RGC real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch @@ -828,13 +786,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !> @brief calculate stress-like penalty due to volume discrepancy !-------------------------------------------------------------------------------------------------- subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of) - use math, only: & - math_det33, & - math_inv33 - use numerics, only: & - maxVolDiscr_RGC,& - volDiscrMod_RGC,& - volDiscrPow_RGC real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume real(pReal), intent(out) :: vDiscrep ! total volume discrepancy @@ -883,8 +834,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! deformation !-------------------------------------------------------------------------------------------------- function surfaceCorrection(avgF,instance,of) - use math, only: & - math_invert33 real(pReal), dimension(3) :: surfaceCorrection @@ -916,8 +865,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor !-------------------------------------------------------------------------------------------------- function equivalentModuli(grainID,ip,el) - use constitutive, only: & - constitutive_homogenizedC real(pReal), dimension(2) :: equivalentModuli @@ -1015,8 +962,6 @@ end subroutine homogenization_RGC_averageStressAndItsTangent !-------------------------------------------------------------------------------------------------- subroutine mech_RGC_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) - use results, only: & - results_writeDataset integer, intent(in) :: instance character(len=*) :: group diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mech_isostrain.f90 index 7dd7bad7d..b17085b57 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -5,7 +5,10 @@ !> @brief Isostrain (full constraint Taylor assuption) homogenization scheme !-------------------------------------------------------------------------------------------------- submodule(homogenization) homogenization_mech_isostrain - + use config + use debug + use IO + implicit none enum, bind(c) @@ -30,14 +33,6 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- module subroutine mech_isostrain_init - use debug, only: & - debug_HOMOGENIZATION, & - debug_level, & - debug_levelBasic - use IO, only: & - IO_error - use config, only: & - config_homogenization integer :: & Ninstance, & diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index e7a5a12e6..b8b74c267 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -5,6 +5,8 @@ !> @brief dummy homogenization homogenization scheme for 1 constituent per material point !-------------------------------------------------------------------------------------------------- submodule(homogenization) homogenization_mech_none + use config + use debug implicit none @@ -14,12 +16,6 @@ contains !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- module subroutine mech_none_init - use debug, only: & - debug_HOMOGENIZATION, & - debug_level, & - debug_levelBasic - use config, only: & - config_homogenization integer :: & Ninstance, & From 2258bfb22161c60987043ef89bc2d4e4dfeac132 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 May 2019 07:23:46 +0200 Subject: [PATCH 41/59] RGC as submodule submodules inherit use-associated entities and implicit none/private statements --- src/homogenization.f90 | 71 ++++++++++++++++++++------- src/homogenization_mech_RGC.f90 | 70 +++++++++++--------------- src/homogenization_mech_isostrain.f90 | 5 -- src/homogenization_mech_none.f90 | 6 +-- 4 files changed, 83 insertions(+), 69 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index d7b5b3fdc..cbc6471b4 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -60,11 +60,24 @@ module homogenization module subroutine mech_isostrain_init end subroutine mech_isostrain_init + module subroutine mech_RGC_init + end subroutine mech_RGC_init + + module subroutine mech_isostrain_partitionDeformation(F,avgF) real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point end subroutine mech_isostrain_partitionDeformation + module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) + real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient + real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point + integer, intent(in) :: & + instance, & + of + end subroutine mech_RGC_partitionDeformation + + module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point @@ -73,7 +86,37 @@ module homogenization real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses integer, intent(in) :: instance end subroutine mech_isostrain_averageStressAndItsTangent + + module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) + real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point + real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point + + real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + integer, intent(in) :: instance + end subroutine mech_RGC_averageStressAndItsTangent + + + module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) +logical, dimension(2) :: mech_RGC_updateState + real(pReal), dimension(:,:,:), intent(in) :: & + P,& !< array of P + F,& !< array of F + F0 !< array of initial F + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< array of current grain stiffness + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + end function + + module subroutine mech_RGC_results(instance,group) + + integer, intent(in) :: instance + character(len=*), intent(in) :: group + end subroutine end interface public :: & @@ -112,7 +155,7 @@ subroutine homogenization_init if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init - if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call homogenization_RGC_init + if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init @@ -610,8 +653,6 @@ end subroutine materialpoint_postResults !> @brief partition material point def grad onto constituents !-------------------------------------------------------------------------------------------------- subroutine partitionDeformation(ip,el) - use homogenization_mech_RGC, only: & - homogenization_RGC_partitionDeformation integer, intent(in) :: & ip, & !< integration point @@ -628,7 +669,7 @@ subroutine partitionDeformation(ip,el) materialpoint_subF(1:3,1:3,ip,el)) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - call homogenization_RGC_partitionDeformation(& + call mech_RGC_partitionDeformation(& crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & materialpoint_subF(1:3,1:3,ip,el),& ip, & @@ -643,8 +684,6 @@ end subroutine partitionDeformation !> "happy" with result !-------------------------------------------------------------------------------------------------- function updateState(ip,el) - use homogenization_mech_RGC, only: & - homogenization_RGC_updateState use thermal_adiabatic, only: & thermal_adiabatic_updateState use damage_local, only: & @@ -660,14 +699,14 @@ function updateState(ip,el) case (HOMOGENIZATION_RGC_ID) chosenHomogenization updateState = & updateState .and. & - homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & - crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & - crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),& - materialpoint_subF(1:3,1:3,ip,el),& - materialpoint_subdt(ip,el), & - crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & - ip, & - el) + mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),& + materialpoint_subF(1:3,1:3,ip,el),& + materialpoint_subdt(ip,el), & + crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + ip, & + el) end select chosenHomogenization chosenThermal: select case (thermal_type(mesh_element(3,el))) @@ -695,8 +734,6 @@ end function updateState !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- subroutine averageStressAndItsTangent(ip,el) - use homogenization_mech_RGC, only: & - homogenization_RGC_averageStressAndItsTangent integer, intent(in) :: & ip, & !< integration point @@ -716,7 +753,7 @@ subroutine averageStressAndItsTangent(ip,el) homogenization_typeInstance(mesh_element(3,el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - call homogenization_RGC_averageStressAndItsTangent(& + call mech_RGC_averageStressAndItsTangent(& materialpoint_P(1:3,1:3,ip,el), & materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),& crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index f27733eb5..4e115a498 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -6,20 +6,7 @@ !> @brief Relaxed grain cluster (RGC) homogenization scheme !> Nconstituents is defined as p x q x r (cluster) !-------------------------------------------------------------------------------------------------- -module homogenization_mech_RGC - use prec - use IO - use config - use debug - use math - use material - use numerics - use constitutive -#if defined(PETSc) || defined(DAMASK_HDF5) - use results -#endif - - implicit none +submodule(homogenization) homogenization_mech_RGC enum, bind(c) enumerator :: & @@ -79,7 +66,7 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_init +module subroutine mech_RGC_init integer :: & Ninstance, & @@ -197,17 +184,17 @@ subroutine homogenization_RGC_init enddo -end subroutine homogenization_RGC_init +end subroutine mech_RGC_init !-------------------------------------------------------------------------------------------------- !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) +module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain - real(pReal), dimension (:,:), intent(in) :: avgF !< averaged F + real(pReal), dimension (3,3), intent(in) :: avgF !< averaged F integer, intent(in) :: & instance, & of @@ -247,14 +234,14 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) end associate -end subroutine homogenization_RGC_partitionDeformation +end subroutine mech_RGC_partitionDeformation !-------------------------------------------------------------------------------------------------- !> @brief update the internal state of the homogenization scheme and tell whether "done" and ! "happy" with result !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) +module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) real(pReal), dimension(:,:,:), intent(in) :: & P,& !< array of P @@ -267,8 +254,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ip, & !< integration point number el !< element number - logical, dimension(2) :: homogenization_RGC_updateState - integer, dimension(4) :: intFaceN,intFaceP,faceID integer, dimension(3) :: nGDim,iGr3N,iGr3P integer :: instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, of @@ -285,7 +270,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) #endif zeroTimeStep: if(dEq0(dt)) then - homogenization_RGC_updateState = .true. ! pretend everything is fine and return + mech_RGC_updateState = .true. ! pretend everything is fine and return return endif zeroTimeStep @@ -404,12 +389,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) endif #endif - homogenization_RGC_updateState = .false. + mech_RGC_updateState = .false. !-------------------------------------------------------------------------------------------------- ! If convergence reached => done and happy if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then - homogenization_RGC_updateState = .true. + mech_RGC_updateState = .true. #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & .and. prm%of_debug == of) write(6,'(1x,a55,/)')'... done and happy' @@ -451,7 +436,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! if residual blows-up => done but unhappy elseif (residMax > relMax_RGC*stresMax .or. residMax > absMax_RGC) then ! try to restart when residual blows up exceeding maximum bound - homogenization_RGC_updateState = [.true.,.false.] ! with direct cut-back + mech_RGC_updateState = [.true.,.false.] ! with direct cut-back #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & @@ -648,7 +633,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo; enddo stt%relaxationVector(:,of) = relax + drelax ! Updateing the state variable for the next iteration if (any(abs(drelax) > maxdRelax_RGC)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large - homogenization_RGC_updateState = [.true.,.false.] + mech_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,e15.8)')'due to large relaxation change =',maxval(abs(drelax)) @@ -935,13 +920,13 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) end subroutine grainDeformation -end function homogenization_RGC_updateState +end function mech_RGC_updateState !-------------------------------------------------------------------------------------------------- !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) +module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point @@ -953,7 +938,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF, avgP = sum(P,3) /real(product(param(instance)%Nconstituents),pReal) dAvgPdAvgF = sum(dPdF,5)/real(product(param(instance)%Nconstituents),pReal) -end subroutine homogenization_RGC_averageStressAndItsTangent +end subroutine mech_RGC_averageStressAndItsTangent !-------------------------------------------------------------------------------------------------- @@ -963,8 +948,9 @@ end subroutine homogenization_RGC_averageStressAndItsTangent subroutine mech_RGC_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) - integer, intent(in) :: instance - character(len=*) :: group + integer, intent(in) :: instance + character(len=*), intent(in) :: group + integer :: o associate(stt => state(instance), dst => dependentState(instance), prm => param(instance)) @@ -1135,7 +1121,7 @@ integer pure function interface4to1(iFace4D, nGDim) else interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1) & + nGDim(3)*nGDim(1)*(iFace4D(3)-1) & - + (nGDim(1)-1)*nGDim(2)*nGDim(3) ! total number of interfaces normal //e1 + + (nGDim(1)-1)*nGDim(2)*nGDim(3) ! total # of interfaces normal || e1 endif case(3) @@ -1144,8 +1130,8 @@ integer pure function interface4to1(iFace4D, nGDim) else interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1) & + nGDim(1)*nGDim(2)*(iFace4D(4)-1) & - + (nGDim(1)-1)*nGDim(2)*nGDim(3) & ! total number of interfaces normal //e1 - + nGDim(1)*(nGDim(2)-1)*nGDim(3) ! total number of interfaces normal //e2 + + (nGDim(1)-1)*nGDim(2)*nGDim(3) & ! total # of interfaces normal || e1 + + nGDim(1)*(nGDim(2)-1)*nGDim(3) ! total # of interfaces normal || e2 endif case default @@ -1169,23 +1155,23 @@ pure function interface1to4(iFace1D, nGDim) !-------------------------------------------------------------------------------------------------- ! compute the total number of interfaces, which ... - nIntFace = [(nGDim(1)-1)*nGDim(2)*nGDim(3), & ! ... normal //e1 - nGDim(1)*(nGDim(2)-1)*nGDim(3), & ! ... normal //e2 - nGDim(1)*nGDim(2)*(nGDim(3)-1)] ! ... normal //e3 + nIntFace = [(nGDim(1)-1)*nGDim(2)*nGDim(3), & ! ... normal || e1 + nGDim(1)*(nGDim(2)-1)*nGDim(3), & ! ... normal || e2 + nGDim(1)*nGDim(2)*(nGDim(3)-1)] ! ... normal || e3 !-------------------------------------------------------------------------------------------------- ! get the corresponding interface ID in 4D (normal and local position) - if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then ! interface with normal //e1 + if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then ! interface with normal || e1 interface1to4(1) = 1 interface1to4(3) = mod((iFace1D-1),nGDim(2))+1 interface1to4(4) = mod(int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)),nGDim(3))+1 interface1to4(2) = int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)/real(nGDim(3),pReal))+1 - elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then ! interface with normal //e2 + elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then ! interface with normal || e2 interface1to4(1) = 2 interface1to4(4) = mod((iFace1D-nIntFace(1)-1),nGDim(3))+1 interface1to4(2) = mod(int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)),nGDim(1))+1 interface1to4(3) = int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)/real(nGDim(1),pReal))+1 - elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal //e3 + elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal || e3 interface1to4(1) = 3 interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1),nGDim(1))+1 interface1to4(3) = mod(int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)),nGDim(2))+1 @@ -1195,4 +1181,4 @@ pure function interface1to4(iFace1D, nGDim) end function interface1to4 -end module homogenization_mech_RGC +end submodule homogenization_mech_RGC diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mech_isostrain.f90 index b17085b57..c1eba821c 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -5,11 +5,6 @@ !> @brief Isostrain (full constraint Taylor assuption) homogenization scheme !-------------------------------------------------------------------------------------------------- submodule(homogenization) homogenization_mech_isostrain - use config - use debug - use IO - - implicit none enum, bind(c) enumerator :: & diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index b8b74c267..d5b24e5d1 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -5,10 +5,6 @@ !> @brief dummy homogenization homogenization scheme for 1 constituent per material point !-------------------------------------------------------------------------------------------------- submodule(homogenization) homogenization_mech_none - use config - use debug - - implicit none contains @@ -23,7 +19,7 @@ module subroutine mech_none_init NofMyHomog write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' - + Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID) if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance From 34bcd382403d1dff1c7e136d53db3e9672cb269f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 May 2019 07:39:55 +0200 Subject: [PATCH 42/59] cleanup --- src/commercialFEM_fileList.f90 | 2 +- src/homogenization.f90 | 53 ++++++++++++--------------------- src/homogenization_mech_RGC.f90 | 8 ++--- 3 files changed, 24 insertions(+), 39 deletions(-) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 0ae1323f0..5e1cd71eb 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -46,7 +46,6 @@ #include "plastic_nonlocal.f90" #include "constitutive.f90" #include "crystallite.f90" -#include "homogenization_mech_RGC.f90" #include "thermal_isothermal.f90" #include "thermal_adiabatic.f90" #include "thermal_conduction.f90" @@ -56,4 +55,5 @@ #include "homogenization.f90" #include "homogenization_mech_none.f90" #include "homogenization_mech_isostrain.f90" +#include "homogenization_mech_RGC.f90" #include "CPFEM.f90" diff --git a/src/homogenization.f90 b/src/homogenization.f90 index cbc6471b4..be07318d7 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -35,7 +35,6 @@ module homogenization materialpoint_results !< results array of material point integer, public, protected :: & materialpoint_sizeResults, & - homogenization_maxSizePostResults, & thermal_maxSizePostResults, & damage_maxSizePostResults @@ -98,25 +97,25 @@ module homogenization module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) -logical, dimension(2) :: mech_RGC_updateState - real(pReal), dimension(:,:,:), intent(in) :: & - P,& !< array of P - F,& !< array of F - F0 !< array of initial F - real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< array of current grain stiffness - real(pReal), dimension(3,3), intent(in) :: avgF !< average F - real(pReal), intent(in) :: dt !< time increment - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - end function - - module subroutine mech_RGC_results(instance,group) + logical, dimension(2) :: mech_RGC_updateState + real(pReal), dimension(:,:,:), intent(in) :: & + P,& !< partitioned stresses + F,& !< partitioned deformation gradients + F0 !< partitioned initial deformation gradients + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + end function mech_RGC_updateState - integer, intent(in) :: instance - character(len=*), intent(in) :: group - end subroutine + module subroutine mech_RGC_results(instance,group) + integer, intent(in) :: instance !< homogenization instance + character(len=*), intent(in) :: group !< group name in HDF5 file + end subroutine mech_RGC_results + end interface public :: & @@ -124,11 +123,6 @@ logical, dimension(2) :: mech_RGC_updateState materialpoint_stressAndItsTangent, & materialpoint_postResults, & homogenization_results - private :: & - partitionDeformation, & - updateState, & - averageStressAndItsTangent, & - postResults contains @@ -137,7 +131,6 @@ contains !> @brief module initialization !-------------------------------------------------------------------------------------------------- subroutine homogenization_init - use homogenization_mech_RGC use thermal_isothermal use thermal_adiabatic use thermal_conduction @@ -245,7 +238,7 @@ subroutine homogenization_init ! allocate and initialize global variables allocate(materialpoint_dPdF(3,3,3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) allocate(materialpoint_F0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) - materialpoint_F0 = spread(spread(math_I3,3,theMesh%elem%nIPs),4,theMesh%nElems) ! initialize to identity + materialpoint_F0 = spread(spread(math_I3,3,theMesh%elem%nIPs),4,theMesh%nElems) ! initialize to identity allocate(materialpoint_F(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) materialpoint_F = materialpoint_F0 ! initialize to identity allocate(materialpoint_subF0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) @@ -260,18 +253,15 @@ subroutine homogenization_init !-------------------------------------------------------------------------------------------------- ! allocate and initialize global state and postresutls variables - homogenization_maxSizePostResults = 0 thermal_maxSizePostResults = 0 damage_maxSizePostResults = 0 do p = 1,size(config_homogenization) - homogenization_maxSizePostResults = max(homogenization_maxSizePostResults,homogState (p)%sizePostResults) thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults) damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults) enddo materialpoint_sizeResults = 1 & ! grain count - + 1 + homogenization_maxSizePostResults & ! homogSize & homogResult - + thermal_maxSizePostResults & + + 1 + thermal_maxSizePostResults & + damage_maxSizePostResults & + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results @@ -281,11 +271,6 @@ subroutine homogenization_init write(6,'(/,a)') ' <<<+- homogenization init -+>>>' if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then -#ifdef TODO - write(6,'(a32,1x,7(i8,1x))') 'homogenization_state0: ', shape(homogenization_state0) - write(6,'(a32,1x,7(i8,1x))') 'homogenization_subState0: ', shape(homogenization_subState0) - write(6,'(a32,1x,7(i8,1x))') 'homogenization_state: ', shape(homogenization_state) -#endif write(6,'(a32,1x,7(i8,1x))') 'materialpoint_dPdF: ', shape(materialpoint_dPdF) write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F0: ', shape(materialpoint_F0) write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F: ', shape(materialpoint_F) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 4e115a498..a1e92d575 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -30,7 +30,7 @@ submodule(homogenization) homogenization_mech_RGC angles integer :: & of_debug = 0 - integer(kind(undefined_ID)), dimension(:), allocatable :: & + integer(kind(undefined_ID)), dimension(:), allocatable :: & outputID end type tParameters @@ -945,7 +945,7 @@ end subroutine mech_RGC_averageStressAndItsTangent !> @brief writes results to HDF5 output file ! ToDo: check wheter units are correct !-------------------------------------------------------------------------------------------------- -subroutine mech_RGC_results(instance,group) +module subroutine mech_RGC_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) integer, intent(in) :: instance @@ -981,8 +981,8 @@ subroutine mech_RGC_results(instance,group) end associate #else - integer, intent(in) :: instance - character(len=*) :: group + integer, intent(in) :: instance + character(len=*), intent(in) :: group #endif end subroutine mech_RGC_results From 86205f508149e90c0e00f85af0b235c16aa0bdb7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 May 2019 09:47:20 +0200 Subject: [PATCH 43/59] gfortran complaints about repeated dimension attribute we need to decide whether we want to repeat the declaration of the interface or not --- src/homogenization_mech_RGC.f90 | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index a1e92d575..1cbe837d2 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -241,18 +241,7 @@ end subroutine mech_RGC_partitionDeformation !> @brief update the internal state of the homogenization scheme and tell whether "done" and ! "happy" with result !-------------------------------------------------------------------------------------------------- -module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) - - real(pReal), dimension(:,:,:), intent(in) :: & - P,& !< array of P - F,& !< array of F - F0 !< array of initial F - real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< array of current grain stiffness - real(pReal), dimension(3,3), intent(in) :: avgF !< average F - real(pReal), intent(in) :: dt !< time increment - integer, intent(in) :: & - ip, & !< integration point number - el !< element number +module procedure mech_RGC_updateState integer, dimension(4) :: intFaceN,intFaceP,faceID integer, dimension(3) :: nGDim,iGr3N,iGr3P @@ -579,9 +568,10 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! ... of the numerical viscosity traction "rmatrix" allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal) - forall (i=1:3*nIntFaceTot) & + do i=1,3*nIntFaceTot rmatrix(i,i) = viscModus_RGC*viscPower_RGC/(refRelaxRate_RGC*dt)* & ! tangent due to numerical viscosity traction appears (abs(drelax(i))/(refRelaxRate_RGC*dt))**(viscPower_RGC - 1.0_pReal) ! only in the main diagonal term + enddo #ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then @@ -920,7 +910,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) end subroutine grainDeformation -end function mech_RGC_updateState +end procedure mech_RGC_updateState !-------------------------------------------------------------------------------------------------- From 60ed514e0cdc013e764256773332ad7729e807ae Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 15 May 2019 23:51:29 +0200 Subject: [PATCH 44/59] [skip ci] updated version information after successful test of v2.0.3-301-g789420c9 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index acf2aa8dc..69faed072 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-297-gae084bb2 +v2.0.3-301-g789420c9 From 60c2a5fc068393033a778bdf2a823a07bdf9dcd8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 18:24:54 +0200 Subject: [PATCH 45/59] loop (forall) over integration points wrong this was done for each integration point, but this was not detected for the forall loop --- src/homogenization.f90 | 119 ++++++++++++++++++++--------------------- 1 file changed, 59 insertions(+), 60 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index be07318d7..3210f02d4 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -323,43 +323,46 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! initialize restoration points of ... do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Ngrains(mesh_element(3,e)) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do g = 1,myNgrains + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); + do g = 1,myNgrains + + plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & + plasticState (phaseAt(g,i,e))%state0( :,phasememberAt(g,i,e)) + do mySource = 1, phase_Nsources(phaseAt(g,i,e)) + sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & + sourceState(phaseAt(g,i,e))%p(mySource)%state0( :,phasememberAt(g,i,e)) + enddo + + crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) + crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) + crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) + crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) + crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) + crystallite_partionedS0(1:3,1:3,g,i,e) = crystallite_S0(1:3,1:3,g,i,e) - plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & - plasticState (phaseAt(g,i,e))%state0( :,phasememberAt(g,i,e)) - do mySource = 1, phase_Nsources(phaseAt(g,i,e)) - sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & - sourceState(phaseAt(g,i,e))%p(mySource)%state0( :,phasememberAt(g,i,e)) enddo - crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) ! ...plastic def grads - crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) ! ...plastic velocity grads - crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) ! ...intermediate def grads - crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) ! ...intermediate velocity grads - crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) ! ...def grads - crystallite_partionedS0(1:3,1:3,g,i,e) = crystallite_S0(1:3,1:3,g,i,e) ! ...2nd PK stress - enddo; enddo - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e)) - materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e) ! ...def grad + materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e) materialpoint_subFrac(i,e) = 0.0_pReal materialpoint_subStep(i,e) = 1.0_pReal/subStepSizeHomog ! <> materialpoint_converged(i,e) = .false. ! pretend failed step of twice the required size materialpoint_requested(i,e) = .true. ! everybody requires calculation - endforall - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - homogState(material_homogenizationAt(e))%sizeState > 0) & - homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - thermalState(material_homogenizationAt(e))%sizeState > 0) & - thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - damageState(material_homogenizationAt(e))%sizeState > 0) & - damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state + + if (homogState(material_homogenizationAt(e))%sizeState > 0) & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + homogState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state + + if (thermalState(material_homogenizationAt(e))%sizeState > 0) & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + thermalState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state + + if (damageState(material_homogenizationAt(e))%sizeState > 0) & + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + damageState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state + enddo enddo + NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. & @@ -370,7 +373,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) myNgrains = homogenization_Ngrains(mesh_element(3,e)) IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - converged: if ( materialpoint_converged(i,e) ) then + converged: if (materialpoint_converged(i,e)) then #ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 & .and. ((e == debug_e .and. i == debug_i) & @@ -391,22 +394,22 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! wind forward grain starting point of... crystallite_partionedF0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedF(1:3,1:3,1:myNgrains,i,e) ! ...def grads + crystallite_partionedF(1:3,1:3,1:myNgrains,i,e) crystallite_partionedFp0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Fp (1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads + crystallite_Fp (1:3,1:3,1:myNgrains,i,e) crystallite_partionedLp0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Lp (1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads + crystallite_Lp (1:3,1:3,1:myNgrains,i,e) crystallite_partionedFi0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Fi (1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads + crystallite_Fi (1:3,1:3,1:myNgrains,i,e) crystallite_partionedLi0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Li (1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads + crystallite_Li (1:3,1:3,1:myNgrains,i,e) crystallite_partionedS0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_S (1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress + crystallite_S (1:3,1:3,1:myNgrains,i,e) do g = 1,myNgrains plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & @@ -417,23 +420,22 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) enddo enddo - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - homogState(material_homogenizationAt(e))%sizeState > 0) & + if(homogState(material_homogenizationAt(e))%sizeState > 0) & homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) ! ...internal homogenization state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - thermalState(material_homogenizationAt(e))%sizeState > 0) & + homogState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) + if(thermalState(material_homogenizationAt(e))%sizeState > 0) & thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) ! ...internal thermal state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - damageState(material_homogenizationAt(e))%sizeState > 0) & + thermalState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) + if(damageState(material_homogenizationAt(e))%sizeState > 0) & damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) ! ...internal damage state - materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad + damageState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) + + materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) + endif steppingNeeded else converged - if ( (myNgrains == 1 .and. materialpoint_subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + if ( (myNgrains == 1 .and. materialpoint_subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite subStepSizeHomog * materialpoint_subStep(i,e) <= subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense !$OMP FLUSH(terminallyIll) @@ -462,16 +464,16 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! restore... if (materialpoint_subStep(i,e) < 1.0_pReal) then ! protect against fake cutback from \Delta t = 2 to 1. Maybe that "trick" is not necessary anymore at all? I.e. start with \Delta t = 1 crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic velocity grads + crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) crystallite_Li(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate velocity grads + crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) endif ! maybe protecting everything from overwriting (not only L) makes even more sense crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) ! ...plastic def grads + crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) ! ...intermediate def grads + crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) crystallite_S(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) ! ...2nd PK stress + crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) do g = 1, myNgrains plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e)) = & plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) @@ -480,18 +482,15 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) enddo enddo - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - homogState(material_homogenizationAt(e))%sizeState > 0) & + if(homogState(material_homogenizationAt(e))%sizeState > 0) & homogState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal homogenization state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - thermalState(material_homogenizationAt(e))%sizeState > 0) & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) + if(thermalState(material_homogenizationAt(e))%sizeState > 0) & thermalState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal thermal state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - damageState(material_homogenizationAt(e))%sizeState > 0) & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) + if(damageState(material_homogenizationAt(e))%sizeState > 0) & damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) endif endif converged From c7036e39701c3e7b0fcbf4cfc80db47cc76ac92c Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 17 May 2019 09:06:28 +0200 Subject: [PATCH 46/59] [skip ci] updated version information after successful test of v2.0.3-304-g7b14263c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 69faed072..2d8c83361 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-301-g789420c9 +v2.0.3-304-g7b14263c From 1de0c7e652fcc6572859976e645374b6a36bd1fb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 May 2019 14:19:31 +0200 Subject: [PATCH 47/59] wrong name --- src/plastic_dislotwin.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 7db1f5f7f..05e9a49fd 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -1068,7 +1068,7 @@ subroutine plastic_dislotwin_results(instance,group) call results_writeDataset(group,stt%rho_dip,'rho_dip',& 'dislocation dipole density''1/m²') case (dot_gamma_sl_ID) - call results_writeDataset(group,stt%gamma_sl,'dot_gamma_sl',& + call results_writeDataset(group,stt%gamma_sl,'gamma_sl',& 'plastic shear','1') case (Lambda_sl_ID) call results_writeDataset(group,dst%Lambda_sl,'Lambda_sl',& From c4f07a9ad97102f9e8065dcdab06a1283298fbf3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 May 2019 21:25:05 +0200 Subject: [PATCH 48/59] need to correct tensor order --- src/results.f90 | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/src/results.f90 b/src/results.f90 index c5582b927..05db831f7 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -299,18 +299,26 @@ end subroutine results_writeVectorDataset_real !-------------------------------------------------------------------------------------------------- subroutine results_writeTensorDataset_real(group,dataset,label,description,SIunit) - character(len=*), intent(in) :: label,group,description - character(len=*), intent(in), optional :: SIunit - real(pReal), intent(inout), dimension(:,:,:) :: dataset + character(len=*), intent(in) :: label,group,description + character(len=*), intent(in), optional :: SIunit + real(pReal), intent(in), dimension(:,:,:) :: dataset + integer :: i integer(HID_T) :: groupHandle - + real(pReal), dimension(:,:,:), allocatable :: dataset_transposed + + + allocate(dataset_transposed,mold=dataset) + do i=1,size(dataset,3) + dataset_transposed(1:3,1:3,i) = transpose(dataset(1:3,1:3,i)) + enddo + groupHandle = results_openGroup(group) #ifdef PETSc - call HDF5_write(groupHandle,dataset,label,.true.) + call HDF5_write(groupHandle,dataset_transposed,label,.true.) #else - call HDF5_write(groupHandle,dataset,label,.false.) + call HDF5_write(groupHandle,dataset_transposed,label,.false.) #endif if (HDF5_objectExists(groupHandle,label)) & From d2e64df6a1813b4b169fdf3fbeb3d401ab7d69a1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 18 May 2019 21:27:27 +0200 Subject: [PATCH 49/59] some tests based on HDF5 output --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 639c6f4a5..3a2f89547 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 639c6f4a5eafc893c83c740c57f417eaaabc45ae +Subproject commit 3a2f89547c264044a7bfab9d33aee78eec495a76 From b35465b591f4d4866f421045d03d1ac7da9a3a99 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 May 2019 19:08:56 +0200 Subject: [PATCH 50/59] gamma_slip_ID should be used to write result --- src/plastic_dislotwin.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 05e9a49fd..cb4b3cbae 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -1067,7 +1067,7 @@ subroutine plastic_dislotwin_results(instance,group) case (rho_dip_ID) call results_writeDataset(group,stt%rho_dip,'rho_dip',& 'dislocation dipole density''1/m²') - case (dot_gamma_sl_ID) + case (gamma_sl_ID) call results_writeDataset(group,stt%gamma_sl,'gamma_sl',& 'plastic shear','1') case (Lambda_sl_ID) From e6cec6ecbe32d601f03579eabee202531f87d4c0 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 23 May 2019 12:03:54 -0400 Subject: [PATCH 51/59] added option to reverse inside/outside of primitive body --- processing/pre/geom_addPrimitive.py | 43 +++++++++++++++++------------ 1 file changed, 26 insertions(+), 17 deletions(-) diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index 7fcfdbc5c..0dfd06732 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -43,7 +43,7 @@ parser.add_option('-e', '--exponent', dest='exponent', 1 gives a sphere (|x|^(2^1) + |y|^(2^1) + |z|^(2^1) < 1), \ large values produce boxes, negative turns concave.') parser.add_option('-f', '--fill', dest='fill', - type='int', metavar = 'int', + type='float', metavar = 'float', help='grain index to fill primitive. "0" selects maximum microstructure index + 1 [%default]') parser.add_option('-q', '--quaternion', dest='quaternion', type='float', nargs = 4, metavar=' '.join(['float']*4), @@ -60,15 +60,24 @@ parser.add_option( '--nonperiodic', dest='periodic', parser.add_option( '--realspace', dest='realspace', action='store_true', help = '-c and -d span [origin,origin+size] instead of [0,grid] coordinates') +parser.add_option( '--invert', dest='inside', + action='store_false', + help = 'invert the volume filled by the primitive (inside/outside)') +parser.add_option('--float', dest = 'float', + action = 'store_true', + help = 'use float input') parser.set_defaults(center = (.0,.0,.0), - fill = 0, + fill = 0.0, degrees = False, exponent = (20,20,20), # box shape by default periodic = True, realspace = False, + inside = True, + float = False, ) (options, filenames) = parser.parse_args() + if options.dimension is None: parser.error('no dimension specified.') if options.angleaxis is not None: @@ -78,6 +87,8 @@ elif options.quaternion is not None: else: rotation = damask.Rotation() +datatype = 'f' if options.float else 'i' + options.center = np.array(options.center) options.dimension = np.array(options.dimension) # undo logarithmic sense of exponent and generate ellipsoids for negative dimensions (backward compatibility) @@ -97,13 +108,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures'], - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') @@ -115,7 +120,7 @@ for name in filenames: #--- read data ------------------------------------------------------------------------------------ - microstructure = table.microstructure_read(info['grid']) # read microstructure + microstructure = table.microstructure_read(info['grid'],datatype) # read microstructure # --- do work ------------------------------------------------------------------------------------ @@ -123,7 +128,7 @@ for name in filenames: 'microstructures': 0, } - options.fill = microstructure.max()+1 if options.fill == 0 else options.fill + options.fill = np.nanmax(microstructure)+1 if options.fill == 0 else options.fill microstructure = microstructure.reshape(info['grid'],order='F') @@ -193,19 +198,23 @@ for name in filenames: grid[1] * j : grid[1] * (j+1), grid[2] * k : grid[2] * (k+1)])**options.exponent[2] <= 1.0) - microstructure = np.where(inside, options.fill, microstructure) + microstructure = np.where(inside, + options.fill if options.inside else microstructure, + microstructure if options.inside else options.fill) else: # nonperiodic, much lighter on resources microstructure = np.where(np.abs(X)**options.exponent[0] + np.abs(Y)**options.exponent[1] + - np.abs(Z)**options.exponent[2] <= 1.0, options.fill, microstructure) + np.abs(Z)**options.exponent[2] <= 1.0, + options.fill if options.inside else microstructure, + microstructure if options.inside else options.fill) np.seterr(**old_settings) # Reset warnings to old state - newInfo['microstructures'] = microstructure.max() + newInfo['microstructures'] = len(np.unique(microstructure)) # --- report --------------------------------------------------------------------------------------- if (newInfo['microstructures'] != info['microstructures']): - damask.util.croak('--> microstructures: %i'%newInfo['microstructures']) + damask.util.croak('--> microstructures: {}'.format(newInfo['microstructures'])) #--- write header --------------------------------------------------------------------------------- @@ -225,9 +234,9 @@ for name in filenames: # --- write microstructure information ------------------------------------------------------------ - formatwidth = int(math.floor(math.log10(microstructure.max())+1)) + format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure))+1))) table.data = microstructure.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose() - table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ') + table.data_writeArray(format,delimiter = ' ') #--- output finalization -------------------------------------------------------------------------- From eb13fbc0cee296b9448a8f2eca5ec8c87bda3c9f Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 23 May 2019 13:03:24 -0400 Subject: [PATCH 52/59] streamlined geom-info reporting; added --float option to some scripts; hardened against NaN; "microstructures" now reports uniques not max --- processing/pre/geom_canvas.py | 14 ++++----- processing/pre/geom_clean.py | 14 +++------ processing/pre/geom_fromMinimalSurface.py | 7 +---- processing/pre/geom_fromTable.py | 9 ++---- processing/pre/geom_grainGrowth.py | 13 ++------- processing/pre/geom_mirror.py | 26 ++++++++++------- processing/pre/geom_pack.py | 10 ++----- processing/pre/geom_renumber.py | 10 ++----- processing/pre/geom_rescale.py | 26 +++++++++-------- processing/pre/geom_rotate.py | 35 ++++++++++++----------- processing/pre/geom_toTable.py | 14 +++------ processing/pre/geom_translate.py | 22 ++++++-------- processing/pre/geom_unpack.py | 8 +----- processing/pre/geom_vicinityOffset.py | 14 +++------ 14 files changed, 85 insertions(+), 137 deletions(-) diff --git a/processing/pre/geom_canvas.py b/processing/pre/geom_canvas.py index d7fd1614a..01682deb8 100755 --- a/processing/pre/geom_canvas.py +++ b/processing/pre/geom_canvas.py @@ -35,7 +35,7 @@ parser.add_option('-f', type = 'float', metavar = 'float', help = '(background) canvas grain index. "0" selects maximum microstructure index + 1 [%default]') parser.add_option('--float', - dest = 'real', + dest = 'float', action = 'store_true', help = 'use float input') parser.add_option('--blank', @@ -45,13 +45,13 @@ parser.add_option('--blank', parser.set_defaults(grid = ['0','0','0'], offset = (0,0,0), - fill = 0, - real = False, + fill = 0.0, + float = False, ) (options, filenames) = parser.parse_args() -datatype = 'f' if options.real else 'i' +datatype = 'f' if options.float else 'i' options.grid = ['1','1','1'] if options.blank and options.grid == ['0','0','0'] else options.grid options.fill = 1 if options.blank and options.fill == 0 else options.fill @@ -107,7 +107,7 @@ for name in filenames: newInfo['grid'] = np.where(newInfo['grid'] > 0, newInfo['grid'],info['grid']) microstructure_cropped = np.zeros(newInfo['grid'],datatype) - microstructure_cropped.fill(options.fill if options.real or options.fill > 0 else microstructure.max()+1) + microstructure_cropped.fill(options.fill if options.float or options.fill > 0 else np.nanmax(microstructure)+1) if not options.blank: xindex = np.arange(max(options.offset[0],0),min(options.offset[0]+newInfo['grid'][0],info['grid'][0])) @@ -130,7 +130,7 @@ for name in filenames: newInfo['size'] = info['size']/info['grid']*newInfo['grid'] if np.all(info['grid'] > 0) else newInfo['grid'] newInfo['origin'] = info['origin']+(info['size']/info['grid'] if np.all(info['grid'] > 0) \ else newInfo['size']/newInfo['grid'])*options.offset - newInfo['microstructures'] = microstructure_cropped.max() + newInfo['microstructures'] = len(np.unique(microstructure_cropped)) # --- report --------------------------------------------------------------------------------------- @@ -172,7 +172,7 @@ for name in filenames: # --- write microstructure information ------------------------------------------------------------ - format = '%g' if options.real else '%{}i'.format(int(math.floor(math.log10(microstructure_cropped.max())+1))) + format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure_cropped))+1))) table.data = microstructure_cropped.reshape((newInfo['grid'][0],newInfo['grid'][1]*newInfo['grid'][2]),order='F').transpose() table.data_writeArray(format,delimiter=' ') diff --git a/processing/pre/geom_clean.py b/processing/pre/geom_clean.py index 907431146..1d0769ab3 100755 --- a/processing/pre/geom_clean.py +++ b/processing/pre/geom_clean.py @@ -50,13 +50,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))), - 'size x y z: {}'.format(' x '.join(map(str,info['size']))), - 'origin x y z: {}'.format(' : '.join(map(str,info['origin']))), - 'homogenization: {}'.format(info['homogenization']), - 'microstructures: {}'.format(info['microstructures']), - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') @@ -73,7 +67,7 @@ for name in filenames: # --- do work ------------------------------------------------------------------------------------ microstructure = ndimage.filters.generic_filter(microstructure,mostFrequent,size=(options.stencil,)*3).astype('int_') - newInfo = {'microstructures': microstructure.max()} + newInfo = {'microstructures': len(np.unique(microstructure))} # --- report --------------------------------------------------------------------------------------- if ( newInfo['microstructures'] != info['microstructures']): @@ -91,9 +85,9 @@ for name in filenames: # --- write microstructure information ------------------------------------------------------------ - formatwidth = int(math.floor(math.log10(microstructure.max())+1)) + formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1)) table.data = microstructure.reshape((info['grid'][0],np.prod(info['grid'][1:])),order='F').transpose() - table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ') + table.data_writeArray('%{}i'.format(formatwidth),delimiter = ' ') # --- output finalization -------------------------------------------------------------------------- diff --git a/processing/pre/geom_fromMinimalSurface.py b/processing/pre/geom_fromMinimalSurface.py index 002b4800b..e0023e7ec 100755 --- a/processing/pre/geom_fromMinimalSurface.py +++ b/processing/pre/geom_fromMinimalSurface.py @@ -90,12 +90,7 @@ for name in filenames: #--- report --------------------------------------------------------------------------------------- - damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures'], - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') diff --git a/processing/pre/geom_fromTable.py b/processing/pre/geom_fromTable.py index 8eb1ed8bf..7a905cd26 100755 --- a/processing/pre/geom_fromTable.py +++ b/processing/pre/geom_fromTable.py @@ -192,12 +192,7 @@ for name in filenames: 'homogenization': options.homogenization, } - damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))), - 'size x y z: {}'.format(' x '.join(map(str,info['size']))), - 'origin x y z: {}'.format(' : '.join(map(str,info['origin']))), - 'homogenization: {}'.format(info['homogenization']), - 'microstructures: {}'.format(info['microstructures']), - ]) + damask.util.report_geom(info) # --- write header --------------------------------------------------------------------------------- @@ -230,7 +225,7 @@ for name in filenames: # --- write microstructure information ------------------------------------------------------------ table.data = grain.reshape(info['grid'][1]*info['grid'][2],info['grid'][0]) - table.data_writeArray('%%%ii'%(formatwidth),delimiter=' ') + table.data_writeArray('%{}i'.format(formatwidth),delimiter=' ') #--- output finalization -------------------------------------------------------------------------- diff --git a/processing/pre/geom_grainGrowth.py b/processing/pre/geom_grainGrowth.py index 1afb02715..f7c50c2e5 100755 --- a/processing/pre/geom_grainGrowth.py +++ b/processing/pre/geom_grainGrowth.py @@ -69,13 +69,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))), - 'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))), - 'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))), - 'homogenization: {}'.format(info['homogenization']), - 'microstructures: {}'.format(info['microstructures']), - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') @@ -200,8 +194,7 @@ for name in filenames: newID += 1 microstructure = np.where(microstructure == microstructureID, newID, microstructure) - newInfo = {'microstructures': 0,} - newInfo['microstructures'] = microstructure.max() + newInfo = {'microstructures': len(np.unique(microstructure)),} # --- report -------------------------------------------------------------------------------------- @@ -226,7 +219,7 @@ for name in filenames: # --- write microstructure information ------------------------------------------------------------ - formatwidth = int(math.floor(math.log10(microstructure.max())+1)) + formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1)) table.data = microstructure[::1 if info['grid'][0]>1 else 2, ::1 if info['grid'][1]>1 else 2, ::1 if info['grid'][2]>1 else 2,].\ diff --git a/processing/pre/geom_mirror.py b/processing/pre/geom_mirror.py index 951fb0842..853b99632 100755 --- a/processing/pre/geom_mirror.py +++ b/processing/pre/geom_mirror.py @@ -23,6 +23,13 @@ parser.add_option('-d','--direction', dest = 'directions', action = 'extend', metavar = '', help = "directions in which to mirror {'x','y','z'}") +parser.add_option('--float', + dest = 'float', + action = 'store_true', + help = 'use float input') + +parser.set_defaults(float = False, + ) (options, filenames) = parser.parse_args() @@ -32,6 +39,8 @@ if not set(options.directions).issubset(validDirections): invalidDirections = [str(e) for e in set(options.directions).difference(validDirections)] parser.error('invalid directions {}. '.format(*invalidDirections)) +datatype = 'f' if options.float else 'i' + # --- loop over input files ------------------------------------------------------------------------- if filenames == []: filenames = [None] @@ -39,7 +48,8 @@ if filenames == []: filenames = [None] for name in filenames: try: table = damask.ASCIItable(name = name, - buffered = False, labeled = False) + buffered = False, + labeled = False) except: continue damask.util.report(scriptName,name) @@ -47,13 +57,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures'], - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') @@ -65,7 +69,7 @@ for name in filenames: # --- read data ------------------------------------------------------------------------------------ - microstructure = table.microstructure_read(info['grid']).reshape(info['grid'],order='F') # read microstructure + microstructure = table.microstructure_read(info['grid'],datatype).reshape(info['grid'],order='F') # read microstructure if 'z' in options.directions: microstructure = np.concatenate([microstructure,microstructure[:,:,::-1]],2) @@ -107,9 +111,9 @@ for name in filenames: # --- write microstructure information ------------------------------------------------------------ - formatwidth = int(math.floor(math.log10(microstructure.max())+1)) + formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1)) table.data = microstructure.reshape((newInfo['grid'][0],np.prod(newInfo['grid'][1:])),order='F').transpose() - table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ') + table.data_writeArray('%{}i'.format(formatwidth),delimiter = ' ') # --- output finalization -------------------------------------------------------------------------- diff --git a/processing/pre/geom_pack.py b/processing/pre/geom_pack.py index 0d864bbf5..2e6080a6b 100755 --- a/processing/pre/geom_pack.py +++ b/processing/pre/geom_pack.py @@ -35,14 +35,8 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))), - 'size x y z: {}'.format(' x '.join(map(str,info['size']))), - 'origin x y z: {}'.format(' : '.join(map(str,info['origin']))), - 'homogenization: {}'.format(info['homogenization']), - 'microstructures: {}'.format(info['microstructures']), - ]) - + damask.util.report_geom(info) + errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') if np.any(info['size'] <= 0.0): errors.append('invalid size x y z.') diff --git a/processing/pre/geom_renumber.py b/processing/pre/geom_renumber.py index 033b4a566..3faa7f449 100755 --- a/processing/pre/geom_renumber.py +++ b/processing/pre/geom_renumber.py @@ -35,13 +35,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures'], - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') @@ -93,7 +87,7 @@ for name in filenames: # --- write microstructure information ----------------------------------------------------------- - format = '%{}i'.format(int(math.floor(math.log10(newInfo['microstructures'])+1))) + format = '%{}i'.format(int(math.floor(math.log10(np.nanmax(renumbered))+1))) table.data = renumbered.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose() table.data_writeArray(format,delimiter = ' ') diff --git a/processing/pre/geom_rescale.py b/processing/pre/geom_rescale.py index b3716bd62..4a14c0050 100755 --- a/processing/pre/geom_rescale.py +++ b/processing/pre/geom_rescale.py @@ -31,14 +31,21 @@ parser.add_option('-r', '--renumber', dest = 'renumber', action = 'store_true', help = 'renumber microstructure indices from 1..N [%default]') +parser.add_option('--float', + dest = 'float', + action = 'store_true', + help = 'use float input') parser.set_defaults(renumber = False, grid = ['0','0','0'], size = ['0.0','0.0','0.0'], + float = False, ) (options, filenames) = parser.parse_args() +datatype = 'f' if options.float else 'i' + # --- loop over input files ------------------------------------------------------------------------- if filenames == []: filenames = [None] @@ -46,7 +53,8 @@ if filenames == []: filenames = [None] for name in filenames: try: table = damask.ASCIItable(name = name, - buffered = False, labeled = False) + buffered = False, + labeled = False) except: continue damask.util.report(scriptName,name) @@ -54,13 +62,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures'], - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') @@ -72,7 +74,7 @@ for name in filenames: # --- read data ------------------------------------------------------------------------------------ - microstructure = table.microstructure_read(info['grid']) # read microstructure + microstructure = table.microstructure_read(info['grid'],datatype) # read microstructure # --- do work ------------------------------------------------------------------------------------ @@ -113,7 +115,7 @@ for name in filenames: newID += 1 microstructure = np.where(microstructure == microstructureID, newID,microstructure).reshape(microstructure.shape) - newInfo['microstructures'] = microstructure.max() + newInfo['microstructures'] = len(np.unique(microstructure)) # --- report --------------------------------------------------------------------------------------- @@ -152,9 +154,9 @@ for name in filenames: # --- write microstructure information ------------------------------------------------------------ - formatwidth = int(math.floor(math.log10(microstructure.max())+1)) + format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure))+1))) table.data = microstructure.reshape((newInfo['grid'][0],newInfo['grid'][1]*newInfo['grid'][2]),order='F').transpose() - table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ') + table.data_writeArray(format,delimiter=' ') # --- output finalization -------------------------------------------------------------------------- diff --git a/processing/pre/geom_rotate.py b/processing/pre/geom_rotate.py index 4da59cddf..7cce5800d 100755 --- a/processing/pre/geom_rotate.py +++ b/processing/pre/geom_rotate.py @@ -43,9 +43,15 @@ parser.add_option('-f', '--fill', dest = 'fill', type = 'int', metavar = 'int', help = 'background grain index. "0" selects maximum microstructure index + 1 [%default]') +parser.add_option('--float', + dest = 'float', + action = 'store_true', + help = 'use float input') parser.set_defaults(degrees = False, - fill = 0) + fill = 0, + float = False, + ) (options, filenames) = parser.parse_args() @@ -61,6 +67,8 @@ if options.matrix is not None: if options.eulers is not None: eulers = damask.Rotation.fromEulers(np.array(options.eulers),degrees=True).asEulers(degrees=True) +datatype = 'f' if options.float else 'i' + # --- loop over input files ------------------------------------------------------------------------- if filenames == []: filenames = [None] @@ -77,13 +85,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))), - 'size x y z: {}'.format(' x '.join(map(str,info['size']))), - 'origin x y z: {}'.format(' : '.join(map(str,info['origin']))), - 'homogenization: {}'.format(info['homogenization']), - 'microstructures: {}'.format(info['microstructures']), - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') @@ -95,9 +97,9 @@ for name in filenames: # --- read data ------------------------------------------------------------------------------------ - microstructure = table.microstructure_read(info['grid']).reshape(info['grid'],order='F') # read microstructure + microstructure = table.microstructure_read(info['grid'],datatype).reshape(info['grid'],order='F') # read microstructure - newGrainID = options.fill if options.fill != 0 else microstructure.max()+1 + newGrainID = options.fill if options.fill != 0 else np.nanmax(microstructure)+1 microstructure = ndimage.rotate(microstructure,eulers[2],(0,1),order=0,prefilter=False,output=int,cval=newGrainID) # rotation around Z microstructure = ndimage.rotate(microstructure,eulers[1],(1,2),order=0,prefilter=False,output=int,cval=newGrainID) # rotation around X microstructure = ndimage.rotate(microstructure,eulers[0],(0,1),order=0,prefilter=False,output=int,cval=newGrainID) # rotation around Z @@ -107,19 +109,18 @@ for name in filenames: newInfo = { 'size': microstructure.shape*info['size']/info['grid'], 'grid': microstructure.shape, - 'microstructures': microstructure.max(), + 'microstructures': len(np.unique(microstructure)), } - # --- report --------------------------------------------------------------------------------------- remarks = [] if (any(newInfo['grid'] != info['grid'])): - remarks.append('--> grid a b c: %s'%(' x '.join(map(str,newInfo['grid'])))) + remarks.append('--> grid a b c: {}'.format(' x '.join(map(str,newInfo['grid'])))) if (any(newInfo['size'] != info['size'])): - remarks.append('--> size x y z: %s'%(' x '.join(map(str,newInfo['size'])))) + remarks.append('--> size x y z: {}'.format(' x '.join(map(str,newInfo['size'])))) if ( newInfo['microstructures'] != info['microstructures']): - remarks.append('--> microstructures: %i'%newInfo['microstructures']) + remarks.append('--> microstructures: {}'.format(newInfo['microstructures'])) if remarks != []: damask.util.croak(remarks) # --- write header --------------------------------------------------------------------------------- @@ -138,9 +139,9 @@ for name in filenames: # --- write microstructure information ------------------------------------------------------------ - formatwidth = int(math.floor(math.log10(microstructure.max())+1)) + format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure))+1))) table.data = microstructure.reshape((newInfo['grid'][0],np.prod(newInfo['grid'][1:])),order='F').transpose() - table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ') + table.data_writeArray(format,delimiter=' ') # --- output finalization -------------------------------------------------------------------------- diff --git a/processing/pre/geom_toTable.py b/processing/pre/geom_toTable.py index 73e4888d1..0a71b335e 100755 --- a/processing/pre/geom_toTable.py +++ b/processing/pre/geom_toTable.py @@ -20,15 +20,15 @@ Translate geom description into ASCIItable containing position and microstructur """, version = scriptID) parser.add_option('--float', - dest = 'real', + dest = 'float', action = 'store_true', help = 'use float input') -parser.set_defaults(real = False, +parser.set_defaults(float = False, ) (options, filenames) = parser.parse_args() -datatype = 'f' if options.real else 'i' +datatype = 'f' if options.float else 'i' # --- loop over input files ------------------------------------------------------------------------- @@ -47,13 +47,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))), - 'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))), - 'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))), - 'homogenization: {}'.format(info['homogenization']), - 'microstructures: {}'.format(info['microstructures']), - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') diff --git a/processing/pre/geom_translate.py b/processing/pre/geom_translate.py index 59aaac5d5..072c270ea 100755 --- a/processing/pre/geom_translate.py +++ b/processing/pre/geom_translate.py @@ -31,19 +31,19 @@ parser.add_option('-s', '--substitute', action = 'extend', metavar = '', help = 'substitutions of microstructure indices from,to,from,to,...') parser.add_option('--float', - dest = 'real', + dest = 'float', action = 'store_true', help = 'use float input') parser.set_defaults(origin = (0.0,0.0,0.0), microstructure = 0, substitute = [], - real = False, + float = False, ) (options, filenames) = parser.parse_args() -datatype = 'f' if options.real else 'i' +datatype = 'f' if options.float else 'i' sub = {} for i in range(len(options.substitute)//2): # split substitution list into "from" -> "to" @@ -64,13 +64,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures'], - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') @@ -92,7 +86,7 @@ for name in filenames: } substituted = np.copy(microstructure) - for k, v in sub.items(): substituted[microstructure==k] = v # substitute microstructure indices + for k, v in sub.items(): substituted[microstructure==k] = v # substitute microstructure indices substituted += options.microstructure # shift microstructure indices @@ -103,9 +97,9 @@ for name in filenames: remarks = [] if (any(newInfo['origin'] != info['origin'])): - remarks.append('--> origin x y z: %s'%(' : '.join(map(str,newInfo['origin'])))) + remarks.append('--> origin x y z: {}'.format(' : '.join(map(str,newInfo['origin'])))) if ( newInfo['microstructures'] != info['microstructures']): - remarks.append('--> microstructures: %i'%newInfo['microstructures']) + remarks.append('--> microstructures: {}'.format(newInfo['microstructures'])) if remarks != []: damask.util.croak(remarks) # --- write header ------------------------------------------------------------------------------- @@ -124,7 +118,7 @@ for name in filenames: # --- write microstructure information ----------------------------------------------------------- - format = '%g' if options.real else '%{}i'.format(int(math.floor(math.log10(microstructure.max())+1))) + format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(substituted))+1))) table.data = substituted.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose() table.data_writeArray(format,delimiter = ' ') diff --git a/processing/pre/geom_unpack.py b/processing/pre/geom_unpack.py index 726e4ef04..4cac76c5f 100755 --- a/processing/pre/geom_unpack.py +++ b/processing/pre/geom_unpack.py @@ -43,13 +43,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures'], - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') diff --git a/processing/pre/geom_vicinityOffset.py b/processing/pre/geom_vicinityOffset.py index 9fce7201a..733276d01 100755 --- a/processing/pre/geom_vicinityOffset.py +++ b/processing/pre/geom_vicinityOffset.py @@ -73,13 +73,7 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - - damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures'], - ]) + damask.util.report_geom(info) errors = [] if np.any(info['grid'] < 1): errors.append('invalid grid a b c.') @@ -108,7 +102,7 @@ for name in filenames: extra_keywords={"trigger":options.trigger,"size":1+2*options.vicinity}), microstructure + options.offset,microstructure) - newInfo['microstructures'] = microstructure.max() + newInfo['microstructures'] = len(np.unique(microstructure)) # --- report --------------------------------------------------------------------------------------- @@ -131,9 +125,9 @@ for name in filenames: # --- write microstructure information ------------------------------------------------------------ - formatwidth = int(math.floor(math.log10(microstructure.max())+1)) + formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1)) table.data = microstructure.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose() - table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ') + table.data_writeArray('%{}i'.format(formatwidth),delimiter = ' ') # --- output finalization -------------------------------------------------------------------------- From e743a55ff2254a0b870ed65d60bbba0e6bba9f0c Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 23 May 2019 23:01:28 +0200 Subject: [PATCH 53/59] [skip ci] updated version information after successful test of v2.0.3-307-geb13fbc0 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 2d8c83361..98f27ab76 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-304-g7b14263c +v2.0.3-307-geb13fbc0 From 144361295d362a7179adfaf76184f74b176e2208 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 27 May 2019 15:39:37 +0200 Subject: [PATCH 54/59] [skip ci] updated version information after successful test of v2.0.3-332-g5abcca50 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 98f27ab76..d961b0f73 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-307-geb13fbc0 +v2.0.3-332-g5abcca50 From 0db42642652fc047895aa6fa4d9c71e7560634b6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 May 2019 09:27:52 +0200 Subject: [PATCH 55/59] cleaning --- src/config.f90 | 2 +- src/quaternions.f90 | 334 ++++++++++++++++++++++---------------------- 2 files changed, 168 insertions(+), 168 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 8729014ce..cd67c4641 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -15,7 +15,7 @@ module config implicit none private - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & + type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & config_phase, & config_microstructure, & config_homogenization, & diff --git a/src/quaternions.f90 b/src/quaternions.f90 index 47490daba..dc894bdfa 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -3,27 +3,27 @@ ! Modified 2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH ! All rights reserved. ! -! Redistribution and use in source and binary forms, with or without modification, are +! Redistribution and use in source and binary forms, with or without modification, are ! permitted provided that the following conditions are met: ! -! - Redistributions of source code must retain the above copyright notice, this list +! - Redistributions of source code must retain the above copyright notice, this list ! of conditions and the following disclaimer. -! - Redistributions in binary form must reproduce the above copyright notice, this -! list of conditions and the following disclaimer in the documentation and/or +! - Redistributions in binary form must reproduce the above copyright notice, this +! list of conditions and the following disclaimer in the documentation and/or ! other materials provided with the distribution. -! - Neither the names of Marc De Graef, Carnegie Mellon University nor the names -! of its contributors may be used to endorse or promote products derived from +! - Neither the names of Marc De Graef, Carnegie Mellon University nor the names +! of its contributors may be used to endorse or promote products derived from ! this software without specific prior written permission. ! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE -! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE ! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ################################################################### @@ -34,57 +34,57 @@ !> @details w is the real part, (x, y, z) are the imaginary parts. !--------------------------------------------------------------------------------------------------- module quaternions - use prec - use future + use prec + use future - implicit none - public - - real(pReal), parameter, public :: P = -1.0_pReal !< parameter for orientation conversion. - - type, public :: quaternion - real(pReal) :: w = 0.0_pReal - real(pReal) :: x = 0.0_pReal - real(pReal) :: y = 0.0_pReal - real(pReal) :: z = 0.0_pReal - + implicit none + public - contains - procedure, private :: add__ - procedure, private :: pos__ - generic, public :: operator(+) => add__,pos__ + real(pReal), parameter, public :: P = -1.0_pReal !< parameter for orientation conversion. - procedure, private :: sub__ - procedure, private :: neg__ - generic, public :: operator(-) => sub__,neg__ + type, public :: quaternion + real(pReal) :: w = 0.0_pReal + real(pReal) :: x = 0.0_pReal + real(pReal) :: y = 0.0_pReal + real(pReal) :: z = 0.0_pReal - procedure, private :: mul_quat__ - procedure, private :: mul_scal__ - generic, public :: operator(*) => mul_quat__, mul_scal__ - procedure, private :: div_quat__ - procedure, private :: div_scal__ - generic, public :: operator(/) => div_quat__, div_scal__ + contains + procedure, private :: add__ + procedure, private :: pos__ + generic, public :: operator(+) => add__,pos__ - procedure, private :: eq__ - generic, public :: operator(==) => eq__ + procedure, private :: sub__ + procedure, private :: neg__ + generic, public :: operator(-) => sub__,neg__ - procedure, private :: neq__ - generic, public :: operator(/=) => neq__ + procedure, private :: mul_quat__ + procedure, private :: mul_scal__ + generic, public :: operator(*) => mul_quat__, mul_scal__ - procedure, private :: pow_quat__ - procedure, private :: pow_scal__ - generic, public :: operator(**) => pow_quat__, pow_scal__ + procedure, private :: div_quat__ + procedure, private :: div_scal__ + generic, public :: operator(/) => div_quat__, div_scal__ - procedure, public :: abs__ - procedure, public :: dot_product__ - procedure, public :: conjg__ - procedure, public :: exp__ - procedure, public :: log__ + procedure, private :: eq__ + generic, public :: operator(==) => eq__ - procedure, public :: homomorphed => quat_homomorphed + procedure, private :: neq__ + generic, public :: operator(/=) => neq__ - end type + procedure, private :: pow_quat__ + procedure, private :: pow_scal__ + generic, public :: operator(**) => pow_quat__, pow_scal__ + + procedure, public :: abs__ + procedure, public :: dot_product__ + procedure, public :: conjg__ + procedure, public :: exp__ + procedure, public :: log__ + + procedure, public :: homomorphed => quat_homomorphed + + end type interface assignment (=) module procedure assign_quat__ @@ -123,12 +123,12 @@ contains !--------------------------------------------------------------------------------------------------- type(quaternion) pure function init__(array) - real(pReal), intent(in), dimension(4) :: array - - init__%w=array(1) - init__%x=array(2) - init__%y=array(3) - init__%z=array(4) + real(pReal), intent(in), dimension(4) :: array + + init__%w=array(1) + init__%x=array(2) + init__%y=array(3) + init__%z=array(4) end function init__ @@ -138,14 +138,14 @@ end function init__ !--------------------------------------------------------------------------------------------------- elemental subroutine assign_quat__(self,other) - type(quaternion), intent(out) :: self - type(quaternion), intent(in) :: other - - self%w = other%w - self%x = other%x - self%y = other%y - self%z = other%z - + type(quaternion), intent(out) :: self + type(quaternion), intent(in) :: other + + self%w = other%w + self%x = other%x + self%y = other%y + self%z = other%z + end subroutine assign_quat__ @@ -154,14 +154,14 @@ end subroutine assign_quat__ !--------------------------------------------------------------------------------------------------- pure subroutine assign_vec__(self,other) - type(quaternion), intent(out) :: self - real(pReal), intent(in), dimension(4) :: other - - self%w = other(1) - self%x = other(2) - self%y = other(3) - self%z = other(4) - + type(quaternion), intent(out) :: self + real(pReal), intent(in), dimension(4) :: other + + self%w = other(1) + self%x = other(2) + self%y = other(3) + self%z = other(4) + end subroutine assign_vec__ @@ -170,13 +170,13 @@ end subroutine assign_vec__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function add__(self,other) - class(quaternion), intent(in) :: self,other - - add__%w = self%w + other%w - add__%x = self%x + other%x - add__%y = self%y + other%y - add__%z = self%z + other%z - + class(quaternion), intent(in) :: self,other + + add__%w = self%w + other%w + add__%x = self%x + other%x + add__%y = self%y + other%y + add__%z = self%z + other%z + end function add__ @@ -185,13 +185,13 @@ end function add__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pos__(self) - class(quaternion), intent(in) :: self - - pos__%w = self%w - pos__%x = self%x - pos__%y = self%y - pos__%z = self%z - + class(quaternion), intent(in) :: self + + pos__%w = self%w + pos__%x = self%x + pos__%y = self%y + pos__%z = self%z + end function pos__ @@ -200,13 +200,13 @@ end function pos__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function sub__(self,other) - class(quaternion), intent(in) :: self,other - - sub__%w = self%w - other%w - sub__%x = self%x - other%x - sub__%y = self%y - other%y - sub__%z = self%z - other%z - + class(quaternion), intent(in) :: self,other + + sub__%w = self%w - other%w + sub__%x = self%x - other%x + sub__%y = self%y - other%y + sub__%z = self%z - other%z + end function sub__ @@ -215,13 +215,13 @@ end function sub__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function neg__(self) - class(quaternion), intent(in) :: self - - neg__%w = -self%w - neg__%x = -self%x - neg__%y = -self%y - neg__%z = -self%z - + class(quaternion), intent(in) :: self + + neg__%w = -self%w + neg__%x = -self%x + neg__%y = -self%y + neg__%z = -self%z + end function neg__ @@ -230,13 +230,13 @@ end function neg__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function mul_quat__(self,other) - class(quaternion), intent(in) :: self, other + class(quaternion), intent(in) :: self, other + + mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z + mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y) + mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z) + mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x) - mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z - mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y) - mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z) - mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x) - end function mul_quat__ @@ -245,14 +245,14 @@ end function mul_quat__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function mul_scal__(self,scal) - class(quaternion), intent(in) :: self - real(pReal), intent(in) :: scal + class(quaternion), intent(in) :: self + real(pReal), intent(in) :: scal + + mul_scal__%w = self%w*scal + mul_scal__%x = self%x*scal + mul_scal__%y = self%y*scal + mul_scal__%z = self%z*scal - mul_scal__%w = self%w*scal - mul_scal__%x = self%x*scal - mul_scal__%y = self%y*scal - mul_scal__%z = self%z*scal - end function mul_scal__ @@ -261,9 +261,9 @@ end function mul_scal__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function div_quat__(self,other) - class(quaternion), intent(in) :: self, other + class(quaternion), intent(in) :: self, other - div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal)) + div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal)) end function div_quat__ @@ -273,10 +273,10 @@ end function div_quat__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function div_scal__(self,scal) - class(quaternion), intent(in) :: self - real(pReal), intent(in) :: scal + class(quaternion), intent(in) :: self + real(pReal), intent(in) :: scal - div_scal__ = [self%w,self%x,self%y,self%z]/scal + div_scal__ = [self%w,self%x,self%y,self%z]/scal end function div_scal__ @@ -286,11 +286,11 @@ end function div_scal__ !--------------------------------------------------------------------------------------------------- logical elemental function eq__(self,other) - class(quaternion), intent(in) :: self,other + class(quaternion), intent(in) :: self,other + + eq__ = all(dEq([ self%w, self%x, self%y, self%z], & + [other%w,other%x,other%y,other%z])) - eq__ = all(dEq([ self%w, self%x, self%y, self%z], & - [other%w,other%x,other%y,other%z])) - end function eq__ @@ -299,10 +299,10 @@ end function eq__ !--------------------------------------------------------------------------------------------------- logical elemental function neq__(self,other) - class(quaternion), intent(in) :: self,other + class(quaternion), intent(in) :: self,other + + neq__ = .not. self%eq__(other) - neq__ = .not. self%eq__(other) - end function neq__ @@ -311,11 +311,11 @@ end function neq__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pow_scal__(self,expon) - class(quaternion), intent(in) :: self - real(pReal), intent(in) :: expon - - pow_scal__ = exp(log(self)*expon) - + class(quaternion), intent(in) :: self + real(pReal), intent(in) :: expon + + pow_scal__ = exp(log(self)*expon) + end function pow_scal__ @@ -324,11 +324,11 @@ end function pow_scal__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pow_quat__(self,expon) - class(quaternion), intent(in) :: self - type(quaternion), intent(in) :: expon - - pow_quat__ = exp(log(self)*expon) - + class(quaternion), intent(in) :: self + type(quaternion), intent(in) :: expon + + pow_quat__ = exp(log(self)*expon) + end function pow_quat__ @@ -338,15 +338,15 @@ end function pow_quat__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function exp__(self) - class(quaternion), intent(in) :: self - real(pReal) :: absImag + class(quaternion), intent(in) :: self + real(pReal) :: absImag - absImag = norm2([self%x, self%y, self%z]) + absImag = norm2([self%x, self%y, self%z]) - exp__ = exp(self%w) * [ cos(absImag), & - self%x/absImag * sin(absImag), & - self%y/absImag * sin(absImag), & - self%z/absImag * sin(absImag)] + exp__ = exp(self%w) * [ cos(absImag), & + self%x/absImag * sin(absImag), & + self%y/absImag * sin(absImag), & + self%z/absImag * sin(absImag)] end function exp__ @@ -357,16 +357,16 @@ end function exp__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function log__(self) - class(quaternion), intent(in) :: self - real(pReal) :: absImag + class(quaternion), intent(in) :: self + real(pReal) :: absImag - absImag = norm2([self%x, self%y, self%z]) + absImag = norm2([self%x, self%y, self%z]) + + log__ = [log(abs(self)), & + self%x/absImag * acos(self%w/abs(self)), & + self%y/absImag * acos(self%w/abs(self)), & + self%z/absImag * acos(self%w/abs(self))] - log__ = [log(abs(self)), & - self%x/absImag * acos(self%w/abs(self)), & - self%y/absImag * acos(self%w/abs(self)), & - self%z/absImag * acos(self%w/abs(self))] - end function log__ @@ -375,10 +375,10 @@ end function log__ !--------------------------------------------------------------------------------------------------- real(pReal) elemental function abs__(a) - class(quaternion), intent(in) :: a + class(quaternion), intent(in) :: a + + abs__ = norm2([a%w,a%x,a%y,a%z]) - abs__ = norm2([a%w,a%x,a%y,a%z]) - end function abs__ @@ -387,10 +387,10 @@ end function abs__ !--------------------------------------------------------------------------------------------------- real(pReal) elemental function dot_product__(a,b) - class(quaternion), intent(in) :: a,b + class(quaternion), intent(in) :: a,b + + dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z - dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z - end function dot_product__ @@ -399,10 +399,10 @@ end function dot_product__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function conjg__(a) - class(quaternion), intent(in) :: a + class(quaternion), intent(in) :: a + + conjg__ = quaternion([a%w, -a%x, -a%y, -a%z]) - conjg__ = quaternion([a%w, -a%x, -a%y, -a%z]) - end function conjg__ @@ -411,10 +411,10 @@ end function conjg__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function quat_homomorphed(a) - class(quaternion), intent(in) :: a + class(quaternion), intent(in) :: a + + quat_homomorphed = quaternion(-[a%w,a%x,a%y,a%z]) - quat_homomorphed = quaternion(-[a%w,a%x,a%y,a%z]) - end function quat_homomorphed end module quaternions From a5c6e4b17c21337dde6966ecf4dc2e1d5d176bc0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 May 2019 12:06:21 +0200 Subject: [PATCH 56/59] do not clutter the code with use statements --- src/DAMASK_interface.f90 | 7 +- src/HDF5_utilities.f90 | 10 +- src/damage_nonlocal.f90 | 399 ++++++++++++------------ src/homogenization.f90 | 24 +- src/kinematics_cleavage_opening.f90 | 298 +++++++++--------- src/list.f90 | 34 +- src/results.f90 | 16 +- src/source_damage_anisoBrittle.f90 | 465 +++++++++++++--------------- src/source_thermal_dissipation.f90 | 34 +- src/source_thermal_externalheat.f90 | 31 +- src/thermal_adiabatic.f90 | 77 +---- 11 files changed, 614 insertions(+), 781 deletions(-) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index b76813fe6..cb13bfaea 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -14,7 +14,11 @@ #define PETSC_MAJOR 3 #define PETSC_MINOR_MIN 10 #define PETSC_MINOR_MAX 11 + module DAMASK_interface + use, intrinsic :: iso_fortran_env + use PETScSys + use prec use system_routines @@ -50,9 +54,6 @@ contains !! information on computation to screen !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init - use, intrinsic :: iso_fortran_env - use PETScSys - #include #if defined(__GFORTRAN__) && __GNUC__ @details to be done !-------------------------------------------------------------------------------------------------- module damage_nonlocal - use prec - use material - use numerics - use config - use crystallite - use lattice - use mesh + use prec + use material + use numerics + use config + use crystallite + use lattice + use mesh + use source_damage_isoBrittle + use source_damage_isoDuctile + use source_damage_anisoBrittle + use source_damage_anisoDuctile - implicit none - private - - integer, dimension(:,:), allocatable, target, public :: & - damage_nonlocal_sizePostResult !< size of each post result output + implicit none + private + + integer, dimension(:,:), allocatable, target, public :: & + damage_nonlocal_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & - damage_nonlocal_output !< name of each post result output - - integer, dimension(:), allocatable, target, public :: & - damage_nonlocal_Noutput !< number of outputs per instance of this damage + character(len=64), dimension(:,:), allocatable, target, public :: & + damage_nonlocal_output !< name of each post result output + + integer, dimension(:), allocatable, target, public :: & + damage_nonlocal_Noutput !< number of outputs per instance of this damage - enum, bind(c) - enumerator :: undefined_ID, & - damage_ID - end enum + enum, bind(c) + enumerator :: undefined_ID, & + damage_ID + end enum - type :: tParameters - integer(kind(undefined_ID)), dimension(:), allocatable :: & - outputID - end type tParameters - - type(tparameters), dimension(:), allocatable :: & - param + type :: tParameters + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID + end type tParameters + + type(tparameters), dimension(:), allocatable :: & + param - public :: & - damage_nonlocal_init, & - damage_nonlocal_getSourceAndItsTangent, & - damage_nonlocal_getDiffusion33, & - damage_nonlocal_getMobility, & - damage_nonlocal_putNonLocalDamage, & - damage_nonlocal_postResults + public :: & + damage_nonlocal_init, & + damage_nonlocal_getSourceAndItsTangent, & + damage_nonlocal_getDiffusion33, & + damage_nonlocal_getMobility, & + damage_nonlocal_putNonLocalDamage, & + damage_nonlocal_postResults contains @@ -53,129 +57,122 @@ contains !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_init - integer :: maxNinstance,homog,instance,o,i - integer :: sizeState - integer :: NofMyHomog, h - integer(kind(undefined_ID)) :: & - outputID - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - character(len=65536), dimension(:), allocatable :: & - outputs + integer :: maxNinstance,homog,instance,o,i + integer :: sizeState + integer :: NofMyHomog, h + integer(kind(undefined_ID)) :: & + outputID + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + character(len=65536), dimension(:), allocatable :: & + outputs - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - - maxNinstance = count(damage_type == DAMAGE_nonlocal_ID) - if (maxNinstance == 0) return - - allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) - allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance)) - damage_nonlocal_output = '' - allocate(damage_nonlocal_Noutput (maxNinstance), source=0) - - allocate(param(maxNinstance)) + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - do h = 1, size(damage_type) - if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle - associate(prm => param(damage_typeInstance(h)), & - config => config_homogenization(h)) - - instance = damage_typeInstance(h) - outputs = config%getStrings('(output)',defaultVal=emptyStringArray) - allocate(prm%outputID(0)) + maxNinstance = count(damage_type == DAMAGE_nonlocal_ID) + if (maxNinstance == 0) return + + allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) + allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance)) + damage_nonlocal_output = '' + allocate(damage_nonlocal_Noutput (maxNinstance), source=0) + + allocate(param(maxNinstance)) - do i=1, size(outputs) - outputID = undefined_ID - select case(outputs(i)) - - case ('damage') - damage_nonlocal_output(i,damage_typeInstance(h)) = outputs(i) - damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1 - damage_nonlocal_sizePostResult(i,damage_typeInstance(h)) = 1 - prm%outputID = [prm%outputID , damage_ID] - end select - - enddo + do h = 1, size(damage_type) + if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle + associate(prm => param(damage_typeInstance(h)), & + config => config_homogenization(h)) + + instance = damage_typeInstance(h) + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + + do i=1, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + + case ('damage') + damage_nonlocal_output(i,damage_typeInstance(h)) = outputs(i) + damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1 + damage_nonlocal_sizePostResult(i,damage_typeInstance(h)) = 1 + prm%outputID = [prm%outputID , damage_ID] + end select + + enddo - homog = h + homog = h - NofMyHomog = count(material_homogenizationAt == homog) - instance = damage_typeInstance(homog) + NofMyHomog = count(material_homogenizationAt == homog) + instance = damage_typeInstance(homog) -! allocate state arrays - sizeState = 1 - damageState(homog)%sizeState = sizeState - damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance)) - allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) - allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog)) - allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog)) +! allocate state arrays + sizeState = 1 + damageState(homog)%sizeState = sizeState + damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance)) + allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) + allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog)) + allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog)) - nullify(damageMapping(homog)%p) - damageMapping(homog)%p => mappingHomogenization(1,:,:) - deallocate(damage(homog)%p) - damage(homog)%p => damageState(homog)%state(1,:) - - end associate - enddo + nullify(damageMapping(homog)%p) + damageMapping(homog)%p => mappingHomogenization(1,:,:) + deallocate(damage(homog)%p) + damage(homog)%p => damageState(homog)%state(1,:) + + end associate + enddo end subroutine damage_nonlocal_init + !-------------------------------------------------------------------------------------------------- !> @brief calculates homogenized damage driving forces !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) - use source_damage_isoBrittle, only: & - source_damage_isobrittle_getRateAndItsTangent - use source_damage_isoDuctile, only: & - source_damage_isoductile_getRateAndItsTangent - use source_damage_anisoBrittle, only: & - source_damage_anisobrittle_getRateAndItsTangent - use source_damage_anisoDuctile, only: & - source_damage_anisoductile_getRateAndItsTangent - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi - integer :: & - phase, & - grain, & - source, & - constituent - real(pReal) :: & - phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + phi + integer :: & + phase, & + grain, & + source, & + constituent + real(pReal) :: & + phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi - phiDot = 0.0_pReal - dPhiDot_dPhi = 0.0_pReal - do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) - phase = phaseAt(grain,ip,el) - constituent = phasememberAt(grain,ip,el) - do source = 1, phase_Nsources(phase) - select case(phase_source(source,phase)) - case (SOURCE_damage_isoBrittle_ID) - call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) + phiDot = 0.0_pReal + dPhiDot_dPhi = 0.0_pReal + do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) + phase = phaseAt(grain,ip,el) + constituent = phasememberAt(grain,ip,el) + do source = 1, phase_Nsources(phase) + select case(phase_source(source,phase)) + case (SOURCE_damage_isoBrittle_ID) + call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_isoDuctile_ID) - call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) + case (SOURCE_damage_isoDuctile_ID) + call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_anisoBrittle_ID) - call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) + case (SOURCE_damage_anisoBrittle_ID) + call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_anisoDuctile_ID) - call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) + case (SOURCE_damage_anisoDuctile_ID) + call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case default - localphiDot = 0.0_pReal - dLocalphiDot_dPhi = 0.0_pReal + case default + localphiDot = 0.0_pReal + dLocalphiDot_dPhi = 0.0_pReal - end select - phiDot = phiDot + localphiDot - dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi - enddo - enddo - - phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) - dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) + end select + phiDot = phiDot + localphiDot + dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi + enddo + enddo + + phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) + dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) end subroutine damage_nonlocal_getSourceAndItsTangent @@ -185,24 +182,24 @@ end subroutine damage_nonlocal_getSourceAndItsTangent !-------------------------------------------------------------------------------------------------- function damage_nonlocal_getDiffusion33(ip,el) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - damage_nonlocal_getDiffusion33 - integer :: & - homog, & - grain - - homog = material_homogenizationAt(el) - damage_nonlocal_getDiffusion33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(homog) - damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + & - crystallite_push33ToRef(grain,ip,el,lattice_DamageDiffusion33(1:3,1:3,material_phase(grain,ip,el))) - enddo + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3) :: & + damage_nonlocal_getDiffusion33 + integer :: & + homog, & + grain + + homog = material_homogenizationAt(el) + damage_nonlocal_getDiffusion33 = 0.0_pReal + do grain = 1, homogenization_Ngrains(homog) + damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + & + crystallite_push33ToRef(grain,ip,el,lattice_DamageDiffusion33(1:3,1:3,material_phase(grain,ip,el))) + enddo - damage_nonlocal_getDiffusion33 = & - charLength**2*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal) + damage_nonlocal_getDiffusion33 = & + charLength**2*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal) end function damage_nonlocal_getDiffusion33 @@ -212,20 +209,20 @@ end function damage_nonlocal_getDiffusion33 !-------------------------------------------------------------------------------------------------- real(pReal) function damage_nonlocal_getMobility(ip,el) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - integer :: & - ipc - - damage_nonlocal_getMobility = 0.0_pReal - - do ipc = 1, homogenization_Ngrains(mesh_element(3,el)) - damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el)) - enddo + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + integer :: & + ipc + + damage_nonlocal_getMobility = 0.0_pReal + + do ipc = 1, homogenization_Ngrains(mesh_element(3,el)) + damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el)) + enddo - damage_nonlocal_getMobility = damage_nonlocal_getMobility/& - real(homogenization_Ngrains(mesh_element(3,el)),pReal) + damage_nonlocal_getMobility = damage_nonlocal_getMobility/& + real(homogenization_Ngrains(mesh_element(3,el)),pReal) end function damage_nonlocal_getMobility @@ -235,18 +232,18 @@ end function damage_nonlocal_getMobility !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi - integer :: & - homog, & - offset - - homog = material_homogenizationAt(el) - offset = damageMapping(homog)%p(ip,el) - damage(homog)%p(offset) = phi + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + phi + integer :: & + homog, & + offset + + homog = material_homogenizationAt(el) + offset = damageMapping(homog)%p(ip,el) + damage(homog)%p(offset) = phi end subroutine damage_nonlocal_putNonLocalDamage @@ -256,31 +253,31 @@ end subroutine damage_nonlocal_putNonLocalDamage !-------------------------------------------------------------------------------------------------- function damage_nonlocal_postResults(ip,el) - integer, intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & - damage_nonlocal_postResults + integer, intent(in) :: & + ip, & !< integration point + el !< element + real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & + damage_nonlocal_postResults - integer :: & - instance, homog, offset, o, c - - homog = material_homogenizationAt(el) - offset = damageMapping(homog)%p(ip,el) - instance = damage_typeInstance(homog) - associate(prm => param(instance)) - c = 0 + integer :: & + instance, homog, offset, o, c + + homog = material_homogenizationAt(el) + offset = damageMapping(homog)%p(ip,el) + instance = damage_typeInstance(homog) + associate(prm => param(instance)) + c = 0 - outputsLoop: do o = 1,size(prm%outputID) - select case(prm%outputID(o)) - - case (damage_ID) - damage_nonlocal_postResults(c+1) = damage(homog)%p(offset) - c = c + 1 - end select - enddo outputsLoop + outputsLoop: do o = 1,size(prm%outputID) + select case(prm%outputID(o)) + + case (damage_ID) + damage_nonlocal_postResults(c+1) = damage(homog)%p(offset) + c = c + 1 + end select + enddo outputsLoop - end associate + end associate end function damage_nonlocal_postResults end module damage_nonlocal diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 3210f02d4..9287cc4bf 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -16,6 +16,12 @@ module homogenization use crystallite use mesh use FEsolving + use thermal_isothermal + use thermal_adiabatic + use thermal_conduction + use damage_none + use damage_local + use damage_nonlocal #if defined(PETSc) || defined(DAMASK_HDF5) use results use HDF5_utilities @@ -131,12 +137,6 @@ contains !> @brief module initialization !-------------------------------------------------------------------------------------------------- subroutine homogenization_init - use thermal_isothermal - use thermal_adiabatic - use thermal_conduction - use damage_none - use damage_local - use damage_nonlocal integer, parameter :: FILEUNIT = 200 integer :: e,i,p @@ -668,10 +668,6 @@ end subroutine partitionDeformation !> "happy" with result !-------------------------------------------------------------------------------------------------- function updateState(ip,el) - use thermal_adiabatic, only: & - thermal_adiabatic_updateState - use damage_local, only: & - damage_local_updateState integer, intent(in) :: & ip, & !< integration point @@ -753,14 +749,6 @@ end subroutine averageStressAndItsTangent !> if homogenization_sizePostResults(i,e) > 0 !! !-------------------------------------------------------------------------------------------------- function postResults(ip,el) - use thermal_adiabatic, only: & - thermal_adiabatic_postResults - use thermal_conduction, only: & - thermal_conduction_postResults - use damage_local, only: & - damage_local_postResults - use damage_nonlocal, only: & - damage_nonlocal_postResults integer, intent(in) :: & ip, & !< integration point diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 60d9cb500..39bfbf340 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -13,43 +13,43 @@ module kinematics_cleavage_opening use lattice use material - implicit none - private + implicit none + private - integer, dimension(:), allocatable :: kinematics_cleavage_opening_instance + integer, dimension(:), allocatable :: kinematics_cleavage_opening_instance - type :: tParameters !< container type for internal constitutive parameters - integer :: & - totalNcleavage - integer, dimension(:), allocatable :: & - Ncleavage !< active number of cleavage systems per family - real(pReal) :: & - sdot0, & - n - real(pReal), dimension(:), allocatable :: & - critDisp, & - critLoad - end type + type :: tParameters !< container type for internal constitutive parameters + integer :: & + totalNcleavage + integer, dimension(:), allocatable :: & + Ncleavage !< active number of cleavage systems per family + real(pReal) :: & + sdot0, & + n + real(pReal), dimension(:), allocatable :: & + critDisp, & + critLoad + end type ! Begin Deprecated - integer, dimension(:), allocatable :: & - kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems - - integer, dimension(:,:), allocatable :: & - kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family - - real(pReal), dimension(:), allocatable :: & - kinematics_cleavage_opening_sdot_0, & - kinematics_cleavage_opening_N + integer, dimension(:), allocatable :: & + kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems + + integer, dimension(:,:), allocatable :: & + kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family + + real(pReal), dimension(:), allocatable :: & + kinematics_cleavage_opening_sdot_0, & + kinematics_cleavage_opening_N - real(pReal), dimension(:,:), allocatable :: & - kinematics_cleavage_opening_critDisp, & - kinematics_cleavage_opening_critLoad + real(pReal), dimension(:,:), allocatable :: & + kinematics_cleavage_opening_critDisp, & + kinematics_cleavage_opening_critLoad ! End Deprecated - public :: & - kinematics_cleavage_opening_init, & - kinematics_cleavage_opening_LiAndItsTangent + public :: & + kinematics_cleavage_opening_init, & + kinematics_cleavage_opening_LiAndItsTangent contains @@ -60,142 +60,142 @@ contains !-------------------------------------------------------------------------------------------------- subroutine kinematics_cleavage_opening_init - integer, allocatable, dimension(:) :: tempInt - real(pReal), allocatable, dimension(:) :: tempFloat + integer, allocatable, dimension(:) :: tempInt + real(pReal), allocatable, dimension(:) :: tempFloat - integer :: maxNinstance,p,instance + integer :: maxNinstance,p,instance - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' - maxNinstance = count(phase_kinematics == KINEMATICS_cleavage_opening_ID) - if (maxNinstance == 0) return - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0) - do p = 1, size(config_phase) - kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct? - enddo - - allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0) - allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0) - allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal) - allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal) + maxNinstance = count(phase_kinematics == KINEMATICS_cleavage_opening_ID) + if (maxNinstance == 0) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0) + do p = 1, size(config_phase) + kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct? + enddo + + allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) + allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) + allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0) + allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0) + allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal) + allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal) - do p = 1, size(config_phase) - if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle - instance = kinematics_cleavage_opening_instance(p) - kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0') - kinematics_cleavage_opening_N(instance) = config_phase(p)%getFloat('anisobrittle_ratesensitivity') - tempInt = config_phase(p)%getInts('ncleavage') - kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt + do p = 1, size(config_phase) + if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle + instance = kinematics_cleavage_opening_instance(p) + kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0') + kinematics_cleavage_opening_N(instance) = config_phase(p)%getFloat('anisobrittle_ratesensitivity') + tempInt = config_phase(p)%getInts('ncleavage') + kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt - tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(tempInt)) - kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat + tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(tempInt)) + kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat - tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredSize=size(tempInt)) - kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat + tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredSize=size(tempInt)) + kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat - kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & - min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,p),& ! limit active cleavage systems per family to min of available and requested - kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance)) - kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether - if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') - if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') - if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') - if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & - call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') - enddo + kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & + min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,p),& ! limit active cleavage systems per family to min of available and requested + kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance)) + kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether + if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & + call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') + if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) & + call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') + if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) & + call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') + if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & + call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') + enddo end subroutine kinematics_cleavage_opening_init - + !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(in), dimension(3,3) :: & - S - real(pReal), intent(out), dimension(3,3) :: & - Ld !< damage velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) - integer :: & - instance, phase, & - homog, damageOffset, & - f, i, index_myFamily, k, l, m, n - real(pReal) :: & - traction_d, traction_t, traction_n, traction_crit, & - udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt + integer, intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(in), dimension(3,3) :: & + S + real(pReal), intent(out), dimension(3,3) :: & + Ld !< damage velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) + integer :: & + instance, phase, & + homog, damageOffset, & + f, i, index_myFamily, k, l, m, n + real(pReal) :: & + traction_d, traction_t, traction_n, traction_crit, & + udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - phase = material_phase(ipc,ip,el) - instance = kinematics_cleavage_opening_instance(phase) - homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) - - Ld = 0.0_pReal - dLd_dTstar = 0.0_pReal - do f = 1,lattice_maxNcleavageFamily - index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family - do i = 1,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family - traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) - traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) - traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) - traction_crit = kinematics_cleavage_opening_critLoad(f,instance)* & - damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) - udotd = & - sign(1.0_pReal,traction_d)* & - kinematics_cleavage_opening_sdot_0(instance)* & - (max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) - if (abs(udotd) > tol_math_check) then - Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase) - dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ & - max(0.0_pReal, abs(traction_d) - traction_crit) - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & - dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* & - lattice_Scleavage(m,n,1,index_myFamily+i,phase) - endif + phase = material_phase(ipc,ip,el) + instance = kinematics_cleavage_opening_instance(phase) + homog = material_homogenizationAt(el) + damageOffset = damageMapping(homog)%p(ip,el) + + Ld = 0.0_pReal + dLd_dTstar = 0.0_pReal + do f = 1,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family + do i = 1,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family + traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) + traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) + traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) + traction_crit = kinematics_cleavage_opening_critLoad(f,instance)* & + damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) + udotd = & + sign(1.0_pReal,traction_d)* & + kinematics_cleavage_opening_sdot_0(instance)* & + (max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) + if (abs(udotd) > tol_math_check) then + Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase) + dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ & + max(0.0_pReal, abs(traction_d) - traction_crit) + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & + dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* & + lattice_Scleavage(m,n,1,index_myFamily+i,phase) + endif - udott = & - sign(1.0_pReal,traction_t)* & - kinematics_cleavage_opening_sdot_0(instance)* & - (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) - if (abs(udott) > tol_math_check) then - Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase) - dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ & - max(0.0_pReal, abs(traction_t) - traction_crit) - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & - dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* & - lattice_Scleavage(m,n,2,index_myFamily+i,phase) - endif + udott = & + sign(1.0_pReal,traction_t)* & + kinematics_cleavage_opening_sdot_0(instance)* & + (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) + if (abs(udott) > tol_math_check) then + Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase) + dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ & + max(0.0_pReal, abs(traction_t) - traction_crit) + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & + dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* & + lattice_Scleavage(m,n,2,index_myFamily+i,phase) + endif - udotn = & - sign(1.0_pReal,traction_n)* & - kinematics_cleavage_opening_sdot_0(instance)* & - (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) - if (abs(udotn) > tol_math_check) then - Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase) - dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ & - max(0.0_pReal, abs(traction_n) - traction_crit) - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & - dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* & - lattice_Scleavage(m,n,3,index_myFamily+i,phase) - endif - enddo - enddo + udotn = & + sign(1.0_pReal,traction_n)* & + kinematics_cleavage_opening_sdot_0(instance)* & + (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) + if (abs(udotn) > tol_math_check) then + Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase) + dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ & + max(0.0_pReal, abs(traction_n) - traction_crit) + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & + dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* & + lattice_Scleavage(m,n,3,index_myFamily+i,phase) + endif + enddo + enddo end subroutine kinematics_cleavage_opening_LiAndItsTangent diff --git a/src/list.f90 b/src/list.f90 index be80b151d..79eafc964 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -3,8 +3,8 @@ !> @brief linked list !-------------------------------------------------------------------------------------------------- module list - use prec, only: & - pReal + use prec + use IO implicit none private @@ -65,10 +65,6 @@ contains !! to lower case. The data is not stored in the new element but in the current. !-------------------------------------------------------------------------------------------------- subroutine add(this,string) - use IO, only: & - IO_isBlank, & - IO_lc, & - IO_stringPos class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: string @@ -157,8 +153,6 @@ end subroutine finalizeArray !> @brief reports wether a given key (string value at first position) exists in the list !-------------------------------------------------------------------------------------------------- logical function keyExists(this,key) - use IO, only: & - IO_stringValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -180,8 +174,6 @@ end function keyExists !> @details traverses list and counts each occurrence of specified key !-------------------------------------------------------------------------------------------------- integer function countKeys(this,key) - use IO, only: & - IO_stringValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -205,10 +197,6 @@ end function countKeys !! error unless default is given !-------------------------------------------------------------------------------------------------- real(pReal) function getFloat(this,key,defaultVal) - use IO, only : & - IO_error, & - IO_stringValue, & - IO_FloatValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -241,10 +229,6 @@ end function getFloat !! error unless default is given !-------------------------------------------------------------------------------------------------- integer function getInt(this,key,defaultVal) - use IO, only: & - IO_error, & - IO_stringValue, & - IO_IntValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -278,9 +262,6 @@ end function getInt !! the individual chunks are returned !-------------------------------------------------------------------------------------------------- character(len=65536) function getString(this,key,defaultVal,raw) - use IO, only: & - IO_error, & - IO_stringValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -327,10 +308,6 @@ end function getString !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- function getFloats(this,key,defaultVal,requiredSize) - use IO, only: & - IO_error, & - IO_stringValue, & - IO_FloatValue real(pReal), dimension(:), allocatable :: getFloats class(tPartitionedStringList), target, intent(in) :: this @@ -376,10 +353,6 @@ end function getFloats !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- function getInts(this,key,defaultVal,requiredSize) - use IO, only: & - IO_error, & - IO_stringValue, & - IO_IntValue integer, dimension(:), allocatable :: getInts class(tPartitionedStringList), target, intent(in) :: this @@ -426,9 +399,6 @@ end function getInts !! If raw is true, the the complete string is returned, otherwise the individual chunks are returned !-------------------------------------------------------------------------------------------------- function getStrings(this,key,defaultVal,raw) - use IO, only: & - IO_error, & - IO_StringValue character(len=65536),dimension(:), allocatable :: getStrings class(tPartitionedStringList),target, intent(in) :: this diff --git a/src/results.f90 b/src/results.f90 index 05db831f7..cee86c7da 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -5,6 +5,9 @@ !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !-------------------------------------------------------------------------------------------------- module results + use DAMASK_interface + use rotations + use numerics use HDF5_utilities #ifdef PETSc use PETSC @@ -55,8 +58,6 @@ module results contains subroutine results_init - use DAMASK_interface, only: & - getSolverJobName character(len=pStringLen) :: commandLine @@ -83,9 +84,6 @@ end subroutine results_init !> @brief opens the results file to append data !-------------------------------------------------------------------------------------------------- subroutine results_openJobFile - use DAMASK_interface, only: & - getSolverJobName - resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.) @@ -396,8 +394,6 @@ end subroutine results_writeTensorDataset_int !> @brief stores a scalar dataset in a group !-------------------------------------------------------------------------------------------------- subroutine results_writeScalarDataset_rotation(group,dataset,label,description,lattice_structure) - use rotations, only: & - rotation character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: lattice_structure @@ -428,9 +424,6 @@ end subroutine results_writeScalarDataset_rotation !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- subroutine results_mapping_constituent(phaseAt,memberAt,label) - use numerics, only: & - worldrank, & - worldsize integer, dimension(:,:), intent(in) :: phaseAt !< phase section at (constituent,element) integer, dimension(:,:,:), intent(in) :: memberAt !< phase member at (constituent,IP,element) @@ -566,9 +559,6 @@ end subroutine results_mapping_constituent !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- subroutine results_mapping_materialpoint(homogenizationAt,memberAt,label) - use numerics, only: & - worldrank, & - worldsize integer, dimension(:), intent(in) :: homogenizationAt !< homogenization section at (element) integer, dimension(:,:), intent(in) :: memberAt !< homogenization member at (IP,element) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 2f5fc119f..ccad7c6b0 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -5,55 +5,62 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_anisoBrittle - use prec + use prec + use debug + use IO + use math + use material + use config + use lattice - implicit none - private - integer, dimension(:), allocatable, public, protected :: & - source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? - source_damage_anisoBrittle_instance !< instance of source mechanism + implicit none + private - integer, dimension(:,:), allocatable, target, public :: & - source_damage_anisoBrittle_sizePostResult !< size of each post result output + integer, dimension(:), allocatable, public, protected :: & + source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? + source_damage_anisoBrittle_instance !< instance of source mechanism - character(len=64), dimension(:,:), allocatable, target, public :: & - source_damage_anisoBrittle_output !< name of each post result output - - integer, dimension(:,:), allocatable, private :: & - source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family + integer, dimension(:,:), allocatable, target, public :: & + source_damage_anisoBrittle_sizePostResult !< size of each post result output - enum, bind(c) - enumerator :: undefined_ID, & - damage_drivingforce_ID - end enum + character(len=64), dimension(:,:), allocatable, target, public :: & + source_damage_anisoBrittle_output !< name of each post result output + + integer, dimension(:,:), allocatable :: & + source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family + + enum, bind(c) + enumerator :: undefined_ID, & + damage_drivingforce_ID + end enum - type, private :: tParameters !< container type for internal constitutive parameters - real(pReal) :: & - aTol, & - sdot_0, & - N - real(pReal), dimension(:), allocatable :: & - critDisp, & - critLoad - real(pReal), dimension(:,:,:,:), allocatable :: & - cleavage_systems - integer :: & - totalNcleavage - integer, dimension(:), allocatable :: & - Ncleavage - integer(kind(undefined_ID)), allocatable, dimension(:) :: & - outputID !< ID of each post result output - end type tParameters + type :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + aTol, & + sdot_0, & + N + real(pReal), dimension(:), allocatable :: & + critDisp, & + critLoad + real(pReal), dimension(:,:,:,:), allocatable :: & + cleavage_systems + integer :: & + totalNcleavage + integer, dimension(:), allocatable :: & + Ncleavage + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID !< ID of each post result output + end type tParameters - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) - public :: & - source_damage_anisoBrittle_init, & - source_damage_anisoBrittle_dotState, & - source_damage_anisobrittle_getRateAndItsTangent, & - source_damage_anisoBrittle_postResults + public :: & + source_damage_anisoBrittle_init, & + source_damage_anisoBrittle_dotState, & + source_damage_anisobrittle_getRateAndItsTangent, & + source_damage_anisoBrittle_postResults contains @@ -63,266 +70,230 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoBrittle_init - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use IO, only: & - IO_error - use math, only: & - math_expand - use material, only: & - material_allocateSourceState, & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_damage_anisoBrittle_label, & - SOURCE_damage_anisoBrittle_ID, & - material_phase, & - sourceState - use config, only: & - config_phase, & - material_Nphase - use lattice, only: & - lattice_SchmidMatrix_cleavage, & - lattice_maxNcleavageFamily - integer :: Ninstance,phase,instance,source,sourceOffset - integer :: NofMyPhase,p ,i - integer, dimension(0), parameter :: emptyIntArray = [integer::] - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - integer(kind(undefined_ID)) :: & - outputID + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p ,i + integer, dimension(0), parameter :: emptyIntArray = [integer::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - character(len=pStringLen) :: & - extmsg = '' - character(len=65536), dimension(:), allocatable :: & - outputs + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' - Ninstance = count(phase_source == SOURCE_damage_anisoBrittle_ID) - if (Ninstance == 0) return - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - - allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0) - allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0) - do phase = 1, material_Nphase - source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID) - do source = 1, phase_Nsources(phase) - if (phase_source(source,phase) == source_damage_anisoBrittle_ID) & - source_damage_anisoBrittle_offset(phase) = source - enddo - enddo - - allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0) - allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) - source_damage_anisoBrittle_output = '' + Ninstance = count(phase_source == SOURCE_damage_anisoBrittle_ID) + if (Ninstance == 0) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + + allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0) + allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0) + do phase = 1, material_Nphase + source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_damage_anisoBrittle_ID) & + source_damage_anisoBrittle_offset(phase) = source + enddo + enddo + + allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0) + allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) + source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0) + allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0) - allocate(param(Ninstance)) - - do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISOBRITTLE_ID)) cycle - associate(prm => param(source_damage_anisoBrittle_instance(p)), & - config => config_phase(p)) - - prm%aTol = config%getFloat('anisobrittle_atol',defaultVal = 1.0e-3_pReal) + allocate(param(Ninstance)) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISOBRITTLE_ID)) cycle + associate(prm => param(source_damage_anisoBrittle_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('anisobrittle_atol',defaultVal = 1.0e-3_pReal) - prm%N = config%getFloat('anisobrittle_ratesensitivity') - prm%sdot_0 = config%getFloat('anisobrittle_sdot0') - - ! sanity checks - if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_atol' - - if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_ratesensitivity' - if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0' - - prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray) + prm%N = config%getFloat('anisobrittle_ratesensitivity') + prm%sdot_0 = config%getFloat('anisobrittle_sdot0') + + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_ratesensitivity' + if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0' + + prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray) - prm%critDisp = config%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(prm%Ncleavage)) - prm%critLoad = config%getFloats('anisobrittle_criticalload', requiredSize=size(prm%Ncleavage)) - - prm%cleavage_systems = lattice_SchmidMatrix_cleavage (prm%Ncleavage,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%critDisp = config%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(prm%Ncleavage)) + prm%critLoad = config%getFloats('anisobrittle_criticalload', requiredSize=size(prm%Ncleavage)) + + prm%cleavage_systems = lattice_SchmidMatrix_cleavage (prm%Ncleavage,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) - ! expand: family => system - prm%critDisp = math_expand(prm%critDisp, prm%Ncleavage) - prm%critLoad = math_expand(prm%critLoad, prm%Ncleavage) - - if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticalload' - if (any(prm%critDisp < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticaldisplacement' + ! expand: family => system + prm%critDisp = math_expand(prm%critDisp, prm%Ncleavage) + prm%critLoad = math_expand(prm%critLoad, prm%Ncleavage) + + if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticalload' + if (any(prm%critDisp < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticaldisplacement' !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') & - call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') + if (extmsg /= '') & + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters - outputs = config%getStrings('(output)',defaultVal=emptyStringArray) - allocate(prm%outputID(0)) - do i=1, size(outputs) - outputID = undefined_ID - select case(outputs(i)) - - case ('anisobrittle_drivingforce') - source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1 - source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i) - prm%outputID = [prm%outputID, damage_drivingforce_ID] + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + + case ('anisobrittle_drivingforce') + source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1 + source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] - end select + end select - enddo + enddo - end associate - - phase = p - NofMyPhase=count(material_phase==phase) - instance = source_damage_anisoBrittle_instance(phase) - sourceOffset = source_damage_anisoBrittle_offset(phase) + end associate + + phase = p + NofMyPhase=count(material_phase==phase) + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) - sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - source_damage_anisoBrittle_Ncleavage(1:size(param(instance)%Ncleavage),instance) = param(instance)%Ncleavage - enddo + source_damage_anisoBrittle_Ncleavage(1:size(param(instance)%Ncleavage),instance) = param(instance)%Ncleavage + enddo - end subroutine source_damage_anisoBrittle_init + !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) - use math, only: & - math_mul33xx33 - use material, only: & - phaseAt, phasememberAt, & - sourceState, & - material_homogenizationAt, & - damage, & - damageMapping - use lattice, only: & - lattice_Scleavage, & - lattice_maxNcleavageFamily, & - lattice_NcleavageSystem - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S - integer :: & - phase, & - constituent, & - instance, & - sourceOffset, & - damageOffset, & - homog, & - f, i, index_myFamily, index - real(pReal) :: & - traction_d, traction_t, traction_n, traction_crit + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + S + integer :: & + phase, & + constituent, & + instance, & + sourceOffset, & + damageOffset, & + homog, & + f, i, index_myFamily, index + real(pReal) :: & + traction_d, traction_t, traction_n, traction_crit - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) - instance = source_damage_anisoBrittle_instance(phase) - sourceOffset = source_damage_anisoBrittle_offset(phase) - homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) - - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal - - index = 1 - do f = 1,lattice_maxNcleavageFamily - index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family - do i = 1,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) + homog = material_homogenizationAt(el) + damageOffset = damageMapping(homog)%p(ip,el) + + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal + + index = 1 + do f = 1,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family + do i = 1,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family - traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) - traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) - traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) - - traction_crit = param(instance)%critLoad(index)* & - damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) + traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) + traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) + traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) + + traction_crit = param(instance)%critLoad(index)* & + damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & - param(instance)%sdot_0* & - ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + & - (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + & - (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ & - param(instance)%critDisp(index) + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & + param(instance)%sdot_0* & + ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + & + (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + & + (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ & + param(instance)%critDisp(index) - index = index + 1 - enddo - enddo + index = index + 1 + enddo + enddo end subroutine source_damage_anisoBrittle_dotState + !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - use material, only: & - sourceState - integer, intent(in) :: & - phase, & - constituent - real(pReal), intent(in) :: & - phi - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - integer :: & - sourceOffset + integer, intent(in) :: & + phase, & + constituent + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + integer :: & + sourceOffset - sourceOffset = source_damage_anisoBrittle_offset(phase) - - localphiDot = 1.0_pReal & - - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi - - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + sourceOffset = source_damage_anisoBrittle_offset(phase) + + localphiDot = 1.0_pReal & + - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi + + dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) end subroutine source_damage_anisobrittle_getRateAndItsTangent - + + !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- function source_damage_anisoBrittle_postResults(phase, constituent) - use material, only: & - sourceState - integer, intent(in) :: & - phase, & - constituent - real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, & - source_damage_anisoBrittle_instance(phase)))) :: & - source_damage_anisoBrittle_postResults + integer, intent(in) :: & + phase, & + constituent - integer :: & - instance, sourceOffset, o, c - - instance = source_damage_anisoBrittle_instance(phase) - sourceOffset = source_damage_anisoBrittle_offset(phase) + real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, & + source_damage_anisoBrittle_instance(phase)))) :: & + source_damage_anisoBrittle_postResults - c = 0 + integer :: & + instance, sourceOffset, o, c + + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) - do o = 1,size(param(instance)%outputID) - select case(param(instance)%outputID(o)) - case (damage_drivingforce_ID) - source_damage_anisoBrittle_postResults(c+1) = & - sourceState(phase)%p(sourceOffset)%state(1,constituent) - c = c + 1 + c = 0 - end select - enddo + do o = 1,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) + case (damage_drivingforce_ID) + source_damage_anisoBrittle_postResults(c+1) = & + sourceState(phase)%p(sourceOffset)%state(1,constituent) + c = c + 1 + + end select + enddo end function source_damage_anisoBrittle_postResults end module source_damage_anisoBrittle diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 94452eb47..e8464edd0 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -5,27 +5,30 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_thermal_dissipation - use prec, only: & - pReal + use prec + use debug + use material + use config implicit none private + integer, dimension(:), allocatable, public, protected :: & - source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism? - source_thermal_dissipation_instance !< instance of thermal dissipation source mechanism + source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism? + source_thermal_dissipation_instance !< instance of thermal dissipation source mechanism integer, dimension(:,:), allocatable, target, public :: & - source_thermal_dissipation_sizePostResult !< size of each post result output + source_thermal_dissipation_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & - source_thermal_dissipation_output !< name of each post result output + source_thermal_dissipation_output !< name of each post result output - type, private :: tParameters !< container type for internal constitutive parameters + type :: tParameters !< container type for internal constitutive parameters real(pReal) :: & kappa end type tParameters - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) public :: & @@ -40,21 +43,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_thermal_dissipation_init - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use material, only: & - material_allocateSourceState, & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_thermal_dissipation_label, & - SOURCE_thermal_dissipation_ID, & - material_phase - use config, only: & - config_phase, & - material_Nphase integer :: Ninstance,instance,source,sourceOffset integer :: NofMyPhase,p diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 699902ad3..99d9a6f1f 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -5,11 +5,14 @@ !> @brief material subroutine for variable heat source !-------------------------------------------------------------------------------------------------- module source_thermal_externalheat - use prec, only: & - pReal + use prec + use debug + use material + use config implicit none private + integer, dimension(:), allocatable, public, protected :: & source_thermal_externalheat_offset, & !< which source is my current thermal dissipation mechanism? source_thermal_externalheat_instance !< instance of thermal dissipation source mechanism @@ -23,7 +26,7 @@ module source_thermal_externalheat integer, dimension(:), allocatable, target, public :: & source_thermal_externalheat_Noutput !< number of outputs per instance of this source - type, private :: tParameters !< container type for internal constitutive parameters + type :: tParameters !< container type for internal constitutive parameters real(pReal), dimension(:), allocatable :: & time, & heat_rate @@ -31,7 +34,7 @@ module source_thermal_externalheat nIntervals end type tParameters - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) public :: & @@ -47,22 +50,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_thermal_externalheat_init - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use material, only: & - material_allocateSourceState, & - material_phase, & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_thermal_externalheat_label, & - SOURCE_thermal_externalheat_ID - use config, only: & - config_phase, & - material_Nphase - integer :: maxNinstance,instance,source,sourceOffset,NofMyPhase,p @@ -116,8 +103,6 @@ end subroutine source_thermal_externalheat_init !> @details state only contains current time to linearly interpolate given heat powers !-------------------------------------------------------------------------------------------------- subroutine source_thermal_externalheat_dotState(phase, of) - use material, only: & - sourceState integer, intent(in) :: & phase, & @@ -135,8 +120,6 @@ end subroutine source_thermal_externalheat_dotState !> @brief returns local heat generation rate !-------------------------------------------------------------------------------------------------- subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of) - use material, only: & - sourceState integer, intent(in) :: & phase, & diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index bfd5633d1..3c9fd0c6e 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -3,9 +3,16 @@ !> @brief material subroutine for adiabatic temperature evolution !-------------------------------------------------------------------------------------------------- module thermal_adiabatic - use prec, only: & - pReal - + use prec + use config + use numerics + use material + use source_thermal_dissipation + use source_thermal_externalheat + use crystallite + use lattice + use mesh + implicit none private @@ -21,7 +28,7 @@ module thermal_adiabatic enumerator :: undefined_ID, & temperature_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + integer(kind(undefined_ID)), dimension(:,:), allocatable :: & thermal_adiabatic_outputID !< ID of each post result output @@ -41,21 +48,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_init - use material, only: & - thermal_type, & - thermal_typeInstance, & - homogenization_Noutput, & - THERMAL_ADIABATIC_label, & - THERMAL_adiabatic_ID, & - material_homogenizationAt, & - mappingHomogenization, & - thermalState, & - thermalMapping, & - thermal_initialT, & - temperature, & - temperatureRate - use config, only: & - config_homogenization integer :: maxNinstance,section,instance,i,sizeState,NofMyHomog character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -112,16 +104,6 @@ end subroutine thermal_adiabatic_init !> @brief calculates adiabatic change in temperature based on local heat generation model !-------------------------------------------------------------------------------------------------- function thermal_adiabatic_updateState(subdt, ip, el) - use numerics, only: & - err_thermal_tolAbs, & - err_thermal_tolRel - use material, only: & - material_homogenizationAt, & - mappingHomogenization, & - thermalState, & - temperature, & - temperatureRate, & - thermalMapping integer, intent(in) :: & ip, & !< integration point number @@ -156,27 +138,11 @@ function thermal_adiabatic_updateState(subdt, ip, el) end function thermal_adiabatic_updateState + !-------------------------------------------------------------------------------------------------- !> @brief returns heat generation rate !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - use material, only: & - homogenization_Ngrains, & - material_homogenizationAt, & - phaseAt, & - phasememberAt, & - thermal_typeInstance, & - phase_Nsources, & - phase_source, & - SOURCE_thermal_dissipation_ID, & - SOURCE_thermal_externalheat_ID - use source_thermal_dissipation, only: & - source_thermal_dissipation_getRateAndItsTangent - use source_thermal_externalheat, only: & - source_thermal_externalheat_getRateAndItsTangent - use crystallite, only: & - crystallite_S, & - crystallite_Lp integer, intent(in) :: & ip, & !< integration point number @@ -229,18 +195,12 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) dTdot_dT = dTdot_dT/real(homogenization_Ngrains(homog),pReal) end subroutine thermal_adiabatic_getSourceAndItsTangent - + + !-------------------------------------------------------------------------------------------------- !> @brief returns homogenized specific heat capacity !-------------------------------------------------------------------------------------------------- function thermal_adiabatic_getSpecificHeat(ip,el) - use lattice, only: & - lattice_specificHeat - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element integer, intent(in) :: & ip, & !< integration point number @@ -269,13 +229,6 @@ end function thermal_adiabatic_getSpecificHeat !> @brief returns homogenized mass density !-------------------------------------------------------------------------------------------------- function thermal_adiabatic_getMassDensity(ip,el) - use lattice, only: & - lattice_massDensity - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element integer, intent(in) :: & ip, & !< integration point number @@ -303,8 +256,6 @@ end function thermal_adiabatic_getMassDensity !> @brief return array of thermal results !-------------------------------------------------------------------------------------------------- function thermal_adiabatic_postResults(homog,instance,of) result(postResults) - use material, only: & - temperature integer, intent(in) :: & homog, & From 358272eb2ede29437b1371e76c6fcc822267e37f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 May 2019 12:29:46 +0200 Subject: [PATCH 57/59] not needed, better readable without --- src/debug.f90 | 22 +++------------------- 1 file changed, 3 insertions(+), 19 deletions(-) diff --git a/src/debug.f90 b/src/debug.f90 index 4f9566c05..ff084b133 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -6,12 +6,12 @@ !> @brief Reading in and interpretating the debugging settings for the various modules !-------------------------------------------------------------------------------------------------- module debug - use prec, only: & - pInt, & - pReal + use prec + use IO implicit none private + integer(pInt), parameter, public :: & debug_LEVELSELECTIVE = 2_pInt**0_pInt, & debug_LEVELBASIC = 2_pInt**1_pInt, & @@ -78,19 +78,7 @@ contains !> @brief reads in parameters from debug.config and allocates arrays !-------------------------------------------------------------------------------------------------- subroutine debug_init - use prec, only: & - pStringLen - use IO, only: & - IO_read_ASCII, & - IO_error, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_lc, & - IO_floatValue, & - IO_intValue - implicit none character(len=pStringLen), dimension(:), allocatable :: fileContent integer :: i, what, j @@ -253,8 +241,6 @@ end subroutine debug_init !-------------------------------------------------------------------------------------------------- subroutine debug_reset - implicit none - debug_stressMaxLocation = 0_pInt debug_stressMinLocation = 0_pInt debug_jacobianMaxLocation = 0_pInt @@ -272,8 +258,6 @@ end subroutine debug_reset !-------------------------------------------------------------------------------------------------- subroutine debug_info - implicit none - !$OMP CRITICAL (write2out) debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 & .and. any(debug_stressMinLocation /= 0_pInt) & From 43a50713b0c1cc981457b269f316983584f155e4 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 30 May 2019 11:00:01 +0200 Subject: [PATCH 58/59] [skip ci] updated version information after successful test of v2.0.3-344-gb25c64d1 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index d961b0f73..40e72919d 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-332-g5abcca50 +v2.0.3-344-gb25c64d1 From 8c38a2e56f1ec77c6f7b0f8d2e576393591e55d1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 May 2019 17:39:49 +0200 Subject: [PATCH 59/59] include relaxation to nonlocal tests --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 3a2f89547..d31da38cf 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3a2f89547c264044a7bfab9d33aee78eec495a76 +Subproject commit d31da38cf25734a91e994a3d5d33bb048eb2f44f