From fd4ae7127952d2c798df249f20c89874309b9ef7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 30 Dec 2018 21:08:48 +0100 Subject: [PATCH 001/154] takeover from 40_XX and 41_XX branch easier to focus on damage instead of doing all kinematics and sources together --- src/constitutive.f90 | 14 ++- src/damage_local.f90 | 13 +- src/damage_nonlocal.f90 | 13 +- src/kinematics_cleavage_opening.f90 | 167 ++++++++------------------ src/kinematics_slipplane_opening.f90 | 170 ++++++++------------------- src/source_damage_anisoBrittle.f90 | 85 ++++++++------ src/source_damage_anisoDuctile.f90 | 85 ++++++++------ src/source_damage_isoBrittle.f90 | 70 ++++++----- src/source_damage_isoDuctile.f90 | 70 ++++++----- 9 files changed, 302 insertions(+), 385 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 8294047e7..ceb396823 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -186,8 +186,8 @@ subroutine constitutive_init() !-------------------------------------------------------------------------------------------------- ! parse kinematic mechanisms from config file call IO_checkAndRewind(FILEUNIT) - if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init(FILEUNIT) - if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init(FILEUNIT) + if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init + if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init(FILEUNIT) if (any(phase_kinematics == KINEMATICS_vacancy_strain_ID)) call kinematics_vacancy_strain_init(FILEUNIT) if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) @@ -1173,16 +1173,18 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) SourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) startPos = endPos + 1_pInt endPos = endPos + sourceState(material_phase(ipc,ip,el))%p(s)%sizePostResults + of = phasememberAt(ipc,ip,el) sourceType: select case (phase_source(s,material_phase(ipc,ip,el))) case (SOURCE_damage_isoBrittle_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(ipc, ip, el) + constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(material_phase(ipc,ip,el),of) case (SOURCE_damage_isoDuctile_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(ipc, ip, el) + constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(material_phase(ipc,ip,el),of) case (SOURCE_damage_anisoBrittle_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(ipc, ip, el) + constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(material_phase(ipc,ip,el),of) case (SOURCE_damage_anisoDuctile_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(ipc, ip, el) + constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(material_phase(ipc,ip,el),of) end select sourceType + enddo SourceLoop end function constitutive_postResults diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 74bcb00db..6569347c2 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -225,6 +225,7 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el homogenization_Ngrains, & mappingHomogenization, & phaseAt, & + phasememberAt, & phase_source, & phase_Nsources, & SOURCE_damage_isoBrittle_ID, & @@ -249,7 +250,8 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el integer(pInt) :: & phase, & grain, & - source + source, & + constituent real(pReal) :: & phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi @@ -257,19 +259,20 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el dPhiDot_dPhi = 0.0_pReal do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,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, grain, ip, el) + 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, grain, ip, el) + 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, grain, ip, el) + 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, grain, ip, el) + call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case default localphiDot = 0.0_pReal diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 6b9093ef1..eab808266 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -186,6 +186,7 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, homogenization_Ngrains, & mappingHomogenization, & phaseAt, & + phasememberAt, & phase_source, & phase_Nsources, & SOURCE_damage_isoBrittle_ID, & @@ -210,7 +211,8 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, integer(pInt) :: & phase, & grain, & - source + source, & + constituent real(pReal) :: & phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi @@ -218,19 +220,20 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, dPhiDot_dPhi = 0.0_pReal do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) phase = phaseAt(grain,ip,el) + constituent = phasememberAt(grain,ip,el) do source = 1_pInt, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_damage_isoBrittle_ID) - call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + 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, grain, ip, el) + 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, grain, ip, el) + 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, grain, ip, el) + call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case default localphiDot = 0.0_pReal diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 998b19562..89d9dcd68 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -11,20 +11,22 @@ module kinematics_cleavage_opening implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - kinematics_cleavage_opening_sizePostResults, & !< cumulative size of post results - kinematics_cleavage_opening_offset, & !< which kinematics is my current damage mechanism? - kinematics_cleavage_opening_instance !< instance of damage kinematics mechanism + integer(pInt), dimension(:), allocatable, private :: kinematics_cleavage_opening_instance - integer(pInt), dimension(:,:), allocatable, target, public :: & - kinematics_cleavage_opening_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - kinematics_cleavage_opening_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - kinematics_cleavage_opening_Noutput !< number of outputs per instance of this damage + type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt) :: & + totalNcleavage + integer(pInt), dimension(:), allocatable :: & + Ncleavage !< active number of cleavage systems per family + real(pReal) :: & + sdot0, & + n + real(pReal), dimension(:), allocatable :: & + critDip, & + critLoad + end type +! Begin Deprecated integer(pInt), dimension(:), allocatable, private :: & kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems @@ -38,6 +40,7 @@ module kinematics_cleavage_opening real(pReal), dimension(:,:), allocatable, private :: & kinematics_cleavage_opening_critDisp, & kinematics_cleavage_opening_critLoad +! End Deprecated public :: & kinematics_cleavage_opening_init, & @@ -50,7 +53,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_cleavage_opening_init(fileUnit) +subroutine kinematics_cleavage_opening_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -60,41 +63,25 @@ subroutine kinematics_cleavage_opening_init(fileUnit) debug_level,& debug_constitutive,& debug_levelBasic + use config, only: & + config_phase use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & phase_kinematics, & - phase_Nkinematics, & - phase_Noutput, & KINEMATICS_cleavage_opening_label, & KINEMATICS_cleavage_opening_ID - use config, only: & - material_Nphase, & - MATERIAL_partPhase use lattice, only: & lattice_maxNcleavageFamily, & lattice_NcleavageSystem implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), allocatable, dimension(:) :: tempInt + real(pReal), allocatable, dimension(:) :: tempFloat - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,kinematics - integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j - character(len=65536) :: & - tag = '', & - line = '' + integer(pInt) :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -106,21 +93,11 @@ subroutine kinematics_cleavage_opening_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(kinematics_cleavage_opening_offset(material_Nphase), source=0_pInt) - allocate(kinematics_cleavage_opening_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - kinematics_cleavage_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_cleavage_opening_ID) - do kinematics = 1, phase_Nkinematics(phase) - if (phase_kinematics(kinematics,phase) == kinematics_cleavage_opening_ID) & - kinematics_cleavage_opening_offset(phase) = kinematics - enddo + allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0_pInt) + do p = 1_pInt, 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_sizePostResults(maxNinstance), source=0_pInt) - allocate(kinematics_cleavage_opening_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) - allocate(kinematics_cleavage_opening_output(maxval(phase_Noutput),maxNinstance)) - kinematics_cleavage_opening_output = '' - allocate(kinematics_cleavage_opening_Noutput(maxNinstance), source=0_pInt) 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) @@ -128,84 +105,44 @@ subroutine kinematics_cleavage_opening_init(fileUnit) allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal) allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal) - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_cleavage_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = kinematics_cleavage_opening_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('anisobrittle_sdot0') - kinematics_cleavage_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('anisobrittle_ratesensitivity') - kinematics_cleavage_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('ncleavage') ! - Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_CleavageFamilies - kinematics_cleavage_opening_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo + do p = 1_pInt, 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 - case ('anisobrittle_criticaldisplacement') - do j = 1_pInt, Nchunks_CleavageFamilies - kinematics_cleavage_opening_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo + tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredShape=shape(tempInt)) + kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat - case ('anisobrittle_criticalload') - do j = 1_pInt, Nchunks_CleavageFamilies - kinematics_cleavage_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo + tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredShape=shape(tempInt)) + kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat - end select - endif; endif - enddo parsingFile - -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_kinematics(:,phase) == KINEMATICS_cleavage_opening_ID)) then - instance = kinematics_cleavage_opening_instance(phase) - kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & - min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested + 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_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') - if (any(kinematics_cleavage_opening_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & + 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//')') - if (any(kinematics_cleavage_opening_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & + 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//')') if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') - endif myPhase - enddo sanityChecks + enddo end subroutine kinematics_cleavage_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar_v, ipc, ip, el) +subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, ip, el) use prec, only: & tol_math_check use material, only: & - phaseAt, phasememberAt, & + material_phase, & material_homog, & damage, & damageMapping @@ -225,25 +162,22 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar real(pReal), intent(out), dimension(3,3) :: & Ld !< damage velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & - dLd_dTstar3333 !< derivative of Ld with respect to Tstar (4th-order tensor) + dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) integer(pInt) :: & - phase, & - constituent, & - instance, & + 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 = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) + phase = material_phase(ipc,ip,el) instance = kinematics_cleavage_opening_instance(phase) homog = material_homog(ip,el) damageOffset = damageMapping(homog)%p(ip,el) Ld = 0.0_pReal - dLd_dTstar3333 = 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 @@ -261,7 +195,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar 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) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + 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 @@ -275,7 +209,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar 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) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + 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 @@ -289,11 +223,10 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar 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) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + 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 diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 61ff84b9f..573fe7d78 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -11,20 +11,22 @@ module kinematics_slipplane_opening implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - kinematics_slipplane_opening_sizePostResults, & !< cumulative size of post results - kinematics_slipplane_opening_offset, & !< which kinematics is my current damage mechanism? - kinematics_slipplane_opening_instance !< instance of damage kinematics mechanism - - integer(pInt), dimension(:,:), allocatable, target, public :: & - kinematics_slipplane_opening_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - kinematics_slipplane_opening_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - kinematics_slipplane_opening_Noutput !< number of outputs per instance of this damage + integer(pInt), dimension(:), allocatable, private :: kinematics_slipplane_opening_instance + type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt) :: & + totalNslip + integer(pInt), dimension(:), allocatable :: & + Nslip !< active number of slip systems per family + real(pReal) :: & + sdot0, & + n + real(pReal), dimension(:), allocatable :: & + critDip, & + critPlasticStrain + end type + +! Begin Deprecated integer(pInt), dimension(:), allocatable, private :: & kinematics_slipplane_opening_totalNslip !< total number of slip systems @@ -38,6 +40,7 @@ module kinematics_slipplane_opening real(pReal), dimension(:,:), allocatable, private :: & kinematics_slipplane_opening_critPlasticStrain, & kinematics_slipplane_opening_critLoad +! End Deprecated public :: & kinematics_slipplane_opening_init, & @@ -50,7 +53,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_slipplane_opening_init(fileUnit) +subroutine kinematics_slipplane_opening_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -60,41 +63,25 @@ subroutine kinematics_slipplane_opening_init(fileUnit) debug_level,& debug_constitutive,& debug_levelBasic + use config, only: & + config_phase use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & phase_kinematics, & - phase_Nkinematics, & - phase_Noutput, & KINEMATICS_slipplane_opening_label, & KINEMATICS_slipplane_opening_ID - use config, only: & - material_Nphase, & - MATERIAL_partPhase use lattice, only: & lattice_maxNslipFamily, & lattice_NslipSystem implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), allocatable, dimension(:) :: tempInt + real(pReal), allocatable, dimension(:) :: tempFloat - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,kinematics - integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j - character(len=65536) :: & - tag = '', & - line = '' + integer(pInt) :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -106,21 +93,11 @@ subroutine kinematics_slipplane_opening_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(kinematics_slipplane_opening_offset(material_Nphase), source=0_pInt) - allocate(kinematics_slipplane_opening_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - kinematics_slipplane_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_slipplane_opening_ID) - do kinematics = 1, phase_Nkinematics(phase) - if (phase_kinematics(kinematics,phase) == kinematics_slipplane_opening_ID) & - kinematics_slipplane_opening_offset(phase) = kinematics - enddo + allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0_pInt) + do p = 1_pInt, size(config_phase) + kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct? enddo - allocate(kinematics_slipplane_opening_sizePostResults(maxNinstance), source=0_pInt) - allocate(kinematics_slipplane_opening_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(kinematics_slipplane_opening_output(maxval(phase_Noutput),maxNinstance)) - kinematics_slipplane_opening_output = '' - allocate(kinematics_slipplane_opening_Noutput(maxNinstance), source=0_pInt) allocate(kinematics_slipplane_opening_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(kinematics_slipplane_opening_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) allocate(kinematics_slipplane_opening_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) @@ -128,61 +105,22 @@ subroutine kinematics_slipplane_opening_init(fileUnit) allocate(kinematics_slipplane_opening_N(maxNinstance), source=0.0_pReal) allocate(kinematics_slipplane_opening_sdot_0(maxNinstance), source=0.0_pReal) - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_slipplane_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = kinematics_slipplane_opening_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('nslip') ! - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_SlipFamilies - kinematics_slipplane_opening_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo + do p = 1_pInt, size(config_phase) + if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle + instance = kinematics_slipplane_opening_instance(p) + kinematics_slipplane_opening_sdot_0(instance) = config_phase(p)%getFloat('anisoductile_sdot0') + kinematics_slipplane_opening_N(instance) = config_phase(p)%getFloat('anisoductile_ratesensitivity') + tempInt = config_phase(p)%getInts('ncleavage') + kinematics_slipplane_opening_Nslip(1:size(tempInt),instance) = tempInt - case ('anisoductile_sdot0') - kinematics_slipplane_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('anisoductile_criticalplasticstrain') - do j = 1_pInt, Nchunks_SlipFamilies - kinematics_slipplane_opening_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisoductile_ratesensitivity') - kinematics_slipplane_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt) + tempFloat = config_phase(p)%getFloats('anisoductile_criticalplasticstrain',requiredShape=shape(tempInt)) + kinematics_slipplane_opening_critPlasticStrain(1:size(tempInt),instance) = tempFloat - case ('anisoductile_criticalload') - do j = 1_pInt, Nchunks_SlipFamilies - kinematics_slipplane_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - end select - endif; endif - enddo parsingFile + tempFloat = config_phase(p)%getFloats('anisoductile_criticalload',requiredShape=shape(tempInt)) + kinematics_slipplane_opening_critLoad(1:size(tempInt),instance) = tempFloat -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_kinematics(:,phase) == KINEMATICS_slipplane_opening_ID)) then - instance = kinematics_slipplane_opening_instance(phase) kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested + min(lattice_NslipSystem(1:lattice_maxNslipFamily,p),& ! limit active cleavage systems per family to min of available and requested kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance)) kinematics_slipplane_opening_totalNslip(instance) = sum(kinematics_slipplane_opening_Nslip(:,instance)) if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) & @@ -191,16 +129,14 @@ subroutine kinematics_slipplane_opening_init(fileUnit) call IO_error(211_pInt,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//')') - endif myPhase - enddo sanityChecks + enddo - end subroutine kinematics_slipplane_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar_v, ipc, ip, el) +subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, ip, el) use prec, only: & tol_math_check use lattice, only: & @@ -210,19 +146,15 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta lattice_st, & lattice_sn use material, only: & - phaseAt, phasememberAt, & + material_phase, & material_homog, & damage, & damageMapping use math, only: & math_Plain3333to99, & - math_I3, & - math_identity4th, & math_symmetric33, & math_Mandel33to6, & - math_tensorproduct33, & - math_det33, & - math_mul33x33 + math_tensorproduct33 implicit none integer(pInt), intent(in) :: & @@ -234,29 +166,26 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta real(pReal), intent(out), dimension(3,3) :: & Ld !< damage velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & - dLd_dTstar3333 !< derivative of Ld with respect to Tstar (4th-order tensor) + dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) real(pReal), dimension(3,3) :: & projection_d, projection_t, projection_n !< projection modes 3x3 tensor real(pReal), dimension(6) :: & projection_d_v, projection_t_v, projection_n_v !< projection modes 3x3 vector integer(pInt) :: & - phase, & - constituent, & - instance, & + 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 = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) + phase = material_phase(ipc,ip,el) instance = kinematics_slipplane_opening_instance(phase) homog = material_homog(ip,el) damageOffset = damageMapping(homog)%p(ip,el) Ld = 0.0_pReal - dLd_dTstar3333 = 0.0_pReal + dLd_dTstar = 0.0_pReal do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,kinematics_slipplane_opening_Nslip(f,instance) ! process each (active) slip system in family @@ -287,7 +216,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta Ld = Ld + udotd*projection_d dudotd_dt = udotd*kinematics_slipplane_opening_N(instance)/traction_d forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotd_dt*projection_d(k,l)*projection_d(m,n) endif @@ -300,9 +229,10 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta Ld = Ld + udott*projection_t dudott_dt = udott*kinematics_slipplane_opening_N(instance)/traction_t forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudott_dt*projection_t(k,l)*projection_t(m,n) endif + udotn = & kinematics_slipplane_opening_sdot_0(instance)* & (max(0.0_pReal,traction_n)/traction_crit - & @@ -311,7 +241,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta Ld = Ld + udotn*projection_n dudotn_dt = udotn*kinematics_slipplane_opening_N(instance)/traction_n forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotn_dt*projection_n(k,l)*projection_n(m,n) endif enddo diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 6b222c37c..b8bd3246d 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -49,6 +49,23 @@ module source_damage_anisoBrittle source_damage_anisoBrittle_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + aTol, & + sdot_0, & + N + real(pReal), dimension(:), allocatable :: & + critDisp, & + critLoad + integer(pInt) :: & + totalNcleavage + integer(pInt), dimension(:), allocatable :: & + Ncleavage + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_damage_anisoBrittle_init, & source_damage_anisoBrittle_dotState, & @@ -94,6 +111,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase use numerics,only: & @@ -106,9 +124,9 @@ subroutine source_damage_anisoBrittle_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase + integer(pInt) :: NofMyPhase,p integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j character(len=65536) :: & tag = '', & @@ -118,11 +136,11 @@ subroutine source_damage_anisoBrittle_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + 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) @@ -134,19 +152,24 @@ subroutine source_damage_anisoBrittle_init(fileUnit) enddo enddo - allocate(source_damage_anisoBrittle_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),maxNinstance)) + allocate(source_damage_anisoBrittle_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(source_damage_anisoBrittle_Noutput(maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_totalNcleavage(maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_aTol(maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_sdot_0(maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_N(maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) + allocate(source_damage_anisoBrittle_Noutput(Ninstance), source=0_pInt) + + allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_totalNcleavage(Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_aTol(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_sdot_0(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_N(Ninstance), source=0.0_pReal) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_damage_anisoBrittle_ID)) cycle + enddo rewind(fileUnit) phase = 0_pInt @@ -349,26 +372,22 @@ end subroutine source_damage_anisoBrittle_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) +subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + phase, & + constituent real(pReal), intent(in) :: & phi real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi integer(pInt) :: & - phase, constituent, sourceOffset + sourceOffset - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) sourceOffset = source_damage_anisoBrittle_offset(phase) localphiDot = 1.0_pReal - & @@ -381,25 +400,21 @@ end subroutine source_damage_anisobrittle_getRateAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- -function source_damage_anisoBrittle_postResults(ipc,ip,el) +function source_damage_anisoBrittle_postResults(phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer(pInt), intent(in) :: & + phase, & + constituent real(pReal), dimension(source_damage_anisoBrittle_sizePostResults( & - source_damage_anisoBrittle_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_anisoBrittle_instance(phase))) :: & source_damage_anisoBrittle_postResults integer(pInt) :: & - instance, phase, constituent, sourceOffset, o, c + instance, sourceOffset, o, c - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_anisoBrittle_instance(phase) sourceOffset = source_damage_anisoBrittle_offset(phase) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 5978960fb..c52dd4ff4 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -53,6 +53,23 @@ module source_damage_anisoDuctile source_damage_anisoDuctile_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + aTol, & + sdot_0, & + N + real(pReal), dimension(:), allocatable :: & + critPlasticStrain, & + critLoad + integer(pInt) :: & + totalNslip + integer(pInt), dimension(:), allocatable :: & + Nslip + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_damage_anisoDuctile_init, & source_damage_anisoDuctile_dotState, & @@ -98,6 +115,7 @@ subroutine source_damage_anisoDuctile_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase use numerics,only: & @@ -110,9 +128,9 @@ subroutine source_damage_anisoDuctile_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase + integer(pInt) :: NofMyPhase,p integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j character(len=65536) :: & tag = '', & @@ -122,11 +140,11 @@ subroutine source_damage_anisoDuctile_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_anisoDuctile_offset(material_Nphase), source=0_pInt) allocate(source_damage_anisoDuctile_instance(material_Nphase), source=0_pInt) @@ -138,19 +156,24 @@ subroutine source_damage_anisoDuctile_init(fileUnit) enddo enddo - allocate(source_damage_anisoDuctile_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),maxNinstance)) + allocate(source_damage_anisoDuctile_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoDuctile_output = '' - allocate(source_damage_anisoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(source_damage_anisoDuctile_Noutput(maxNinstance), source=0_pInt) - allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(source_damage_anisoDuctile_totalNslip(maxNinstance), source=0_pInt) - allocate(source_damage_anisoDuctile_N(maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_sdot_0(maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_aTol(maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) + allocate(source_damage_anisoDuctile_Noutput(Ninstance), source=0_pInt) + + allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,Ninstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) + allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) + allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) + allocate(source_damage_anisoDuctile_N(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_sdot_0(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_aTol(Ninstance), source=0.0_pReal) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_damage_anisoDuctile_ID)) cycle + enddo rewind(fileUnit) phase = 0_pInt @@ -338,26 +361,22 @@ end subroutine source_damage_anisoDuctile_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) +subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + phase, & + constituent real(pReal), intent(in) :: & phi real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi integer(pInt) :: & - phase, constituent, sourceOffset + sourceOffset - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) sourceOffset = source_damage_anisoDuctile_offset(phase) localphiDot = 1.0_pReal - & @@ -371,25 +390,21 @@ end subroutine source_damage_anisoDuctile_getRateAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- -function source_damage_anisoDuctile_postResults(ipc,ip,el) +function source_damage_anisoDuctile_postResults(phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer(pInt), intent(in) :: & + phase, & + constituent real(pReal), dimension(source_damage_anisoDuctile_sizePostResults( & - source_damage_anisoDuctile_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_anisoDuctile_instance(phase))) :: & source_damage_anisoDuctile_postResults integer(pInt) :: & - instance, phase, constituent, sourceOffset, o, c + instance, sourceOffset, o, c - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 041761afe..6f572c72b 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -39,6 +39,16 @@ module source_damage_isoBrittle source_damage_isoBrittle_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + critStrainEnergy, & + N, & + aTol + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_damage_isoBrittle_init, & source_damage_isoBrittle_deltaState, & @@ -84,6 +94,7 @@ subroutine source_damage_isoBrittle_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase use numerics,only: & @@ -93,9 +104,9 @@ subroutine source_damage_isoBrittle_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase + integer(pInt) :: NofMyPhase,p character(len=65536) :: & tag = '', & line = '' @@ -104,11 +115,11 @@ subroutine source_damage_isoBrittle_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + 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) @@ -120,15 +131,20 @@ subroutine source_damage_isoBrittle_init(fileUnit) enddo enddo - allocate(source_damage_isoBrittle_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),maxNinstance)) + allocate(source_damage_isoBrittle_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_isoBrittle_output = '' - allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(source_damage_isoBrittle_Noutput(maxNinstance), source=0_pInt) - allocate(source_damage_isoBrittle_critStrainEnergy(maxNinstance), source=0.0_pReal) - allocate(source_damage_isoBrittle_N(maxNinstance), source=1.0_pReal) - allocate(source_damage_isoBrittle_aTol(maxNinstance), source=0.0_pReal) + allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) + allocate(source_damage_isoBrittle_Noutput(Ninstance), source=0_pInt) + + allocate(source_damage_isoBrittle_critStrainEnergy(Ninstance), source=0.0_pReal) + allocate(source_damage_isoBrittle_N(Ninstance), source=1.0_pReal) + allocate(source_damage_isoBrittle_aTol(Ninstance), source=0.0_pReal) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_damage_isoBrittle_ID)) cycle + enddo rewind(fileUnit) phase = 0_pInt @@ -306,26 +322,22 @@ end subroutine source_damage_isoBrittle_deltaState !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) +subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + phase, & + constituent real(pReal), intent(in) :: & phi real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi integer(pInt) :: & - phase, constituent, instance, sourceOffset + instance, sourceOffset - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) @@ -340,25 +352,21 @@ end subroutine source_damage_isoBrittle_getRateAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- -function source_damage_isoBrittle_postResults(ipc,ip,el) +function source_damage_isoBrittle_postResults(phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer(pInt), intent(in) :: & + phase, & + constituent real(pReal), dimension(source_damage_isoBrittle_sizePostResults( & - source_damage_isoBrittle_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_isoBrittle_instance(phase))) :: & source_damage_isoBrittle_postResults integer(pInt) :: & - instance, phase, constituent, sourceOffset, o, c + instance, sourceOffset, o, c - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index e843be728..b4ecb53e4 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -39,6 +39,16 @@ module source_damage_isoDuctile source_damage_isoDuctile_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + critPlasticStrain, & + N, & + aTol + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_damage_isoDuctile_init, & source_damage_isoDuctile_dotState, & @@ -84,6 +94,7 @@ subroutine source_damage_isoDuctile_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase @@ -94,9 +105,9 @@ subroutine source_damage_isoDuctile_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase + integer(pInt) :: NofMyPhase,p character(len=65536) :: & tag = '', & line = '' @@ -105,11 +116,11 @@ subroutine source_damage_isoDuctile_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + 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) @@ -121,15 +132,20 @@ subroutine source_damage_isoDuctile_init(fileUnit) enddo enddo - allocate(source_damage_isoDuctile_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),maxNinstance)) + allocate(source_damage_isoDuctile_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_isoDuctile_output = '' - allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(source_damage_isoDuctile_Noutput(maxNinstance), source=0_pInt) - allocate(source_damage_isoDuctile_critPlasticStrain(maxNinstance), source=0.0_pReal) - allocate(source_damage_isoDuctile_N(maxNinstance), source=0.0_pReal) - allocate(source_damage_isoDuctile_aTol(maxNinstance), source=0.0_pReal) + allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) + allocate(source_damage_isoDuctile_Noutput(Ninstance), source=0_pInt) + + allocate(source_damage_isoDuctile_critPlasticStrain(Ninstance), source=0.0_pReal) + allocate(source_damage_isoDuctile_N(Ninstance), source=0.0_pReal) + allocate(source_damage_isoDuctile_aTol(Ninstance), source=0.0_pReal) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_damage_isoDuctile_ID)) cycle + enddo rewind(fileUnit) phase = 0_pInt @@ -275,26 +291,22 @@ end subroutine source_damage_isoDuctile_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) +subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + phase, & + constituent real(pReal), intent(in) :: & phi real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi integer(pInt) :: & - phase, constituent, sourceOffset + sourceOffset - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) sourceOffset = source_damage_isoDuctile_offset(phase) localphiDot = 1.0_pReal - & @@ -308,25 +320,21 @@ end subroutine source_damage_isoDuctile_getRateAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- -function source_damage_isoDuctile_postResults(ipc,ip,el) +function source_damage_isoDuctile_postResults(phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer(pInt), intent(in) :: & + phase, & + constituent real(pReal), dimension(source_damage_isoDuctile_sizePostResults( & - source_damage_isoDuctile_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_isoDuctile_instance(phase))) :: & source_damage_isoDuctile_postResults integer(pInt) :: & - instance, phase, constituent, sourceOffset, o, c + instance, sourceOffset, o, c - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) From efb07e0b93c83e3c0e2afacf8d32fad4c76ba5b6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Jan 2019 04:55:40 +0100 Subject: [PATCH 002/154] only output direct quantities derived quantities can be easily calculated during post processing --- src/plastic_nonlocal.f90 | 573 +-------------------------------------- 1 file changed, 4 insertions(+), 569 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index e1355da8f..a7288bde0 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -150,61 +150,34 @@ module plastic_nonlocal enum, bind(c) enumerator :: undefined_ID, & - rho_ID, & - delta_ID, & - rho_edge_ID, & - rho_screw_ID, & - rho_sgl_ID, & - delta_sgl_ID, & - rho_sgl_edge_ID, & - rho_sgl_edge_pos_ID, & - rho_sgl_edge_neg_ID, & - rho_sgl_screw_ID, & - rho_sgl_screw_pos_ID, & - rho_sgl_screw_neg_ID, & - rho_sgl_mobile_ID, & - rho_sgl_edge_mobile_ID, & rho_sgl_edge_pos_mobile_ID, & rho_sgl_edge_neg_mobile_ID, & - rho_sgl_screw_mobile_ID, & rho_sgl_screw_pos_mobile_ID, & rho_sgl_screw_neg_mobile_ID, & - rho_sgl_immobile_ID, & - rho_sgl_edge_immobile_ID, & rho_sgl_edge_pos_immobile_ID, & rho_sgl_edge_neg_immobile_ID, & - rho_sgl_screw_immobile_ID, & rho_sgl_screw_pos_immobile_ID, & rho_sgl_screw_neg_immobile_ID, & - rho_dip_ID, & - delta_dip_ID, & rho_dip_edge_ID, & rho_dip_screw_ID, & - excess_rho_ID, & - excess_rho_edge_ID, & - excess_rho_screw_ID, & rho_forest_ID, & shearrate_ID, & resolvedstress_ID, & resolvedstress_external_ID, & resolvedstress_back_ID, & resistance_ID, & - rho_dot_ID, & rho_dot_sgl_ID, & rho_dot_sgl_mobile_ID, & rho_dot_dip_ID, & rho_dot_gen_ID, & rho_dot_gen_edge_ID, & rho_dot_gen_screw_ID, & - rho_dot_sgl2dip_ID, & rho_dot_sgl2dip_edge_ID, & rho_dot_sgl2dip_screw_ID, & rho_dot_ann_ath_ID, & - rho_dot_ann_the_ID, & rho_dot_ann_the_edge_ID, & rho_dot_ann_the_screw_ID, & rho_dot_edgejogs_ID, & - rho_dot_flux_ID, & rho_dot_flux_mobile_ID, & rho_dot_flux_edge_ID, & rho_dot_flux_screw_ID, & @@ -212,28 +185,9 @@ module plastic_nonlocal velocity_edge_neg_ID, & velocity_screw_pos_ID, & velocity_screw_neg_ID, & - slipdirectionx_ID, & - slipdirectiony_ID, & - slipdirectionz_ID, & - slipnormalx_ID, & - slipnormaly_ID, & - slipnormalz_ID, & - fluxdensity_edge_posx_ID, & - fluxdensity_edge_posy_ID, & - fluxdensity_edge_posz_ID, & - fluxdensity_edge_negx_ID, & - fluxdensity_edge_negy_ID, & - fluxdensity_edge_negz_ID, & - fluxdensity_screw_posx_ID, & - fluxdensity_screw_posy_ID, & - fluxdensity_screw_posz_ID, & - fluxdensity_screw_negx_ID, & - fluxdensity_screw_negy_ID, & - fluxdensity_screw_negz_ID, & maximumdipoleheight_edge_ID, & maximumdipoleheight_screw_ID, & - accumulatedshear_ID, & - dislocationstress_ID + accumulatedshear_ID end enum integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_nonlocal_outputID !< ID of each post result output @@ -426,76 +380,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s select case(tag) case ('(output)') select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('rho') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('delta') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('delta_sgl') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_sgl_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_pos') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_neg') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_pos') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_neg') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_pos_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_mobile_ID @@ -506,11 +390,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_pos_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_mobile_ID @@ -521,31 +400,11 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_pos_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_neg_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_pos_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID @@ -556,16 +415,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dip') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('delta_dip') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_dip_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dip_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_edge_ID @@ -576,21 +425,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('excess_rho') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('excess_rho_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('excess_rho_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_forest') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_forest_ID @@ -621,11 +455,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resistance_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_sgl') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_ID @@ -656,11 +485,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_sgl2dip') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_sgl2dip_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_edge_ID @@ -676,11 +500,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_ath_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_ann_the') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_ann_the_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_edge_ID @@ -696,11 +515,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_edgejogs_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_flux') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_flux_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_mobile_ID @@ -736,96 +550,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_neg_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipdirection.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipdirection.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectiony_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipdirection.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipnormal.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipnormal.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormaly_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipnormal.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_pos.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_pos.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posy_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_pos.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_neg.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_neg.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negy_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_neg.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_pos.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_pos.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posy_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_pos.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_neg.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_neg.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negy_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_neg.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('maximumdipoleheight_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_edge_ID @@ -841,11 +565,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = accumulatedshear_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('dislocationstress') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = dislocationstress_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('nslip') if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & @@ -1195,93 +914,8 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) select case(plastic_nonlocal_outputID(o,instance)) - case( rho_ID, & - delta_ID, & - rho_edge_ID, & - rho_screw_ID, & - rho_sgl_ID, & - delta_sgl_ID, & - rho_sgl_edge_ID, & - rho_sgl_edge_pos_ID, & - rho_sgl_edge_neg_ID, & - rho_sgl_screw_ID, & - rho_sgl_screw_pos_ID, & - rho_sgl_screw_neg_ID, & - rho_sgl_mobile_ID, & - rho_sgl_edge_mobile_ID, & - rho_sgl_edge_pos_mobile_ID, & - rho_sgl_edge_neg_mobile_ID, & - rho_sgl_screw_mobile_ID, & - rho_sgl_screw_pos_mobile_ID, & - rho_sgl_screw_neg_mobile_ID, & - rho_sgl_immobile_ID, & - rho_sgl_edge_immobile_ID, & - rho_sgl_edge_pos_immobile_ID, & - rho_sgl_edge_neg_immobile_ID, & - rho_sgl_screw_immobile_ID, & - rho_sgl_screw_pos_immobile_ID, & - rho_sgl_screw_neg_immobile_ID, & - rho_dip_ID, & - delta_dip_ID, & - rho_dip_edge_ID, & - rho_dip_screw_ID, & - excess_rho_ID, & - excess_rho_edge_ID, & - excess_rho_screw_ID, & - rho_forest_ID, & - shearrate_ID, & - resolvedstress_ID, & - resolvedstress_external_ID, & - resolvedstress_back_ID, & - resistance_ID, & - rho_dot_ID, & - rho_dot_sgl_ID, & - rho_dot_sgl_mobile_ID, & - rho_dot_dip_ID, & - rho_dot_gen_ID, & - rho_dot_gen_edge_ID, & - rho_dot_gen_screw_ID, & - rho_dot_sgl2dip_ID, & - rho_dot_sgl2dip_edge_ID, & - rho_dot_sgl2dip_screw_ID, & - rho_dot_ann_ath_ID, & - rho_dot_ann_the_ID, & - rho_dot_ann_the_edge_ID, & - rho_dot_ann_the_screw_ID, & - rho_dot_edgejogs_ID, & - rho_dot_flux_ID, & - rho_dot_flux_mobile_ID, & - rho_dot_flux_edge_ID, & - rho_dot_flux_screw_ID, & - velocity_edge_pos_ID, & - velocity_edge_neg_ID, & - velocity_screw_pos_ID, & - velocity_screw_neg_ID, & - slipdirectionx_ID, & - slipdirectiony_ID, & - slipdirectionz_ID, & - slipnormalx_ID, & - slipnormaly_ID, & - slipnormalz_ID, & - fluxdensity_edge_posx_ID, & - fluxdensity_edge_posy_ID, & - fluxdensity_edge_posz_ID, & - fluxdensity_edge_negx_ID, & - fluxdensity_edge_negy_ID, & - fluxdensity_edge_negz_ID, & - fluxdensity_screw_posx_ID, & - fluxdensity_screw_posy_ID, & - fluxdensity_screw_posz_ID, & - fluxdensity_screw_negx_ID, & - fluxdensity_screw_negy_ID, & - fluxdensity_screw_negz_ID, & - maximumdipoleheight_edge_ID, & - maximumdipoleheight_screw_ID, & - accumulatedshear_ID ) - mySize = totalNslip(instance) - case(dislocationstress_ID) - mySize = 6_pInt case default + mySize = totalNslip(instance) end select if (mySize > 0_pInt) then ! any meaningful output found @@ -3655,45 +3289,6 @@ forall (s = 1_pInt:ns) & outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) select case(plastic_nonlocal_outputID(o,instance)) - case (rho_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) + sum(rhoDip,2) - cs = cs + ns - - case (rho_sgl_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) - cs = cs + ns - - case (rho_sgl_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,1:4)),2) - cs = cs + ns - - case (rho_sgl_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:8),2) - cs = cs + ns - - case (rho_dip_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDip,2) - cs = cs + ns - - case (rho_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + rhoDip(1:ns,1) - cs = cs + ns - - case (rho_sgl_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) - cs = cs + ns - - case (rho_sgl_edge_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,1:2),2) - cs = cs + ns - - case (rho_sgl_edge_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:6),2) - cs = cs + ns - - case (rho_sgl_edge_pos_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5)) - cs = cs + ns case (rho_sgl_edge_pos_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) @@ -3703,10 +3298,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,5) cs = cs + ns - case (rho_sgl_edge_neg_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6)) - cs = cs + ns - case (rho_sgl_edge_neg_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) cs = cs + ns @@ -3719,26 +3310,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,1) cs = cs + ns - case (rho_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + rhoDip(1:ns,2) - cs = cs + ns - - case (rho_sgl_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) - cs = cs + ns - - case (rho_sgl_screw_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,3:4),2) - cs = cs + ns - - case (rho_sgl_screw_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,7:8),2) - cs = cs + ns - - case (rho_sgl_screw_pos_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7)) - cs = cs + ns - case (rho_sgl_screw_pos_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) cs = cs + ns @@ -3746,10 +3317,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) case (rho_sgl_screw_pos_immobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,7) cs = cs + ns - - case (rho_sgl_screw_neg_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8)) - cs = cs + ns case (rho_sgl_screw_neg_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) @@ -3763,38 +3330,9 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,2) cs = cs + ns - case (excess_rho_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) & - - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) & - + (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) & - - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))) - cs = cs + ns - - case (excess_rho_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) & - - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) - cs = cs + ns - - case (excess_rho_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) & - - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))) - cs = cs + ns - case (rho_forest_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoForest cs = cs + ns - - case (delta_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2) + sum(rhoDip,2)) - cs = cs + ns - - case (delta_sgl_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2)) - cs = cs + ns - - case (delta_dip_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(rhoDip,2)) - cs = cs + ns case (shearrate_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(gdot,2) @@ -3818,12 +3356,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) case (resistance_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tauThreshold cs = cs + ns - - case (rho_dot_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & - + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) & - + sum(rhoDotDip,2) - cs = cs + ns case (rho_dot_sgl_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & @@ -3838,7 +3370,7 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2) cs = cs + ns - case (rho_dot_gen_ID) + case (rho_dot_gen_ID) ! Obsolete plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) & + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns @@ -3850,11 +3382,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) case (rho_dot_gen_screw_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns - - case (rho_dot_sgl2dip_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el) - cs = cs + ns case (rho_dot_sgl2dip_edge_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) @@ -3868,11 +3395,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns - - case (rho_dot_ann_the_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) - cs = cs + ns case (rho_dot_ann_the_edge_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) @@ -3890,11 +3412,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) cs = cs + ns - case (rho_dot_flux_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,5:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) - cs = cs + ns - case (rho_dot_flux_edge_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,1_pInt,ip,el),2) & + sum(rhoDotFluxOutput(1:ns,5:6,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) @@ -3921,78 +3438,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,4) cs = cs + ns - case (slipdirectionx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(1,1:ns,1) - cs = cs + ns - - case (slipdirectiony_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(2,1:ns,1) - cs = cs + ns - - case (slipdirectionz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(3,1:ns,1) - cs = cs + ns - - case (slipnormalx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(1,1:ns) - cs = cs + ns - - case (slipnormaly_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(2,1:ns) - cs = cs + ns - - case (slipnormalz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(3,1:ns) - cs = cs + ns - - case (fluxdensity_edge_posx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(1,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_posy_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(2,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_posz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(3,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_negx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(1,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_negy_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(2,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_negz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(3,1:ns,1) - cs = cs + ns - - case (fluxdensity_screw_posx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(1,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_posy_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(2,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_posz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(3,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_negx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(1,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_negy_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(2,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_negz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(3,1:ns,2) - cs = cs + ns - case (maximumdipoleheight_edge_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,1) cs = cs + ns @@ -4000,17 +3445,7 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) case (maximumdipoleheight_screw_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,2) cs = cs + ns - - case(dislocationstress_ID) - sigma = plastic_nonlocal_dislocationstress(Fe, ip, el) - plastic_nonlocal_postResults(cs+1_pInt) = sigma(1,1) - plastic_nonlocal_postResults(cs+2_pInt) = sigma(2,2) - plastic_nonlocal_postResults(cs+3_pInt) = sigma(3,3) - plastic_nonlocal_postResults(cs+4_pInt) = sigma(1,2) - plastic_nonlocal_postResults(cs+5_pInt) = sigma(2,3) - plastic_nonlocal_postResults(cs+6_pInt) = sigma(3,1) - cs = cs + 6_pInt - + case(accumulatedshear_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = plasticState(ph)%state(iGamma(1:ns,instance),of) cs = cs + ns From 854afb7107612ae75c3ef312b8825839374dc140 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Jan 2019 15:54:05 +0100 Subject: [PATCH 003/154] removed on output too much --- src/plastic_nonlocal.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index a7288bde0..c43de6627 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -405,6 +405,11 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_neg_immobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_pos_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID From 558a610df1dce05e7a132b6cdf00cb1aec8ef045 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 09:49:21 +0100 Subject: [PATCH 004/154] underscore for separation --- src/CMakeLists.txt | 2 +- src/{meshFEM.f90 => mesh_FEM.f90} | 0 2 files changed, 1 insertion(+), 1 deletion(-) rename src/{meshFEM.f90 => mesh_FEM.f90} (100%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 23c7a5643..9e8926d0a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -66,7 +66,7 @@ elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") add_dependencies(FEZoo DAMASK_MATH) list(APPEND OBJECTFILES $) - add_library(MESH OBJECT "meshFEM.f90") + add_library(MESH OBJECT "mesh_FEM.f90") add_dependencies(MESH FEZoo) list(APPEND OBJECTFILES $) endif() diff --git a/src/meshFEM.f90 b/src/mesh_FEM.f90 similarity index 100% rename from src/meshFEM.f90 rename to src/mesh_FEM.f90 From 612fa31188c68882e691f801b5dfc95382b60393 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 09:52:18 +0100 Subject: [PATCH 005/154] preparing solver-specific mesh functionality --- src/CMakeLists.txt | 2 +- src/commercialFEM_fileList.f90 | 7 +- src/{mesh.f90 => mesh_abaqus.f90} | 0 src/mesh_grid.f90 | 4280 +++++++++++++++++++++++++++++ src/mesh_marc.f90 | 4280 +++++++++++++++++++++++++++++ 5 files changed, 8567 insertions(+), 2 deletions(-) rename src/{mesh.f90 => mesh_abaqus.f90} (100%) create mode 100644 src/mesh_grid.f90 create mode 100644 src/mesh_marc.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9e8926d0a..3818130da 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -59,7 +59,7 @@ list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") - add_library(MESH OBJECT "mesh.f90") + add_library(MESH OBJECT "mesh_grid.f90") add_dependencies(MESH DAMASK_MATH) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 4feb52bed..a7a61c2f7 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -12,7 +12,12 @@ #endif #include "math.f90" #include "FEsolving.f90" -#include "mesh.f90" +#ifdef Abaqus +#include "mesh_abaqus.f90" +#endif +#ifdef Marc4DAMASK +#include "mesh_marc.f90" +#endif #include "material.f90" #include "lattice.f90" #include "source_thermal_dissipation.f90" diff --git a/src/mesh.f90 b/src/mesh_abaqus.f90 similarity index 100% rename from src/mesh.f90 rename to src/mesh_abaqus.f90 diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 new file mode 100644 index 000000000..e55165d51 --- /dev/null +++ b/src/mesh_grid.f90 @@ -0,0 +1,4280 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver +!-------------------------------------------------------------------------------------------------- +module mesh + use, intrinsic :: iso_c_binding + use prec, only: pReal, pInt + + implicit none + private + integer(pInt), 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 + mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) + mesh_Ncells, & !< total number of cells in mesh + mesh_NipsPerElem, & !< number of IPs in per element + mesh_NcellnodesPerElem, & !< number of cell nodes per element + 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 :: & + 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 :: & + mesh_homogenizationAt, & !< homogenization ID of each element + mesh_microstructureAt !< microstructure ID of each element + + integer(pInt), dimension(:,:), allocatable, public, protected :: & + mesh_CPnodeID, & !< nodes forming an element + 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 :: & + mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] + + real(pReal), public, protected :: & + mesh_unitlength !< physical length of one unit in mesh + + real(pReal), dimension(:,:), allocatable, public :: & + mesh_node, & !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + mesh_cellnode !< cell node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + + real(pReal), dimension(:,:), allocatable, public, protected :: & + mesh_ipVolume, & !< volume associated with IP (initially!) + mesh_node0 !< node x,y,z coordinates (initially!) + + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + mesh_ipArea !< area of interface to neighboring IP (initially!) + + real(pReal), dimension(:,:,:), allocatable, public :: & + mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) + + logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) + +#if defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), private :: & + mesh_maxNelemInSet, & + mesh_Nmaterials +#endif + + integer(pInt), dimension(2), private :: & + mesh_maxValStateVar = 0_pInt + +integer(pInt), dimension(:,:), allocatable, private :: & + mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID + + integer(pInt),dimension(:,:,:), allocatable, private :: & + mesh_cell !< cell connectivity for each element,ip/cell + + integer(pInt), 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 + FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell + + real(pReal), dimension(:,:,:), allocatable, private :: & + FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes + + integer(pInt), 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(pInt), 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) + 3, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 3, & ! element 54 (2D 8node 4ip) + 5, & ! element 134 (3D 4node 1ip) + 6, & ! element 157 (3D 5node 4ip) + 6, & ! element 127 (3D 10node 4ip) + 7, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 9, & ! element 7 (3D 8node 8ip) + 9, & ! element 57 (3D 20node 8ip) + 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 + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 4, & ! element 136 (3D 6node 6ip) + 4, & ! element 117 (3D 8node 1ip) + 4, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type + int([ & + 2, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 3, & ! element 127 (3D 10node 4ip) + 3, & ! element 136 (3D 6node 6ip) + 3, & ! element 117 (3D 8node 1ip) + 3, & ! element 7 (3D 8node 8ip) + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 6, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 8, & ! element 27 (2D 8node 9ip) + 8, & ! element 54 (2D 8node 4ip) + 4, & ! element 134 (3D 4node 1ip) + 5, & ! element 157 (3D 5node 4ip) + 10, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 20, & ! element 57 (3D 20node 8ip) + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 5, & ! element 136 (3D 6node 6ip) + 6, & ! element 117 (3D 8node 1ip) + 6, & ! element 7 (3D 8node 8ip) + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 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 + reshape(int([ & + 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) + 2,2,2,0,0,0, & ! element 125 (2D 6node 3ip) + 2,2,2,2,0,0, & ! element 11 (2D 4node 4ip) + 2,2,2,2,0,0, & ! element 27 (2D 8node 9ip) + 3,3,3,3,0,0, & ! element 134 (3D 4node 1ip) + 3,3,3,3,0,0, & ! element 127 (3D 10node 4ip) + 3,4,4,4,3,0, & ! element 136 (3D 6node 6ip) + 4,4,4,4,4,4, & ! element 117 (3D 8node 1ip) + 4,4,4,4,4,4, & ! element 7 (3D 8node 8ip) + 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), & + 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) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 125 (2D 6node 3ip) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 11 (2D 4node 4ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 27 (2D 8node 9ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 134 (3D 4node 1ip) + 1,4,2,0 , & + 2,3,4,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 127 (3D 10node 4ip) + 1,4,2,0 , & + 2,4,3,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 136 (3D 6node 6ip) + 1,4,5,2 , & + 2,5,6,3 , & + 1,3,6,4 , & + 4,6,5,0 , & + 0,0,0,0 , & + 1,2,3,4 , & ! element 117 (3D 8node 1ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 7 (3D 8node 8ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 21 (3D 20node 27ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 7, & ! element 125 (2D 6node 3ip) + 9, & ! element 11 (2D 4node 4ip) + 16, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 15, & ! element 127 (3D 10node 4ip) + 21, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 27, & ! element 7 (3D 8node 8ip) + 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 + int([ & + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 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 + int([& + 2, & ! (2D 3node) + 2, & ! (2D 4node) + 3, & ! (3D 4node) + 4 & ! (3D 8node) + ],pInt) + + integer(pInt), 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) + 4, & ! element 11 (2D 4node 4ip) + 9, & ! element 27 (2D 8node 9ip) + 1, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 1, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 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 + int([& + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 1, & ! element 125 (2D 6node 3ip) + 1, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 1, & ! element 127 (3D 10node 4ip) + 1, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 1, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + +#if defined(Spectral) + integer(pInt), dimension(3), public, protected :: & + grid !< (global) grid + integer(pInt), public, protected :: & + mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh + grid3, & !< (local) grid in 3rd direction + grid3Offset !< (local) grid offset in 3rd direction + real(pReal), dimension(3), public, protected :: & + geomSize + real(pReal), public, protected :: & + size3, & !< (local) size in 3rd direction + size3offset !< (local) size offset in 3rd direction +#elif defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), 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 + character(len=64), 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 :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(:,:), allocatable, target, private :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] +#endif +#if defined(Marc4DAMASK) + integer(pInt), private :: & + MarcVersion, & !< Version of input file format (Marc only) + hypoelasticTableStyle, & !< Table style (Marc only) + initialcondTableStyle !< Table style (Marc only) + integer(pInt), dimension(:), allocatable, private :: & + Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) +#elif defined(Abaqus) + logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information +#endif + + public :: & + mesh_init, & + mesh_build_cellnodes, & + mesh_build_ipVolumes, & + mesh_build_ipCoordinates, & + mesh_cellCenterCoordinates, & + mesh_get_Ncellnodes, & + mesh_get_unitlength, & + mesh_get_nodeAtIP, & +#if defined(Spectral) + mesh_spectral_getGrid, & + mesh_spectral_getSize +#elif defined(Marc4DAMASK) || defined(Abaqus) + mesh_FEasCP +#endif + + private :: & + mesh_get_damaskOptions, & + mesh_build_cellconnectivity, & + mesh_build_ipAreas, & + mesh_tell_statistics, & + FE_mapElemtype, & + mesh_faceMatch, & + mesh_build_FEdata, & +#if defined(Spectral) + mesh_spectral_getHomogenization, & + mesh_spectral_count, & + mesh_spectral_count_cpSizes, & + mesh_spectral_build_nodes, & + mesh_spectral_build_elements, & + mesh_spectral_build_ipNeighborhood +#elif defined(Marc4DAMASK) || defined(Abaqus) + mesh_build_nodeTwins, & + mesh_build_sharedElems, & + mesh_build_ipNeighborhood, & +#endif +#if defined(Marc4DAMASK) + mesh_marc_get_fileFormat, & + mesh_marc_get_tableStyles, & + mesh_marc_get_matNumber, & + mesh_marc_count_nodesAndElements, & + mesh_marc_count_elementSets, & + mesh_marc_map_elementSets, & + mesh_marc_count_cpElements, & + mesh_marc_map_Elements, & + mesh_marc_map_nodes, & + mesh_marc_build_nodes, & + mesh_marc_count_cpSizes, & + mesh_marc_build_elements +#elif defined(Abaqus) + mesh_abaqus_count_nodesAndElements, & + mesh_abaqus_count_elementSets, & + mesh_abaqus_count_materials, & + mesh_abaqus_map_elementSets, & + mesh_abaqus_map_materials, & + mesh_abaqus_count_cpElements, & + mesh_abaqus_map_elements, & + mesh_abaqus_map_nodes, & + mesh_abaqus_build_nodes, & + mesh_abaqus_count_cpSizes, & + mesh_abaqus_build_elements +#endif + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the mesh by calling all necessary private routines the mesh module +!! Order and routines strongly depend on type of solver +!-------------------------------------------------------------------------------------------------- +subroutine mesh_init(ip,el) +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif +#ifdef Spectral +#include + use PETScsys +#endif + use DAMASK_interface + use IO, only: & +#ifdef Abaqus + IO_abaqus_hasNoPart, & +#endif +#ifdef Spectral + IO_open_file, & + IO_error, & +#else + IO_open_InputFile, & +#endif + IO_timeStamp, & + IO_error, & + IO_write_jobFile + use debug, only: & + debug_e, & + debug_i, & + debug_level, & + debug_mesh, & + debug_levelBasic + use numerics, only: & + usePingPong, & + numerics_unitlength, & + worldrank + use FEsolving, only: & +#ifndef Spectral + modelName, & + calcMode, & +#endif + FEsolving_execElem, & + FEsolving_execIP + + implicit none +#ifdef Spectral + include 'fftw3-mpi.f03' + integer(C_INTPTR_T) :: devNull, local_K, local_K_offset + integer :: ierr, worldsize +#endif + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt), intent(in), optional :: el, ip + integer(pInt) :: j + logical :: myDebug + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + + call mesh_build_FEdata ! get properties of the different types of elements + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh + + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + +#ifdef Spectral + call fftw_mpi_init() + call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... + if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) + grid = mesh_spectral_getGrid(fileUnit) + call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') + if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') + + geomSize = mesh_spectral_getSize(fileUnit) + devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & + int(grid(2),C_INTPTR_T), & + int(grid(1),C_INTPTR_T)/2+1, & + PETSC_COMM_WORLD, & + local_K, & ! domain grid size along z + local_K_offset) ! domain grid offset along z + grid3 = int(local_K,pInt) + grid3Offset = int(local_K_offset,pInt) + size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) + size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) + if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) + call mesh_spectral_count() + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_spectral_count_cpSizes + if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) + call mesh_spectral_build_nodes() + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_spectral_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#elif defined Marc4DAMASK + call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... + if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + call mesh_marc_get_fileFormat(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) + call mesh_marc_get_tableStyles(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) + if (MarcVersion > 12) then + call mesh_marc_get_matNumber(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) + endif + call mesh_marc_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_marc_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_marc_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_marc_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_marc_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_marc_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_marc_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_marc_count_cpSizes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + call mesh_marc_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#elif defined Abaqus + call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... + if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + noPart = IO_abaqus_hasNoPart(FILEUNIT) + call mesh_abaqus_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_abaqus_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_abaqus_count_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) + call mesh_abaqus_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_abaqus_map_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) + call mesh_abaqus_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_abaqus_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_abaqus_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_abaqus_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_abaqus_count_cpSizes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + call mesh_abaqus_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#endif + + call mesh_get_damaskOptions(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + call mesh_build_cellconnectivity + if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) + mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) + if (myDebug) write(6,'(a)') ' Built cell nodes'; flush(6) + call mesh_build_ipCoordinates + if (myDebug) write(6,'(a)') ' Built IP coordinates'; flush(6) + call mesh_build_ipVolumes + if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) + call mesh_build_ipAreas + if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) + close (FILEUNIT) + +#if defined(Marc4DAMASK) || defined(Abaqus) + call mesh_build_nodeTwins + if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) + call mesh_build_sharedElems + if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) + call mesh_build_ipNeighborhood +#else + call mesh_spectral_build_ipNeighborhood +#endif + if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) + + if (worldrank == 0_pInt) then + call mesh_tell_statistics + endif + +#if defined(Marc4DAMASK) || defined(Abaqus) + if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements +#endif + 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 + +#if defined(Marc4DAMASK) || defined(Abaqus) + 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" +#endif + +!!!! COMPATIBILITY HACK !!!! +! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. +! hence, xxPerElem instead of maxXX + mesh_NipsPerElem = mesh_maxNips + mesh_NcellnodesPerElem = mesh_maxNcellnodes +! better name + mesh_homogenizationAt = mesh_element(3,:) + mesh_microstructureAt = mesh_element(4,:) + mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) +!!!!!!!!!!!!!!!!!!!!!!!! + +end subroutine mesh_init + + +#if defined(Marc4DAMASK) || defined(Abaqus) +!-------------------------------------------------------------------------------------------------- +!> @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) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),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) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP +#endif + +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(mesh_maxNcellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + 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) + +!-------------------------------------------------------------------------------------------------- +! 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 + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + localCellnode2globalCellnode = 0_pInt + 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 + 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 ... + 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 + 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 ... + 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 + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), 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) :: & + e,t,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) + do n = 1_pInt,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)) & + * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: e,t,g,c,i,m,f,n + real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + !$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 + 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 + 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 + 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))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + 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 + 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 + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,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)) & + 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)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: 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 + 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 + myCoords = 0.0_pReal + do n = 1_pInt,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) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), 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 + + t = mesh_element(2_pInt,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 + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) + enddo + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) + + end function mesh_cellCenterCoordinates + + +#ifdef Spectral +!-------------------------------------------------------------------------------------------------- +!> @brief Reads grid information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +function mesh_spectral_getGrid(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + integer(pInt), dimension(3) :: mesh_spectral_getGrid + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, j, myFileUnit + logical :: gotGrid = .false. + + mesh_spectral_getGrid = -1_pInt + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) + case ('grid') + gotGrid = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotGrid) & + call IO_error(error_ID = 845_pInt, ext_msg='grid') + if(any(mesh_spectral_getGrid < 1_pInt)) & + call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') + +end function mesh_spectral_getGrid + + +!-------------------------------------------------------------------------------------------------- +!> @brief Reads size information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +function mesh_spectral_getSize(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + real(pReal), dimension(3) :: mesh_spectral_getSize + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, j, myFileUnit + logical :: gotSize = .false. + + mesh_spectral_getSize = -1.0_pReal + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) + case ('size') + gotSize = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotSize) & + call IO_error(error_ID = 845_pInt, ext_msg='size') + if (any(mesh_spectral_getSize<=0.0_pReal)) & + call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') + +end function mesh_spectral_getSize + + +!-------------------------------------------------------------------------------------------------- +!> @brief Reads homogenization information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_spectral_getHomogenization(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, myFileUnit + logical :: gotHomogenization = .false. + + mesh_spectral_getHomogenization = -1_pInt + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) + case ('homogenization') + gotHomogenization = .true. + mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotHomogenization ) & + call IO_error(error_ID = 845_pInt, ext_msg='homogenization') + if (mesh_spectral_getHomogenization<1_pInt) & + call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') + +end function mesh_spectral_getHomogenization + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores them in +!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_count() + + implicit none + + mesh_NcpElems= product(grid(1:2))*grid3 + mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) + + mesh_NcpElemsGlobal = product(grid) + +end subroutine mesh_spectral_count + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. +!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_count_cpSizes + + implicit none + integer(pInt) :: t,g,c + + t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element + g = FE_geomtype(t) + c = FE_celltype(g) + + mesh_maxNips = FE_Nips(g) + mesh_maxNipNeighbors = FE_NipNeighbors(c) + mesh_maxNcellnodes = FE_Ncellnodes(g) + +end subroutine mesh_spectral_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_nodes() + + implicit none + integer(pInt) :: n + + allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) + allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) + + forall (n = 0_pInt:mesh_Nnodes-1_pInt) + mesh_node0(1,n+1_pInt) = mesh_unitlength * & + geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & + / real(grid(1),pReal) + mesh_node0(2,n+1_pInt) = mesh_unitlength * & + geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & + / real(grid(2),pReal) + mesh_node0(3,n+1_pInt) = mesh_unitlength * & + size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & + / real(grid3,pReal) + & + size3offset + end forall + + mesh_node = mesh_node0 + +end subroutine mesh_spectral_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, material, texture, and node list per element. +!! Allocates global array 'mesh_element' +!> @todo does the IO_error makes sense? +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_elements(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error, & + IO_continuousIntValues, & + IO_intValue, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: & + fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + e, i, & + headerLength = 0_pInt, & + maxDataPerLine, & + homog, & + elemType, & + elemOffset + integer(pInt), dimension(:), allocatable :: & + microstructures, & + microGlobal + integer(pInt), dimension(1,1) :: & + dummySet = 0_pInt + character(len=65536) :: & + line, & + keyword + character(len=64), dimension(1) :: & + dummyName = '' + + homog = mesh_spectral_getHomogenization(fileUnit) + +!-------------------------------------------------------------------------------------------------- +! get header length + call IO_checkAndRewind(fileUnit) + read(fileUnit,'(a65536)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') + endif + +!-------------------------------------------------------------------------------------------------- +! get maximum microstructure index + call IO_checkAndRewind(fileUnit) + do i = 1_pInt, headerLength + read(fileUnit,'(a65536)') line + enddo + + maxDataPerLine = 0_pInt + i = 1_pInt + + do while (i > 0_pInt) + i = IO_countContinuousIntValues(fileUnit) + maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? + enddo + allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) + allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size + allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) + +!-------------------------------------------------------------------------------------------------- +! read in microstructures + call IO_checkAndRewind(fileUnit) + do i=1_pInt,headerLength + read(fileUnit,'(a65536)') line + enddo + + e = 0_pInt + do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) + microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements + do i = 1_pInt,microstructures(1_pInt) + e = e+1_pInt ! valid element entry + microGlobal(e) = microstructures(1_pInt+i) + enddo + enddo + + elemType = FE_mapElemtype('C3D8R') + elemOffset = product(grid(1:2))*grid3Offset + e = 0_pInt + do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) + e = e+1_pInt ! valid element entry + mesh_element( 1,e) = -1_pInt ! DEPRECATED + mesh_element( 2,e) = elemType ! elem type + mesh_element( 3,e) = homog ! homogenization + mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure + mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & + ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node + mesh_element( 6,e) = mesh_element(5,e) + 1_pInt + mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt + mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt + mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node + mesh_element(10,e) = mesh_element(9,e) + 1_pInt + mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt + mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt + mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) + enddo + + if (e /= mesh_NcpElems) call IO_error(880_pInt,e) + +end subroutine mesh_spectral_build_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief build neighborhood relations for spectral +!> @details assign globals: mesh_ipNeighborhood +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_ipNeighborhood + + implicit none + integer(pInt) :: & + x,y,z, & + e + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) + + e = 0_pInt + do z = 0_pInt,grid3-1_pInt + do y = 0_pInt,grid(2)-1_pInt + do x = 0_pInt,grid(1)-1_pInt + e = e + 1_pInt + mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x+1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x-1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & + + modulo(y+1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & + + modulo(y-1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt + mesh_ipNeighborhood(3,1,1,e) = 2_pInt + mesh_ipNeighborhood(3,2,1,e) = 1_pInt + mesh_ipNeighborhood(3,3,1,e) = 4_pInt + mesh_ipNeighborhood(3,4,1,e) = 3_pInt + mesh_ipNeighborhood(3,5,1,e) = 6_pInt + mesh_ipNeighborhood(3,6,1,e) = 5_pInt + enddo + enddo + enddo + +end subroutine mesh_spectral_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) +!-------------------------------------------------------------------------------------------------- +function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) + use debug, only: & + debug_mesh, & + debug_level, & + debug_levelBasic + use math, only: & + math_mul33x3 + + implicit none + real(pReal), intent(in), dimension(:,:,:,:) :: & + centres + real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & + nodes + real(pReal), intent(in), dimension(3) :: & + gDim + real(pReal), intent(in), dimension(3,3) :: & + Favg + real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & + wrappedCentres + + integer(pInt) :: & + i,j,k,n + integer(pInt), dimension(3), parameter :: & + diag = 1_pInt + integer(pInt), dimension(3) :: & + shift = 0_pInt, & + lookup = 0_pInt, & + me = 0_pInt, & + iRes = 0_pInt + integer(pInt), dimension(3,8) :: & + neighbor = reshape([ & + 0_pInt, 0_pInt, 0_pInt, & + 1_pInt, 0_pInt, 0_pInt, & + 1_pInt, 1_pInt, 0_pInt, & + 0_pInt, 1_pInt, 0_pInt, & + 0_pInt, 0_pInt, 1_pInt, & + 1_pInt, 0_pInt, 1_pInt, & + 1_pInt, 1_pInt, 1_pInt, & + 0_pInt, 1_pInt, 1_pInt ], [3,8]) + +!-------------------------------------------------------------------------------------------------- +! initializing variables + iRes = [size(centres,2),size(centres,3),size(centres,4)] + nodes = 0.0_pReal + wrappedCentres = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! report + if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then + write(6,'(a)') ' Meshing cubes around centroids' + write(6,'(a,3(e12.5))') ' Dimension: ', gDim + write(6,'(a,3(i5))') ' Resolution:', iRes + endif + +!-------------------------------------------------------------------------------------------------- +! building wrappedCentres = centroids + ghosts + wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres + do k = 0_pInt,iRes(3)+1_pInt + do j = 0_pInt,iRes(2)+1_pInt + do i = 0_pInt,iRes(1)+1_pInt + if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin + j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin + i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin + me = [i,j,k] ! me on skin + shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) + lookup = me-diag+shift*iRes + wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & + centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & + - math_mul33x3(Favg, real(shift,pReal)*gDim) + endif + enddo; enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! averaging + do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) + do n = 1_pInt,8_pInt + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & + j+1_pInt+neighbor(2,n), & + k+1_pInt+neighbor(3,n) ) + enddo + enddo; enddo; enddo + nodes = nodes/8.0_pReal + +end function mesh_nodesAroundCentres +#endif + +#ifdef Marc4DAMASK +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out version of Marc input file format and stores ist as MarcVersion +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_fileFormat(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then + MarcVersion = IO_intValue(line,chunkPos,2_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_fileFormat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and +!! 'hypoelasticTableStyle' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_tableStyles(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + initialcondTableStyle = 0_pInt + hypoelasticTableStyle = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then + initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) + hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_tableStyles + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_matNumber(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i, j, data_blocks + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + + data_blocks = 1_pInt + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + read (fileUnit,610,END=620) line + if (len(trim(line))/=0_pInt) then + chunkPos = IO_stringPos(line) + data_blocks = IO_intValue(line,chunkPos,1_pInt) + endif + allocate(Marc_matNumber(data_blocks)) + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) + do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block + read (fileUnit,610,END=620) line + enddo + enddo + exit + endif + enddo + +620 end subroutine mesh_marc_get_matNumber + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores the numbers in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_nodesAndElements(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_IntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & + mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file + endif + enddo + +620 end subroutine mesh_marc_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- + subroutine mesh_marc_count_elementSets(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,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 + mesh_NelemSets = mesh_NelemSets + 1_pInt + mesh_maxNelemInSet = max(mesh_maxNelemInSet, & + IO_countContinuousIntValues(fileUnit)) + endif + enddo + +620 end subroutine mesh_marc_count_elementSets + + +!******************************************************************** +! map element sets +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!******************************************************************** +subroutine mesh_marc_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,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 + mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mesh_mapElemSet(:,elemSet) = & + IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + endif + enddo + +640 end subroutine mesh_marc_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues, & + IO_error, & + IO_intValue, & + IO_countNumericalDataLines + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i + character(len=300):: line + + mesh_NcpElems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + if (MarcVersion < 13) then ! Marc 2016 or earlier + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + read (fileUnit,610,END=620) line + enddo + mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update + exit + endif + enddo + else ! Marc2017 and later + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + endif + endif + enddo + end if + +620 end subroutine mesh_marc_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line, & + tmp + + integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,cpElem = 0_pInt + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + +610 FORMAT(A300) + + contInts = 0_pInt + rewind(fileUnit) + do + read (fileUnit,610,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+hypoelasticTableStyle ! skip three (or four if new table style!) lines + read (fileUnit,610,END=660) line + enddo + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& + mesh_mapElemSet,mesh_NelemSets) + exit + endif + else ! Marc2017 and later + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + exit + else + contInts(1) = contInts(1) + 1_pInt + read (tmp,*) contInts(contInts(1)+1) + endif + enddo + endif + endif + endif + enddo +660 do i = 1_pInt,contInts(1) + cpElem = cpElem+1_pInt + mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) + mesh_mapFEtoCPelem(2,cpElem) = cpElem + enddo + +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + +end subroutine mesh_marc_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt) :: i + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + +610 FORMAT(A300) + + node_count = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,610,END=650) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,610,END=650) line ! skip crap line + do i = 1_pInt,mesh_Nnodes + read (fileUnit,610,END=650) line + mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) + mesh_mapFEtoCPnode(2_pInt,i) = i + enddo + exit + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + +end subroutine mesh_marc_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_nodes(fileUnit) + + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue, & + IO_fixedNoEFloatValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=670) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,610,END=670) line ! skip crap line + do i=1_pInt,mesh_Nnodes + read (fileUnit,610,END=670) 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) + enddo + enddo + exit + endif + enddo + +670 mesh_node = mesh_node0 + +end subroutine mesh_marc_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_intValue, & + IO_skipChunks + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,t,g,e,c + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + +610 FORMAT(A300) + rewind(fileUnit) + do + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,610,END=630) line ! Garbage line + do i=1_pInt,mesh_Nelems ! read all elements + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) ! limit to id and type + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + endif + enddo + exit + endif + enddo + +630 end subroutine mesh_marc_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per element. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_fixedNoEFloatValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead + + allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,610,END=620) line ! garbage line + do i = 1_pInt,mesh_Nelems + read (fileUnit,610,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) & + 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 + enddo + nNodesAlreadyRead = chunkPos(1) - 2_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + exit + endif + enddo + +620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" + read (fileUnit,610,END=620) 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,610,END=620) line ! read extra line for new style + read (fileUnit,610,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 + read (fileUnit,610,END=620) 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 + mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index + if (initialcondTableStyle == 2_pInt) then + read (fileUnit,610,END=630) line ! read extra line + read (fileUnit,610,END=630) line ! read extra line + endif + contInts = IO_continuousIntValues& ! get affected elements + (fileUnit,mesh_NcpElems,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 + enddo + if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + enddo + endif + else + read (fileUnit,610,END=630) line + endif + enddo + +630 end subroutine mesh_marc_build_elements +#endif + +#ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores them in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_nodesAndElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical :: inPart + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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 (inPart .or. noPart) then + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) + 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' & + ) & + 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' & + ) then + mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) + endif + endselect + endif + enddo + +620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) + if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) + +end subroutine mesh_abaqus_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical :: inPart + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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 ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & + mesh_NelemSets = mesh_NelemSets + 1_pInt + enddo + +620 continue + if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) + +end subroutine mesh_abaqus_count_elementSets + + +!-------------------------------------------------------------------------------------------------- +! count overall number of solid sections sets in mesh (Abaqus only) +! +! mesh_Nmaterials +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical inPart + + mesh_Nmaterials = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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 ( (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 + enddo + +620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + +end subroutine mesh_abaqus_count_materials + + +!-------------------------------------------------------------------------------------------------- +! Build element set mapping +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt,i + logical :: inPart = .false. + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + +610 FORMAT(A300) + + + rewind(fileUnit) + do + read (fileUnit,610,END=640) 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 ( (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')) + mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& + mesh_mapElemSet,elemSet-1_pInt) + endif + enddo + +640 do i = 1_pInt,elemSet + if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) + enddo + +end subroutine mesh_abaqus_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +! map solid section (Abaqus only) +! +! allocate globals: mesh_nameMaterial, mesh_mapMaterial +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt) :: i,c = 0_pInt + logical :: inPart = .false. + character(len=64) :: elemSetName,materialName + + allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' + allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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 ( (inPart .or. noPart) .and. & + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then + + elemSetName = '' + materialName = '' + + do i = 3_pInt,chunkPos(1_pInt) + 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') /= '') & + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) + enddo + + if (elemSetName /= '' .and. materialName /= '') then + c = c + 1_pInt + mesh_nameMaterial(c) = materialName ! name of material used for this section + mesh_mapMaterial(c) = elemSetName ! mapped to respective element set + endif + endif + enddo + +620 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) + enddo + + end subroutine mesh_abaqus_map_materials + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error, & + IO_extractValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + integer(pInt) :: i,k + logical :: materialFound = .false. + character(len=64) ::materialName,elemSetName + + mesh_NcpElems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'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 (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 + if (elemSetName == mesh_nameElemSet(k)) & ! matched? + mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + +end subroutine mesh_abaqus_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) ::i,j,k,cpElem = 0_pInt + logical :: materialFound = .false. + character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'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 (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 + 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 + mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + + if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) + +end subroutine mesh_abaqus_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_intValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt) :: i,c,cpNode = 0_pInt + logical :: inPart = .false. + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=650) 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( (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' ) & + ) then + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,610,END=650) 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 + enddo + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + + if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) + +end subroutine mesh_abaqus_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_nodes(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_floatValue, & + IO_stringPos, & + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m,c + logical :: inPart + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=670) 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( (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' ) & + ) then + c = IO_countDataLines(fileUnit) ! how many nodes are defined here? + do i = 1_pInt,c + backspace(fileUnit) ! rewind to first entry + enddo + do i = 1_pInt,c + read (fileUnit,610,END=670) 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) + enddo + enddo + endif + enddo + +670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + mesh_node = mesh_node0 + +end subroutine mesh_abaqus_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue ,& + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,c,t,g + logical :: inPart + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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( (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' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + endif + enddo + +620 end subroutine mesh_abaqus_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per elemen. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_extractValue, & + IO_floatValue, & + IO_countDataLines, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + + integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead + logical inPart,materialFound + character (len=64) :: materialName,elemSetName + character(len=300) :: line + + allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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( (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' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,610,END=620) 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) & + 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: + enddo + nNodesAlreadyRead = chunkPos(1) - 1_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + endif + enddo + + +620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" + + materialFound = .false. + do + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & + materialFound ) then + read (fileUnit,610,END=630) 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 + 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 + if (elemSetName == mesh_nameElemSet(k)) then ! matched? + do j = 1_pInt,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 + mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +630 end subroutine mesh_abaqus_build_elements +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief get any additional damask options from input file, sets mesh_periodicSurface +!-------------------------------------------------------------------------------------------------- +subroutine mesh_get_damaskOptions(fileUnit) + +use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + +#ifdef Spectral + mesh_periodicSurface = .true. + + end subroutine mesh_get_damaskOptions + +#else + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) chunk, Nchunks + character(len=300) :: line, damaskOption, v + character(len=300) :: keyword + + mesh_periodicSurface = .false. +#ifdef Marc4DAMASK + keyword = '$damask' +#endif +#ifdef Abaqus + keyword = '**damask' +#endif + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Nchunks = chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + select case(damaskOption) + case('periodic') ! damask Option that allows to specify periodic fluxes + do chunk = 3_pInt,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' + mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' + enddo + endselect + endif + enddo + +610 FORMAT(A300) + +620 end subroutine mesh_get_damaskOptions +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipAreas + use math, only: & + math_crossproduct + + implicit none + integer(pInt) :: 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) + + !$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 + 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)) & + 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 + normal(3) = 0.0_pReal + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + 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)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal = math_crossproduct(nodePos(1:3,2) - nodePos(1:3,1), & + nodePos(1:3,3) - nodePos(1:3,1)) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (4_pInt) ! 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)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + normals(1:3,n) = 0.5_pReal & + * math_crossproduct(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & + nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) + normal = 0.5_pReal * sum(normals,2) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) + enddo + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipAreas + +#ifndef Spectral +!-------------------------------------------------------------------------------------------------- +!> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_nodeTwins + + implicit none + integer(pInt) 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 + 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 + + tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal + + do dir = 1_pInt,3_pInt ! 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 + minCoord = minval(mesh_node0(dir,:)) + maxCoord = maxval(mesh_node0(dir,:)) + do node = 1_pInt,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 + elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then + maximumNodes(1) = maximumNodes(1) + 1_pInt + maximumNodes(maximumNodes(1)+1_pInt) = node + endif + enddo + + + !*** 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) + if (unpaired(minimumNode)) then + do n2 = 1_pInt,maximumNodes(1) + maximumNode = maximumNodes(n2+1_pInt) + 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 + mesh_nodeTwins(dir,maximumNode) = minimumNode + unpaired(maximumNode) = .false. ! remember this node, we don't have to look for his partner again + exit + endif + enddo + endif + enddo + + endif + enddo + +end subroutine mesh_build_nodeTwins + + +!-------------------------------------------------------------------------------------------------- +!> @brief get maximum count of shared elements among cpElements and build list of elements shared +!! by each node in mesh. Allocate globals '_maxNsharedElems' and '_sharedElem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_sharedElems + + implicit none + integer(pint) e, & ! element index + g, & ! element type + node, & ! CP node index + 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 + + allocate(node_seen(maxval(FE_NmatchingNodes))) + + node_count = 0_pInt + + do e = 1_pInt,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 = 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... + 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 + enddo + endif + node_seen(n) = node ! remember this node to be counted already + enddo + enddo + + mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node + + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) + + do e = 1_pInt,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) + 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... + 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 + mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id + endif + enddo + endif + node_seen(n) = node + enddo + enddo + +end subroutine mesh_build_sharedElems + + +!-------------------------------------------------------------------------------------------------- +!> @brief build up of IP neighborhood, allocate globals '_ipNeighborhood' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipNeighborhood + use math, only: & + math_mul3x3 + + implicit none + integer(pInt) :: myElem, & ! my CP element index + myIP, & + myType, & ! my element type + myFace, & + neighbor, & ! neighor index + neighboringIPkey, & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element) + candidateIP, & + neighboringType, & ! element type of neighbor + NlinkedNodes, & ! number of linked nodes + twin_of_linkedNode, & ! node twin of a specific linkedNode + NmatchingNodes, & ! number of matching nodes + dir, & ! direction of periodicity + matchingElem, & ! CP elem number of matching element + matchingFace, & ! face ID of matching element + a, anchor, & + neighboringIP, & + neighboringElem, & + pointingToMe + integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & + linkedNodes = 0_pInt, & + matchingNodes + logical checkTwins + + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) + mesh_ipNeighborhood = 0_pInt + + + do myElem = 1_pInt,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 + 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 + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey + + + !*** 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 + 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? + neighboringType = FE_geomtype(mesh_element(2,matchingElem)) + + !*** trivial solution if neighbor has only one IP + + if (FE_Nips(neighboringType) == 1_pInt) then + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt + 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 + anchor = FE_nodesAtIP(a,myIP,myType) + if (anchor /= 0_pInt) 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 + else ! something went wrong with the linkage, since not all anchors sit on my face + NlinkedNodes = 0_pInt + linkedNodes = 0_pInt + exit + endif + endif + enddo + + !*** loop through the ips of my neighbor + !*** 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 + anchor = FE_nodesAtIP(a,candidateIP,neighboringType) + if (anchor /= 0_pInt) then ! valid anchor node + if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? + NmatchingNodes = NmatchingNodes + 1_pInt + 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 + exit + endif + endif + enddo + + if (NmatchingNodes /= NlinkedNodes) & ! this ip has wrong count of anchors on face + cycle checkCandidateIP + + !*** check "normal" nodes whether they match or not + + checkTwins = .false. + do a = 1_pInt,NlinkedNodes + if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode + checkTwins = .true. + exit ! no need to search further + endif + enddo + + !*** if no match found, then also check node twins + + 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 + twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) + if (twin_of_linkedNode == 0_pInt .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 + enddo + endif + + !*** we found a match !!! + + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = candidateIP + exit checkCandidateIP + enddo checkCandidateIP + endif ! end of valid external matching + endif ! end of internal/external matching + enddo + enddo + enddo + do myElem = 1_pInt,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 + 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 ... + 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 + 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),& + mesh_ipAreaNormal(1:3,pointingToMe,neighboringIP,neighboringElem)) < 0.0_pReal) then ! area normals have opposite orientation (we have to check that because of special case for single element with two ips and periodicity. In this case the neighbor is identical in two different directions.) + mesh_ipNeighborhood(3,neighbor,myIP,myElem) = pointingToMe ! found match + exit ! so no need to search further + endif + endif + enddo + endif + enddo + enddo + enddo + +end subroutine mesh_build_ipNeighborhood +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief write statistics regarding input file parsing to the output file +!-------------------------------------------------------------------------------------------------- +subroutine mesh_tell_statistics + use math, only: & + math_range + use IO, only: & + IO_error + use debug, only: & + debug_level, & + debug_MESH, & + debug_LEVELBASIC, & + debug_LEVELEXTENSIVE, & + debug_LEVELSELECTIVE, & + debug_e, & + debug_i + + implicit none + integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro + character(len=64) :: myFmt + integer(pInt) :: i,e,n,f,t,g,c, myDebug + + myDebug = debug_level(debug_mesh) + + if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified + if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified + + allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) + do e = 1_pInt,mesh_NcpElems + if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified + if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified + mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & + mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure + enddo +!$OMP CRITICAL (write2out) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) then + write(6,'(/,a,/)') ' Input Parser: STATISTICS' + write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' + write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' + write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' + write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' + write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' + write(6,*) + write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' + write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) + write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' + do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations + write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures + enddo + write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' + write(6,*) 'periodic surface : ', mesh_periodicSurface + write(6,*) + flush(6) + endif + + if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then + write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' + write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get elemType + g = FE_geomtype(t) ! get elemGeomType + c = FE_celltype(g) ! get cellType + write(6,'(i8,3(1x,i8))') e,t,g,c + enddo + write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' + write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) + write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + 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) + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) + do f = 1_pInt,FE_NipNeighbors(c) + write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) + enddo + enddo + enddo + write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' + write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + 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 of elem + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i2)') e,i + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell + write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & + mesh_cellnode(1:3,mesh_cell(n,i,e)) + enddo + enddo + enddo + write(6,'(/,a)') 'Input Parser: IP COORDINATES' + write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) + enddo + enddo +#ifndef Spectral + write(6,'(/,a,/)') 'Input Parser: NODE TWINS' + write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' + do n = 1_pInt,mesh_Nnodes ! loop over cpNodes + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle + write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) + enddo +#endif + write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' + write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + 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 of elem + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP + write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) + enddo + enddo + enddo + endif +!$OMP END CRITICAL (write2out) + +end subroutine mesh_tell_statistics + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( '6') + FE_mapElemtype = 1_pInt ! 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) + case ( '11', & + 'cpe4', & + 'cpe4t') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( '27', & + 'cpe8', & + 'cpe8t') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( '54') + FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration + case ( '134', & + 'c3d4', & + 'c3d4t') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( '157') + FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations + case ( '127') + FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron + case ( '136', & + 'c3d6', & + 'c3d6t') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( '117', & + '123', & + 'c3d8r', & + 'c3d8rt') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( '7', & + 'c3d8', & + 'c3d8t') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( '57', & + 'c3d20r', & + 'c3d20rt') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( '21', & + 'c3d20', & + 'c3d20t') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + + +!-------------------------------------------------------------------------------------------------- +!> @brief find face-matching element of same type +!-------------------------------------------------------------------------------------------------- +subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) + +implicit none +integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID + matchingFace ! matching face ID +integer(pInt), intent(in) :: face, & ! face ID + elem ! CP elem ID +integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & + myFaceNodes ! global node ids on my face +integer(pInt) :: myType, & + candidateType, & + candidateElem, & + candidateFace, & + candidateFaceNode, & + minNsharedElems, & + NsharedElems, & + lonelyNode = 0_pInt, & + i, & + n, & + dir ! periodicity direction +integer(pInt), 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 + +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 + if (NsharedElems < minNsharedElems) then + minNsharedElems = NsharedElems ! remember min # shared elems + lonelyNode = n ! remember most lonely node + endif +enddo + +allocate(element_seen(minNsharedElems)) +element_seen = 0_pInt + +checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements + candidateElem = mesh_sharedElem(1_pInt+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 + 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) + 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 + 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 + cycle checkCandidateFace + else + cycle checkCandidateFaceTwins ! try twins in next dimension + endif + endif + enddo + exit checkCandidateFaceTwins + enddo checkCandidateFaceTwins + endif + matchingFace = candidateFace + matchingElem = candidateElem + exit checkCandidate ! found my matching candidate + enddo checkCandidateFace + endif +enddo checkCandidate + +end subroutine mesh_faceMatch + + +!-------------------------------------------------------------------------------------------------- +!> @brief get properties of different types of finite elements +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!-------------------------------------------------------------------------------------------------- +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) + 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) + + + !*** fill FE_nodesAtIP with data *** + + me = 0_pInt + + me = me + 1_pInt + 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 + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, & + 2, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, & + 2, & + 4, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + 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 + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 1, & + 2, & + 3, & + 4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + 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 + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + reshape(int([& + 1,0, 0,0, & + 1,2, 0,0, & + 2,0, 0,0, & + 1,4, 0,0, & + 1,3, 2,4, & + 2,3, 0,0, & + 4,0, 0,0, & + 3,4, 0,0, & + 3,0, 0,0, & + 1,5, 0,0, & + 1,6, 2,5, & + 2,6, 0,0, & + 1,8, 4,5, & + 0,0, 0,0, & + 2,7, 3,6, & + 4,8, 0,0, & + 3,8, 4,7, & + 3,7, 0,0, & + 5,0, 0,0, & + 5,6, 0,0, & + 6,0, 0,0, & + 5,8, 0,0, & + 5,7, 6,8, & + 6,7, 0,0, & + 8,0, 0,0, & + 7,8, 0,0, & + 7,0, 0,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + + ! *** FE_ipNeighbor *** + ! is a list of the neighborhood of each IP. + ! 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 = me + 1_pInt + 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 + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 2,-4, 4,-1, & + 3, 1, 5,-1, & + -2, 2, 6,-1, & + 5,-4, 7, 1, & + 6, 4, 8, 2, & + -2, 5, 9, 3, & + 8,-4,-3, 4, & + 9, 7,-3, 5, & + -2, 8,-3, 6 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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 + 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, & + -2, 1, 3,-2, 4,-1, & + 2,-4,-3, 1, 4,-1, & + 2,-4, 3,-2,-3, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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, & + -3, 1, 3,-2, 5,-1, & + 2,-4,-3, 1, 6,-1, & + 5,-4, 6,-2,-5, 1, & + -3, 4, 6,-2,-5, 2, & + 5,-4,-3, 4,-5, 3 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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 + 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, & + -3, 1, 4,-2, 6,-1, & + 4,-5,-4, 1, 7,-1, & + -3, 3,-4, 2, 8,-1, & + 6,-5, 7,-2,-6, 1, & + -3, 5, 8,-2,-6, 2, & + 8,-5,-4, 5,-6, 3, & + -3, 7,-4, 6,-6, 4 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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, & + 3, 1, 5,-2,11,-1, & + -3, 2, 6,-2,12,-1, & + 5,-5, 7, 1,13,-1, & + 6, 4, 8, 2,14,-1, & + -3, 5, 9, 3,15,-1, & + 8,-5,-4, 4,16,-1, & + 9, 7,-4, 5,17,-1, & + -3, 8,-4, 6,18,-1, & + 11,-5,13,-2,19, 1, & + 12,10,14,-2,20, 2, & + -3,11,15,-2,21, 3, & + 14,-5,16,10,22, 4, & + 15,13,17,11,23, 5, & + -3,14,18,12,24, 6, & + 17,-5,-4,13,25, 7, & + 18,16,-4,14,26, 8, & + -3,17,-4,15,27, 9, & + 20,-5,22,-2,-6,10, & + 21,19,23,-2,-6,11, & + -3,20,24,-2,-6,12, & + 23,-5,25,19,-6,13, & + 24,22,26,20,-6,14, & + -3,23,27,21,-6,15, & + 26,-5,-4,22,-6,16, & + 27,25,-4,23,-6,17, & + -3,26,-4,24,-6,18 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cell *** + me = 0_pInt + + me = me + 1_pInt + 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 + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1, 5,13,12, & + 5, 6,14,13, & + 6, 2, 7,14, & + 12,13,16,11, & + 13,14,15,16, & + 14, 7, 8,15, & + 11,16,10, 4, & + 16,15, 9,10, & + 15, 8, 3, 9 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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 + 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, & + 5, 2, 6,11,12, 9,13,15, & + 7,11, 6, 3,14,15,13,10, & + 8,12,15, 4, 4, 9,13,10 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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, & + 7, 2, 8,16,17,11,18,21, & + 9,16, 8, 3,19,21,18,12, & + 10,17,21,19, 4,13,20,15, & + 17,11,18,21,13, 5,14,20, & + 19,21,18,12,15,20,14, 6 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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 + 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, & + 9, 2,10,21,22,14,23,27, & + 12,21,11, 4,25,27,24,16, & + 21,10, 3,11,27,23,15,24, & + 13,22,27,25, 5,17,26,20, & + 22,14,23,27,17, 6,18,26, & + 25,27,24,16,20,26,19, 8, & + 27,23,15,24,26,18, 7,19 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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, & + 9,10,34,33,37,38,58,57, & + 10, 2,11,34,38,18,39,58, & + 16,33,36,15,44,57,60,43, & + 33,34,35,36,57,58,59,60, & + 34,11,12,35,58,39,40,59, & + 15,36,14, 4,43,60,42,20, & + 36,35,13,14,60,59,41,42, & + 35,12, 3,13,59,40,19,41, & + 17,37,57,44,21,45,61,52, & + 37,38,58,57,45,46,62,61, & + 38,18,39,58,46,22,47,62, & + 44,57,60,43,52,61,64,51, & + 57,58,59,60,61,62,63,64, & + 58,39,40,59,62,47,48,63, & + 43,60,42,20,51,64,50,24, & + 60,59,41,42,64,63,49,50, & + 59,40,19,41,63,48,23,49, & + 21,45,61,52, 5,25,53,32, & + 45,46,62,61,25,26,54,53, & + 46,22,47,62,26, 6,27,54, & + 52,61,64,51,32,53,56,31, & + 61,62,63,64,53,54,55,56, & + 62,47,48,63,54,27,28,55, & + 51,64,50,24,31,56,30, 8, & + 64,63,49,50,56,55,29,30, & + 63,48,23,49,55,28, 7,29 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cellnodeParentnodeWeights *** + ! center of gravity of the weighted nodes gives the position of the cell node. + ! fill with 0. + ! 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 = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) + reshape(real([& + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 2, 2, 2 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1, & + 1, 1, 0, 0, & + 0, 1, 1, 0, & + 0, 0, 1, 1, & + 1, 0, 0, 1, & + 1, 1, 1, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 1, 0, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 0, 2, & + 1, 0, 0, 0, 0, 0, 0, 2, & + 4, 1, 1, 1, 8, 2, 2, 8, & + 1, 4, 1, 1, 8, 8, 2, 2, & + 1, 1, 4, 1, 2, 8, 8, 2, & + 1, 1, 1, 4, 2, 2, 8, 8 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 1, 2, 2, 2, 2 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, & + 0, 0, 1, 0, 0, & + 0, 0, 0, 1, 0, & + 1, 1, 0, 0, 0, & + 0, 1, 1, 0, 0, & + 1, 0, 1, 0, 0, & + 1, 0, 0, 1, 0, & + 0, 1, 0, 1, 0, & + 0, 0, 1, 1, 0, & + 1, 1, 1, 0, 0, & + 1, 1, 0, 1, 0, & + 0, 1, 1, 1, 0, & + 1, 0, 1, 1, 0, & + 0, 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & + 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & + 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & + 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & + 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 0, 0, 0, 0, & + 0, 1, 1, 0, 0, 0, & + 1, 0, 1, 0, 0, 0, & + 1, 0, 0, 1, 0, 0, & + 0, 1, 0, 0, 1, 0, & + 0, 0, 1, 0, 0, 1, & + 0, 0, 0, 1, 1, 0, & + 0, 0, 0, 0, 1, 1, & + 0, 0, 0, 1, 0, 1, & + 1, 1, 1, 0, 0, 0, & + 1, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 1, & + 1, 0, 1, 1, 0, 1, & + 0, 0, 0, 1, 1, 1, & + 1, 1, 1, 1, 1, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & ! + 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, & ! + 1, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 1, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 1, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 1, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 1, & ! + 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, & ! + 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, & ! + 1, 1, 1, 1, 1, 1, 1, 1 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! + 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! + 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 + 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, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 + 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! + 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 + 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! + 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! + 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! + 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 + 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! + 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 + 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! + 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! + 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 + 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! + 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! + 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! + 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! + 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 + 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! + 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! + 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! + 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + + + ! *** FE_cellface *** + me = 0_pInt + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) + reshape(int([& + 2,3, & + 3,1, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) + reshape(int([& + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) + reshape(int([& + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) + reshape(int([& + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + +end subroutine mesh_build_FEdata + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns global variable mesh_Ncellnodes +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_Ncellnodes() + + implicit none + + mesh_get_Ncellnodes = mesh_Ncellnodes + +end function mesh_get_Ncellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns global variable mesh_unitlength +!-------------------------------------------------------------------------------------------------- +real(pReal) function mesh_get_unitlength() + + implicit none + + mesh_get_unitlength = mesh_unitlength + +end function mesh_get_unitlength + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns node that is located at an ip +!> @details return zero if requested ip does not exist or not available (more ips than nodes) +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) + + implicit none + character(len=*), intent(in) :: elemtypeFE + integer(pInt), intent(in) :: ip + integer(pInt) :: elemtype + integer(pInt) :: geomtype + + mesh_get_nodeAtIP = 0_pInt + + elemtype = FE_mapElemtype(elemtypeFE) + geomtype = FE_geomtype(elemtype) + if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & + mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) + +end function mesh_get_nodeAtIP + + +end module mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 new file mode 100644 index 000000000..e55165d51 --- /dev/null +++ b/src/mesh_marc.f90 @@ -0,0 +1,4280 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver +!-------------------------------------------------------------------------------------------------- +module mesh + use, intrinsic :: iso_c_binding + use prec, only: pReal, pInt + + implicit none + private + integer(pInt), 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 + mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) + mesh_Ncells, & !< total number of cells in mesh + mesh_NipsPerElem, & !< number of IPs in per element + mesh_NcellnodesPerElem, & !< number of cell nodes per element + 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 :: & + 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 :: & + mesh_homogenizationAt, & !< homogenization ID of each element + mesh_microstructureAt !< microstructure ID of each element + + integer(pInt), dimension(:,:), allocatable, public, protected :: & + mesh_CPnodeID, & !< nodes forming an element + 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 :: & + mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] + + real(pReal), public, protected :: & + mesh_unitlength !< physical length of one unit in mesh + + real(pReal), dimension(:,:), allocatable, public :: & + mesh_node, & !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + mesh_cellnode !< cell node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + + real(pReal), dimension(:,:), allocatable, public, protected :: & + mesh_ipVolume, & !< volume associated with IP (initially!) + mesh_node0 !< node x,y,z coordinates (initially!) + + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + mesh_ipArea !< area of interface to neighboring IP (initially!) + + real(pReal), dimension(:,:,:), allocatable, public :: & + mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) + + logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) + +#if defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), private :: & + mesh_maxNelemInSet, & + mesh_Nmaterials +#endif + + integer(pInt), dimension(2), private :: & + mesh_maxValStateVar = 0_pInt + +integer(pInt), dimension(:,:), allocatable, private :: & + mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID + + integer(pInt),dimension(:,:,:), allocatable, private :: & + mesh_cell !< cell connectivity for each element,ip/cell + + integer(pInt), 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 + FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell + + real(pReal), dimension(:,:,:), allocatable, private :: & + FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes + + integer(pInt), 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(pInt), 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) + 3, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 3, & ! element 54 (2D 8node 4ip) + 5, & ! element 134 (3D 4node 1ip) + 6, & ! element 157 (3D 5node 4ip) + 6, & ! element 127 (3D 10node 4ip) + 7, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 9, & ! element 7 (3D 8node 8ip) + 9, & ! element 57 (3D 20node 8ip) + 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 + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 4, & ! element 136 (3D 6node 6ip) + 4, & ! element 117 (3D 8node 1ip) + 4, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type + int([ & + 2, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 3, & ! element 127 (3D 10node 4ip) + 3, & ! element 136 (3D 6node 6ip) + 3, & ! element 117 (3D 8node 1ip) + 3, & ! element 7 (3D 8node 8ip) + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 6, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 8, & ! element 27 (2D 8node 9ip) + 8, & ! element 54 (2D 8node 4ip) + 4, & ! element 134 (3D 4node 1ip) + 5, & ! element 157 (3D 5node 4ip) + 10, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 20, & ! element 57 (3D 20node 8ip) + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 5, & ! element 136 (3D 6node 6ip) + 6, & ! element 117 (3D 8node 1ip) + 6, & ! element 7 (3D 8node 8ip) + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 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 + reshape(int([ & + 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) + 2,2,2,0,0,0, & ! element 125 (2D 6node 3ip) + 2,2,2,2,0,0, & ! element 11 (2D 4node 4ip) + 2,2,2,2,0,0, & ! element 27 (2D 8node 9ip) + 3,3,3,3,0,0, & ! element 134 (3D 4node 1ip) + 3,3,3,3,0,0, & ! element 127 (3D 10node 4ip) + 3,4,4,4,3,0, & ! element 136 (3D 6node 6ip) + 4,4,4,4,4,4, & ! element 117 (3D 8node 1ip) + 4,4,4,4,4,4, & ! element 7 (3D 8node 8ip) + 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), & + 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) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 125 (2D 6node 3ip) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 11 (2D 4node 4ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 27 (2D 8node 9ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 134 (3D 4node 1ip) + 1,4,2,0 , & + 2,3,4,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 127 (3D 10node 4ip) + 1,4,2,0 , & + 2,4,3,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 136 (3D 6node 6ip) + 1,4,5,2 , & + 2,5,6,3 , & + 1,3,6,4 , & + 4,6,5,0 , & + 0,0,0,0 , & + 1,2,3,4 , & ! element 117 (3D 8node 1ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 7 (3D 8node 8ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 21 (3D 20node 27ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 7, & ! element 125 (2D 6node 3ip) + 9, & ! element 11 (2D 4node 4ip) + 16, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 15, & ! element 127 (3D 10node 4ip) + 21, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 27, & ! element 7 (3D 8node 8ip) + 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 + int([ & + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 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 + int([& + 2, & ! (2D 3node) + 2, & ! (2D 4node) + 3, & ! (3D 4node) + 4 & ! (3D 8node) + ],pInt) + + integer(pInt), 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) + 4, & ! element 11 (2D 4node 4ip) + 9, & ! element 27 (2D 8node 9ip) + 1, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 1, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 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 + int([& + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 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 + int([ & + 3, & ! element 6 (2D 3node 1ip) + 1, & ! element 125 (2D 6node 3ip) + 1, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 1, & ! element 127 (3D 10node 4ip) + 1, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 1, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + +#if defined(Spectral) + integer(pInt), dimension(3), public, protected :: & + grid !< (global) grid + integer(pInt), public, protected :: & + mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh + grid3, & !< (local) grid in 3rd direction + grid3Offset !< (local) grid offset in 3rd direction + real(pReal), dimension(3), public, protected :: & + geomSize + real(pReal), public, protected :: & + size3, & !< (local) size in 3rd direction + size3offset !< (local) size offset in 3rd direction +#elif defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), 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 + character(len=64), 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 :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(:,:), allocatable, target, private :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] +#endif +#if defined(Marc4DAMASK) + integer(pInt), private :: & + MarcVersion, & !< Version of input file format (Marc only) + hypoelasticTableStyle, & !< Table style (Marc only) + initialcondTableStyle !< Table style (Marc only) + integer(pInt), dimension(:), allocatable, private :: & + Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) +#elif defined(Abaqus) + logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information +#endif + + public :: & + mesh_init, & + mesh_build_cellnodes, & + mesh_build_ipVolumes, & + mesh_build_ipCoordinates, & + mesh_cellCenterCoordinates, & + mesh_get_Ncellnodes, & + mesh_get_unitlength, & + mesh_get_nodeAtIP, & +#if defined(Spectral) + mesh_spectral_getGrid, & + mesh_spectral_getSize +#elif defined(Marc4DAMASK) || defined(Abaqus) + mesh_FEasCP +#endif + + private :: & + mesh_get_damaskOptions, & + mesh_build_cellconnectivity, & + mesh_build_ipAreas, & + mesh_tell_statistics, & + FE_mapElemtype, & + mesh_faceMatch, & + mesh_build_FEdata, & +#if defined(Spectral) + mesh_spectral_getHomogenization, & + mesh_spectral_count, & + mesh_spectral_count_cpSizes, & + mesh_spectral_build_nodes, & + mesh_spectral_build_elements, & + mesh_spectral_build_ipNeighborhood +#elif defined(Marc4DAMASK) || defined(Abaqus) + mesh_build_nodeTwins, & + mesh_build_sharedElems, & + mesh_build_ipNeighborhood, & +#endif +#if defined(Marc4DAMASK) + mesh_marc_get_fileFormat, & + mesh_marc_get_tableStyles, & + mesh_marc_get_matNumber, & + mesh_marc_count_nodesAndElements, & + mesh_marc_count_elementSets, & + mesh_marc_map_elementSets, & + mesh_marc_count_cpElements, & + mesh_marc_map_Elements, & + mesh_marc_map_nodes, & + mesh_marc_build_nodes, & + mesh_marc_count_cpSizes, & + mesh_marc_build_elements +#elif defined(Abaqus) + mesh_abaqus_count_nodesAndElements, & + mesh_abaqus_count_elementSets, & + mesh_abaqus_count_materials, & + mesh_abaqus_map_elementSets, & + mesh_abaqus_map_materials, & + mesh_abaqus_count_cpElements, & + mesh_abaqus_map_elements, & + mesh_abaqus_map_nodes, & + mesh_abaqus_build_nodes, & + mesh_abaqus_count_cpSizes, & + mesh_abaqus_build_elements +#endif + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the mesh by calling all necessary private routines the mesh module +!! Order and routines strongly depend on type of solver +!-------------------------------------------------------------------------------------------------- +subroutine mesh_init(ip,el) +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif +#ifdef Spectral +#include + use PETScsys +#endif + use DAMASK_interface + use IO, only: & +#ifdef Abaqus + IO_abaqus_hasNoPart, & +#endif +#ifdef Spectral + IO_open_file, & + IO_error, & +#else + IO_open_InputFile, & +#endif + IO_timeStamp, & + IO_error, & + IO_write_jobFile + use debug, only: & + debug_e, & + debug_i, & + debug_level, & + debug_mesh, & + debug_levelBasic + use numerics, only: & + usePingPong, & + numerics_unitlength, & + worldrank + use FEsolving, only: & +#ifndef Spectral + modelName, & + calcMode, & +#endif + FEsolving_execElem, & + FEsolving_execIP + + implicit none +#ifdef Spectral + include 'fftw3-mpi.f03' + integer(C_INTPTR_T) :: devNull, local_K, local_K_offset + integer :: ierr, worldsize +#endif + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt), intent(in), optional :: el, ip + integer(pInt) :: j + logical :: myDebug + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + + call mesh_build_FEdata ! get properties of the different types of elements + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh + + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + +#ifdef Spectral + call fftw_mpi_init() + call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... + if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) + grid = mesh_spectral_getGrid(fileUnit) + call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') + if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') + + geomSize = mesh_spectral_getSize(fileUnit) + devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & + int(grid(2),C_INTPTR_T), & + int(grid(1),C_INTPTR_T)/2+1, & + PETSC_COMM_WORLD, & + local_K, & ! domain grid size along z + local_K_offset) ! domain grid offset along z + grid3 = int(local_K,pInt) + grid3Offset = int(local_K_offset,pInt) + size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) + size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) + if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) + call mesh_spectral_count() + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_spectral_count_cpSizes + if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) + call mesh_spectral_build_nodes() + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_spectral_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#elif defined Marc4DAMASK + call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... + if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + call mesh_marc_get_fileFormat(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) + call mesh_marc_get_tableStyles(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) + if (MarcVersion > 12) then + call mesh_marc_get_matNumber(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) + endif + call mesh_marc_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_marc_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_marc_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_marc_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_marc_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_marc_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_marc_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_marc_count_cpSizes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + call mesh_marc_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#elif defined Abaqus + call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... + if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + noPart = IO_abaqus_hasNoPart(FILEUNIT) + call mesh_abaqus_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_abaqus_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_abaqus_count_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) + call mesh_abaqus_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_abaqus_map_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) + call mesh_abaqus_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_abaqus_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_abaqus_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_abaqus_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_abaqus_count_cpSizes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + call mesh_abaqus_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#endif + + call mesh_get_damaskOptions(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + call mesh_build_cellconnectivity + if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) + mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) + if (myDebug) write(6,'(a)') ' Built cell nodes'; flush(6) + call mesh_build_ipCoordinates + if (myDebug) write(6,'(a)') ' Built IP coordinates'; flush(6) + call mesh_build_ipVolumes + if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) + call mesh_build_ipAreas + if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) + close (FILEUNIT) + +#if defined(Marc4DAMASK) || defined(Abaqus) + call mesh_build_nodeTwins + if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) + call mesh_build_sharedElems + if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) + call mesh_build_ipNeighborhood +#else + call mesh_spectral_build_ipNeighborhood +#endif + if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) + + if (worldrank == 0_pInt) then + call mesh_tell_statistics + endif + +#if defined(Marc4DAMASK) || defined(Abaqus) + if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements +#endif + 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 + +#if defined(Marc4DAMASK) || defined(Abaqus) + 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" +#endif + +!!!! COMPATIBILITY HACK !!!! +! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. +! hence, xxPerElem instead of maxXX + mesh_NipsPerElem = mesh_maxNips + mesh_NcellnodesPerElem = mesh_maxNcellnodes +! better name + mesh_homogenizationAt = mesh_element(3,:) + mesh_microstructureAt = mesh_element(4,:) + mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) +!!!!!!!!!!!!!!!!!!!!!!!! + +end subroutine mesh_init + + +#if defined(Marc4DAMASK) || defined(Abaqus) +!-------------------------------------------------------------------------------------------------- +!> @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) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),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) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP +#endif + +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(mesh_maxNcellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + 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) + +!-------------------------------------------------------------------------------------------------- +! 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 + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + localCellnode2globalCellnode = 0_pInt + 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 + 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 ... + 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 + 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 ... + 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 + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), 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) :: & + e,t,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) + do n = 1_pInt,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)) & + * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: e,t,g,c,i,m,f,n + real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + !$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 + 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 + 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 + 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))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + 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 + 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 + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,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)) & + 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)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: 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 + 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 + myCoords = 0.0_pReal + do n = 1_pInt,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) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), 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 + + t = mesh_element(2_pInt,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 + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) + enddo + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) + + end function mesh_cellCenterCoordinates + + +#ifdef Spectral +!-------------------------------------------------------------------------------------------------- +!> @brief Reads grid information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +function mesh_spectral_getGrid(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + integer(pInt), dimension(3) :: mesh_spectral_getGrid + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, j, myFileUnit + logical :: gotGrid = .false. + + mesh_spectral_getGrid = -1_pInt + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) + case ('grid') + gotGrid = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotGrid) & + call IO_error(error_ID = 845_pInt, ext_msg='grid') + if(any(mesh_spectral_getGrid < 1_pInt)) & + call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') + +end function mesh_spectral_getGrid + + +!-------------------------------------------------------------------------------------------------- +!> @brief Reads size information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +function mesh_spectral_getSize(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + real(pReal), dimension(3) :: mesh_spectral_getSize + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, j, myFileUnit + logical :: gotSize = .false. + + mesh_spectral_getSize = -1.0_pReal + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) + case ('size') + gotSize = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotSize) & + call IO_error(error_ID = 845_pInt, ext_msg='size') + if (any(mesh_spectral_getSize<=0.0_pReal)) & + call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') + +end function mesh_spectral_getSize + + +!-------------------------------------------------------------------------------------------------- +!> @brief Reads homogenization information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_spectral_getHomogenization(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, myFileUnit + logical :: gotHomogenization = .false. + + mesh_spectral_getHomogenization = -1_pInt + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) + case ('homogenization') + gotHomogenization = .true. + mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotHomogenization ) & + call IO_error(error_ID = 845_pInt, ext_msg='homogenization') + if (mesh_spectral_getHomogenization<1_pInt) & + call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') + +end function mesh_spectral_getHomogenization + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores them in +!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_count() + + implicit none + + mesh_NcpElems= product(grid(1:2))*grid3 + mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) + + mesh_NcpElemsGlobal = product(grid) + +end subroutine mesh_spectral_count + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. +!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_count_cpSizes + + implicit none + integer(pInt) :: t,g,c + + t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element + g = FE_geomtype(t) + c = FE_celltype(g) + + mesh_maxNips = FE_Nips(g) + mesh_maxNipNeighbors = FE_NipNeighbors(c) + mesh_maxNcellnodes = FE_Ncellnodes(g) + +end subroutine mesh_spectral_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_nodes() + + implicit none + integer(pInt) :: n + + allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) + allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) + + forall (n = 0_pInt:mesh_Nnodes-1_pInt) + mesh_node0(1,n+1_pInt) = mesh_unitlength * & + geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & + / real(grid(1),pReal) + mesh_node0(2,n+1_pInt) = mesh_unitlength * & + geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & + / real(grid(2),pReal) + mesh_node0(3,n+1_pInt) = mesh_unitlength * & + size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & + / real(grid3,pReal) + & + size3offset + end forall + + mesh_node = mesh_node0 + +end subroutine mesh_spectral_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, material, texture, and node list per element. +!! Allocates global array 'mesh_element' +!> @todo does the IO_error makes sense? +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_elements(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error, & + IO_continuousIntValues, & + IO_intValue, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: & + fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + e, i, & + headerLength = 0_pInt, & + maxDataPerLine, & + homog, & + elemType, & + elemOffset + integer(pInt), dimension(:), allocatable :: & + microstructures, & + microGlobal + integer(pInt), dimension(1,1) :: & + dummySet = 0_pInt + character(len=65536) :: & + line, & + keyword + character(len=64), dimension(1) :: & + dummyName = '' + + homog = mesh_spectral_getHomogenization(fileUnit) + +!-------------------------------------------------------------------------------------------------- +! get header length + call IO_checkAndRewind(fileUnit) + read(fileUnit,'(a65536)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') + endif + +!-------------------------------------------------------------------------------------------------- +! get maximum microstructure index + call IO_checkAndRewind(fileUnit) + do i = 1_pInt, headerLength + read(fileUnit,'(a65536)') line + enddo + + maxDataPerLine = 0_pInt + i = 1_pInt + + do while (i > 0_pInt) + i = IO_countContinuousIntValues(fileUnit) + maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? + enddo + allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) + allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size + allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) + +!-------------------------------------------------------------------------------------------------- +! read in microstructures + call IO_checkAndRewind(fileUnit) + do i=1_pInt,headerLength + read(fileUnit,'(a65536)') line + enddo + + e = 0_pInt + do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) + microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements + do i = 1_pInt,microstructures(1_pInt) + e = e+1_pInt ! valid element entry + microGlobal(e) = microstructures(1_pInt+i) + enddo + enddo + + elemType = FE_mapElemtype('C3D8R') + elemOffset = product(grid(1:2))*grid3Offset + e = 0_pInt + do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) + e = e+1_pInt ! valid element entry + mesh_element( 1,e) = -1_pInt ! DEPRECATED + mesh_element( 2,e) = elemType ! elem type + mesh_element( 3,e) = homog ! homogenization + mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure + mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & + ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node + mesh_element( 6,e) = mesh_element(5,e) + 1_pInt + mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt + mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt + mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node + mesh_element(10,e) = mesh_element(9,e) + 1_pInt + mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt + mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt + mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) + enddo + + if (e /= mesh_NcpElems) call IO_error(880_pInt,e) + +end subroutine mesh_spectral_build_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief build neighborhood relations for spectral +!> @details assign globals: mesh_ipNeighborhood +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_ipNeighborhood + + implicit none + integer(pInt) :: & + x,y,z, & + e + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) + + e = 0_pInt + do z = 0_pInt,grid3-1_pInt + do y = 0_pInt,grid(2)-1_pInt + do x = 0_pInt,grid(1)-1_pInt + e = e + 1_pInt + mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x+1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x-1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & + + modulo(y+1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & + + modulo(y-1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt + mesh_ipNeighborhood(3,1,1,e) = 2_pInt + mesh_ipNeighborhood(3,2,1,e) = 1_pInt + mesh_ipNeighborhood(3,3,1,e) = 4_pInt + mesh_ipNeighborhood(3,4,1,e) = 3_pInt + mesh_ipNeighborhood(3,5,1,e) = 6_pInt + mesh_ipNeighborhood(3,6,1,e) = 5_pInt + enddo + enddo + enddo + +end subroutine mesh_spectral_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) +!-------------------------------------------------------------------------------------------------- +function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) + use debug, only: & + debug_mesh, & + debug_level, & + debug_levelBasic + use math, only: & + math_mul33x3 + + implicit none + real(pReal), intent(in), dimension(:,:,:,:) :: & + centres + real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & + nodes + real(pReal), intent(in), dimension(3) :: & + gDim + real(pReal), intent(in), dimension(3,3) :: & + Favg + real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & + wrappedCentres + + integer(pInt) :: & + i,j,k,n + integer(pInt), dimension(3), parameter :: & + diag = 1_pInt + integer(pInt), dimension(3) :: & + shift = 0_pInt, & + lookup = 0_pInt, & + me = 0_pInt, & + iRes = 0_pInt + integer(pInt), dimension(3,8) :: & + neighbor = reshape([ & + 0_pInt, 0_pInt, 0_pInt, & + 1_pInt, 0_pInt, 0_pInt, & + 1_pInt, 1_pInt, 0_pInt, & + 0_pInt, 1_pInt, 0_pInt, & + 0_pInt, 0_pInt, 1_pInt, & + 1_pInt, 0_pInt, 1_pInt, & + 1_pInt, 1_pInt, 1_pInt, & + 0_pInt, 1_pInt, 1_pInt ], [3,8]) + +!-------------------------------------------------------------------------------------------------- +! initializing variables + iRes = [size(centres,2),size(centres,3),size(centres,4)] + nodes = 0.0_pReal + wrappedCentres = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! report + if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then + write(6,'(a)') ' Meshing cubes around centroids' + write(6,'(a,3(e12.5))') ' Dimension: ', gDim + write(6,'(a,3(i5))') ' Resolution:', iRes + endif + +!-------------------------------------------------------------------------------------------------- +! building wrappedCentres = centroids + ghosts + wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres + do k = 0_pInt,iRes(3)+1_pInt + do j = 0_pInt,iRes(2)+1_pInt + do i = 0_pInt,iRes(1)+1_pInt + if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin + j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin + i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin + me = [i,j,k] ! me on skin + shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) + lookup = me-diag+shift*iRes + wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & + centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & + - math_mul33x3(Favg, real(shift,pReal)*gDim) + endif + enddo; enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! averaging + do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) + do n = 1_pInt,8_pInt + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & + j+1_pInt+neighbor(2,n), & + k+1_pInt+neighbor(3,n) ) + enddo + enddo; enddo; enddo + nodes = nodes/8.0_pReal + +end function mesh_nodesAroundCentres +#endif + +#ifdef Marc4DAMASK +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out version of Marc input file format and stores ist as MarcVersion +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_fileFormat(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then + MarcVersion = IO_intValue(line,chunkPos,2_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_fileFormat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and +!! 'hypoelasticTableStyle' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_tableStyles(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + initialcondTableStyle = 0_pInt + hypoelasticTableStyle = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then + initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) + hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_tableStyles + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_matNumber(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i, j, data_blocks + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + + data_blocks = 1_pInt + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + read (fileUnit,610,END=620) line + if (len(trim(line))/=0_pInt) then + chunkPos = IO_stringPos(line) + data_blocks = IO_intValue(line,chunkPos,1_pInt) + endif + allocate(Marc_matNumber(data_blocks)) + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) + do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block + read (fileUnit,610,END=620) line + enddo + enddo + exit + endif + enddo + +620 end subroutine mesh_marc_get_matNumber + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores the numbers in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_nodesAndElements(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_IntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & + mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file + endif + enddo + +620 end subroutine mesh_marc_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- + subroutine mesh_marc_count_elementSets(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,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 + mesh_NelemSets = mesh_NelemSets + 1_pInt + mesh_maxNelemInSet = max(mesh_maxNelemInSet, & + IO_countContinuousIntValues(fileUnit)) + endif + enddo + +620 end subroutine mesh_marc_count_elementSets + + +!******************************************************************** +! map element sets +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!******************************************************************** +subroutine mesh_marc_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,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 + mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mesh_mapElemSet(:,elemSet) = & + IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + endif + enddo + +640 end subroutine mesh_marc_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues, & + IO_error, & + IO_intValue, & + IO_countNumericalDataLines + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i + character(len=300):: line + + mesh_NcpElems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + if (MarcVersion < 13) then ! Marc 2016 or earlier + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + read (fileUnit,610,END=620) line + enddo + mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update + exit + endif + enddo + else ! Marc2017 and later + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + endif + endif + enddo + end if + +620 end subroutine mesh_marc_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line, & + tmp + + integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,cpElem = 0_pInt + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + +610 FORMAT(A300) + + contInts = 0_pInt + rewind(fileUnit) + do + read (fileUnit,610,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+hypoelasticTableStyle ! skip three (or four if new table style!) lines + read (fileUnit,610,END=660) line + enddo + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& + mesh_mapElemSet,mesh_NelemSets) + exit + endif + else ! Marc2017 and later + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + exit + else + contInts(1) = contInts(1) + 1_pInt + read (tmp,*) contInts(contInts(1)+1) + endif + enddo + endif + endif + endif + enddo +660 do i = 1_pInt,contInts(1) + cpElem = cpElem+1_pInt + mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) + mesh_mapFEtoCPelem(2,cpElem) = cpElem + enddo + +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + +end subroutine mesh_marc_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt) :: i + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + +610 FORMAT(A300) + + node_count = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,610,END=650) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,610,END=650) line ! skip crap line + do i = 1_pInt,mesh_Nnodes + read (fileUnit,610,END=650) line + mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) + mesh_mapFEtoCPnode(2_pInt,i) = i + enddo + exit + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + +end subroutine mesh_marc_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_nodes(fileUnit) + + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue, & + IO_fixedNoEFloatValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=670) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,610,END=670) line ! skip crap line + do i=1_pInt,mesh_Nnodes + read (fileUnit,610,END=670) 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) + enddo + enddo + exit + endif + enddo + +670 mesh_node = mesh_node0 + +end subroutine mesh_marc_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_intValue, & + IO_skipChunks + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,t,g,e,c + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + +610 FORMAT(A300) + rewind(fileUnit) + do + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,610,END=630) line ! Garbage line + do i=1_pInt,mesh_Nelems ! read all elements + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) ! limit to id and type + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + endif + enddo + exit + endif + enddo + +630 end subroutine mesh_marc_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per element. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_fixedNoEFloatValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead + + allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,610,END=620) line ! garbage line + do i = 1_pInt,mesh_Nelems + read (fileUnit,610,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) & + 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 + enddo + nNodesAlreadyRead = chunkPos(1) - 2_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + exit + endif + enddo + +620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" + read (fileUnit,610,END=620) 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,610,END=620) line ! read extra line for new style + read (fileUnit,610,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 + read (fileUnit,610,END=620) 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 + mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index + if (initialcondTableStyle == 2_pInt) then + read (fileUnit,610,END=630) line ! read extra line + read (fileUnit,610,END=630) line ! read extra line + endif + contInts = IO_continuousIntValues& ! get affected elements + (fileUnit,mesh_NcpElems,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 + enddo + if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + enddo + endif + else + read (fileUnit,610,END=630) line + endif + enddo + +630 end subroutine mesh_marc_build_elements +#endif + +#ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores them in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_nodesAndElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical :: inPart + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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 (inPart .or. noPart) then + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) + 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' & + ) & + 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' & + ) then + mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) + endif + endselect + endif + enddo + +620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) + if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) + +end subroutine mesh_abaqus_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical :: inPart + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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 ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & + mesh_NelemSets = mesh_NelemSets + 1_pInt + enddo + +620 continue + if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) + +end subroutine mesh_abaqus_count_elementSets + + +!-------------------------------------------------------------------------------------------------- +! count overall number of solid sections sets in mesh (Abaqus only) +! +! mesh_Nmaterials +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical inPart + + mesh_Nmaterials = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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 ( (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 + enddo + +620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + +end subroutine mesh_abaqus_count_materials + + +!-------------------------------------------------------------------------------------------------- +! Build element set mapping +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt,i + logical :: inPart = .false. + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + +610 FORMAT(A300) + + + rewind(fileUnit) + do + read (fileUnit,610,END=640) 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 ( (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')) + mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& + mesh_mapElemSet,elemSet-1_pInt) + endif + enddo + +640 do i = 1_pInt,elemSet + if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) + enddo + +end subroutine mesh_abaqus_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +! map solid section (Abaqus only) +! +! allocate globals: mesh_nameMaterial, mesh_mapMaterial +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt) :: i,c = 0_pInt + logical :: inPart = .false. + character(len=64) :: elemSetName,materialName + + allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' + allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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 ( (inPart .or. noPart) .and. & + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then + + elemSetName = '' + materialName = '' + + do i = 3_pInt,chunkPos(1_pInt) + 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') /= '') & + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) + enddo + + if (elemSetName /= '' .and. materialName /= '') then + c = c + 1_pInt + mesh_nameMaterial(c) = materialName ! name of material used for this section + mesh_mapMaterial(c) = elemSetName ! mapped to respective element set + endif + endif + enddo + +620 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) + enddo + + end subroutine mesh_abaqus_map_materials + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error, & + IO_extractValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + integer(pInt) :: i,k + logical :: materialFound = .false. + character(len=64) ::materialName,elemSetName + + mesh_NcpElems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'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 (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 + if (elemSetName == mesh_nameElemSet(k)) & ! matched? + mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + +end subroutine mesh_abaqus_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) ::i,j,k,cpElem = 0_pInt + logical :: materialFound = .false. + character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'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 (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 + 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 + mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + + if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) + +end subroutine mesh_abaqus_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_intValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt) :: i,c,cpNode = 0_pInt + logical :: inPart = .false. + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=650) 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( (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' ) & + ) then + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,610,END=650) 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 + enddo + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + + if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) + +end subroutine mesh_abaqus_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_nodes(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_floatValue, & + IO_stringPos, & + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m,c + logical :: inPart + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=670) 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( (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' ) & + ) then + c = IO_countDataLines(fileUnit) ! how many nodes are defined here? + do i = 1_pInt,c + backspace(fileUnit) ! rewind to first entry + enddo + do i = 1_pInt,c + read (fileUnit,610,END=670) 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) + enddo + enddo + endif + enddo + +670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + mesh_node = mesh_node0 + +end subroutine mesh_abaqus_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue ,& + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,c,t,g + logical :: inPart + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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( (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' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + endif + enddo + +620 end subroutine mesh_abaqus_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per elemen. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_extractValue, & + IO_floatValue, & + IO_countDataLines, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + + integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead + logical inPart,materialFound + character (len=64) :: materialName,elemSetName + character(len=300) :: line + + allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) 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( (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' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,610,END=620) 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) & + 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: + enddo + nNodesAlreadyRead = chunkPos(1) - 1_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + endif + enddo + + +620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" + + materialFound = .false. + do + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & + materialFound ) then + read (fileUnit,610,END=630) 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 + 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 + if (elemSetName == mesh_nameElemSet(k)) then ! matched? + do j = 1_pInt,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 + mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +630 end subroutine mesh_abaqus_build_elements +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief get any additional damask options from input file, sets mesh_periodicSurface +!-------------------------------------------------------------------------------------------------- +subroutine mesh_get_damaskOptions(fileUnit) + +use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + +#ifdef Spectral + mesh_periodicSurface = .true. + + end subroutine mesh_get_damaskOptions + +#else + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) chunk, Nchunks + character(len=300) :: line, damaskOption, v + character(len=300) :: keyword + + mesh_periodicSurface = .false. +#ifdef Marc4DAMASK + keyword = '$damask' +#endif +#ifdef Abaqus + keyword = '**damask' +#endif + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Nchunks = chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + select case(damaskOption) + case('periodic') ! damask Option that allows to specify periodic fluxes + do chunk = 3_pInt,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' + mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' + enddo + endselect + endif + enddo + +610 FORMAT(A300) + +620 end subroutine mesh_get_damaskOptions +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipAreas + use math, only: & + math_crossproduct + + implicit none + integer(pInt) :: 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) + + !$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 + 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)) & + 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 + normal(3) = 0.0_pReal + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + 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)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal = math_crossproduct(nodePos(1:3,2) - nodePos(1:3,1), & + nodePos(1:3,3) - nodePos(1:3,1)) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (4_pInt) ! 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)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + normals(1:3,n) = 0.5_pReal & + * math_crossproduct(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & + nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) + normal = 0.5_pReal * sum(normals,2) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) + enddo + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipAreas + +#ifndef Spectral +!-------------------------------------------------------------------------------------------------- +!> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_nodeTwins + + implicit none + integer(pInt) 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 + 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 + + tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal + + do dir = 1_pInt,3_pInt ! 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 + minCoord = minval(mesh_node0(dir,:)) + maxCoord = maxval(mesh_node0(dir,:)) + do node = 1_pInt,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 + elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then + maximumNodes(1) = maximumNodes(1) + 1_pInt + maximumNodes(maximumNodes(1)+1_pInt) = node + endif + enddo + + + !*** 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) + if (unpaired(minimumNode)) then + do n2 = 1_pInt,maximumNodes(1) + maximumNode = maximumNodes(n2+1_pInt) + 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 + mesh_nodeTwins(dir,maximumNode) = minimumNode + unpaired(maximumNode) = .false. ! remember this node, we don't have to look for his partner again + exit + endif + enddo + endif + enddo + + endif + enddo + +end subroutine mesh_build_nodeTwins + + +!-------------------------------------------------------------------------------------------------- +!> @brief get maximum count of shared elements among cpElements and build list of elements shared +!! by each node in mesh. Allocate globals '_maxNsharedElems' and '_sharedElem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_sharedElems + + implicit none + integer(pint) e, & ! element index + g, & ! element type + node, & ! CP node index + 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 + + allocate(node_seen(maxval(FE_NmatchingNodes))) + + node_count = 0_pInt + + do e = 1_pInt,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 = 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... + 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 + enddo + endif + node_seen(n) = node ! remember this node to be counted already + enddo + enddo + + mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node + + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) + + do e = 1_pInt,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) + 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... + 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 + mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id + endif + enddo + endif + node_seen(n) = node + enddo + enddo + +end subroutine mesh_build_sharedElems + + +!-------------------------------------------------------------------------------------------------- +!> @brief build up of IP neighborhood, allocate globals '_ipNeighborhood' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipNeighborhood + use math, only: & + math_mul3x3 + + implicit none + integer(pInt) :: myElem, & ! my CP element index + myIP, & + myType, & ! my element type + myFace, & + neighbor, & ! neighor index + neighboringIPkey, & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element) + candidateIP, & + neighboringType, & ! element type of neighbor + NlinkedNodes, & ! number of linked nodes + twin_of_linkedNode, & ! node twin of a specific linkedNode + NmatchingNodes, & ! number of matching nodes + dir, & ! direction of periodicity + matchingElem, & ! CP elem number of matching element + matchingFace, & ! face ID of matching element + a, anchor, & + neighboringIP, & + neighboringElem, & + pointingToMe + integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & + linkedNodes = 0_pInt, & + matchingNodes + logical checkTwins + + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) + mesh_ipNeighborhood = 0_pInt + + + do myElem = 1_pInt,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 + 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 + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey + + + !*** 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 + 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? + neighboringType = FE_geomtype(mesh_element(2,matchingElem)) + + !*** trivial solution if neighbor has only one IP + + if (FE_Nips(neighboringType) == 1_pInt) then + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt + 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 + anchor = FE_nodesAtIP(a,myIP,myType) + if (anchor /= 0_pInt) 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 + else ! something went wrong with the linkage, since not all anchors sit on my face + NlinkedNodes = 0_pInt + linkedNodes = 0_pInt + exit + endif + endif + enddo + + !*** loop through the ips of my neighbor + !*** 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 + anchor = FE_nodesAtIP(a,candidateIP,neighboringType) + if (anchor /= 0_pInt) then ! valid anchor node + if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? + NmatchingNodes = NmatchingNodes + 1_pInt + 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 + exit + endif + endif + enddo + + if (NmatchingNodes /= NlinkedNodes) & ! this ip has wrong count of anchors on face + cycle checkCandidateIP + + !*** check "normal" nodes whether they match or not + + checkTwins = .false. + do a = 1_pInt,NlinkedNodes + if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode + checkTwins = .true. + exit ! no need to search further + endif + enddo + + !*** if no match found, then also check node twins + + 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 + twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) + if (twin_of_linkedNode == 0_pInt .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 + enddo + endif + + !*** we found a match !!! + + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = candidateIP + exit checkCandidateIP + enddo checkCandidateIP + endif ! end of valid external matching + endif ! end of internal/external matching + enddo + enddo + enddo + do myElem = 1_pInt,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 + 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 ... + 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 + 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),& + mesh_ipAreaNormal(1:3,pointingToMe,neighboringIP,neighboringElem)) < 0.0_pReal) then ! area normals have opposite orientation (we have to check that because of special case for single element with two ips and periodicity. In this case the neighbor is identical in two different directions.) + mesh_ipNeighborhood(3,neighbor,myIP,myElem) = pointingToMe ! found match + exit ! so no need to search further + endif + endif + enddo + endif + enddo + enddo + enddo + +end subroutine mesh_build_ipNeighborhood +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief write statistics regarding input file parsing to the output file +!-------------------------------------------------------------------------------------------------- +subroutine mesh_tell_statistics + use math, only: & + math_range + use IO, only: & + IO_error + use debug, only: & + debug_level, & + debug_MESH, & + debug_LEVELBASIC, & + debug_LEVELEXTENSIVE, & + debug_LEVELSELECTIVE, & + debug_e, & + debug_i + + implicit none + integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro + character(len=64) :: myFmt + integer(pInt) :: i,e,n,f,t,g,c, myDebug + + myDebug = debug_level(debug_mesh) + + if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified + if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified + + allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) + do e = 1_pInt,mesh_NcpElems + if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified + if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified + mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & + mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure + enddo +!$OMP CRITICAL (write2out) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) then + write(6,'(/,a,/)') ' Input Parser: STATISTICS' + write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' + write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' + write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' + write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' + write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' + write(6,*) + write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' + write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) + write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' + do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations + write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures + enddo + write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' + write(6,*) 'periodic surface : ', mesh_periodicSurface + write(6,*) + flush(6) + endif + + if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then + write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' + write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get elemType + g = FE_geomtype(t) ! get elemGeomType + c = FE_celltype(g) ! get cellType + write(6,'(i8,3(1x,i8))') e,t,g,c + enddo + write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' + write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) + write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + 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) + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) + do f = 1_pInt,FE_NipNeighbors(c) + write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) + enddo + enddo + enddo + write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' + write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + 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 of elem + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i2)') e,i + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell + write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & + mesh_cellnode(1:3,mesh_cell(n,i,e)) + enddo + enddo + enddo + write(6,'(/,a)') 'Input Parser: IP COORDINATES' + write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) + enddo + enddo +#ifndef Spectral + write(6,'(/,a,/)') 'Input Parser: NODE TWINS' + write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' + do n = 1_pInt,mesh_Nnodes ! loop over cpNodes + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle + write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) + enddo +#endif + write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' + write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + 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 of elem + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP + write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) + enddo + enddo + enddo + endif +!$OMP END CRITICAL (write2out) + +end subroutine mesh_tell_statistics + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( '6') + FE_mapElemtype = 1_pInt ! 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) + case ( '11', & + 'cpe4', & + 'cpe4t') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( '27', & + 'cpe8', & + 'cpe8t') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( '54') + FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration + case ( '134', & + 'c3d4', & + 'c3d4t') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( '157') + FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations + case ( '127') + FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron + case ( '136', & + 'c3d6', & + 'c3d6t') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( '117', & + '123', & + 'c3d8r', & + 'c3d8rt') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( '7', & + 'c3d8', & + 'c3d8t') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( '57', & + 'c3d20r', & + 'c3d20rt') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( '21', & + 'c3d20', & + 'c3d20t') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + + +!-------------------------------------------------------------------------------------------------- +!> @brief find face-matching element of same type +!-------------------------------------------------------------------------------------------------- +subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) + +implicit none +integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID + matchingFace ! matching face ID +integer(pInt), intent(in) :: face, & ! face ID + elem ! CP elem ID +integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & + myFaceNodes ! global node ids on my face +integer(pInt) :: myType, & + candidateType, & + candidateElem, & + candidateFace, & + candidateFaceNode, & + minNsharedElems, & + NsharedElems, & + lonelyNode = 0_pInt, & + i, & + n, & + dir ! periodicity direction +integer(pInt), 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 + +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 + if (NsharedElems < minNsharedElems) then + minNsharedElems = NsharedElems ! remember min # shared elems + lonelyNode = n ! remember most lonely node + endif +enddo + +allocate(element_seen(minNsharedElems)) +element_seen = 0_pInt + +checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements + candidateElem = mesh_sharedElem(1_pInt+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 + 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) + 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 + 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 + cycle checkCandidateFace + else + cycle checkCandidateFaceTwins ! try twins in next dimension + endif + endif + enddo + exit checkCandidateFaceTwins + enddo checkCandidateFaceTwins + endif + matchingFace = candidateFace + matchingElem = candidateElem + exit checkCandidate ! found my matching candidate + enddo checkCandidateFace + endif +enddo checkCandidate + +end subroutine mesh_faceMatch + + +!-------------------------------------------------------------------------------------------------- +!> @brief get properties of different types of finite elements +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!-------------------------------------------------------------------------------------------------- +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) + 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) + + + !*** fill FE_nodesAtIP with data *** + + me = 0_pInt + + me = me + 1_pInt + 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 + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, & + 2, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, & + 2, & + 4, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + 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 + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 1, & + 2, & + 3, & + 4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + 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 + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + reshape(int([& + 1,0, 0,0, & + 1,2, 0,0, & + 2,0, 0,0, & + 1,4, 0,0, & + 1,3, 2,4, & + 2,3, 0,0, & + 4,0, 0,0, & + 3,4, 0,0, & + 3,0, 0,0, & + 1,5, 0,0, & + 1,6, 2,5, & + 2,6, 0,0, & + 1,8, 4,5, & + 0,0, 0,0, & + 2,7, 3,6, & + 4,8, 0,0, & + 3,8, 4,7, & + 3,7, 0,0, & + 5,0, 0,0, & + 5,6, 0,0, & + 6,0, 0,0, & + 5,8, 0,0, & + 5,7, 6,8, & + 6,7, 0,0, & + 8,0, 0,0, & + 7,8, 0,0, & + 7,0, 0,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + + ! *** FE_ipNeighbor *** + ! is a list of the neighborhood of each IP. + ! 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 = me + 1_pInt + 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 + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 2,-4, 4,-1, & + 3, 1, 5,-1, & + -2, 2, 6,-1, & + 5,-4, 7, 1, & + 6, 4, 8, 2, & + -2, 5, 9, 3, & + 8,-4,-3, 4, & + 9, 7,-3, 5, & + -2, 8,-3, 6 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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 + 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, & + -2, 1, 3,-2, 4,-1, & + 2,-4,-3, 1, 4,-1, & + 2,-4, 3,-2,-3, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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, & + -3, 1, 3,-2, 5,-1, & + 2,-4,-3, 1, 6,-1, & + 5,-4, 6,-2,-5, 1, & + -3, 4, 6,-2,-5, 2, & + 5,-4,-3, 4,-5, 3 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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 + 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, & + -3, 1, 4,-2, 6,-1, & + 4,-5,-4, 1, 7,-1, & + -3, 3,-4, 2, 8,-1, & + 6,-5, 7,-2,-6, 1, & + -3, 5, 8,-2,-6, 2, & + 8,-5,-4, 5,-6, 3, & + -3, 7,-4, 6,-6, 4 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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, & + 3, 1, 5,-2,11,-1, & + -3, 2, 6,-2,12,-1, & + 5,-5, 7, 1,13,-1, & + 6, 4, 8, 2,14,-1, & + -3, 5, 9, 3,15,-1, & + 8,-5,-4, 4,16,-1, & + 9, 7,-4, 5,17,-1, & + -3, 8,-4, 6,18,-1, & + 11,-5,13,-2,19, 1, & + 12,10,14,-2,20, 2, & + -3,11,15,-2,21, 3, & + 14,-5,16,10,22, 4, & + 15,13,17,11,23, 5, & + -3,14,18,12,24, 6, & + 17,-5,-4,13,25, 7, & + 18,16,-4,14,26, 8, & + -3,17,-4,15,27, 9, & + 20,-5,22,-2,-6,10, & + 21,19,23,-2,-6,11, & + -3,20,24,-2,-6,12, & + 23,-5,25,19,-6,13, & + 24,22,26,20,-6,14, & + -3,23,27,21,-6,15, & + 26,-5,-4,22,-6,16, & + 27,25,-4,23,-6,17, & + -3,26,-4,24,-6,18 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cell *** + me = 0_pInt + + me = me + 1_pInt + 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 + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1, 5,13,12, & + 5, 6,14,13, & + 6, 2, 7,14, & + 12,13,16,11, & + 13,14,15,16, & + 14, 7, 8,15, & + 11,16,10, 4, & + 16,15, 9,10, & + 15, 8, 3, 9 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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 + 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, & + 5, 2, 6,11,12, 9,13,15, & + 7,11, 6, 3,14,15,13,10, & + 8,12,15, 4, 4, 9,13,10 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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, & + 7, 2, 8,16,17,11,18,21, & + 9,16, 8, 3,19,21,18,12, & + 10,17,21,19, 4,13,20,15, & + 17,11,18,21,13, 5,14,20, & + 19,21,18,12,15,20,14, 6 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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 + 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, & + 9, 2,10,21,22,14,23,27, & + 12,21,11, 4,25,27,24,16, & + 21,10, 3,11,27,23,15,24, & + 13,22,27,25, 5,17,26,20, & + 22,14,23,27,17, 6,18,26, & + 25,27,24,16,20,26,19, 8, & + 27,23,15,24,26,18, 7,19 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + 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, & + 9,10,34,33,37,38,58,57, & + 10, 2,11,34,38,18,39,58, & + 16,33,36,15,44,57,60,43, & + 33,34,35,36,57,58,59,60, & + 34,11,12,35,58,39,40,59, & + 15,36,14, 4,43,60,42,20, & + 36,35,13,14,60,59,41,42, & + 35,12, 3,13,59,40,19,41, & + 17,37,57,44,21,45,61,52, & + 37,38,58,57,45,46,62,61, & + 38,18,39,58,46,22,47,62, & + 44,57,60,43,52,61,64,51, & + 57,58,59,60,61,62,63,64, & + 58,39,40,59,62,47,48,63, & + 43,60,42,20,51,64,50,24, & + 60,59,41,42,64,63,49,50, & + 59,40,19,41,63,48,23,49, & + 21,45,61,52, 5,25,53,32, & + 45,46,62,61,25,26,54,53, & + 46,22,47,62,26, 6,27,54, & + 52,61,64,51,32,53,56,31, & + 61,62,63,64,53,54,55,56, & + 62,47,48,63,54,27,28,55, & + 51,64,50,24,31,56,30, 8, & + 64,63,49,50,56,55,29,30, & + 63,48,23,49,55,28, 7,29 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cellnodeParentnodeWeights *** + ! center of gravity of the weighted nodes gives the position of the cell node. + ! fill with 0. + ! 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 = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) + reshape(real([& + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 2, 2, 2 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1, & + 1, 1, 0, 0, & + 0, 1, 1, 0, & + 0, 0, 1, 1, & + 1, 0, 0, 1, & + 1, 1, 1, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 1, 0, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 0, 2, & + 1, 0, 0, 0, 0, 0, 0, 2, & + 4, 1, 1, 1, 8, 2, 2, 8, & + 1, 4, 1, 1, 8, 8, 2, 2, & + 1, 1, 4, 1, 2, 8, 8, 2, & + 1, 1, 1, 4, 2, 2, 8, 8 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 1, 2, 2, 2, 2 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, & + 0, 0, 1, 0, 0, & + 0, 0, 0, 1, 0, & + 1, 1, 0, 0, 0, & + 0, 1, 1, 0, 0, & + 1, 0, 1, 0, 0, & + 1, 0, 0, 1, 0, & + 0, 1, 0, 1, 0, & + 0, 0, 1, 1, 0, & + 1, 1, 1, 0, 0, & + 1, 1, 0, 1, 0, & + 0, 1, 1, 1, 0, & + 1, 0, 1, 1, 0, & + 0, 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & + 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & + 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & + 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & + 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 0, 0, 0, 0, & + 0, 1, 1, 0, 0, 0, & + 1, 0, 1, 0, 0, 0, & + 1, 0, 0, 1, 0, 0, & + 0, 1, 0, 0, 1, 0, & + 0, 0, 1, 0, 0, 1, & + 0, 0, 0, 1, 1, 0, & + 0, 0, 0, 0, 1, 1, & + 0, 0, 0, 1, 0, 1, & + 1, 1, 1, 0, 0, 0, & + 1, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 1, & + 1, 0, 1, 1, 0, 1, & + 0, 0, 0, 1, 1, 1, & + 1, 1, 1, 1, 1, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & ! + 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, & ! + 1, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 1, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 1, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 1, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 1, & ! + 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, & ! + 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, & ! + 1, 1, 1, 1, 1, 1, 1, 1 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + 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, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! + 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! + 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 + 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, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 + 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! + 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 + 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! + 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! + 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! + 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 + 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! + 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 + 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! + 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! + 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 + 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! + 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! + 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! + 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! + 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 + 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! + 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! + 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! + 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + + + ! *** FE_cellface *** + me = 0_pInt + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) + reshape(int([& + 2,3, & + 3,1, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) + reshape(int([& + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) + reshape(int([& + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) + reshape(int([& + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + +end subroutine mesh_build_FEdata + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns global variable mesh_Ncellnodes +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_Ncellnodes() + + implicit none + + mesh_get_Ncellnodes = mesh_Ncellnodes + +end function mesh_get_Ncellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns global variable mesh_unitlength +!-------------------------------------------------------------------------------------------------- +real(pReal) function mesh_get_unitlength() + + implicit none + + mesh_get_unitlength = mesh_unitlength + +end function mesh_get_unitlength + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns node that is located at an ip +!> @details return zero if requested ip does not exist or not available (more ips than nodes) +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) + + implicit none + character(len=*), intent(in) :: elemtypeFE + integer(pInt), intent(in) :: ip + integer(pInt) :: elemtype + integer(pInt) :: geomtype + + mesh_get_nodeAtIP = 0_pInt + + elemtype = FE_mapElemtype(elemtypeFE) + geomtype = FE_geomtype(elemtype) + if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & + mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) + +end function mesh_get_nodeAtIP + + +end module mesh From 012759d0360a92ff8b10d1cf4f9740b9f4201a0f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:04:43 +0100 Subject: [PATCH 006/154] remove non-marc specific code --- src/mesh_marc.f90 | 1520 +-------------------------------------------- 1 file changed, 5 insertions(+), 1515 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index e55165d51..b993b43d6 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -62,11 +62,9 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) -#if defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_maxNelemInSet, & mesh_Nmaterials -#endif integer(pInt), dimension(2), private :: & mesh_maxValStateVar = 0_pInt @@ -344,19 +342,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) -#if defined(Spectral) - integer(pInt), dimension(3), public, protected :: & - grid !< (global) grid - integer(pInt), public, protected :: & - mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh - grid3, & !< (local) grid in 3rd direction - grid3Offset !< (local) grid offset in 3rd direction - real(pReal), dimension(3), public, protected :: & - geomSize - real(pReal), public, protected :: & - size3, & !< (local) size in 3rd direction - size3offset !< (local) size offset in 3rd direction -#elif defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element @@ -370,17 +355,14 @@ integer(pInt), dimension(:,:), allocatable, private :: & integer(pInt), dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] -#endif -#if defined(Marc4DAMASK) + + integer(pInt), private :: & MarcVersion, & !< Version of input file format (Marc only) hypoelasticTableStyle, & !< Table style (Marc only) initialcondTableStyle !< Table style (Marc only) integer(pInt), dimension(:), allocatable, private :: & Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) -#elif defined(Abaqus) - logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information -#endif public :: & mesh_init, & @@ -391,12 +373,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_Ncellnodes, & mesh_get_unitlength, & mesh_get_nodeAtIP, & -#if defined(Spectral) - mesh_spectral_getGrid, & - mesh_spectral_getSize -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_FEasCP -#endif + private :: & mesh_get_damaskOptions, & @@ -406,19 +384,9 @@ integer(pInt), dimension(:,:), allocatable, private :: & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & -#if defined(Spectral) - mesh_spectral_getHomogenization, & - mesh_spectral_count, & - mesh_spectral_count_cpSizes, & - mesh_spectral_build_nodes, & - mesh_spectral_build_elements, & - mesh_spectral_build_ipNeighborhood -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_build_nodeTwins, & mesh_build_sharedElems, & mesh_build_ipNeighborhood, & -#endif -#if defined(Marc4DAMASK) mesh_marc_get_fileFormat, & mesh_marc_get_tableStyles, & mesh_marc_get_matNumber, & @@ -431,19 +399,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_build_nodes, & mesh_marc_count_cpSizes, & mesh_marc_build_elements -#elif defined(Abaqus) - mesh_abaqus_count_nodesAndElements, & - mesh_abaqus_count_elementSets, & - mesh_abaqus_count_materials, & - mesh_abaqus_map_elementSets, & - mesh_abaqus_map_materials, & - mesh_abaqus_count_cpElements, & - mesh_abaqus_map_elements, & - mesh_abaqus_map_nodes, & - mesh_abaqus_build_nodes, & - mesh_abaqus_count_cpSizes, & - mesh_abaqus_build_elements -#endif contains @@ -457,22 +412,10 @@ subroutine mesh_init(ip,el) use, intrinsic :: iso_fortran_env, only: & compiler_version, & compiler_options -#endif -#ifdef Spectral -#include - use PETScsys #endif use DAMASK_interface use IO, only: & -#ifdef Abaqus - IO_abaqus_hasNoPart, & -#endif -#ifdef Spectral - IO_open_file, & - IO_error, & -#else IO_open_InputFile, & -#endif IO_timeStamp, & IO_error, & IO_write_jobFile @@ -487,19 +430,12 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral modelName, & calcMode, & -#endif FEsolving_execElem, & FEsolving_execIP implicit none -#ifdef Spectral - include 'fftw3-mpi.f03' - integer(C_INTPTR_T) :: devNull, local_K, local_K_offset - integer :: ierr, worldsize -#endif integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j @@ -514,36 +450,6 @@ subroutine mesh_init(ip,el) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) -#ifdef Spectral - call fftw_mpi_init() - call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... - if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) - grid = mesh_spectral_getGrid(fileUnit) - call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') - if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') - - geomSize = mesh_spectral_getSize(fileUnit) - devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & - int(grid(2),C_INTPTR_T), & - int(grid(1),C_INTPTR_T)/2+1, & - PETSC_COMM_WORLD, & - local_K, & ! domain grid size along z - local_K_offset) ! domain grid offset along z - grid3 = int(local_K,pInt) - grid3Offset = int(local_K_offset,pInt) - size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) - size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) - if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) - call mesh_spectral_count() - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_spectral_count_cpSizes - if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) - call mesh_spectral_build_nodes() - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_spectral_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Marc4DAMASK call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) call mesh_marc_get_fileFormat(FILEUNIT) @@ -572,33 +478,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Abaqus - call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... - if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - noPart = IO_abaqus_hasNoPart(FILEUNIT) - call mesh_abaqus_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_abaqus_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_abaqus_count_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) - call mesh_abaqus_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_abaqus_map_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) - call mesh_abaqus_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_abaqus_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_abaqus_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_abaqus_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_abaqus_count_cpSizes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) - call mesh_abaqus_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#endif call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) @@ -614,25 +493,16 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) close (FILEUNIT) -#if defined(Marc4DAMASK) || defined(Abaqus) + call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) call mesh_build_ipNeighborhood -#else - call mesh_spectral_build_ipNeighborhood -#endif if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (worldrank == 0_pInt) then - call mesh_tell_statistics - endif - -#if defined(Marc4DAMASK) || defined(Abaqus) if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements -#endif 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)))) & @@ -642,11 +512,9 @@ subroutine mesh_init(ip,el) 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 -#if defined(Marc4DAMASK) || defined(Abaqus) 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" -#endif !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. @@ -662,7 +530,6 @@ subroutine mesh_init(ip,el) end subroutine mesh_init -#if defined(Marc4DAMASK) || defined(Abaqus) !-------------------------------------------------------------------------------------------------- !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' @@ -711,7 +578,6 @@ integer(pInt) function mesh_FEasCP(what,myID) enddo binarySearch end function mesh_FEasCP -#endif !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -953,548 +819,6 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -#ifdef Spectral -!-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getGrid(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), dimension(3) :: mesh_spectral_getGrid - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotGrid = .false. - - mesh_spectral_getGrid = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) - case ('grid') - gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotGrid) & - call IO_error(error_ID = 845_pInt, ext_msg='grid') - if(any(mesh_spectral_getGrid < 1_pInt)) & - call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') - -end function mesh_spectral_getGrid - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getSize(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - real(pReal), dimension(3) :: mesh_spectral_getSize - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotSize = .false. - - mesh_spectral_getSize = -1.0_pReal - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('size') - gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotSize) & - call IO_error(error_ID = 845_pInt, ext_msg='size') - if (any(mesh_spectral_getSize<=0.0_pReal)) & - call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') - -end function mesh_spectral_getSize - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, myFileUnit - logical :: gotHomogenization = .false. - - mesh_spectral_getHomogenization = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('homogenization') - gotHomogenization = .true. - mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotHomogenization ) & - call IO_error(error_ID = 845_pInt, ext_msg='homogenization') - if (mesh_spectral_getHomogenization<1_pInt) & - call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - -end function mesh_spectral_getHomogenization - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count() - - implicit none - - mesh_NcpElems= product(grid(1:2))*grid3 - mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) - - mesh_NcpElemsGlobal = product(grid) - -end subroutine mesh_spectral_count - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count_cpSizes - - implicit none - integer(pInt) :: t,g,c - - t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element - g = FE_geomtype(t) - c = FE_celltype(g) - - mesh_maxNips = FE_Nips(g) - mesh_maxNipNeighbors = FE_NipNeighbors(c) - mesh_maxNcellnodes = FE_Ncellnodes(g) - -end subroutine mesh_spectral_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_nodes() - - implicit none - integer(pInt) :: n - - allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) - allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) - - forall (n = 0_pInt:mesh_Nnodes-1_pInt) - mesh_node0(1,n+1_pInt) = mesh_unitlength * & - geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & - / real(grid(1),pReal) - mesh_node0(2,n+1_pInt) = mesh_unitlength * & - geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & - / real(grid(2),pReal) - mesh_node0(3,n+1_pInt) = mesh_unitlength * & - size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & - / real(grid3,pReal) + & - size3offset - end forall - - mesh_node = mesh_node0 - -end subroutine mesh_spectral_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, material, texture, and node list per element. -!! Allocates global array 'mesh_element' -!> @todo does the IO_error makes sense? -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_elements(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_continuousIntValues, & - IO_intValue, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: & - fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - e, i, & - headerLength = 0_pInt, & - maxDataPerLine, & - homog, & - elemType, & - elemOffset - integer(pInt), dimension(:), allocatable :: & - microstructures, & - microGlobal - integer(pInt), dimension(1,1) :: & - dummySet = 0_pInt - character(len=65536) :: & - line, & - keyword - character(len=64), dimension(1) :: & - dummyName = '' - - homog = mesh_spectral_getHomogenization(fileUnit) - -!-------------------------------------------------------------------------------------------------- -! get header length - call IO_checkAndRewind(fileUnit) - read(fileUnit,'(a65536)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') - endif - -!-------------------------------------------------------------------------------------------------- -! get maximum microstructure index - call IO_checkAndRewind(fileUnit) - do i = 1_pInt, headerLength - read(fileUnit,'(a65536)') line - enddo - - maxDataPerLine = 0_pInt - i = 1_pInt - - do while (i > 0_pInt) - i = IO_countContinuousIntValues(fileUnit) - maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? - enddo - allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) - allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size - allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) - -!-------------------------------------------------------------------------------------------------- -! read in microstructures - call IO_checkAndRewind(fileUnit) - do i=1_pInt,headerLength - read(fileUnit,'(a65536)') line - enddo - - e = 0_pInt - do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) - microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements - do i = 1_pInt,microstructures(1_pInt) - e = e+1_pInt ! valid element entry - microGlobal(e) = microstructures(1_pInt+i) - enddo - enddo - - elemType = FE_mapElemtype('C3D8R') - elemOffset = product(grid(1:2))*grid3Offset - e = 0_pInt - do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) - e = e+1_pInt ! valid element entry - mesh_element( 1,e) = -1_pInt ! DEPRECATED - mesh_element( 2,e) = elemType ! elem type - mesh_element( 3,e) = homog ! homogenization - mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure - mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & - ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node - mesh_element( 6,e) = mesh_element(5,e) + 1_pInt - mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt - mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt - mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node - mesh_element(10,e) = mesh_element(9,e) + 1_pInt - mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt - mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) - enddo - - if (e /= mesh_NcpElems) call IO_error(880_pInt,e) - -end subroutine mesh_spectral_build_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief build neighborhood relations for spectral -!> @details assign globals: mesh_ipNeighborhood -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_ipNeighborhood - - implicit none - integer(pInt) :: & - x,y,z, & - e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) - - e = 0_pInt - do z = 0_pInt,grid3-1_pInt - do y = 0_pInt,grid(2)-1_pInt - do x = 0_pInt,grid(1)-1_pInt - e = e + 1_pInt - mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x+1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x-1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & - + modulo(y+1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & - + modulo(y-1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt - mesh_ipNeighborhood(3,1,1,e) = 2_pInt - mesh_ipNeighborhood(3,2,1,e) = 1_pInt - mesh_ipNeighborhood(3,3,1,e) = 4_pInt - mesh_ipNeighborhood(3,4,1,e) = 3_pInt - mesh_ipNeighborhood(3,5,1,e) = 6_pInt - mesh_ipNeighborhood(3,6,1,e) = 5_pInt - enddo - enddo - enddo - -end subroutine mesh_spectral_build_ipNeighborhood - - -!-------------------------------------------------------------------------------------------------- -!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) -!-------------------------------------------------------------------------------------------------- -function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) - use debug, only: & - debug_mesh, & - debug_level, & - debug_levelBasic - use math, only: & - math_mul33x3 - - implicit none - real(pReal), intent(in), dimension(:,:,:,:) :: & - centres - real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & - nodes - real(pReal), intent(in), dimension(3) :: & - gDim - real(pReal), intent(in), dimension(3,3) :: & - Favg - real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & - wrappedCentres - - integer(pInt) :: & - i,j,k,n - integer(pInt), dimension(3), parameter :: & - diag = 1_pInt - integer(pInt), dimension(3) :: & - shift = 0_pInt, & - lookup = 0_pInt, & - me = 0_pInt, & - iRes = 0_pInt - integer(pInt), dimension(3,8) :: & - neighbor = reshape([ & - 0_pInt, 0_pInt, 0_pInt, & - 1_pInt, 0_pInt, 0_pInt, & - 1_pInt, 1_pInt, 0_pInt, & - 0_pInt, 1_pInt, 0_pInt, & - 0_pInt, 0_pInt, 1_pInt, & - 1_pInt, 0_pInt, 1_pInt, & - 1_pInt, 1_pInt, 1_pInt, & - 0_pInt, 1_pInt, 1_pInt ], [3,8]) - -!-------------------------------------------------------------------------------------------------- -! initializing variables - iRes = [size(centres,2),size(centres,3),size(centres,4)] - nodes = 0.0_pReal - wrappedCentres = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! report - if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then - write(6,'(a)') ' Meshing cubes around centroids' - write(6,'(a,3(e12.5))') ' Dimension: ', gDim - write(6,'(a,3(i5))') ' Resolution:', iRes - endif - -!-------------------------------------------------------------------------------------------------- -! building wrappedCentres = centroids + ghosts - wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres - do k = 0_pInt,iRes(3)+1_pInt - do j = 0_pInt,iRes(2)+1_pInt - do i = 0_pInt,iRes(1)+1_pInt - if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin - j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin - i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin - me = [i,j,k] ! me on skin - shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) - lookup = me-diag+shift*iRes - wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & - centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & - - math_mul33x3(Favg, real(shift,pReal)*gDim) - endif - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! averaging - do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) - do n = 1_pInt,8_pInt - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & - j+1_pInt+neighbor(2,n), & - k+1_pInt+neighbor(3,n) ) - enddo - enddo; enddo; enddo - nodes = nodes/8.0_pReal - -end function mesh_nodesAroundCentres -#endif - -#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief Figures out version of Marc input file format and stores ist as MarcVersion !-------------------------------------------------------------------------------------------------- @@ -2105,693 +1429,6 @@ subroutine mesh_marc_build_elements(fileUnit) enddo 630 end subroutine mesh_marc_build_elements -#endif - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_nodesAndElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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 (inPart .or. noPart) then - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) - 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' & - ) & - 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' & - ) then - mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) - endif - endselect - endif - enddo - -620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) - if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) - -end subroutine mesh_abaqus_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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 ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & - mesh_NelemSets = mesh_NelemSets + 1_pInt - enddo - -620 continue - if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) - -end subroutine mesh_abaqus_count_elementSets - - -!-------------------------------------------------------------------------------------------------- -! count overall number of solid sections sets in mesh (Abaqus only) -! -! mesh_Nmaterials -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical inPart - - mesh_Nmaterials = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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 ( (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 - enddo - -620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) - -end subroutine mesh_abaqus_count_materials - - -!-------------------------------------------------------------------------------------------------- -! Build element set mapping -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt,i - logical :: inPart = .false. - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) - -610 FORMAT(A300) - - - rewind(fileUnit) - do - read (fileUnit,610,END=640) 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 ( (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')) - mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& - mesh_mapElemSet,elemSet-1_pInt) - endif - enddo - -640 do i = 1_pInt,elemSet - if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) - enddo - -end subroutine mesh_abaqus_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -! map solid section (Abaqus only) -! -! allocate globals: mesh_nameMaterial, mesh_mapMaterial -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c = 0_pInt - logical :: inPart = .false. - character(len=64) :: elemSetName,materialName - - allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' - allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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 ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then - - elemSetName = '' - materialName = '' - - do i = 3_pInt,chunkPos(1_pInt) - 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') /= '') & - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) - enddo - - if (elemSetName /= '' .and. materialName /= '') then - c = c + 1_pInt - mesh_nameMaterial(c) = materialName ! name of material used for this section - mesh_mapMaterial(c) = elemSetName ! mapped to respective element set - endif - endif - enddo - -620 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) - enddo - - end subroutine mesh_abaqus_map_materials - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_extractValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - integer(pInt) :: i,k - logical :: materialFound = .false. - character(len=64) ::materialName,elemSetName - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'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 (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 - if (elemSetName == mesh_nameElemSet(k)) & ! matched? - mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) - -end subroutine mesh_abaqus_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) ::i,j,k,cpElem = 0_pInt - logical :: materialFound = .false. - character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'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 (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 - 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 - mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - - if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) - -end subroutine mesh_abaqus_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_intValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c,cpNode = 0_pInt - logical :: inPart = .false. - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=650) 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( (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' ) & - ) then - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=650) 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 - enddo - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - - if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) - -end subroutine mesh_abaqus_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_nodes(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_floatValue, & - IO_stringPos, & - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m,c - logical :: inPart - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=670) 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( (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' ) & - ) then - c = IO_countDataLines(fileUnit) ! how many nodes are defined here? - do i = 1_pInt,c - backspace(fileUnit) ! rewind to first entry - enddo - do i = 1_pInt,c - read (fileUnit,610,END=670) 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) - enddo - enddo - endif - enddo - -670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) - mesh_node = mesh_node0 - -end subroutine mesh_abaqus_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue ,& - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,c,t,g - logical :: inPart - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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( (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' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - endif - enddo - -620 end subroutine mesh_abaqus_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per elemen. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_extractValue, & - IO_floatValue, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - - integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead - logical inPart,materialFound - character (len=64) :: materialName,elemSetName - character(len=300) :: line - - allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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( (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' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=620) 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) & - 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: - enddo - nNodesAlreadyRead = chunkPos(1) - 1_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - endif - enddo - - -620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" - - materialFound = .false. - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & - materialFound ) then - read (fileUnit,610,END=630) 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 - 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 - if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,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 - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -630 end subroutine mesh_abaqus_build_elements -#endif !-------------------------------------------------------------------------------------------------- @@ -2807,12 +1444,6 @@ use IO, only: & implicit none integer(pInt), intent(in) :: fileUnit -#ifdef Spectral - mesh_periodicSurface = .true. - - end subroutine mesh_get_damaskOptions - -#else integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) chunk, Nchunks @@ -2820,12 +1451,7 @@ use IO, only: & character(len=300) :: keyword mesh_periodicSurface = .false. -#ifdef Marc4DAMASK keyword = '$damask' -#endif -#ifdef Abaqus - keyword = '**damask' -#endif rewind(fileUnit) do @@ -2849,7 +1475,6 @@ use IO, only: & 610 FORMAT(A300) 620 end subroutine mesh_get_damaskOptions -#endif !-------------------------------------------------------------------------------------------------- @@ -2925,7 +1550,7 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral + !-------------------------------------------------------------------------------------------------- !> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' !-------------------------------------------------------------------------------------------------- @@ -3227,141 +1852,6 @@ subroutine mesh_build_ipNeighborhood enddo end subroutine mesh_build_ipNeighborhood -#endif - - -!-------------------------------------------------------------------------------------------------- -!> @brief write statistics regarding input file parsing to the output file -!-------------------------------------------------------------------------------------------------- -subroutine mesh_tell_statistics - use math, only: & - math_range - use IO, only: & - IO_error - use debug, only: & - debug_level, & - debug_MESH, & - debug_LEVELBASIC, & - debug_LEVELEXTENSIVE, & - debug_LEVELSELECTIVE, & - debug_e, & - debug_i - - implicit none - integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro - character(len=64) :: myFmt - integer(pInt) :: i,e,n,f,t,g,c, myDebug - - myDebug = debug_level(debug_mesh) - - if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified - if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified - - allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) - do e = 1_pInt,mesh_NcpElems - if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified - if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure - enddo -!$OMP CRITICAL (write2out) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - write(6,'(/,a,/)') ' Input Parser: STATISTICS' - write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' - write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' - write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' - write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' - write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' - write(6,*) - write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) - write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations - write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures - enddo - write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' - write(6,*) 'periodic surface : ', mesh_periodicSurface - write(6,*) - flush(6) - endif - - if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' - write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get elemType - g = FE_geomtype(t) ! get elemGeomType - c = FE_celltype(g) ! get cellType - write(6,'(i8,3(1x,i8))') e,t,g,c - enddo - write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' - write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) - write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - 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) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) - do f = 1_pInt,FE_NipNeighbors(c) - write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) - enddo - enddo - enddo - write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' - write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - 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 of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i2)') e,i - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell - write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & - mesh_cellnode(1:3,mesh_cell(n,i,e)) - enddo - enddo - enddo - write(6,'(/,a)') 'Input Parser: IP COORDINATES' - write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) - enddo - enddo -#ifndef Spectral - write(6,'(/,a,/)') 'Input Parser: NODE TWINS' - write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' - do n = 1_pInt,mesh_Nnodes ! loop over cpNodes - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle - write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) - enddo -#endif - write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' - write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - 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 of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP - write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) - enddo - enddo - enddo - endif -!$OMP END CRITICAL (write2out) - -end subroutine mesh_tell_statistics !-------------------------------------------------------------------------------------------------- From f6cd37f11adadd55175a094c8c987eac517228c4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:12:27 +0100 Subject: [PATCH 007/154] removing non-grid(spectral) related functionality --- src/mesh_grid.f90 | 2001 +-------------------------------------------- 1 file changed, 7 insertions(+), 1994 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index e55165d51..7cf7a1e64 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -62,12 +62,6 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) -#if defined(Marc4DAMASK) || defined(Abaqus) - integer(pInt), private :: & - mesh_maxNelemInSet, & - mesh_Nmaterials -#endif - integer(pInt), dimension(2), private :: & mesh_maxValStateVar = 0_pInt @@ -344,7 +338,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) -#if defined(Spectral) + integer(pInt), dimension(3), public, protected :: & grid !< (global) grid integer(pInt), public, protected :: & @@ -356,31 +350,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & real(pReal), public, protected :: & size3, & !< (local) size in 3rd direction size3offset !< (local) size offset in 3rd direction -#elif defined(Marc4DAMASK) || defined(Abaqus) - integer(pInt), 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 - character(len=64), 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 :: & - mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(:,:), allocatable, target, private :: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] -#endif -#if defined(Marc4DAMASK) - integer(pInt), private :: & - MarcVersion, & !< Version of input file format (Marc only) - hypoelasticTableStyle, & !< Table style (Marc only) - initialcondTableStyle !< Table style (Marc only) - integer(pInt), dimension(:), allocatable, private :: & - Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) -#elif defined(Abaqus) - logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information -#endif public :: & mesh_init, & @@ -391,59 +360,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_Ncellnodes, & mesh_get_unitlength, & mesh_get_nodeAtIP, & -#if defined(Spectral) + mesh_spectral_getGrid, & mesh_spectral_getSize -#elif defined(Marc4DAMASK) || defined(Abaqus) - mesh_FEasCP -#endif private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_tell_statistics, & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & -#if defined(Spectral) mesh_spectral_getHomogenization, & mesh_spectral_count, & mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood -#elif defined(Marc4DAMASK) || defined(Abaqus) - mesh_build_nodeTwins, & - mesh_build_sharedElems, & - mesh_build_ipNeighborhood, & -#endif -#if defined(Marc4DAMASK) - mesh_marc_get_fileFormat, & - mesh_marc_get_tableStyles, & - mesh_marc_get_matNumber, & - mesh_marc_count_nodesAndElements, & - mesh_marc_count_elementSets, & - mesh_marc_map_elementSets, & - mesh_marc_count_cpElements, & - mesh_marc_map_Elements, & - mesh_marc_map_nodes, & - mesh_marc_build_nodes, & - mesh_marc_count_cpSizes, & - mesh_marc_build_elements -#elif defined(Abaqus) - mesh_abaqus_count_nodesAndElements, & - mesh_abaqus_count_elementSets, & - mesh_abaqus_count_materials, & - mesh_abaqus_map_elementSets, & - mesh_abaqus_map_materials, & - mesh_abaqus_count_cpElements, & - mesh_abaqus_map_elements, & - mesh_abaqus_map_nodes, & - mesh_abaqus_build_nodes, & - mesh_abaqus_count_cpSizes, & - mesh_abaqus_build_elements -#endif + contains @@ -458,21 +392,14 @@ subroutine mesh_init(ip,el) compiler_version, & compiler_options #endif -#ifdef Spectral + #include use PETScsys -#endif + use DAMASK_interface use IO, only: & -#ifdef Abaqus - IO_abaqus_hasNoPart, & -#endif -#ifdef Spectral IO_open_file, & IO_error, & -#else - IO_open_InputFile, & -#endif IO_timeStamp, & IO_error, & IO_write_jobFile @@ -487,19 +414,13 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral - modelName, & - calcMode, & -#endif FEsolving_execElem, & FEsolving_execIP implicit none -#ifdef Spectral include 'fftw3-mpi.f03' integer(C_INTPTR_T) :: devNull, local_K, local_K_offset integer :: ierr, worldsize -#endif integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j @@ -514,7 +435,6 @@ subroutine mesh_init(ip,el) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) -#ifdef Spectral call fftw_mpi_init() call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) @@ -543,63 +463,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) call mesh_spectral_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Marc4DAMASK - call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... - if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - call mesh_marc_get_fileFormat(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) - call mesh_marc_get_tableStyles(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) - if (MarcVersion > 12) then - call mesh_marc_get_matNumber(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) - endif - call mesh_marc_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_marc_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_marc_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_marc_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_marc_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_marc_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_marc_count_cpSizes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) - call mesh_marc_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Abaqus - call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... - if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - noPart = IO_abaqus_hasNoPart(FILEUNIT) - call mesh_abaqus_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_abaqus_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_abaqus_count_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) - call mesh_abaqus_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_abaqus_map_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) - call mesh_abaqus_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_abaqus_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_abaqus_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_abaqus_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_abaqus_count_cpSizes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) - call mesh_abaqus_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#endif - call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -614,25 +477,10 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) close (FILEUNIT) -#if defined(Marc4DAMASK) || defined(Abaqus) - call mesh_build_nodeTwins - if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) - call mesh_build_sharedElems - if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) - call mesh_build_ipNeighborhood -#else call mesh_spectral_build_ipNeighborhood -#endif + if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (worldrank == 0_pInt) then - call mesh_tell_statistics - endif - -#if defined(Marc4DAMASK) || defined(Abaqus) - if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & - call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements -#endif 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)))) & @@ -642,11 +490,6 @@ subroutine mesh_init(ip,el) 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 -#if defined(Marc4DAMASK) || defined(Abaqus) - 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" -#endif !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. @@ -661,58 +504,6 @@ subroutine mesh_init(ip,el) end subroutine mesh_init - -#if defined(Marc4DAMASK) || defined(Abaqus) -!-------------------------------------------------------------------------------------------------- -!> @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) - use IO, only: & - IO_lc - - implicit none - character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID - - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center - - mesh_FEasCP = 0_pInt - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect - - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),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) - return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) - return - endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then - lower = center - elseif (lookupMap(1_pInt,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2_pInt,center) - exit - endif - enddo binarySearch - -end function mesh_FEasCP -#endif - !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. !> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). @@ -953,7 +744,6 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -#ifdef Spectral !-------------------------------------------------------------------------------------------------- !> @brief Reads grid information from geometry file. If fileUnit is given, !! assumes an opened file, otherwise tries to open the one specified in geometryFile @@ -1492,1306 +1282,6 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) nodes = nodes/8.0_pReal end function mesh_nodesAroundCentres -#endif - -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_fileFormat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_tableStyles - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, j, data_blocks - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - - data_blocks = 1_pInt - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - read (fileUnit,610,END=620) line - if (len(trim(line))/=0_pInt) then - chunkPos = IO_stringPos(line) - data_blocks = IO_intValue(line,chunkPos,1_pInt) - endif - allocate(Marc_matNumber(data_blocks)) - do i=1_pInt,data_blocks ! read all data blocks - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block - read (fileUnit,610,END=620) line - enddo - enddo - exit - endif - enddo - -620 end subroutine mesh_marc_get_matNumber - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_nodesAndElements(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_IntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file - endif - enddo - -620 end subroutine mesh_marc_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,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 - mesh_NelemSets = mesh_NelemSets + 1_pInt - mesh_maxNelemInSet = max(mesh_maxNelemInSet, & - IO_countContinuousIntValues(fileUnit)) - endif - enddo - -620 end subroutine mesh_marc_count_elementSets - - -!******************************************************************** -! map element sets -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!******************************************************************** -subroutine mesh_marc_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,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 - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mesh_mapElemSet(:,elemSet) = & - IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - endif - enddo - -640 end subroutine mesh_marc_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues, & - IO_error, & - IO_intValue, & - IO_countNumericalDataLines - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,610,END=620) line - enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update - exit - endif - enddo - else ! Marc2017 and later - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end subroutine mesh_marc_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line, & - tmp - - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - contInts = 0_pInt - rewind(fileUnit) - do - read (fileUnit,610,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+hypoelasticTableStyle ! skip three (or four if new table style!) lines - read (fileUnit,610,END=660) line - enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) - exit - endif - else ! Marc2017 and later - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),"0123456789")/=0) then ! found keyword - exit - else - contInts(1) = contInts(1) + 1_pInt - read (tmp,*) contInts(contInts(1)+1) - endif - enddo - endif - endif - endif - enddo -660 do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) - mesh_mapFEtoCPelem(2,cpElem) = cpElem - enddo - -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - -end subroutine mesh_marc_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt) :: i - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - -610 FORMAT(A300) - - node_count = 0_pInt - - rewind(fileUnit) - do - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=650) line ! skip crap line - do i = 1_pInt,mesh_Nnodes - read (fileUnit,610,END=650) line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) - mesh_mapFEtoCPnode(2_pInt,i) = i - enddo - exit - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - -end subroutine mesh_marc_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_nodes(fileUnit) - - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue, & - IO_fixedNoEFloatValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=670) line ! skip crap line - do i=1_pInt,mesh_Nnodes - read (fileUnit,610,END=670) 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) - enddo - enddo - exit - endif - enddo - -670 mesh_node = mesh_node0 - -end subroutine mesh_marc_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_intValue, & - IO_skipChunks - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,t,g,e,c - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - rewind(fileUnit) - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=630) line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line - endif - enddo - exit - endif - enddo - -630 end subroutine mesh_marc_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per element. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_fixedNoEFloatValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=620) line ! garbage line - do i = 1_pInt,mesh_Nelems - read (fileUnit,610,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) & - 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 - enddo - nNodesAlreadyRead = chunkPos(1) - 2_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - exit - endif - enddo - -620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,610,END=620) 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,610,END=620) line ! read extra line for new style - read (fileUnit,610,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 - read (fileUnit,610,END=620) 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 - mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index - if (initialcondTableStyle == 2_pInt) then - read (fileUnit,610,END=630) line ! read extra line - read (fileUnit,610,END=630) line ! read extra line - endif - contInts = IO_continuousIntValues& ! get affected elements - (fileUnit,mesh_NcpElems,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 - enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - enddo - endif - else - read (fileUnit,610,END=630) line - endif - enddo - -630 end subroutine mesh_marc_build_elements -#endif - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_nodesAndElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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 (inPart .or. noPart) then - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) - 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' & - ) & - 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' & - ) then - mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) - endif - endselect - endif - enddo - -620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) - if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) - -end subroutine mesh_abaqus_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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 ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & - mesh_NelemSets = mesh_NelemSets + 1_pInt - enddo - -620 continue - if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) - -end subroutine mesh_abaqus_count_elementSets - - -!-------------------------------------------------------------------------------------------------- -! count overall number of solid sections sets in mesh (Abaqus only) -! -! mesh_Nmaterials -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical inPart - - mesh_Nmaterials = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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 ( (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 - enddo - -620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) - -end subroutine mesh_abaqus_count_materials - - -!-------------------------------------------------------------------------------------------------- -! Build element set mapping -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt,i - logical :: inPart = .false. - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) - -610 FORMAT(A300) - - - rewind(fileUnit) - do - read (fileUnit,610,END=640) 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 ( (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')) - mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& - mesh_mapElemSet,elemSet-1_pInt) - endif - enddo - -640 do i = 1_pInt,elemSet - if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) - enddo - -end subroutine mesh_abaqus_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -! map solid section (Abaqus only) -! -! allocate globals: mesh_nameMaterial, mesh_mapMaterial -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c = 0_pInt - logical :: inPart = .false. - character(len=64) :: elemSetName,materialName - - allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' - allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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 ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then - - elemSetName = '' - materialName = '' - - do i = 3_pInt,chunkPos(1_pInt) - 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') /= '') & - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) - enddo - - if (elemSetName /= '' .and. materialName /= '') then - c = c + 1_pInt - mesh_nameMaterial(c) = materialName ! name of material used for this section - mesh_mapMaterial(c) = elemSetName ! mapped to respective element set - endif - endif - enddo - -620 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) - enddo - - end subroutine mesh_abaqus_map_materials - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_extractValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - integer(pInt) :: i,k - logical :: materialFound = .false. - character(len=64) ::materialName,elemSetName - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'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 (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 - if (elemSetName == mesh_nameElemSet(k)) & ! matched? - mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) - -end subroutine mesh_abaqus_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) ::i,j,k,cpElem = 0_pInt - logical :: materialFound = .false. - character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'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 (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 - 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 - mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - - if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) - -end subroutine mesh_abaqus_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_intValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c,cpNode = 0_pInt - logical :: inPart = .false. - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=650) 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( (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' ) & - ) then - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=650) 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 - enddo - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - - if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) - -end subroutine mesh_abaqus_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_nodes(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_floatValue, & - IO_stringPos, & - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m,c - logical :: inPart - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=670) 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( (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' ) & - ) then - c = IO_countDataLines(fileUnit) ! how many nodes are defined here? - do i = 1_pInt,c - backspace(fileUnit) ! rewind to first entry - enddo - do i = 1_pInt,c - read (fileUnit,610,END=670) 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) - enddo - enddo - endif - enddo - -670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) - mesh_node = mesh_node0 - -end subroutine mesh_abaqus_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue ,& - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,c,t,g - logical :: inPart - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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( (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' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - endif - enddo - -620 end subroutine mesh_abaqus_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per elemen. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_extractValue, & - IO_floatValue, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - - integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead - logical inPart,materialFound - character (len=64) :: materialName,elemSetName - character(len=300) :: line - - allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) 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( (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' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=620) 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) & - 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: - enddo - nNodesAlreadyRead = chunkPos(1) - 1_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - endif - enddo - - -620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" - - materialFound = .false. - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & - materialFound ) then - read (fileUnit,610,END=630) 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 - 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 - if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,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 - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -630 end subroutine mesh_abaqus_build_elements -#endif !-------------------------------------------------------------------------------------------------- @@ -2807,50 +1297,11 @@ use IO, only: & implicit none integer(pInt), intent(in) :: fileUnit -#ifdef Spectral + mesh_periodicSurface = .true. end subroutine mesh_get_damaskOptions -#else - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword - - mesh_periodicSurface = .false. -#ifdef Marc4DAMASK - keyword = '$damask' -#endif -#ifdef Abaqus - keyword = '**damask' -#endif - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(damaskOption) - case('periodic') ! damask Option that allows to specify periodic fluxes - do chunk = 3_pInt,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' - mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' - enddo - endselect - endif - enddo - -610 FORMAT(A300) - -620 end subroutine mesh_get_damaskOptions -#endif - !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' @@ -2925,444 +1376,6 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral -!-------------------------------------------------------------------------------------------------- -!> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_nodeTwins - - implicit none - integer(pInt) 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 - 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 - - tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal - - do dir = 1_pInt,3_pInt ! 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 - minCoord = minval(mesh_node0(dir,:)) - maxCoord = maxval(mesh_node0(dir,:)) - do node = 1_pInt,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 - elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then - maximumNodes(1) = maximumNodes(1) + 1_pInt - maximumNodes(maximumNodes(1)+1_pInt) = node - endif - enddo - - - !*** 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) - if (unpaired(minimumNode)) then - do n2 = 1_pInt,maximumNodes(1) - maximumNode = maximumNodes(n2+1_pInt) - 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 - mesh_nodeTwins(dir,maximumNode) = minimumNode - unpaired(maximumNode) = .false. ! remember this node, we don't have to look for his partner again - exit - endif - enddo - endif - enddo - - endif - enddo - -end subroutine mesh_build_nodeTwins - - -!-------------------------------------------------------------------------------------------------- -!> @brief get maximum count of shared elements among cpElements and build list of elements shared -!! by each node in mesh. Allocate globals '_maxNsharedElems' and '_sharedElem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_sharedElems - - implicit none - integer(pint) e, & ! element index - g, & ! element type - node, & ! CP node index - 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 - - allocate(node_seen(maxval(FE_NmatchingNodes))) - - node_count = 0_pInt - - do e = 1_pInt,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 = 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... - 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 - enddo - endif - node_seen(n) = node ! remember this node to be counted already - enddo - enddo - - mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node - - allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) - - do e = 1_pInt,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) - 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... - 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 - mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id - endif - enddo - endif - node_seen(n) = node - enddo - enddo - -end subroutine mesh_build_sharedElems - - -!-------------------------------------------------------------------------------------------------- -!> @brief build up of IP neighborhood, allocate globals '_ipNeighborhood' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipNeighborhood - use math, only: & - math_mul3x3 - - implicit none - integer(pInt) :: myElem, & ! my CP element index - myIP, & - myType, & ! my element type - myFace, & - neighbor, & ! neighor index - neighboringIPkey, & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element) - candidateIP, & - neighboringType, & ! element type of neighbor - NlinkedNodes, & ! number of linked nodes - twin_of_linkedNode, & ! node twin of a specific linkedNode - NmatchingNodes, & ! number of matching nodes - dir, & ! direction of periodicity - matchingElem, & ! CP elem number of matching element - matchingFace, & ! face ID of matching element - a, anchor, & - neighboringIP, & - neighboringElem, & - pointingToMe - integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & - linkedNodes = 0_pInt, & - matchingNodes - logical checkTwins - - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) - mesh_ipNeighborhood = 0_pInt - - - do myElem = 1_pInt,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 - 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 - mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey - - - !*** 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 - 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? - neighboringType = FE_geomtype(mesh_element(2,matchingElem)) - - !*** trivial solution if neighbor has only one IP - - if (FE_Nips(neighboringType) == 1_pInt) then - mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt - 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 - anchor = FE_nodesAtIP(a,myIP,myType) - if (anchor /= 0_pInt) 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 - else ! something went wrong with the linkage, since not all anchors sit on my face - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt - exit - endif - endif - enddo - - !*** loop through the ips of my neighbor - !*** 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 - anchor = FE_nodesAtIP(a,candidateIP,neighboringType) - if (anchor /= 0_pInt) then ! valid anchor node - if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? - NmatchingNodes = NmatchingNodes + 1_pInt - 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 - exit - endif - endif - enddo - - if (NmatchingNodes /= NlinkedNodes) & ! this ip has wrong count of anchors on face - cycle checkCandidateIP - - !*** check "normal" nodes whether they match or not - - checkTwins = .false. - do a = 1_pInt,NlinkedNodes - if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode - checkTwins = .true. - exit ! no need to search further - endif - enddo - - !*** if no match found, then also check node twins - - 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 - twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) - if (twin_of_linkedNode == 0_pInt .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 - enddo - endif - - !*** we found a match !!! - - mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = candidateIP - exit checkCandidateIP - enddo checkCandidateIP - endif ! end of valid external matching - endif ! end of internal/external matching - enddo - enddo - enddo - do myElem = 1_pInt,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 - 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 ... - 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 - 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),& - mesh_ipAreaNormal(1:3,pointingToMe,neighboringIP,neighboringElem)) < 0.0_pReal) then ! area normals have opposite orientation (we have to check that because of special case for single element with two ips and periodicity. In this case the neighbor is identical in two different directions.) - mesh_ipNeighborhood(3,neighbor,myIP,myElem) = pointingToMe ! found match - exit ! so no need to search further - endif - endif - enddo - endif - enddo - enddo - enddo - -end subroutine mesh_build_ipNeighborhood -#endif - - -!-------------------------------------------------------------------------------------------------- -!> @brief write statistics regarding input file parsing to the output file -!-------------------------------------------------------------------------------------------------- -subroutine mesh_tell_statistics - use math, only: & - math_range - use IO, only: & - IO_error - use debug, only: & - debug_level, & - debug_MESH, & - debug_LEVELBASIC, & - debug_LEVELEXTENSIVE, & - debug_LEVELSELECTIVE, & - debug_e, & - debug_i - - implicit none - integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro - character(len=64) :: myFmt - integer(pInt) :: i,e,n,f,t,g,c, myDebug - - myDebug = debug_level(debug_mesh) - - if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified - if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified - - allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) - do e = 1_pInt,mesh_NcpElems - if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified - if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure - enddo -!$OMP CRITICAL (write2out) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - write(6,'(/,a,/)') ' Input Parser: STATISTICS' - write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' - write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' - write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' - write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' - write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' - write(6,*) - write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) - write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations - write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures - enddo - write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' - write(6,*) 'periodic surface : ', mesh_periodicSurface - write(6,*) - flush(6) - endif - - if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' - write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get elemType - g = FE_geomtype(t) ! get elemGeomType - c = FE_celltype(g) ! get cellType - write(6,'(i8,3(1x,i8))') e,t,g,c - enddo - write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' - write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) - write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - 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) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) - do f = 1_pInt,FE_NipNeighbors(c) - write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) - enddo - enddo - enddo - write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' - write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - 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 of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i2)') e,i - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell - write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & - mesh_cellnode(1:3,mesh_cell(n,i,e)) - enddo - enddo - enddo - write(6,'(/,a)') 'Input Parser: IP COORDINATES' - write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) - enddo - enddo -#ifndef Spectral - write(6,'(/,a,/)') 'Input Parser: NODE TWINS' - write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' - do n = 1_pInt,mesh_Nnodes ! loop over cpNodes - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle - write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) - enddo -#endif - write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' - write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - 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 of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP - write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) - enddo - enddo - enddo - endif -!$OMP END CRITICAL (write2out) - -end subroutine mesh_tell_statistics - !-------------------------------------------------------------------------------------------------- !> @brief mapping of FE element types to internal representation From 55845d222df2796ba6e6b1482dd9f5ae343257db Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:13:40 +0100 Subject: [PATCH 008/154] function was removed --- src/mesh_marc.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index b993b43d6..aa7d77b77 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -380,7 +380,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_tell_statistics, & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & From badf9e9cca1994221ce2e7e1551384c8c1e9c090 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:24:10 +0100 Subject: [PATCH 009/154] object oriented element definitions --- src/CMakeLists.txt | 16 +- src/commercialFEM_fileList.f90 | 1 + src/element.f90 | 908 +++++++++++++++++++++++++++++++++ 3 files changed, 919 insertions(+), 6 deletions(-) create mode 100644 src/element.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3818130da..a09ae4766 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -17,6 +17,10 @@ list(APPEND OBJECTFILES $) add_library(PREC OBJECT "prec.f90") list(APPEND OBJECTFILES $) +add_library(ELEMENT OBJECT "element.f90") +add_dependencies(ELEMENT PREC) +list(APPEND OBJECTFILES $) + add_library(QUIT OBJECT "quit.f90") add_dependencies(QUIT PREC) list(APPEND OBJECTFILES $) @@ -53,21 +57,21 @@ add_library(FEsolving OBJECT "FEsolving.f90") add_dependencies(FEsolving RESULTS) list(APPEND OBJECTFILES $) -add_library(DAMASK_MATH OBJECT "math.f90") -add_dependencies(DAMASK_MATH FEsolving) -list(APPEND OBJECTFILES $) +add_library(MATH OBJECT "math.f90") +add_dependencies(MATH FEsolving) +list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh_grid.f90") - add_dependencies(MESH DAMASK_MATH) + add_dependencies(MESH MATH ELEMENT) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") - add_dependencies(FEZoo DAMASK_MATH) + add_dependencies(FEZoo MATH) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "mesh_FEM.f90") - add_dependencies(MESH FEZoo) + add_dependencies(MESH FEZoo ELEMENT) list(APPEND OBJECTFILES $) endif() diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index a7a61c2f7..7a32e7ade 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -12,6 +12,7 @@ #endif #include "math.f90" #include "FEsolving.f90" +#include "element.f90" #ifdef Abaqus #include "mesh_abaqus.f90" #endif diff --git a/src/element.f90 b/src/element.f90 new file mode 100644 index 000000000..146f24d51 --- /dev/null +++ b/src/element.f90 @@ -0,0 +1,908 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!-------------------------------------------------------------------------------------------------- +module element + use prec, only: & + pInt, & + pReal + + implicit none + private + +!--------------------------------------------------------------------------------------------------- +!> Properties of a single element (the element used in the mesh) +!--------------------------------------------------------------------------------------------------- + type, public :: tElement + integer(pInt) :: & + elemType, & + geomType, & ! geometry type (same for same dimension and same number of integration points) + cellType, & + Nnodes, & + Ncellnodes, & + NcellnodesPerCell, & + nIPs, & + nIPneighbors, & ! ToDo: MD: Do all IPs in one element type have the same number of neighbors? + maxNnodeAtIP + integer(pInt), dimension(:,:), allocatable :: & + Cell, & ! intra-element (cell) nodes that constitute a cell + NnodeAtIP, & + IPneighbor, & + cellFace + real(pReal), dimension(:,:), allocatable :: & + ! center of gravity of the weighted nodes gives the position of the cell node. + ! 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 + cellNodeParentNodeWeights + contains + procedure :: init => tElement_init + end type + + integer(pInt), parameter, private :: & + NELEMTYPE = 13_pInt + + integer(pInt), dimension(NelemType), parameter, private :: NNODE = & + int([ & + 3, & ! 2D 3node 1ip + 6, & ! 2D 6node 3ip + 4, & ! 2D 4node 4ip + 8, & ! 2D 8node 9ip + 8, & ! 2D 8node 4ip + !-------------------- + 4, & ! 3D 4node 1ip + 5, & ! 3D 5node 4ip + 10, & ! 3D 10node 4ip + 6, & ! 3D 6node 6ip + 8, & ! 3D 8node 1ip + 8, & ! 3D 8node 8ip + 20, & ! 3D 20node 8ip + 20 & ! 3D 20node 27ip + ],pInt) !< number of nodes that constitute a specific type of element + + integer(pInt), dimension(NelemType), parameter, public :: GEOMTYPE = & + int([ & + 1, & ! 2D 3node 1ip + 2, & ! 2D 6node 3ip + 3, & ! 2D 4node 4ip + 4, & ! 2D 8node 9ip + 3, & ! 2D 8node 4ip + !-------------------- + 5, & ! 3D 4node 1ip + 6, & ! 3D 5node 4ip + 6, & ! 3D 10node 4ip + 7, & ! 3D 6node 6ip + 8, & ! 3D 8node 1ip + 9, & ! 3D 8node 8ip + 9, & ! 3D 20node 8ip + 10 & ! 3D 20node 27ip + ],pInt) !< geometry type of particular element type + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: NCELLNODE = & ! Intel 16.0 complains + integer(pInt), dimension(10), parameter, private :: NCELLNODE = & + int([ & + 3, & + 7, & + 9, & + 16, & + 4, & + 15, & + 21, & + 8, & + 27, & + 64 & + ],pInt) !< number of cell nodes in a specific geometry type + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: NIP = & ! Intel 16.0 complains + integer(pInt), dimension(10), parameter, private :: NIP = & + int([ & + 1, & + 3, & + 4, & + 9, & + 1, & + 4, & + 6, & + 1, & + 8, & + 27 & + ],pInt) !< number of IPs in a specific geometry type + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: CELLTYPE = & ! Intel 16.0 complains + integer(pInt), dimension(10), parameter, private :: CELLTYPE = & !< cell type that is used by each geometry type + int([ & + 1, & ! 2D 3node + 2, & ! 2D 4node + 2, & ! 2D 4node + 2, & ! 2D 4node + 3, & ! 3D 4node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4 & ! 3D 8node + ],pInt) + + !integer(pInt), dimension(maxval(cellType)), parameter, private :: nIPNeighbor = & ! causes problem with Intel 16.0 + integer(pInt), dimension(4), parameter, private :: NIPNEIGHBOR = & !< number of ip neighbors / cell faces in a specific cell type + int([& + 3, & ! 2D 3node + 4, & ! 2D 4node + 4, & ! 3D 4node + 6 & ! 3D 8node + ],pInt) + + !integer(pInt), dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & + integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELLFACE = & !< number of cell nodes in a specific cell type + int([ & + 2, & ! 2D 3node + 2, & ! 2D 4node + 3, & ! 3D 4node + 4 & ! 3D 8node + ],pInt) + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: maxNodeAtIP = & ! causes problem with Intel 16.0 + integer(pInt), dimension(10), parameter, private :: maxNnodeAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element + int([ & + 3, & + 1, & + 1, & + 2, & + 4, & + 1, & + 1, & + 8, & + 1, & + 4 & + ],pInt) + + + !integer(pInt), dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains + integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELL = & !< number of cell nodes in a specific cell type + int([ & + 3, & ! 2D 3node + 4, & ! 2D 4node + 4, & ! 3D 4node + 8 & ! 3D 8node + ],pInt) + + integer(pInt), dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = & + reshape(int([& + 1,2,3 & + ],pInt),[maxNnodeAtIP(1),nIP(1)]) + + integer(pInt), dimension(maxNnodeAtIP(2),nIP(2)), parameter, private :: NnodeAtIP2 = & + reshape(int([& + 1, & + 2, & + 3 & + ],pInt),[maxNnodeAtIP(2),nIP(2)]) + + integer(pInt), dimension(maxNnodeAtIP(3),nIP(3)), parameter, private :: NnodeAtIP3 = & + reshape(int([& + 1, & + 2, & + 4, & + 3 & + ],pInt),[maxNnodeAtIP(3),nIP(3)]) + + integer(pInt), dimension(maxNnodeAtIP(4),nIP(4)), parameter, private :: NnodeAtIP4 = & + reshape(int([& + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],pInt),[maxNnodeAtIP(4),nIP(4)]) + + integer(pInt), dimension(maxNnodeAtIP(5),nIP(5)), parameter, private :: NnodeAtIP5 = & + reshape(int([& + 1,2,3,4 & + ],pInt),[maxNnodeAtIP(5),nIP(5)]) + + integer(pInt), dimension(maxNnodeAtIP(6),nIP(6)), parameter, private :: NnodeAtIP6 = & + reshape(int([& + 1, & + 2, & + 3, & + 4 & + ],pInt),[maxNnodeAtIP(6),nIP(6)]) + + integer(pInt), dimension(maxNnodeAtIP(7),nIP(7)), parameter, private :: NnodeAtIP7 = & + reshape(int([& + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & + ],pInt),[maxNnodeAtIP(7),nIP(7)]) + + integer(pInt), dimension(maxNnodeAtIP(8),nIP(8)), parameter, private :: NnodeAtIP8 = & + reshape(int([& + 1,2,3,4,5,6,7,8 & + ],pInt),[maxNnodeAtIP(8),nIP(8)]) + + integer(pInt), dimension(maxNnodeAtIP(9),nIP(9)), parameter, private :: NnodeAtIP9 = & + reshape(int([& + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & + ],pInt),[maxNnodeAtIP(9),nIP(9)]) + + integer(pInt), dimension(maxNnodeAtIP(10),nIP(10)), parameter, private :: NnodeAtIP10 = & + reshape(int([& + 1,0, 0,0, & + 1,2, 0,0, & + 2,0, 0,0, & + 1,4, 0,0, & + 1,3, 2,4, & + 2,3, 0,0, & + 4,0, 0,0, & + 3,4, 0,0, & + 3,0, 0,0, & + 1,5, 0,0, & + 1,6, 2,5, & + 2,6, 0,0, & + 1,8, 4,5, & + 0,0, 0,0, & + 2,7, 3,6, & + 4,8, 0,0, & + 3,8, 4,7, & + 3,7, 0,0, & + 5,0, 0,0, & + 5,6, 0,0, & + 6,0, 0,0, & + 5,8, 0,0, & + 5,7, 6,8, & + 6,7, 0,0, & + 8,0, 0,0, & + 7,8, 0,0, & + 7,0, 0,0 & + ],pInt),[maxNnodeAtIP(10),nIP(10)]) + + ! *** FE_ipNeighbor *** + ! is a list of the neighborhood of each IP. + ! 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. + + + integer(pInt), dimension(nIPneighbor(cellType(1)),nIP(1)), parameter, private :: IPneighbor1 = & + reshape(int([& + -2,-3,-1 & + ],pInt),[nIPneighbor(cellType(1)),nIP(1)]) + + integer(pInt), dimension(nIPneighbor(cellType(2)),nIP(2)), parameter, private :: IPneighbor2 = & + reshape(int([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & + ],pInt),[nIPneighbor(cellType(2)),nIP(2)]) + + integer(pInt), dimension(nIPneighbor(cellType(3)),nIP(3)), parameter, private :: IPneighbor3 = & + reshape(int([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & + ],pInt),[nIPneighbor(cellType(3)),nIP(3)]) + + integer(pInt), dimension(nIPneighbor(cellType(4)),nIP(4)), parameter, private :: IPneighbor4 = & + reshape(int([& + 2,-4, 4,-1, & + 3, 1, 5,-1, & + -2, 2, 6,-1, & + 5,-4, 7, 1, & + 6, 4, 8, 2, & + -2, 5, 9, 3, & + 8,-4,-3, 4, & + 9, 7,-3, 5, & + -2, 8,-3, 6 & + ],pInt),[nIPneighbor(cellType(4)),nIP(4)]) + + integer(pInt), dimension(nIPneighbor(cellType(5)),nIP(5)), parameter, private :: IPneighbor5 = & + reshape(int([& + -1,-2,-3,-4 & + ],pInt),[nIPneighbor(cellType(5)),nIP(5)]) + + integer(pInt), dimension(nIPneighbor(cellType(6)),nIP(6)), parameter, private :: IPneighbor6 = & + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -2, 1, 3,-2, 4,-1, & + 2,-4,-3, 1, 4,-1, & + 2,-4, 3,-2,-3, 1 & + ],pInt),[nIPneighbor(cellType(6)),nIP(6)]) + + integer(pInt), dimension(nIPneighbor(cellType(7)),nIP(7)), parameter, private :: IPneighbor7 = & + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -3, 1, 3,-2, 5,-1, & + 2,-4,-3, 1, 6,-1, & + 5,-4, 6,-2,-5, 1, & + -3, 4, 6,-2,-5, 2, & + 5,-4,-3, 4,-5, 3 & + ],pInt),[nIPneighbor(cellType(7)),nIP(7)]) + + integer(pInt), dimension(nIPneighbor(cellType(8)),nIP(8)), parameter, private :: IPneighbor8 = & + reshape(int([& + -3,-5,-4,-2,-6,-1 & + ],pInt),[nIPneighbor(cellType(8)),nIP(8)]) + + integer(pInt), dimension(nIPneighbor(cellType(9)),nIP(9)), parameter, private :: IPneighbor9 = & + reshape(int([& + 2,-5, 3,-2, 5,-1, & + -3, 1, 4,-2, 6,-1, & + 4,-5,-4, 1, 7,-1, & + -3, 3,-4, 2, 8,-1, & + 6,-5, 7,-2,-6, 1, & + -3, 5, 8,-2,-6, 2, & + 8,-5,-4, 5,-6, 3, & + -3, 7,-4, 6,-6, 4 & + ],pInt),[nIPneighbor(cellType(9)),nIP(9)]) + + integer(pInt), dimension(nIPneighbor(cellType(10)),nIP(10)), parameter, private :: IPneighbor10 = & + reshape(int([& + 2,-5, 4,-2,10,-1, & + 3, 1, 5,-2,11,-1, & + -3, 2, 6,-2,12,-1, & + 5,-5, 7, 1,13,-1, & + 6, 4, 8, 2,14,-1, & + -3, 5, 9, 3,15,-1, & + 8,-5,-4, 4,16,-1, & + 9, 7,-4, 5,17,-1, & + -3, 8,-4, 6,18,-1, & + 11,-5,13,-2,19, 1, & + 12,10,14,-2,20, 2, & + -3,11,15,-2,21, 3, & + 14,-5,16,10,22, 4, & + 15,13,17,11,23, 5, & + -3,14,18,12,24, 6, & + 17,-5,-4,13,25, 7, & + 18,16,-4,14,26, 8, & + -3,17,-4,15,27, 9, & + 20,-5,22,-2,-6,10, & + 21,19,23,-2,-6,11, & + -3,20,24,-2,-6,12, & + 23,-5,25,19,-6,13, & + 24,22,26,20,-6,14, & + -3,23,27,21,-6,15, & + 26,-5,-4,22,-6,16, & + 27,25,-4,23,-6,17, & + -3,26,-4,24,-6,18 & + ],pInt),[nIPneighbor(cellType(10)),nIP(10)]) + + + real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = & + reshape(real([& + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & + ],pReal),[nNode(1),NcellNode(geomType(1))]) ! 2D 3node 1ip + + real(pReal), dimension(nNode(2),NcellNode(geomType(2))), parameter :: cellNodeParentNodeWeights2 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 2, 2, 2 & + ],pReal),[nNode(2),NcellNode(geomType(2))]) ! 2D 6node 3ip + + real(pReal), dimension(nNode(3),NcellNode(geomType(3))), parameter :: cellNodeParentNodeWeights3 = & + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1, & + 1, 1, 0, 0, & + 0, 1, 1, 0, & + 0, 0, 1, 1, & + 1, 0, 0, 1, & + 1, 1, 1, 1 & + ],pReal),[nNode(3),NcellNode(geomType(3))]) ! 2D 6node 3ip + + real(pReal), dimension(nNode(4),NcellNode(geomType(4))), parameter :: cellNodeParentNodeWeights4 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 1, 0, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 0, 2, & + 1, 0, 0, 0, 0, 0, 0, 2, & + 4, 1, 1, 1, 8, 2, 2, 8, & + 1, 4, 1, 1, 8, 8, 2, 2, & + 1, 1, 4, 1, 2, 8, 8, 2, & + 1, 1, 1, 4, 2, 2, 8, 8 & + ],pReal),[nNode(4),NcellNode(geomType(4))]) ! 2D 8node 9ip + + real(pReal), dimension(nNode(5),NcellNode(geomType(5))), parameter :: cellNodeParentNodeWeights5 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 1, 2, 2, 2, 2 & + ],pReal),[nNode(5),NcellNode(geomType(5))]) ! 2D 8node 4ip + + real(pReal), dimension(nNode(6),NcellNode(geomType(6))), parameter :: cellNodeParentNodeWeights6 = & + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & + ],pReal),[nNode(6),NcellNode(geomType(6))]) ! 3D 4node 1ip + + real(pReal), dimension(nNode(7),NcellNode(geomType(7))), parameter :: cellNodeParentNodeWeights7 = & + reshape(real([& + 1, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, & + 0, 0, 1, 0, 0, & + 0, 0, 0, 1, 0, & + 1, 1, 0, 0, 0, & + 0, 1, 1, 0, 0, & + 1, 0, 1, 0, 0, & + 1, 0, 0, 1, 0, & + 0, 1, 0, 1, 0, & + 0, 0, 1, 1, 0, & + 1, 1, 1, 0, 0, & + 1, 1, 0, 1, 0, & + 0, 1, 1, 1, 0, & + 1, 0, 1, 1, 0, & + 0, 0, 0, 0, 1 & + ],pReal),[nNode(7),NcellNode(geomType(7))]) ! 3D 5node 4ip + + real(pReal), dimension(nNode(8),NcellNode(geomType(8))), parameter :: cellNodeParentNodeWeights8 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & + 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & + 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & + 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & + 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & + ],pReal),[nNode(8),NcellNode(geomType(8))]) ! 3D 10node 4ip + + real(pReal), dimension(nNode(9),NcellNode(geomType(9))), parameter :: cellNodeParentNodeWeights9 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 0, 0, 0, 0, & + 0, 1, 1, 0, 0, 0, & + 1, 0, 1, 0, 0, 0, & + 1, 0, 0, 1, 0, 0, & + 0, 1, 0, 0, 1, 0, & + 0, 0, 1, 0, 0, 1, & + 0, 0, 0, 1, 1, 0, & + 0, 0, 0, 0, 1, 1, & + 0, 0, 0, 1, 0, 1, & + 1, 1, 1, 0, 0, 0, & + 1, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 1, & + 1, 0, 1, 1, 0, 1, & + 0, 0, 0, 1, 1, 1, & + 1, 1, 1, 1, 1, 1 & + ],pReal),[nNode(9),NcellNode(geomType(9))]) ! 3D 6node 6ip + + real(pReal), dimension(nNode(10),NcellNode(geomType(10))), parameter :: cellNodeParentNodeWeights10 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1 & + ],pReal),[nNode(10),NcellNode(geomType(10))]) ! 3D 8node 1ip + + real(pReal), dimension(nNode(11),NcellNode(geomType(11))), parameter :: cellNodeParentNodeWeights11 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, & ! + 1, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 1, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 1, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 1, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 1, & ! + 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, & ! + 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, & ! + 1, 1, 1, 1, 1, 1, 1, 1 & ! + ],pReal),[nNode(11),NcellNode(geomType(11))]) ! 3D 8node 8ip + + real(pReal), dimension(nNode(12),NcellNode(geomType(12))), parameter :: cellNodeParentNodeWeights12 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! + 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! + 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! + ],pReal),[nNode(12),NcellNode(geomType(12))]) ! 3D 20node 8ip + + real(pReal), dimension(nNode(13),NcellNode(geomType(13))), parameter :: cellNodeParentNodeWeights13 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 + 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! + 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 + 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! + 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! + 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! + 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 + 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! + 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 + 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! + 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! + 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 + 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! + 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! + 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! + 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! + 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 + 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! + 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! + 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! + 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! + ],pReal),[nNode(13),NcellNode(geomType(13))]) ! 3D 20node 27ip + + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)), parameter :: CELL1 = & + reshape(int([& + 1,2,3 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)), parameter :: CELL2 = & + reshape(int([& + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)), parameter :: CELL3 = & + reshape(int([& + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)), parameter :: CELL4 = & + reshape(int([& + 1, 5,13,12, & + 5, 6,14,13, & + 6, 2, 7,14, & + 12,13,16,11, & + 13,14,15,16, & + 14, 7, 8,15, & + 11,16,10, 4, & + 16,15, 9,10, & + 15, 8, 3, 9 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)), parameter :: CELL5 = & + reshape(int([& + 1, 2, 3, 4 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)), parameter :: CELL6 = & + reshape(int([& + 1, 5,11, 7, 8,12,15,14, & + 5, 2, 6,11,12, 9,13,15, & + 7,11, 6, 3,14,15,13,10, & + 8,12,15, 4, 4, 9,13,10 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)), parameter :: CELL7 = & + reshape(int([& + 1, 7,16, 9,10,17,21,19, & + 7, 2, 8,16,17,11,18,21, & + 9,16, 8, 3,19,21,18,12, & + 10,17,21,19, 4,13,20,15, & + 17,11,18,21,13, 5,14,20, & + 19,21,18,12,15,20,14, 6 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)), parameter :: CELL8 = & + reshape(int([& + 1, 2, 3, 4, 5, 6, 7, 8 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)), parameter :: CELL9 = & + reshape(int([& + 1, 9,21,12,13,22,27,25, & + 9, 2,10,21,22,14,23,27, & + 12,21,11, 4,25,27,24,16, & + 21,10, 3,11,27,23,15,24, & + 13,22,27,25, 5,17,26,20, & + 22,14,23,27,17, 6,18,26, & + 25,27,24,16,20,26,19, 8, & + 27,23,15,24,26,18, 7,19 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)), parameter :: CELL10 = & + reshape(int([& + 1, 9,33,16,17,37,57,44, & + 9,10,34,33,37,38,58,57, & + 10, 2,11,34,38,18,39,58, & + 16,33,36,15,44,57,60,43, & + 33,34,35,36,57,58,59,60, & + 34,11,12,35,58,39,40,59, & + 15,36,14, 4,43,60,42,20, & + 36,35,13,14,60,59,41,42, & + 35,12, 3,13,59,40,19,41, & + 17,37,57,44,21,45,61,52, & + 37,38,58,57,45,46,62,61, & + 38,18,39,58,46,22,47,62, & + 44,57,60,43,52,61,64,51, & + 57,58,59,60,61,62,63,64, & + 58,39,40,59,62,47,48,63, & + 43,60,42,20,51,64,50,24, & + 60,59,41,42,64,63,49,50, & + 59,40,19,41,63,48,23,49, & + 21,45,61,52, 5,25,53,32, & + 45,46,62,61,25,26,54,53, & + 46,22,47,62,26, 6,27,54, & + 52,61,64,51,32,53,56,31, & + 61,62,63,64,53,54,55,56, & + 62,47,48,63,54,27,28,55, & + 51,64,50,24,31,56,30, 8, & + 64,63,49,50,56,55,29,30, & + 63,48,23,49,55,28, 7,29 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)]) + + + integer(pInt), dimension(NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)), parameter :: CELLFACE1 = & + reshape(int([& + 2,3, & + 3,1, & + 1,2 & + ],pInt),[NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)]) ! 2D 3node, VTK_TRIANGLE (5) + + integer(pInt), dimension(NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)), parameter :: CELLFACE2 = & + reshape(int([& + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],pInt),[NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)]) ! 2D 4node, VTK_QUAD (9) + + integer(pInt), dimension(NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)), parameter :: CELLFACE3 = & + reshape(int([& + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],pInt),[NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)]) ! 3D 4node, VTK_TETRA (10) + + integer(pInt), dimension(NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)), parameter :: CELLFACE4 = & + reshape(int([& + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],pInt),[NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)]) ! 3D 8node, VTK_HEXAHEDRON (12) + + +contains + + subroutine tElement_init(self,elemType) + implicit none + class(tElement) :: self + integer(pInt), intent(in) :: elemType + self%elemType = elemType + + self%Nnodes = Nnode (self%elemType) + self%geomType = geomType (self%elemType) + select case (self%elemType) + case(1_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights1 + case(2_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights2 + case(3_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights3 + case(4_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights4 + case(5_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights5 + case(6_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights6 + case(7_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights7 + case(8_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights8 + case(9_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights9 + case(10_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights10 + case(11_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights11 + case(12_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights12 + case(13_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights13 + case default + print*, 'Mist' + end select + + + self%NcellNodes = NcellNode (self%geomType) + self%maxNnodeAtIP = maxNnodeAtIP (self%geomType) + self%nIPs = nIP (self%geomType) + self%cellType = cellType (self%geomType) + + + select case (self%geomType) + case(1_pInt) + self%NnodeAtIP = NnodeAtIP1 + self%IPneighbor = IPneighbor1 + self%cell = CELL1 + case(2_pInt) + self%NnodeAtIP = NnodeAtIP2 + self%IPneighbor = IPneighbor2 + self%cell = CELL2 + case(3_pInt) + self%NnodeAtIP = NnodeAtIP3 + self%IPneighbor = IPneighbor3 + self%cell = CELL3 + case(4_pInt) + self%NnodeAtIP = NnodeAtIP4 + self%IPneighbor = IPneighbor4 + self%cell = CELL4 + case(5_pInt) + self%NnodeAtIP = NnodeAtIP5 + self%IPneighbor = IPneighbor5 + self%cell = CELL5 + case(6_pInt) + self%NnodeAtIP = NnodeAtIP6 + self%IPneighbor = IPneighbor6 + self%cell = CELL6 + case(7_pInt) + self%NnodeAtIP = NnodeAtIP7 + self%IPneighbor = IPneighbor7 + self%cell = CELL7 + case(8_pInt) + self%NnodeAtIP = NnodeAtIP8 + self%IPneighbor = IPneighbor8 + self%cell = CELL8 + case(9_pInt) + self%NnodeAtIP = NnodeAtIP9 + self%IPneighbor = IPneighbor9 + self%cell = CELL9 + case(10_pInt) + self%NnodeAtIP = NnodeAtIP10 + self%IPneighbor = IPneighbor10 + self%cell = CELL10 + end select + self%NcellNodesPerCell = NCELLNODEPERCELL(self%cellType) + + select case(self%cellType) + case(1_pInt) + self%cellFace = CELLFACE1 + case(2_pInt) + self%cellFace = CELLFACE2 + case(3_pInt) + self%cellFace = CELLFACE3 + case(4_pInt) + self%cellFace = CELLFACE4 + end select + end subroutine tElement_init + + + +end module element From 8f106ca8c4fa9308db76b9320b591c129a96d57d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 14:53:23 +0100 Subject: [PATCH 010/154] base class for mesh no functions defined yet, only common variables --- src/CMakeLists.txt | 8 ++++++-- src/mesh_base.f90 | 48 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 2 deletions(-) create mode 100644 src/mesh_base.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index a09ae4766..3292e9cf6 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -61,17 +61,21 @@ add_library(MATH OBJECT "math.f90") add_dependencies(MATH FEsolving) list(APPEND OBJECTFILES $) +add_library(MESH_BASE OBJECT "mesh_base.f90") +add_dependencies(MESH_BASE MATH) +list(APPEND OBJECTFILES $) + # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh_grid.f90") - add_dependencies(MESH MATH ELEMENT) + add_dependencies(MESH MATH) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") add_dependencies(FEZoo MATH) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "mesh_FEM.f90") - add_dependencies(MESH FEZoo ELEMENT) + add_dependencies(MESH FEZoo) list(APPEND OBJECTFILES $) endif() diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 new file mode 100644 index 000000000..477fc3aed --- /dev/null +++ b/src/mesh_base.f90 @@ -0,0 +1,48 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Sets up the mesh for the solvers MSC.Marc,FEM, Abaqus and the spectral solver +!-------------------------------------------------------------------------------------------------- +module mesh_base + + use, intrinsic :: iso_c_binding + use prec, only: & + pStringLen, & + pReal, & + pInt + use element, only: & + tElement + + implicit none + +!--------------------------------------------------------------------------------------------------- +!> Properties of a the whole mesh (consisting of one type of elements) +!--------------------------------------------------------------------------------------------------- + type, public :: tMesh + type(tElement) :: & + elem + real(pReal), dimension(:,:), allocatable, public :: & + ipVolume, & !< volume associated with each IP (initially!) + node0, & !< node x,y,z coordinates (initially) + node !< node x,y,z coordinates (deformed) + integer(pInt), dimension(:,:), allocatable, public :: & + cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID + character(pStringLen) :: solver = "undefined" + integer(pInt) :: & + Nnodes, & !< total number of nodes in mesh + Nelems = -1_pInt, & + elemType, & + Ncells, & + nIPneighbors, & + NcellNodes, & + maxElemsPerNode + integer(pInt), dimension(:), allocatable, public :: & + homogenizationAt, & + microstructureAt + integer(pInt), dimension(:,:), allocatable, public :: & + connectivity + end type tMesh + +end module mesh_base From 7e039dff678381262076a9d1331c8dee4568cc10 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 15:18:53 +0100 Subject: [PATCH 011/154] verbose initialization --- src/element.f90 | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/src/element.f90 b/src/element.f90 index 146f24d51..bd602b3b2 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -900,7 +900,27 @@ contains self%cellFace = CELLFACE3 case(4_pInt) self%cellFace = CELLFACE4 - end select + end select + + + write(6,*) 'tElement_init' + + write(6,*)'elemType ',self%elemType + write(6,*)'geomType ',self%geomType + write(6,*)'cellType ',self%cellType + write(6,*)'Nnodes ',self%Nnodes + write(6,*)'Ncellnodes ',self%Ncellnodes + write(6,*)'NcellnodesPerCell ',self%NcellnodesPerCell + write(6,*)'nIPs ',self%nIPs + write(6,*)'nIPneighbors ',self%nIPneighbors + write(6,*)'maxNnodeAtIP ',self%maxNnodeAtIP + write(6,*)'Cell ',self%Cell + write(6,*)'NnodeAtIP ',self%NnodeAtIP + write(6,*)'IPneighbor ',self%IPneighbor + write(6,*)'cellFace ',self%cellFace + write(6,*)'cellNodeParentNodeWeights',self%cellNodeParentNodeWeights + + end subroutine tElement_init From 738114bc279d0f340c16244adc37835da7f211b8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 15:19:17 +0100 Subject: [PATCH 012/154] clean and initialize element --- src/mesh_grid.f90 | 89 ++++++++++++----------------------------------- 1 file changed, 22 insertions(+), 67 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 7cf7a1e64..fee06bee9 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -8,6 +8,7 @@ module mesh use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -368,7 +369,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & mesh_spectral_getHomogenization, & @@ -378,9 +378,23 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood - + type, public, extends(tMesh) :: tMesh_grid + contains + procedure :: init => tMesh_grid_init + end type tMesh_grid + + type(tMesh_grid), public :: theMesh + contains +subroutine tMesh_grid_init(self) + + implicit none + class(tMesh_grid) :: self + + call self%elem%init(10_pInt) + +end subroutine tMesh_grid_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -502,6 +516,9 @@ subroutine mesh_init(ip,el) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! + + call theMesh%init + end subroutine mesh_init !-------------------------------------------------------------------------------------------------- @@ -985,7 +1002,7 @@ subroutine mesh_spectral_count_cpSizes implicit none integer(pInt) :: t,g,c - t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element + t = 10_pInt g = FE_geomtype(t) c = FE_celltype(g) @@ -1112,7 +1129,7 @@ subroutine mesh_spectral_build_elements(fileUnit) enddo enddo - elemType = FE_mapElemtype('C3D8R') + elemType = 10_pInt elemOffset = product(grid(1:2))*grid3Offset e = 0_pInt do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) @@ -1377,68 +1394,6 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -!-------------------------------------------------------------------------------------------------- -!> @brief mapping of FE element types to internal representation -!-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) - use IO, only: IO_lc, IO_error - - implicit none - character(len=*), intent(in) :: what - - select case (IO_lc(what)) - case ( '6') - FE_mapElemtype = 1_pInt ! 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) - case ( '11', & - 'cpe4', & - 'cpe4t') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27', & - 'cpe8', & - 'cpe8t') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral - case ( '54') - FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - case ( '134', & - 'c3d4', & - 'c3d4t') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron - case ( '157') - FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations - case ( '127') - FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron - case ( '136', & - 'c3d6', & - 'c3d6t') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( '117', & - '123', & - 'c3d8r', & - 'c3d8rt') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7', & - 'c3d8', & - 'c3d8t') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57', & - 'c3d20r', & - 'c3d20rt') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21', & - 'c3d20', & - 'c3d20t') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral - case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) - end select - -end function FE_mapElemtype - - !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- @@ -2282,7 +2237,7 @@ integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) mesh_get_nodeAtIP = 0_pInt - elemtype = FE_mapElemtype(elemtypeFE) + elemtype = 10_pInt geomtype = FE_geomtype(elemtype) if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) From cda85b0d2de897c08a8fe2e886409c7ea1aa3840 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 15:51:03 +0100 Subject: [PATCH 013/154] might be needed somewhere --- src/element.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/element.f90 b/src/element.f90 index bd602b3b2..4c0f1e810 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -902,6 +902,7 @@ contains self%cellFace = CELLFACE4 end select + self%nIPneighbors = size(self%IPneighbor,1) write(6,*) 'tElement_init' From 7d3ae1673f039fbd6c3843b32df1d3952c8d6685 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 16:16:41 +0100 Subject: [PATCH 014/154] not needed --- src/FEM_utilities.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 1db950e63..bf5e62851 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -503,7 +503,6 @@ subroutine utilities_indexActiveSet(field,section,x_local,f_local,localIS,global CHKERRQ(ierr) call ISDestroy(dummyIS,ierr); CHKERRQ(ierr) endif - deallocate(localIndices) end subroutine utilities_indexActiveSet From 5c2020c3b483704545f4fe0380faef1b32668841 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 16:17:20 +0100 Subject: [PATCH 015/154] initialize element --- src/mesh_grid.f90 | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index fee06bee9..8b1659ed8 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -379,11 +379,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_spectral_build_ipNeighborhood type, public, extends(tMesh) :: tMesh_grid + + integer(pInt), dimension(3), public :: & + grid !< (global) grid + integer(pInt), public :: & + mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh + grid3, & !< (local) grid in 3rd direction + grid3Offset !< (local) grid offset in 3rd direction + real(pReal), dimension(3), public :: & + geomSize + real(pReal), public :: & + size3, & !< (local) size in 3rd direction + size3offset + contains procedure :: init => tMesh_grid_init end type tMesh_grid - type(tMesh_grid), public :: theMesh + type(tMesh_grid), public, protected :: theMesh contains @@ -444,6 +457,7 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + call theMesh%init call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh @@ -517,7 +531,6 @@ subroutine mesh_init(ip,el) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init end subroutine mesh_init @@ -2194,7 +2207,7 @@ subroutine mesh_build_FEdata 5,6,7,8, & 1,4,3,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - + end subroutine mesh_build_FEdata From 42cc9b8d2b59f5718ed5790885de2f14d8df52cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 25 Jan 2019 00:15:46 +0100 Subject: [PATCH 016/154] dependency was missing --- src/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3292e9cf6..62f44dacb 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -62,7 +62,7 @@ add_dependencies(MATH FEsolving) list(APPEND OBJECTFILES $) add_library(MESH_BASE OBJECT "mesh_base.f90") -add_dependencies(MESH_BASE MATH) +add_dependencies(MESH_BASE MATH ELEMENT) list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files From ab93a86b3e0e47c17a98bdca5a355a0382fce5fd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 16:50:23 +0100 Subject: [PATCH 017/154] initialize element where defined --- src/FEM_zoo.f90 | 4 ++-- src/mesh_FEM.f90 | 34 ++++++++++++++++++++++++++++++++-- 2 files changed, 34 insertions(+), 4 deletions(-) diff --git a/src/FEM_zoo.f90 b/src/FEM_zoo.f90 index 67c518c47..6abdfe883 100644 --- a/src/FEM_zoo.f90 +++ b/src/FEM_zoo.f90 @@ -9,11 +9,11 @@ module FEM_Zoo private integer(pInt), parameter, public:: & maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary) - real(pReal), dimension(2,3), private, protected :: & + real(pReal), dimension(2,3), private, parameter :: & triangle = reshape([-1.0_pReal, -1.0_pReal, & 1.0_pReal, -1.0_pReal, & -1.0_pReal, 1.0_pReal], shape=[2,3]) - real(pReal), dimension(3,4), private, protected :: & + real(pReal), dimension(3,4), private, parameter :: & tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, & 1.0_pReal, -1.0_pReal, -1.0_pReal, & -1.0_pReal, 1.0_pReal, -1.0_pReal, & diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index 1362063f8..7a784a27f 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -12,7 +12,7 @@ module mesh #include #include use prec, only: pReal, pInt - + use mesh_base use PETScdmplex use PETScdmda use PETScis @@ -79,6 +79,17 @@ use PETScis integer(pInt), dimension(1_pInt), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type int([6],pInt) + + type, public, extends(tMesh) :: tMesh_FEM + + + contains + procedure :: init => tMesh_FEM_init + end type tMesh_FEM + + type(tMesh_FEM), public, protected :: theMesh + + public :: & @@ -89,6 +100,23 @@ use PETScis contains +subroutine tMesh_FEM_init(self,dimen,order) + + implicit none + integer(pInt), intent(in) :: dimen,order + class(tMesh_FEM) :: self + + if (dimen == 2_pInt) then + if (order == 1_pInt) call self%elem%init(1_pInt) + if (order == 2_pInt) call self%elem%init(2_pInt) + elseif(dimen == 3_pInt) then + if (order == 1_pInt) call self%elem%init(6_pInt) + if (order == 2_pInt) call self%elem%init(8_pInt) + endif + + +end subroutine tMesh_FEM_init + !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -213,6 +241,8 @@ subroutine mesh_init() FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) mesh_maxNips = FE_Nips(1_pInt) + + write(6,*) 'mesh_maxNips',mesh_maxNips call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p) call mesh_FEM_build_ipVolumes(dimPlex) @@ -243,7 +273,7 @@ subroutine mesh_init() mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%init(dimplex,integrationOrder) end subroutine mesh_init From 3ebc0c2e37b4959cee1b11e3be26905ad3542714 Mon Sep 17 00:00:00 2001 From: navyanthkusam Date: Mon, 28 Jan 2019 13:53:44 +0100 Subject: [PATCH 018/154] tMesh_marc object extends tMesh Functionality seperated for mesh_marc --- src/mesh_marc.f90 | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index aa7d77b77..85b4f3e7d 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -8,6 +8,7 @@ module mesh use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -401,6 +402,46 @@ integer(pInt), dimension(:,:), allocatable, private :: & contains +type, public, extends(tMesh) :: tMesh_marc + + integer(pInt), public :: & + nElemsAll, & + maxNelemInSet, & + NelemSets,& + MarcVersion, & !< Version of input file format ToDo: Better Name? + hypoelasticTableStyle, & !< Table style + initialcondTableStyle + character(len=64), dimension(:), allocatable :: & + nameElemSet,& !< names of elementSet + mesh_nameElemSet, & !< names of elementSet + mapMaterial !< name of elementSet for material + integer(pInt), dimension(:), allocatable :: & + Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) + integer(pInt), dimension(:,:), allocatable, target:: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode + integer(pInt), 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, & + mesh_maxNelemInSet + integer(pInt), dimension(:,:), allocatable :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(2):: & + mesh_maxValStateVar = 0_pInt + + contains + procedure :: init => tMesh_marc_init +end type tMesh_marc + + type(tMesh_marc), public, protected :: theMesh +contains + +subroutine tMesh_marc_init(self) + implicit none + class(tMesh_marc) :: self + +end subroutine tMesh_marc_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -478,6 +519,8 @@ subroutine mesh_init(ip,el) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) + + call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -2767,3 +2810,7 @@ end function mesh_get_nodeAtIP end module mesh + + + + From 5101a3796fe5d0aa3a4a4bfd124ca16591f084b1 Mon Sep 17 00:00:00 2001 From: navyanthkusam Date: Mon, 28 Jan 2019 13:59:54 +0100 Subject: [PATCH 019/154] tMesh_abaqus object extends tMesh Functionality seperated for mesh_abaqus --- src/mesh_abaqus.f90 | 1275 ++----------------------------------------- 1 file changed, 38 insertions(+), 1237 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index e55165d51..bc14cd418 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -8,6 +8,7 @@ module mesh use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -62,11 +63,9 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) -#if defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_maxNelemInSet, & mesh_Nmaterials -#endif integer(pInt), dimension(2), private :: & mesh_maxValStateVar = 0_pInt @@ -329,7 +328,6 @@ 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 int([ & 3, & ! element 6 (2D 3node 1ip) @@ -344,19 +342,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) -#if defined(Spectral) - integer(pInt), dimension(3), public, protected :: & - grid !< (global) grid - integer(pInt), public, protected :: & - mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh - grid3, & !< (local) grid in 3rd direction - grid3Offset !< (local) grid offset in 3rd direction - real(pReal), dimension(3), public, protected :: & - geomSize - real(pReal), public, protected :: & - size3, & !< (local) size in 3rd direction - size3offset !< (local) size offset in 3rd direction -#elif defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element @@ -370,17 +355,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & integer(pInt), dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] -#endif -#if defined(Marc4DAMASK) - integer(pInt), private :: & - MarcVersion, & !< Version of input file format (Marc only) - hypoelasticTableStyle, & !< Table style (Marc only) - initialcondTableStyle !< Table style (Marc only) - integer(pInt), dimension(:), allocatable, private :: & - Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) -#elif defined(Abaqus) logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information -#endif public :: & mesh_init, & @@ -391,12 +366,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_Ncellnodes, & mesh_get_unitlength, & mesh_get_nodeAtIP, & -#if defined(Spectral) - mesh_spectral_getGrid, & - mesh_spectral_getSize -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_FEasCP -#endif private :: & mesh_get_damaskOptions, & @@ -406,32 +376,9 @@ integer(pInt), dimension(:,:), allocatable, private :: & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & -#if defined(Spectral) - mesh_spectral_getHomogenization, & - mesh_spectral_count, & - mesh_spectral_count_cpSizes, & - mesh_spectral_build_nodes, & - mesh_spectral_build_elements, & - mesh_spectral_build_ipNeighborhood -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_build_nodeTwins, & mesh_build_sharedElems, & mesh_build_ipNeighborhood, & -#endif -#if defined(Marc4DAMASK) - mesh_marc_get_fileFormat, & - mesh_marc_get_tableStyles, & - mesh_marc_get_matNumber, & - mesh_marc_count_nodesAndElements, & - mesh_marc_count_elementSets, & - mesh_marc_map_elementSets, & - mesh_marc_count_cpElements, & - mesh_marc_map_Elements, & - mesh_marc_map_nodes, & - mesh_marc_build_nodes, & - mesh_marc_count_cpSizes, & - mesh_marc_build_elements -#elif defined(Abaqus) mesh_abaqus_count_nodesAndElements, & mesh_abaqus_count_elementSets, & mesh_abaqus_count_materials, & @@ -443,10 +390,40 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_abaqus_build_nodes, & mesh_abaqus_count_cpSizes, & mesh_abaqus_build_elements -#endif + + type, public, extends(tMesh) :: tMesh_Abaqus + + integer(pInt):: & + mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) + mesh_maxNnodes, & !< max number of nodes in any CP element + mesh_NelemSets, & + mesh_maxNelemInSet, & + mesh_Nmaterials + character(len=64), dimension(:), allocatable :: & + mesh_nameElemSet, & !< names of elementSet + mesh_nameMaterial, & !< names of material in solid section + mesh_mapMaterial !< name of elementSet for material + integer(pInt), dimension(:,:), allocatable :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(:,:), allocatable, target :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] + logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information + + contains + procedure :: init=>tMesh_abaqus_init + end type tMesh_Abaqus + + type(tMesh_Abaqus), public, protected :: theMesh + contains +subroutine tMesh_abaqus_init + implicit none + class(tMesh_abaqus) :: self + +end subroutine tMesh_abaqus_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -457,22 +434,11 @@ subroutine mesh_init(ip,el) use, intrinsic :: iso_fortran_env, only: & compiler_version, & compiler_options -#endif -#ifdef Spectral -#include - use PETScsys #endif use DAMASK_interface use IO, only: & -#ifdef Abaqus IO_abaqus_hasNoPart, & -#endif -#ifdef Spectral - IO_open_file, & - IO_error, & -#else IO_open_InputFile, & -#endif IO_timeStamp, & IO_error, & IO_write_jobFile @@ -487,19 +453,10 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral - modelName, & - calcMode, & -#endif FEsolving_execElem, & FEsolving_execIP implicit none -#ifdef Spectral - include 'fftw3-mpi.f03' - integer(C_INTPTR_T) :: devNull, local_K, local_K_offset - integer :: ierr, worldsize -#endif integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j @@ -514,65 +471,6 @@ subroutine mesh_init(ip,el) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) -#ifdef Spectral - call fftw_mpi_init() - call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... - if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) - grid = mesh_spectral_getGrid(fileUnit) - call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') - if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') - - geomSize = mesh_spectral_getSize(fileUnit) - devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & - int(grid(2),C_INTPTR_T), & - int(grid(1),C_INTPTR_T)/2+1, & - PETSC_COMM_WORLD, & - local_K, & ! domain grid size along z - local_K_offset) ! domain grid offset along z - grid3 = int(local_K,pInt) - grid3Offset = int(local_K_offset,pInt) - size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) - size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) - if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) - call mesh_spectral_count() - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_spectral_count_cpSizes - if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) - call mesh_spectral_build_nodes() - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_spectral_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Marc4DAMASK - call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... - if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - call mesh_marc_get_fileFormat(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) - call mesh_marc_get_tableStyles(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) - if (MarcVersion > 12) then - call mesh_marc_get_matNumber(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) - endif - call mesh_marc_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_marc_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_marc_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_marc_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_marc_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_marc_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_marc_count_cpSizes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) - call mesh_marc_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Abaqus call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) noPart = IO_abaqus_hasNoPart(FILEUNIT) @@ -598,8 +496,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_abaqus_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#endif - call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -613,40 +509,29 @@ subroutine mesh_init(ip,el) call mesh_build_ipAreas if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) close (FILEUNIT) - -#if defined(Marc4DAMASK) || defined(Abaqus) call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) call mesh_build_ipNeighborhood -#else - call mesh_spectral_build_ipNeighborhood -#endif if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) if (worldrank == 0_pInt) then call mesh_tell_statistics endif -#if defined(Marc4DAMASK) || defined(Abaqus) if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements -#endif 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 - -#if defined(Marc4DAMASK) || defined(Abaqus) 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" -#endif !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. @@ -662,7 +547,6 @@ subroutine mesh_init(ip,el) end subroutine mesh_init -#if defined(Marc4DAMASK) || defined(Abaqus) !-------------------------------------------------------------------------------------------------- !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' @@ -711,7 +595,7 @@ integer(pInt) function mesh_FEasCP(what,myID) enddo binarySearch end function mesh_FEasCP -#endif + !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -953,456 +837,6 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -#ifdef Spectral -!-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getGrid(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), dimension(3) :: mesh_spectral_getGrid - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotGrid = .false. - - mesh_spectral_getGrid = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) - case ('grid') - gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotGrid) & - call IO_error(error_ID = 845_pInt, ext_msg='grid') - if(any(mesh_spectral_getGrid < 1_pInt)) & - call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') - -end function mesh_spectral_getGrid - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getSize(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - real(pReal), dimension(3) :: mesh_spectral_getSize - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotSize = .false. - - mesh_spectral_getSize = -1.0_pReal - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('size') - gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotSize) & - call IO_error(error_ID = 845_pInt, ext_msg='size') - if (any(mesh_spectral_getSize<=0.0_pReal)) & - call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') - -end function mesh_spectral_getSize - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, myFileUnit - logical :: gotHomogenization = .false. - - mesh_spectral_getHomogenization = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('homogenization') - gotHomogenization = .true. - mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotHomogenization ) & - call IO_error(error_ID = 845_pInt, ext_msg='homogenization') - if (mesh_spectral_getHomogenization<1_pInt) & - call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - -end function mesh_spectral_getHomogenization - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count() - - implicit none - - mesh_NcpElems= product(grid(1:2))*grid3 - mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) - - mesh_NcpElemsGlobal = product(grid) - -end subroutine mesh_spectral_count - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count_cpSizes - - implicit none - integer(pInt) :: t,g,c - - t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element - g = FE_geomtype(t) - c = FE_celltype(g) - - mesh_maxNips = FE_Nips(g) - mesh_maxNipNeighbors = FE_NipNeighbors(c) - mesh_maxNcellnodes = FE_Ncellnodes(g) - -end subroutine mesh_spectral_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_nodes() - - implicit none - integer(pInt) :: n - - allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) - allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) - - forall (n = 0_pInt:mesh_Nnodes-1_pInt) - mesh_node0(1,n+1_pInt) = mesh_unitlength * & - geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & - / real(grid(1),pReal) - mesh_node0(2,n+1_pInt) = mesh_unitlength * & - geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & - / real(grid(2),pReal) - mesh_node0(3,n+1_pInt) = mesh_unitlength * & - size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & - / real(grid3,pReal) + & - size3offset - end forall - - mesh_node = mesh_node0 - -end subroutine mesh_spectral_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, material, texture, and node list per element. -!! Allocates global array 'mesh_element' -!> @todo does the IO_error makes sense? -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_elements(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_continuousIntValues, & - IO_intValue, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: & - fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - e, i, & - headerLength = 0_pInt, & - maxDataPerLine, & - homog, & - elemType, & - elemOffset - integer(pInt), dimension(:), allocatable :: & - microstructures, & - microGlobal - integer(pInt), dimension(1,1) :: & - dummySet = 0_pInt - character(len=65536) :: & - line, & - keyword - character(len=64), dimension(1) :: & - dummyName = '' - - homog = mesh_spectral_getHomogenization(fileUnit) - -!-------------------------------------------------------------------------------------------------- -! get header length - call IO_checkAndRewind(fileUnit) - read(fileUnit,'(a65536)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') - endif - -!-------------------------------------------------------------------------------------------------- -! get maximum microstructure index - call IO_checkAndRewind(fileUnit) - do i = 1_pInt, headerLength - read(fileUnit,'(a65536)') line - enddo - - maxDataPerLine = 0_pInt - i = 1_pInt - - do while (i > 0_pInt) - i = IO_countContinuousIntValues(fileUnit) - maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? - enddo - allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) - allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size - allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) - -!-------------------------------------------------------------------------------------------------- -! read in microstructures - call IO_checkAndRewind(fileUnit) - do i=1_pInt,headerLength - read(fileUnit,'(a65536)') line - enddo - - e = 0_pInt - do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) - microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements - do i = 1_pInt,microstructures(1_pInt) - e = e+1_pInt ! valid element entry - microGlobal(e) = microstructures(1_pInt+i) - enddo - enddo - - elemType = FE_mapElemtype('C3D8R') - elemOffset = product(grid(1:2))*grid3Offset - e = 0_pInt - do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) - e = e+1_pInt ! valid element entry - mesh_element( 1,e) = -1_pInt ! DEPRECATED - mesh_element( 2,e) = elemType ! elem type - mesh_element( 3,e) = homog ! homogenization - mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure - mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & - ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node - mesh_element( 6,e) = mesh_element(5,e) + 1_pInt - mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt - mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt - mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node - mesh_element(10,e) = mesh_element(9,e) + 1_pInt - mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt - mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) - enddo - - if (e /= mesh_NcpElems) call IO_error(880_pInt,e) - -end subroutine mesh_spectral_build_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief build neighborhood relations for spectral -!> @details assign globals: mesh_ipNeighborhood -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_ipNeighborhood - - implicit none - integer(pInt) :: & - x,y,z, & - e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) - - e = 0_pInt - do z = 0_pInt,grid3-1_pInt - do y = 0_pInt,grid(2)-1_pInt - do x = 0_pInt,grid(1)-1_pInt - e = e + 1_pInt - mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x+1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x-1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & - + modulo(y+1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & - + modulo(y-1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt - mesh_ipNeighborhood(3,1,1,e) = 2_pInt - mesh_ipNeighborhood(3,2,1,e) = 1_pInt - mesh_ipNeighborhood(3,3,1,e) = 4_pInt - mesh_ipNeighborhood(3,4,1,e) = 3_pInt - mesh_ipNeighborhood(3,5,1,e) = 6_pInt - mesh_ipNeighborhood(3,6,1,e) = 5_pInt - enddo - enddo - enddo - -end subroutine mesh_spectral_build_ipNeighborhood - !-------------------------------------------------------------------------------------------------- !> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) @@ -1492,622 +926,8 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) nodes = nodes/8.0_pReal end function mesh_nodesAroundCentres -#endif -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_fileFormat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_tableStyles - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, j, data_blocks - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - - data_blocks = 1_pInt - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - read (fileUnit,610,END=620) line - if (len(trim(line))/=0_pInt) then - chunkPos = IO_stringPos(line) - data_blocks = IO_intValue(line,chunkPos,1_pInt) - endif - allocate(Marc_matNumber(data_blocks)) - do i=1_pInt,data_blocks ! read all data blocks - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block - read (fileUnit,610,END=620) line - enddo - enddo - exit - endif - enddo - -620 end subroutine mesh_marc_get_matNumber - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_nodesAndElements(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_IntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file - endif - enddo - -620 end subroutine mesh_marc_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,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 - mesh_NelemSets = mesh_NelemSets + 1_pInt - mesh_maxNelemInSet = max(mesh_maxNelemInSet, & - IO_countContinuousIntValues(fileUnit)) - endif - enddo - -620 end subroutine mesh_marc_count_elementSets - - -!******************************************************************** -! map element sets -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!******************************************************************** -subroutine mesh_marc_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,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 - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mesh_mapElemSet(:,elemSet) = & - IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - endif - enddo - -640 end subroutine mesh_marc_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues, & - IO_error, & - IO_intValue, & - IO_countNumericalDataLines - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,610,END=620) line - enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update - exit - endif - enddo - else ! Marc2017 and later - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end subroutine mesh_marc_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line, & - tmp - - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - contInts = 0_pInt - rewind(fileUnit) - do - read (fileUnit,610,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+hypoelasticTableStyle ! skip three (or four if new table style!) lines - read (fileUnit,610,END=660) line - enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) - exit - endif - else ! Marc2017 and later - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),"0123456789")/=0) then ! found keyword - exit - else - contInts(1) = contInts(1) + 1_pInt - read (tmp,*) contInts(contInts(1)+1) - endif - enddo - endif - endif - endif - enddo -660 do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) - mesh_mapFEtoCPelem(2,cpElem) = cpElem - enddo - -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - -end subroutine mesh_marc_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt) :: i - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - -610 FORMAT(A300) - - node_count = 0_pInt - - rewind(fileUnit) - do - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=650) line ! skip crap line - do i = 1_pInt,mesh_Nnodes - read (fileUnit,610,END=650) line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) - mesh_mapFEtoCPnode(2_pInt,i) = i - enddo - exit - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - -end subroutine mesh_marc_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_nodes(fileUnit) - - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue, & - IO_fixedNoEFloatValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=670) line ! skip crap line - do i=1_pInt,mesh_Nnodes - read (fileUnit,610,END=670) 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) - enddo - enddo - exit - endif - enddo - -670 mesh_node = mesh_node0 - -end subroutine mesh_marc_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_intValue, & - IO_skipChunks - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,t,g,e,c - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - rewind(fileUnit) - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=630) line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line - endif - enddo - exit - endif - enddo - -630 end subroutine mesh_marc_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per element. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_fixedNoEFloatValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=620) line ! garbage line - do i = 1_pInt,mesh_Nelems - read (fileUnit,610,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) & - 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 - enddo - nNodesAlreadyRead = chunkPos(1) - 2_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - exit - endif - enddo - -620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,610,END=620) 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,610,END=620) line ! read extra line for new style - read (fileUnit,610,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 - read (fileUnit,610,END=620) 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 - mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index - if (initialcondTableStyle == 2_pInt) then - read (fileUnit,610,END=630) line ! read extra line - read (fileUnit,610,END=630) line ! read extra line - endif - contInts = IO_continuousIntValues& ! get affected elements - (fileUnit,mesh_NcpElems,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 - enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - enddo - endif - else - read (fileUnit,610,END=630) line - endif - enddo - -630 end subroutine mesh_marc_build_elements -#endif - -#ifdef Abaqus !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of nodes and elements in mesh and stores them in !! 'mesh_Nelems' and 'mesh_Nnodes' @@ -2791,7 +1611,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) enddo 630 end subroutine mesh_abaqus_build_elements -#endif + !-------------------------------------------------------------------------------------------------- @@ -2807,25 +1627,14 @@ use IO, only: & implicit none integer(pInt), intent(in) :: fileUnit -#ifdef Spectral - mesh_periodicSurface = .true. - - end subroutine mesh_get_damaskOptions - -#else - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) chunk, Nchunks character(len=300) :: line, damaskOption, v character(len=300) :: keyword mesh_periodicSurface = .false. -#ifdef Marc4DAMASK - keyword = '$damask' -#endif -#ifdef Abaqus keyword = '**damask' -#endif + rewind(fileUnit) do @@ -2849,7 +1658,7 @@ use IO, only: & 610 FORMAT(A300) 620 end subroutine mesh_get_damaskOptions -#endif + !-------------------------------------------------------------------------------------------------- @@ -2925,7 +1734,7 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral + !-------------------------------------------------------------------------------------------------- !> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' !-------------------------------------------------------------------------------------------------- @@ -3227,7 +2036,7 @@ subroutine mesh_build_ipNeighborhood enddo end subroutine mesh_build_ipNeighborhood -#endif + !-------------------------------------------------------------------------------------------------- @@ -3336,14 +2145,6 @@ subroutine mesh_tell_statistics write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) enddo enddo -#ifndef Spectral - write(6,'(/,a,/)') 'Input Parser: NODE TWINS' - write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' - do n = 1_pInt,mesh_Nnodes ! loop over cpNodes - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle - write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) - enddo -#endif write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' do e = 1_pInt,mesh_NcpElems ! loop over cpElems From 09dc1041a55124a0acc8607432d91a73be6f323c Mon Sep 17 00:00:00 2001 From: navyanthkusam Date: Mon, 28 Jan 2019 14:36:44 +0100 Subject: [PATCH 020/154] variable attributes adjusted compiles now --- src/commercialFEM_fileList.f90 | 1 + src/mesh_abaqus.f90 | 8 +++----- src/mesh_marc.f90 | 11 ++++------- 3 files changed, 8 insertions(+), 12 deletions(-) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 7a32e7ade..d2765929f 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -13,6 +13,7 @@ #include "math.f90" #include "FEsolving.f90" #include "element.f90" +#include "mesh_base.f90" #ifdef Abaqus #include "mesh_abaqus.f90" #endif diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index bc14cd418..5d225bfb9 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -406,9 +406,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_mapMaterial !< name of elementSet for material integer(pInt), dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(:,:), allocatable, target :: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information contains @@ -419,7 +416,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & contains -subroutine tMesh_abaqus_init +subroutine tMesh_abaqus_init(self) implicit none class(tMesh_abaqus) :: self @@ -453,7 +450,8 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & - FEsolving_execElem, & + modelName, & + calcMode, & FEsolving_execElem, & FEsolving_execIP implicit none diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 85b4f3e7d..3e0447285 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -3,7 +3,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver +!> @brief Sets up the mesh for the solver MSC.Marc !-------------------------------------------------------------------------------------------------- module mesh use, intrinsic :: iso_c_binding @@ -400,8 +400,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_count_cpSizes, & mesh_marc_build_elements -contains - type, public, extends(tMesh) :: tMesh_marc integer(pInt), public :: & @@ -417,10 +415,7 @@ type, public, extends(tMesh) :: tMesh_marc mapMaterial !< name of elementSet for material integer(pInt), dimension(:), allocatable :: & Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) - integer(pInt), dimension(:,:), allocatable, target:: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode - integer(pInt), private :: & + integer(pInt) :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets, & @@ -435,6 +430,8 @@ type, public, extends(tMesh) :: tMesh_marc end type tMesh_marc type(tMesh_marc), public, protected :: theMesh + + contains subroutine tMesh_marc_init(self) From 346561beed2e7f8332158f1a277fce17612c0289 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Jan 2019 18:46:47 +0100 Subject: [PATCH 021/154] fixed dependencies --- src/CMakeLists.txt | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 62f44dacb..8d0697a65 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -7,6 +7,7 @@ endif() # The dependency detection in CMake is not functioning for Fortran, # hence we declare the dependencies from top to bottom in the following + add_library(C_ROUTINES OBJECT "C_routines.c") set(OBJECTFILES $) @@ -38,7 +39,7 @@ add_dependencies(NUMERICS IO) list(APPEND OBJECTFILES $) add_library(DEBUG OBJECT "debug.f90") -add_dependencies(DEBUG NUMERICS) +add_dependencies(DEBUG IO) list(APPEND OBJECTFILES $) add_library(DAMASK_CONFIG OBJECT "config.f90") @@ -46,7 +47,7 @@ add_dependencies(DAMASK_CONFIG DEBUG) list(APPEND OBJECTFILES $) add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90") -add_dependencies(HDF5_UTILITIES DAMASK_CONFIG) +add_dependencies(HDF5_UTILITIES DAMASK_CONFIG NUMERICS) list(APPEND OBJECTFILES $) add_library(RESULTS OBJECT "results.f90") @@ -54,28 +55,28 @@ add_dependencies(RESULTS HDF5_UTILITIES) list(APPEND OBJECTFILES $) add_library(FEsolving OBJECT "FEsolving.f90") -add_dependencies(FEsolving RESULTS) +add_dependencies(FEsolving DEBUG) list(APPEND OBJECTFILES $) add_library(MATH OBJECT "math.f90") -add_dependencies(MATH FEsolving) +add_dependencies(MATH NUMERICS) list(APPEND OBJECTFILES $) add_library(MESH_BASE OBJECT "mesh_base.f90") -add_dependencies(MESH_BASE MATH ELEMENT) +add_dependencies(MESH_BASE ELEMENT) list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh_grid.f90") - add_dependencies(MESH MATH) + add_dependencies(MESH MESH_BASE MATH FEsolving) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") - add_dependencies(FEZoo MATH) + add_dependencies(FEZoo IO) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "mesh_FEM.f90") - add_dependencies(MESH FEZoo) + add_dependencies(MESH FEZoo MESH_BASE MATH FEsolving) list(APPEND OBJECTFILES $) endif() @@ -83,9 +84,9 @@ add_library(MATERIAL OBJECT "material.f90") add_dependencies(MATERIAL MESH DAMASK_CONFIG) list(APPEND OBJECTFILES $) -add_library(DAMASK_HELPERS OBJECT "lattice.f90") -add_dependencies(DAMASK_HELPERS MATERIAL) -list(APPEND OBJECTFILES $) +add_library(LATTICE OBJECT "lattice.f90") +add_dependencies(LATTICE MATERIAL) +list(APPEND OBJECTFILES $) # For each modular section add_library (PLASTIC OBJECT @@ -96,14 +97,14 @@ add_library (PLASTIC OBJECT "plastic_kinematichardening.f90" "plastic_nonlocal.f90" "plastic_none.f90") -add_dependencies(PLASTIC DAMASK_HELPERS) +add_dependencies(PLASTIC LATTICE RESULTS) list(APPEND OBJECTFILES $) add_library (KINEMATICS OBJECT "kinematics_cleavage_opening.f90" "kinematics_slipplane_opening.f90" "kinematics_thermal_expansion.f90") -add_dependencies(KINEMATICS DAMASK_HELPERS) +add_dependencies(KINEMATICS LATTICE RESULTS) list(APPEND OBJECTFILES $) add_library (SOURCE OBJECT @@ -113,7 +114,7 @@ add_library (SOURCE OBJECT "source_damage_isoDuctile.f90" "source_damage_anisoBrittle.f90" "source_damage_anisoDuctile.f90") -add_dependencies(SOURCE DAMASK_HELPERS) +add_dependencies(SOURCE LATTICE RESULTS) list(APPEND OBJECTFILES $) add_library(CONSTITUTIVE OBJECT "constitutive.f90") From beb0ca01eb388721ee78caa62df777a0e534318c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 11:29:56 +0100 Subject: [PATCH 022/154] define functions where needed only use solver specific element names --- src/IO.f90 | 143 ++++++++++++++++---------------------------- src/mesh_abaqus.f90 | 68 +++++++++++---------- src/mesh_marc.f90 | 36 +++-------- 3 files changed, 97 insertions(+), 150 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 1f9ff937c..66ebb2d88 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -57,19 +57,11 @@ module IO public :: & IO_open_inputFile, & IO_open_logFile -#endif -#ifdef Abaqus - public :: & - IO_abaqus_hasNoPart #endif private :: & IO_fixedFloatValue, & IO_verifyFloatValue, & IO_verifyIntValue -#ifdef Abaqus - private :: & - abaqus_assembleInputFile -#endif contains @@ -385,6 +377,59 @@ subroutine IO_open_inputFile(fileUnit,modelName) 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) + + contains + +!-------------------------------------------------------------------------------------------------- +!> @brief create a new input file for abaqus simulations by removing all comment lines and +!> including "include"s +!-------------------------------------------------------------------------------------------------- +recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) + + implicit none + integer(pInt), intent(in) :: unit1, & + unit2 + + + integer(pInt), 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 + fname = trim(line(9+scan(line(9:),'='):)) + inquire(file=fname, exist=fexist) + if (.not.(fexist)) then + !$OMP CRITICAL (write2out) + write(6,*)'ERROR: file does not exist error in abaqus_assembleInputFile' + write(6,*)'filename: ', trim(fname) + !$OMP END CRITICAL (write2out) + createSuccess = .false. + return + endif + open(unit2+1,err=200,status='old',file=fname) + if (abaqus_assembleInputFile(unit1,unit2+1_pInt)) then + createSuccess=.true. + close(unit2+1) + else + createSuccess=.false. + return + endif + else if (line(1:2) /= '**' .OR. line(1:8)=='**damask') then + write(unit1,'(A)') trim(line) + endif + enddo + +220 createSuccess = .true. + return + +200 createSuccess =.false. + +end function abaqus_assembleInputFile #endif #ifdef Marc4DAMASK path = trim(modelName)//inputFileExtension @@ -556,35 +601,6 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) end subroutine IO_read_intFile -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief check if the input file for Abaqus contains part info -!-------------------------------------------------------------------------------------------------- -logical function IO_abaqus_hasNoPart(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line - - IO_abaqus_hasNoPart = .true. - -610 FORMAT(A65536) - rewind(fileUnit) - do - read(fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then - IO_abaqus_hasNoPart = .false. - exit - endif - enddo - -620 end function IO_abaqus_hasNoPart -#endif - - !-------------------------------------------------------------------------------------------------- !> @brief identifies strings without content !-------------------------------------------------------------------------------------------------- @@ -1598,57 +1614,4 @@ real(pReal) function IO_verifyFloatValue (string,validChars,myName) end function IO_verifyFloatValue -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief create a new input file for abaqus simulations by removing all comment lines and -!> including "include"s -!-------------------------------------------------------------------------------------------------- -recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) - - implicit none - integer(pInt), intent(in) :: unit1, & - unit2 - - - integer(pInt), 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 - fname = trim(line(9+scan(line(9:),'='):)) - inquire(file=fname, exist=fexist) - if (.not.(fexist)) then - !$OMP CRITICAL (write2out) - write(6,*)'ERROR: file does not exist error in abaqus_assembleInputFile' - write(6,*)'filename: ', trim(fname) - !$OMP END CRITICAL (write2out) - createSuccess = .false. - return - endif - open(unit2+1,err=200,status='old',file=fname) - if (abaqus_assembleInputFile(unit1,unit2+1_pInt)) then - createSuccess=.true. - close(unit2+1) - else - createSuccess=.false. - return - endif - else if (line(1:2) /= '**' .OR. line(1:8)=='**damask') then - write(unit1,'(A)') trim(line) - endif - enddo - -220 createSuccess = .true. - return - -200 createSuccess =.false. - -end function abaqus_assembleInputFile -#endif - end module IO diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 5d225bfb9..1758c5986 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -434,7 +434,6 @@ subroutine mesh_init(ip,el) #endif use DAMASK_interface use IO, only: & - IO_abaqus_hasNoPart, & IO_open_InputFile, & IO_timeStamp, & IO_error, & @@ -471,7 +470,7 @@ subroutine mesh_init(ip,el) call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - noPart = IO_abaqus_hasNoPart(FILEUNIT) + noPart = hasNoPart(FILEUNIT) call mesh_abaqus_count_nodesAndElements(FILEUNIT) if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) call mesh_abaqus_count_elementSets(FILEUNIT) @@ -542,6 +541,33 @@ subroutine mesh_init(ip,el) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! +contains +!-------------------------------------------------------------------------------------------------- +!> @brief check if the input file for Abaqus contains part info +!-------------------------------------------------------------------------------------------------- +logical function hasNoPart(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line + + hasNoPart = .true. + +610 FORMAT(A65536) + rewind(fileUnit) + do + read(fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then + hasNoPart = .false. + exit + endif + enddo + +620 end function hasNoPart + end subroutine mesh_init @@ -1497,7 +1523,6 @@ subroutine mesh_abaqus_build_elements(fileUnit) use IO, only: IO_lc, & IO_stringValue, & - IO_skipChunks, & IO_stringPos, & IO_intValue, & IO_extractValue, & @@ -2173,49 +2198,28 @@ integer(pInt) function FE_mapElemtype(what) character(len=*), intent(in) :: what select case (IO_lc(what)) - case ( '6') - FE_mapElemtype = 1_pInt ! 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) - case ( '11', & - 'cpe4', & + case ( 'cpe4', & 'cpe4t') FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27', & - 'cpe8', & + case ( 'cpe8', & 'cpe8t') FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral - case ( '54') - FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - case ( '134', & - 'c3d4', & + case ( 'c3d4', & 'c3d4t') FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron - case ( '157') - FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations - case ( '127') - FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron - case ( '136', & - 'c3d6', & + case ( 'c3d6', & 'c3d6t') FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( '117', & - '123', & - 'c3d8r', & + case ( 'c3d8r', & 'c3d8rt') FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7', & - 'c3d8', & + case ( 'c3d8', & 'c3d8t') FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57', & - 'c3d20r', & + case ( 'c3d20r', & 'c3d20rt') FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21', & - 'c3d20', & + case ( 'c3d20', & 'c3d20t') FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 3e0447285..67c343ebe 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -1909,44 +1909,28 @@ integer(pInt) function FE_mapElemtype(what) '125', & '128') FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) - case ( '11', & - 'cpe4', & - 'cpe4t') + case ( '11') FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27', & - 'cpe8', & - 'cpe8t') + case ( '27') FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral case ( '54') FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - case ( '134', & - 'c3d4', & - 'c3d4t') + case ( '134') FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron case ( '157') FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations case ( '127') FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron - case ( '136', & - 'c3d6', & - 'c3d6t') + case ( '136') FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral case ( '117', & - '123', & - 'c3d8r', & - 'c3d8rt') + '123') FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7', & - 'c3d8', & - 'c3d8t') + case ( '7') FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57', & - 'c3d20r', & - 'c3d20rt') + case ( '57') FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21', & - 'c3d20', & - 'c3d20t') + case ( '21') FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) @@ -2807,7 +2791,3 @@ end function mesh_get_nodeAtIP end module mesh - - - - From 615b1669928c6f66b2bbc8d83b95242be4947a46 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 11:39:28 +0100 Subject: [PATCH 023/154] removed unused stuff --- src/CPFEM2.f90 | 2 -- src/IO.f90 | 31 ------------------------------- src/constitutive.f90 | 1 - src/mesh_marc.f90 | 4 ---- 4 files changed, 38 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 91cc08296..b2aa2f598 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -95,8 +95,6 @@ subroutine CPFEM_init use prec, only: & pInt, pReal, pLongInt use IO, only: & - IO_read_realFile,& - IO_read_intFile, & IO_timeStamp, & IO_error use numerics, only: & diff --git a/src/IO.f90 b/src/IO.f90 index 66ebb2d88..698b8f1d5 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -30,7 +30,6 @@ module IO IO_open_jobFile, & IO_write_jobFile, & IO_write_jobRealFile, & - IO_write_jobIntFile, & IO_read_realFile, & IO_read_intFile, & IO_isBlank, & @@ -515,36 +514,6 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) end subroutine IO_write_jobRealFile -!-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is -!! named after solver job name plus given extension and located in current working directory -!-------------------------------------------------------------------------------------------------- -subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) - use DAMASK_interface, only: & - getSolverJobName - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file - integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverJobName())//'.'//ext - if (present(recMultiplier)) then - open(fileUnit,status='replace',form='unformatted',access='direct', & - recl=pInt*recMultiplier,iostat=myStat,file=path) - else - open(fileUnit,status='replace',form='unformatted',access='direct', & - recl=pInt,iostat=myStat,file=path) - endif - - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - -end subroutine IO_write_jobIntFile - - !-------------------------------------------------------------------------------------------------- !> @brief opens binary file containing array of pReal numbers to given unit for reading. File is !! located in current working directory diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a0d7147a6..43d57a493 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -56,7 +56,6 @@ subroutine constitutive_init() IO_checkAndRewind, & IO_open_jobFile_stat, & IO_write_jobFile, & - IO_write_jobIntFile, & IO_timeStamp use config, only: & config_phase diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 67c343ebe..3db48fe8c 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -515,9 +515,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - - - call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -532,7 +529,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) close (FILEUNIT) - call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems From bcd9908a88b1e138354935ebac1c47bb7a18276f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 12:23:23 +0100 Subject: [PATCH 024/154] all variables/functions were not used --- src/homogenization.f90 | 2 - src/mesh_abaqus.f90 | 50 -------- src/mesh_grid.f90 | 267 ++--------------------------------------- src/mesh_marc.f90 | 62 +--------- 4 files changed, 12 insertions(+), 369 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index ac41158a1..20ce008fd 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -74,7 +74,6 @@ subroutine homogenization_init mesh_maxNips, & mesh_NcpElems, & mesh_element, & - FE_Nips, & FE_geomtype use constitutive, only: & constitutive_plasticity_maxSizePostResults, & @@ -346,7 +345,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_Lp, & crystallite_Li0, & crystallite_Li, & - crystallite_dPdF, & crystallite_Tstar0_v, & crystallite_Tstar_v, & crystallite_partionedF0, & diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 1758c5986..ec6b11ffa 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -363,9 +363,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_ipVolumes, & mesh_build_ipCoordinates, & mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & mesh_FEasCP private :: & @@ -3033,51 +3030,4 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() - - implicit none - - mesh_get_Ncellnodes = mesh_Ncellnodes - -end function mesh_get_Ncellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_unitlength -!-------------------------------------------------------------------------------------------------- -real(pReal) function mesh_get_unitlength() - - implicit none - - mesh_get_unitlength = mesh_unitlength - -end function mesh_get_unitlength - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns node that is located at an ip -!> @details return zero if requested ip does not exist or not available (more ips than nodes) -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) - - implicit none - character(len=*), intent(in) :: elemtypeFE - integer(pInt), intent(in) :: ip - integer(pInt) :: elemtype - integer(pInt) :: geomtype - - mesh_get_nodeAtIP = 0_pInt - - elemtype = FE_mapElemtype(elemtypeFE) - geomtype = FE_geomtype(elemtype) - if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & - mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) - -end function mesh_get_nodeAtIP - - end module mesh diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 8b1659ed8..a2a041955 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -61,10 +61,7 @@ module mesh real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) - logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) - - integer(pInt), dimension(2), private :: & - mesh_maxValStateVar = 0_pInt + logical, dimension(3), public, parameter :: mesh_periodicSurface = .true. !< flag indicating periodic outer surfaces (used for fluxes) integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID @@ -81,9 +78,6 @@ 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 :: & - FE_subNodeOnIPFace - ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" @@ -192,86 +186,6 @@ 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 - reshape(int([ & - 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) - 2,2,2,0,0,0, & ! element 125 (2D 6node 3ip) - 2,2,2,2,0,0, & ! element 11 (2D 4node 4ip) - 2,2,2,2,0,0, & ! element 27 (2D 8node 9ip) - 3,3,3,3,0,0, & ! element 134 (3D 4node 1ip) - 3,3,3,3,0,0, & ! element 127 (3D 10node 4ip) - 3,4,4,4,3,0, & ! element 136 (3D 6node 6ip) - 4,4,4,4,4,4, & ! element 117 (3D 8node 1ip) - 4,4,4,4,4,4, & ! element 7 (3D 8node 8ip) - 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), & - 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) - 2,3,0,0 , & - 3,1,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,0,0 , & ! element 125 (2D 6node 3ip) - 2,3,0,0 , & - 3,1,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,0,0 , & ! element 11 (2D 4node 4ip) - 2,3,0,0 , & - 3,4,0,0 , & - 4,1,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,0,0 , & ! element 27 (2D 8node 9ip) - 2,3,0,0 , & - 3,4,0,0 , & - 4,1,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,3,0 , & ! element 134 (3D 4node 1ip) - 1,4,2,0 , & - 2,3,4,0 , & - 1,3,4,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,3,0 , & ! element 127 (3D 10node 4ip) - 1,4,2,0 , & - 2,4,3,0 , & - 1,3,4,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,3,0 , & ! element 136 (3D 6node 6ip) - 1,4,5,2 , & - 2,5,6,3 , & - 1,3,6,4 , & - 4,6,5,0 , & - 0,0,0,0 , & - 1,2,3,4 , & ! element 117 (3D 8node 1ip) - 2,1,5,6 , & - 3,2,6,7 , & - 4,3,7,8 , & - 4,1,5,8 , & - 8,7,6,5 , & - 1,2,3,4 , & ! element 7 (3D 8node 8ip) - 2,1,5,6 , & - 3,2,6,7 , & - 4,3,7,8 , & - 4,1,5,8 , & - 8,7,6,5 , & - 1,2,3,4 , & ! element 21 (3D 20node 27ip) - 2,1,5,6 , & - 3,2,6,7 , & - 4,3,7,8 , & - 4,1,5,8 , & - 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 int([ & 3, & ! element 6 (2D 3node 1ip) @@ -354,29 +268,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & public :: & mesh_init, & - mesh_build_cellnodes, & - mesh_build_ipVolumes, & - mesh_build_ipCoordinates, & - mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & + mesh_cellCenterCoordinates - mesh_spectral_getGrid, & - mesh_spectral_getSize private :: & - mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_faceMatch, & mesh_build_FEdata, & mesh_spectral_getHomogenization, & mesh_spectral_count, & mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & - mesh_spectral_build_ipNeighborhood + mesh_spectral_build_ipNeighborhood, & + mesh_spectral_getGrid, & + mesh_spectral_getSize, & + mesh_build_cellnodes, & + mesh_build_ipVolumes, & + mesh_build_ipCoordinates type, public, extends(tMesh) :: tMesh_grid @@ -437,9 +346,7 @@ subroutine mesh_init(ip,el) debug_mesh, & debug_levelBasic use numerics, only: & - usePingPong, & - numerics_unitlength, & - worldrank + numerics_unitlength use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -491,8 +398,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) call mesh_spectral_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -1160,8 +1065,6 @@ subroutine mesh_spectral_build_elements(fileUnit) mesh_element(10,e) = mesh_element(9,e) + 1_pInt mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) enddo if (e /= mesh_NcpElems) call IO_error(880_pInt,e) @@ -1314,25 +1217,6 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) end function mesh_nodesAroundCentres -!-------------------------------------------------------------------------------------------------- -!> @brief get any additional damask options from input file, sets mesh_periodicSurface -!-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) - -use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - - mesh_periodicSurface = .true. - - end subroutine mesh_get_damaskOptions - - !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' !-------------------------------------------------------------------------------------------------- @@ -1407,93 +1291,6 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -!-------------------------------------------------------------------------------------------------- -!> @brief find face-matching element of same type -!-------------------------------------------------------------------------------------------------- -subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) - -implicit none -integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID - matchingFace ! matching face ID -integer(pInt), intent(in) :: face, & ! face ID - elem ! CP elem ID -integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & - myFaceNodes ! global node ids on my face -integer(pInt) :: myType, & - candidateType, & - candidateElem, & - candidateFace, & - candidateFaceNode, & - minNsharedElems, & - NsharedElems, & - lonelyNode = 0_pInt, & - i, & - n, & - dir ! periodicity direction -integer(pInt), 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 - -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 - if (NsharedElems < minNsharedElems) then - minNsharedElems = NsharedElems ! remember min # shared elems - lonelyNode = n ! remember most lonely node - endif -enddo - -allocate(element_seen(minNsharedElems)) -element_seen = 0_pInt - -checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements - candidateElem = mesh_sharedElem(1_pInt+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 - 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) - 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 - 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 - cycle checkCandidateFace - else - cycle checkCandidateFaceTwins ! try twins in next dimension - endif - endif - enddo - exit checkCandidateFaceTwins - enddo checkCandidateFaceTwins - endif - matchingFace = candidateFace - matchingElem = candidateElem - exit checkCandidate ! found my matching candidate - enddo checkCandidateFace - endif -enddo checkCandidate - -end subroutine mesh_faceMatch - - !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements !> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace @@ -2212,50 +2009,4 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() - - implicit none - - mesh_get_Ncellnodes = mesh_Ncellnodes - -end function mesh_get_Ncellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_unitlength -!-------------------------------------------------------------------------------------------------- -real(pReal) function mesh_get_unitlength() - - implicit none - - mesh_get_unitlength = mesh_unitlength - -end function mesh_get_unitlength - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns node that is located at an ip -!> @details return zero if requested ip does not exist or not available (more ips than nodes) -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) - - implicit none - character(len=*), intent(in) :: elemtypeFE - integer(pInt), intent(in) :: ip - integer(pInt) :: elemtype - integer(pInt) :: geomtype - - mesh_get_nodeAtIP = 0_pInt - - elemtype = 10_pInt - geomtype = FE_geomtype(elemtype) - if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & - mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) - -end function mesh_get_nodeAtIP - - end module mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 3db48fe8c..7deb14fff 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -67,9 +67,6 @@ module mesh mesh_maxNelemInSet, & mesh_Nmaterials - integer(pInt), dimension(2), private :: & - mesh_maxValStateVar = 0_pInt - integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID @@ -371,9 +368,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_ipVolumes, & mesh_build_ipCoordinates, & mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & mesh_FEasCP @@ -422,9 +416,7 @@ type, public, extends(tMesh) :: tMesh_marc mesh_maxNelemInSet integer(pInt), dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(2):: & - mesh_maxValStateVar = 0_pInt - + contains procedure :: init => tMesh_marc_init end type tMesh_marc @@ -1442,7 +1434,6 @@ subroutine mesh_marc_build_elements(fileUnit) 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 - mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index if (initialcondTableStyle == 2_pInt) then read (fileUnit,610,END=630) line ! read extra line read (fileUnit,610,END=630) line ! read extra line @@ -1493,12 +1484,12 @@ use IO, only: & read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) select case(damaskOption) case('periodic') ! damask Option that allows to specify periodic fluxes do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) - v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? + 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' mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' @@ -2739,51 +2730,4 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() - - implicit none - - mesh_get_Ncellnodes = mesh_Ncellnodes - -end function mesh_get_Ncellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_unitlength -!-------------------------------------------------------------------------------------------------- -real(pReal) function mesh_get_unitlength() - - implicit none - - mesh_get_unitlength = mesh_unitlength - -end function mesh_get_unitlength - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns node that is located at an ip -!> @details return zero if requested ip does not exist or not available (more ips than nodes) -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) - - implicit none - character(len=*), intent(in) :: elemtypeFE - integer(pInt), intent(in) :: ip - integer(pInt) :: elemtype - integer(pInt) :: geomtype - - mesh_get_nodeAtIP = 0_pInt - - elemtype = FE_mapElemtype(elemtypeFE) - geomtype = FE_geomtype(elemtype) - if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & - mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) - -end function mesh_get_nodeAtIP - - end module mesh From ccb320fa6ebd46cc2b8087457ce49eaa8adddd97 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 14:00:26 +0100 Subject: [PATCH 025/154] central function for less depencies --- src/plastic_nonlocal.f90 | 48 +++++++++++++--------------------------- 1 file changed, 15 insertions(+), 33 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index c43de6627..417800629 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -216,8 +216,7 @@ contains !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_init(fileUnit) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) -use math, only: math_Mandel3333to66, & - math_Voigt66to3333, & +use math, only: math_Voigt66to3333, & math_mul3x3, & math_transpose33 use IO, only: IO_read, & @@ -245,11 +244,11 @@ use material, only: phase_plasticity, & PLASTICITY_NONLOCAL_label, & PLASTICITY_NONLOCAL_ID, & plasticState, & - material_phase + material_phase, & + material_allocatePlasticState use config, only: MATERIAL_partPhase use lattice -use numerics,only: & - numerics_integrator + implicit none @@ -929,30 +928,13 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), endif enddo outputsLoop - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_nonlocal_sizePostResults(instance) plasticState(phase)%nonlocal = .true. - plasticState(phase)%nSlip = totalNslip(instance) - plasticState(phase)%nTwin = 0_pInt - plasticState(phase)%nTrans= 0_pInt - allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) + call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & + totalNslip(instance),0_pInt,0_pInt) - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + plasticState(phase)%slipRate => & plasticState(phase)%dotState(iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) plasticState(phase)%accumulatedSlip => & @@ -1638,10 +1620,10 @@ end subroutine plastic_nonlocal_kinetics !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, ip, el) -use math, only: math_Plain3333to99, & +use math, only: math_3333to99, & math_mul6x6, & math_mul33xx33, & - math_Mandel6to33 + math_6toSym33 use debug, only: debug_level, & debug_constitutive, & debug_levelExtensive, & @@ -1733,11 +1715,11 @@ do s = 1_pInt,ns tauNS(s,1) = tau(s) tauNS(s,2) = tau(s) if (tau(s) > 0.0_pReal) then - tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance)) - tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance)) + tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance)) + tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance)) else - tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance)) - tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance)) + tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance)) + tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance)) endif enddo forall (t = 1_pInt:4_pInt) & @@ -1812,7 +1794,7 @@ do s = 1_pInt,ns * burgers(s,instance) endif enddo -dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) +dLp_dTstar99 = math_3333to99(dLp_dTstar3333) #ifdef DEBUG From b9c834f86a60b8789404d187c9586786ca998eba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 17:01:26 +0100 Subject: [PATCH 026/154] missing use from IO --- src/mesh_abaqus.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index ec6b11ffa..8c93a899a 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -543,7 +543,11 @@ contains !> @brief check if the input file for Abaqus contains part info !-------------------------------------------------------------------------------------------------- logical function hasNoPart(fileUnit) - + use IO, only: & + IO_stringPos, & + IO_stringValue, & + IO_lc + implicit none integer(pInt), intent(in) :: fileUnit From 721af0a9a9ad75c8789ad6fe1f5ce256d7a93704 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 07:06:19 +0100 Subject: [PATCH 027/154] plastic_nonlocal still has confusing state handling --- src/plastic_nonlocal.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 417800629..cba989cb5 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -933,7 +933,8 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), plasticState(phase)%nonlocal = .true. call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & totalNslip(instance),0_pInt,0_pInt) - + + plasticState(phase)%offsetDeltaState = 0_pInt plasticState(phase)%slipRate => & plasticState(phase)%dotState(iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) From b87a09a46698faf233c1dbbea4c896fd929a5f36 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 11:22:06 +0100 Subject: [PATCH 028/154] not needed --- src/mesh_abaqus.f90 | 5 +---- src/mesh_marc.f90 | 5 +---- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 8c93a899a..98bdda4ef 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -746,10 +746,7 @@ subroutine mesh_build_ipVolumes integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - if (.not. allocated(mesh_ipVolume)) then - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal - endif + 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 diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 7deb14fff..2cca47239 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -730,10 +730,7 @@ subroutine mesh_build_ipVolumes integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - if (.not. allocated(mesh_ipVolume)) then - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal - endif + 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 From 5f8b110f63cd69dcaea26d239ab35e2d51bc4107 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 12:24:23 +0100 Subject: [PATCH 029/154] initialize mesh and element --- src/mesh_abaqus.f90 | 109 +++++--------------------------------------- src/mesh_base.f90 | 20 +++++++- src/mesh_grid.f90 | 86 +++++++++++----------------------- src/mesh_marc.f90 | 17 +++++-- 4 files changed, 70 insertions(+), 162 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 98bdda4ef..62ece4c93 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -389,7 +389,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_abaqus_build_elements - type, public, extends(tMesh) :: tMesh_Abaqus + type, public, extends(tMesh) :: tMesh_abaqus integer(pInt):: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) @@ -406,16 +406,22 @@ integer(pInt), dimension(:,:), allocatable, private :: & logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information contains - procedure :: init=>tMesh_abaqus_init - end type tMesh_Abaqus + procedure, pass(self) :: tMesh_abaqus_init + generic, public :: init => tMesh_abaqus_init + end type tMesh_abaqus - type(tMesh_Abaqus), public, protected :: theMesh + type(tMesh_abaqus), public, protected :: theMesh contains -subroutine tMesh_abaqus_init(self) +subroutine tMesh_abaqus_init(self,elemType,nodes) + implicit none class(tMesh_abaqus) :: self + real(pReal), dimension(:,:), intent(in) :: nodes + integer(pInt), intent(in) :: elemType + + call self%tMesh%init('mesh',elemType,nodes) end subroutine tMesh_abaqus_init @@ -537,7 +543,7 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%init(mesh_element(2,1),mesh_node0) contains !-------------------------------------------------------------------------------------------------- !> @brief check if the input file for Abaqus contains part info @@ -859,97 +865,6 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates - -!-------------------------------------------------------------------------------------------------- -!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) -!-------------------------------------------------------------------------------------------------- -function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) - use debug, only: & - debug_mesh, & - debug_level, & - debug_levelBasic - use math, only: & - math_mul33x3 - - implicit none - real(pReal), intent(in), dimension(:,:,:,:) :: & - centres - real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & - nodes - real(pReal), intent(in), dimension(3) :: & - gDim - real(pReal), intent(in), dimension(3,3) :: & - Favg - real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & - wrappedCentres - - integer(pInt) :: & - i,j,k,n - integer(pInt), dimension(3), parameter :: & - diag = 1_pInt - integer(pInt), dimension(3) :: & - shift = 0_pInt, & - lookup = 0_pInt, & - me = 0_pInt, & - iRes = 0_pInt - integer(pInt), dimension(3,8) :: & - neighbor = reshape([ & - 0_pInt, 0_pInt, 0_pInt, & - 1_pInt, 0_pInt, 0_pInt, & - 1_pInt, 1_pInt, 0_pInt, & - 0_pInt, 1_pInt, 0_pInt, & - 0_pInt, 0_pInt, 1_pInt, & - 1_pInt, 0_pInt, 1_pInt, & - 1_pInt, 1_pInt, 1_pInt, & - 0_pInt, 1_pInt, 1_pInt ], [3,8]) - -!-------------------------------------------------------------------------------------------------- -! initializing variables - iRes = [size(centres,2),size(centres,3),size(centres,4)] - nodes = 0.0_pReal - wrappedCentres = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! report - if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then - write(6,'(a)') ' Meshing cubes around centroids' - write(6,'(a,3(e12.5))') ' Dimension: ', gDim - write(6,'(a,3(i5))') ' Resolution:', iRes - endif - -!-------------------------------------------------------------------------------------------------- -! building wrappedCentres = centroids + ghosts - wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres - do k = 0_pInt,iRes(3)+1_pInt - do j = 0_pInt,iRes(2)+1_pInt - do i = 0_pInt,iRes(1)+1_pInt - if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin - j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin - i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin - me = [i,j,k] ! me on skin - shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) - lookup = me-diag+shift*iRes - wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & - centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & - - math_mul33x3(Favg, real(shift,pReal)*gDim) - endif - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! averaging - do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) - do n = 1_pInt,8_pInt - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & - j+1_pInt+neighbor(2,n), & - k+1_pInt+neighbor(3,n) ) - enddo - enddo; enddo; enddo - nodes = nodes/8.0_pReal - -end function mesh_nodesAroundCentres - - !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of nodes and elements in mesh and stores them in !! 'mesh_Nelems' and 'mesh_Nnodes' diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index 477fc3aed..f9a076f03 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -29,7 +29,7 @@ module mesh_base node !< node x,y,z coordinates (deformed) integer(pInt), dimension(:,:), allocatable, public :: & cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID - character(pStringLen) :: solver = "undefined" + character(pStringLen) :: type = "n/a" integer(pInt) :: & Nnodes, & !< total number of nodes in mesh Nelems = -1_pInt, & @@ -43,6 +43,24 @@ module mesh_base microstructureAt integer(pInt), dimension(:,:), allocatable, public :: & connectivity + contains + procedure, pass(self) :: tMesh_base_init + generic, public :: init => tMesh_base_init end type tMesh +contains +subroutine tMesh_base_init(self,meshType,elemType,nodes) + + implicit none + class(tMesh) :: self + character(len=*), intent(in) :: meshType + integer(pInt), intent(in) :: elemType + real(pReal), dimension(:,:), intent(in) :: nodes + + self%type = meshType + call self%elem%init(elemType) + self%node0 = nodes + +end subroutine tMesh_base_init + end module mesh_base diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index a2a041955..cff0dbc21 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -270,14 +270,11 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_init, & mesh_cellCenterCoordinates - private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & mesh_build_FEdata, & mesh_spectral_getHomogenization, & - mesh_spectral_count, & - mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & @@ -302,19 +299,21 @@ integer(pInt), dimension(:,:), allocatable, private :: & size3offset contains - procedure :: init => tMesh_grid_init + procedure, pass(self) :: tMesh_grid_init + generic, public :: init => tMesh_grid_init end type tMesh_grid type(tMesh_grid), public, protected :: theMesh contains -subroutine tMesh_grid_init(self) +subroutine tMesh_grid_init(self,nodes) implicit none class(tMesh_grid) :: self + real(pReal), dimension(:,:), intent(in) :: nodes - call self%elem%init(10_pInt) + call self%tMesh%init('grid',10_pInt,nodes) end subroutine tMesh_grid_init @@ -364,7 +363,8 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call theMesh%init + + call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh @@ -389,13 +389,23 @@ subroutine mesh_init(ip,el) grid3Offset = int(local_K_offset,pInt) size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) - if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) - call mesh_spectral_count() - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_spectral_count_cpSizes - if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) + mesh_NcpElems= product(grid(1:2))*grid3 + mesh_NcpElemsGlobal = product(grid) + + mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) + call mesh_spectral_build_nodes() + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call theMesh%init(mesh_node) + ! For compatibility + + mesh_maxNips = theMesh%elem%nIPs + mesh_maxNipNeighbors = theMesh%elem%nIPneighbors + mesh_maxNcellnodes = theMesh%elem%Ncellnodes + + + call mesh_spectral_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_build_cellconnectivity @@ -434,8 +444,6 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - - end subroutine mesh_init @@ -563,10 +571,9 @@ subroutine mesh_build_ipVolumes integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - if (.not. allocated(mesh_ipVolume)) then - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal - endif + + 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 @@ -894,43 +901,6 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) end function mesh_spectral_getHomogenization -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count() - - implicit none - - mesh_NcpElems= product(grid(1:2))*grid3 - mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) - - mesh_NcpElemsGlobal = product(grid) - -end subroutine mesh_spectral_count - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count_cpSizes - - implicit none - integer(pInt) :: t,g,c - - t = 10_pInt - g = FE_geomtype(t) - c = FE_celltype(g) - - mesh_maxNips = FE_Nips(g) - mesh_maxNipNeighbors = FE_NipNeighbors(c) - mesh_maxNcellnodes = FE_Ncellnodes(g) - -end subroutine mesh_spectral_count_cpSizes - - !-------------------------------------------------------------------------------------------------- !> @brief Store x,y,z coordinates of all nodes in mesh. !! Allocates global arrays 'mesh_node0' and 'mesh_node' @@ -941,7 +911,6 @@ subroutine mesh_spectral_build_nodes() integer(pInt) :: n allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) - allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) forall (n = 0_pInt:mesh_Nnodes-1_pInt) mesh_node0(1,n+1_pInt) = mesh_unitlength * & @@ -986,7 +955,6 @@ subroutine mesh_spectral_build_elements(fileUnit) headerLength = 0_pInt, & maxDataPerLine, & homog, & - elemType, & elemOffset integer(pInt), dimension(:), allocatable :: & microstructures, & @@ -1047,13 +1015,13 @@ subroutine mesh_spectral_build_elements(fileUnit) enddo enddo - elemType = 10_pInt + elemOffset = product(grid(1:2))*grid3Offset e = 0_pInt do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) e = e+1_pInt ! valid element entry mesh_element( 1,e) = -1_pInt ! DEPRECATED - mesh_element( 2,e) = elemType ! elem type + mesh_element( 2,e) = 10_pInt mesh_element( 3,e) = homog ! homogenization mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 2cca47239..5607791fb 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -417,8 +417,9 @@ type, public, extends(tMesh) :: tMesh_marc integer(pInt), dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet - contains - procedure :: init => tMesh_marc_init + contains + procedure, pass(self) :: tMesh_marc_init + generic, public :: init => tMesh_marc_init end type tMesh_marc type(tMesh_marc), public, protected :: theMesh @@ -426,10 +427,15 @@ end type tMesh_marc contains -subroutine tMesh_marc_init(self) +subroutine tMesh_marc_init(self,elemType,nodes) + implicit none class(tMesh_marc) :: self - + real(pReal), dimension(:,:), intent(in) :: nodes + integer(pInt), intent(in) :: elemType + + call self%tMesh%init('mesh',elemType,nodes) + end subroutine tMesh_marc_init !-------------------------------------------------------------------------------------------------- @@ -553,7 +559,8 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%init(mesh_element(2,1),mesh_node0) + end subroutine mesh_init From 614a8d694cbbd2442dcc83f14f97270e2f8e82cd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 12:28:18 +0100 Subject: [PATCH 030/154] re-implement mesh reporting later on in mesh_base --- src/mesh_abaqus.f90 | 132 -------------------------------------------- 1 file changed, 132 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 62ece4c93..159f2a7f6 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -369,7 +369,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_tell_statistics, & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & @@ -516,10 +515,6 @@ subroutine mesh_init(ip,el) call mesh_build_ipNeighborhood if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (worldrank == 0_pInt) then - call mesh_tell_statistics - endif - if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements if (debug_e < 1 .or. debug_e > mesh_NcpElems) & @@ -1974,133 +1969,6 @@ subroutine mesh_build_ipNeighborhood end subroutine mesh_build_ipNeighborhood - -!-------------------------------------------------------------------------------------------------- -!> @brief write statistics regarding input file parsing to the output file -!-------------------------------------------------------------------------------------------------- -subroutine mesh_tell_statistics - use math, only: & - math_range - use IO, only: & - IO_error - use debug, only: & - debug_level, & - debug_MESH, & - debug_LEVELBASIC, & - debug_LEVELEXTENSIVE, & - debug_LEVELSELECTIVE, & - debug_e, & - debug_i - - implicit none - integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro - character(len=64) :: myFmt - integer(pInt) :: i,e,n,f,t,g,c, myDebug - - myDebug = debug_level(debug_mesh) - - if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified - if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified - - allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) - do e = 1_pInt,mesh_NcpElems - if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified - if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure - enddo -!$OMP CRITICAL (write2out) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - write(6,'(/,a,/)') ' Input Parser: STATISTICS' - write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' - write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' - write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' - write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' - write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' - write(6,*) - write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) - write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations - write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures - enddo - write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' - write(6,*) 'periodic surface : ', mesh_periodicSurface - write(6,*) - flush(6) - endif - - if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' - write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get elemType - g = FE_geomtype(t) ! get elemGeomType - c = FE_celltype(g) ! get cellType - write(6,'(i8,3(1x,i8))') e,t,g,c - enddo - write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' - write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) - write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - 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) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) - do f = 1_pInt,FE_NipNeighbors(c) - write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) - enddo - enddo - enddo - write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' - write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - 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 of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i2)') e,i - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell - write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & - mesh_cellnode(1:3,mesh_cell(n,i,e)) - enddo - enddo - enddo - write(6,'(/,a)') 'Input Parser: IP COORDINATES' - write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) - enddo - enddo - write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' - write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - 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 of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP - write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) - enddo - enddo - enddo - endif -!$OMP END CRITICAL (write2out) - -end subroutine mesh_tell_statistics - - !-------------------------------------------------------------------------------------------------- !> @brief mapping of FE element types to internal representation !-------------------------------------------------------------------------------------------------- From 8e0556fe3e8cdd0fdb685b88c017e65ec32592c0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 12:43:14 +0100 Subject: [PATCH 031/154] [skip ci] nicer reporting --- src/element.f90 | 28 ++++++++++------------------ src/mesh_base.f90 | 7 ++++++- 2 files changed, 16 insertions(+), 19 deletions(-) diff --git a/src/element.f90 b/src/element.f90 index 4c0f1e810..473d9c73c 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -904,26 +904,18 @@ contains self%nIPneighbors = size(self%IPneighbor,1) - write(6,*) 'tElement_init' - - write(6,*)'elemType ',self%elemType - write(6,*)'geomType ',self%geomType - write(6,*)'cellType ',self%cellType - write(6,*)'Nnodes ',self%Nnodes - write(6,*)'Ncellnodes ',self%Ncellnodes - write(6,*)'NcellnodesPerCell ',self%NcellnodesPerCell - write(6,*)'nIPs ',self%nIPs - write(6,*)'nIPneighbors ',self%nIPneighbors - write(6,*)'maxNnodeAtIP ',self%maxNnodeAtIP - write(6,*)'Cell ',self%Cell - write(6,*)'NnodeAtIP ',self%NnodeAtIP - write(6,*)'IPneighbor ',self%IPneighbor - write(6,*)'cellFace ',self%cellFace - write(6,*)'cellNodeParentNodeWeights',self%cellNodeParentNodeWeights + write(6,'(/,a)') ' <<<+- element_init -+>>>' + write(6,*)' element type ',self%elemType + write(6,*)' geom type ',self%geomType + write(6,*)' cell type ',self%cellType + write(6,*)' # node ',self%Nnodes + write(6,*)' # IP ',self%nIPs + write(6,*)' # cellnode ',self%Ncellnodes + write(6,*)' # cellnode/cell ',self%NcellnodesPerCell + write(6,*)' # IP neighbor ',self%nIPneighbors + write(6,*)' max # node at IP ',self%maxNnodeAtIP end subroutine tElement_init - - end module element diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index f9a076f03..e0ca78c03 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -57,10 +57,15 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes) integer(pInt), intent(in) :: elemType real(pReal), dimension(:,:), intent(in) :: nodes + write(6,'(/,a)') ' <<<+- mesh_base_init -+>>>' + + write(6,*)' mesh type ',meshType + write(6,*)' # node ',size(nodes,2) + self%type = meshType call self%elem%init(elemType) self%node0 = nodes - + end subroutine tMesh_base_init end module mesh_base From 3d750e793339a4a6e601f44b7f5b04b6344057ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 21:56:38 +0100 Subject: [PATCH 032/154] overwriting of init did not work --- src/mesh_FEM.f90 | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index 7a784a27f..b9d171fc3 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -84,14 +84,13 @@ use PETScis contains - procedure :: init => tMesh_FEM_init + procedure, pass(self) :: tMesh_FEM_init + generic, public :: init => tMesh_FEM_init end type tMesh_FEM type(tMesh_FEM), public, protected :: theMesh - - public :: & mesh_init, & mesh_FEM_build_ipVolumes, & @@ -100,22 +99,24 @@ use PETScis contains -subroutine tMesh_FEM_init(self,dimen,order) +subroutine tMesh_FEM_init(self,dimen,order,nodes) implicit none - integer(pInt), intent(in) :: dimen,order + integer, intent(in) :: dimen + integer(pInt), intent(in) :: order + real(pReal), intent(in), dimension(:,:) :: nodes class(tMesh_FEM) :: self if (dimen == 2_pInt) then - if (order == 1_pInt) call self%elem%init(1_pInt) - if (order == 2_pInt) call self%elem%init(2_pInt) + if (order == 1_pInt) call self%tMesh%init('mesh',1_pInt,nodes) + if (order == 2_pInt) call self%tMesh%init('mesh',2_pInt,nodes) elseif(dimen == 3_pInt) then - if (order == 1_pInt) call self%elem%init(6_pInt) - if (order == 2_pInt) call self%elem%init(8_pInt) + if (order == 1_pInt) call self%tMesh%init('mesh',6_pInt,nodes) + if (order == 2_pInt) call self%tMesh%init('mesh',8_pInt,nodes) endif - -end subroutine tMesh_FEM_init + end subroutine tMesh_FEM_init + !-------------------------------------------------------------------------------------------------- @@ -273,7 +274,9 @@ subroutine mesh_init() mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init(dimplex,integrationOrder) + allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) + call theMesh%init(dimplex,integrationOrder,mesh_node0) + end subroutine mesh_init From d13b0f11648deb9430b61f7d57493f3b51510ce7 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 2 Feb 2019 08:54:10 +0100 Subject: [PATCH 033/154] [skip ci] updated version information after successful test of v2.0.2-1674-g683dee82 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 2479c4238..543d23432 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1667-g6b66563b +v2.0.2-1674-g683dee82 From 4a2828405862ef7567b6dec90f2fd25d5a7b28cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 09:18:01 +0100 Subject: [PATCH 034/154] only parse geom file once --- src/mesh_grid.f90 | 386 ++++++++++++++++++++-------------------------- 1 file changed, 163 insertions(+), 223 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index cff0dbc21..942611b1f 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -28,6 +28,8 @@ module mesh mesh_maxNcellnodes !< max number of cell nodes in any CP element !!!! BEGIN DEPRECATED !!!!! + integer(pInt), dimension(:), allocatable, private :: & + microGlobal integer(pInt), dimension(:), allocatable, public, protected :: & mesh_homogenizationAt, & !< homogenization ID of each element mesh_microstructureAt !< microstructure ID of each element @@ -278,8 +280,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & - mesh_spectral_getGrid, & - mesh_spectral_getSize, & mesh_build_cellnodes, & mesh_build_ipVolumes, & mesh_build_ipCoordinates @@ -354,7 +354,6 @@ subroutine mesh_init(ip,el) include 'fftw3-mpi.f03' integer(C_INTPTR_T) :: devNull, local_K, local_K_offset integer :: ierr, worldsize - integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j logical :: myDebug @@ -363,7 +362,6 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh @@ -371,14 +369,14 @@ subroutine mesh_init(ip,el) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) call fftw_mpi_init() - call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... - if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) - grid = mesh_spectral_getGrid(fileUnit) + call mesh_spectral_read_grid() + + call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') - geomSize = mesh_spectral_getSize(fileUnit) + devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & int(grid(2),C_INTPTR_T), & int(grid(1),C_INTPTR_T)/2+1, & @@ -395,19 +393,20 @@ subroutine mesh_init(ip,el) mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) call mesh_spectral_build_nodes() - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call theMesh%init(mesh_node) + + call theMesh%init(mesh_node) + ! For compatibility - mesh_maxNips = theMesh%elem%nIPs mesh_maxNipNeighbors = theMesh%elem%nIPneighbors mesh_maxNcellnodes = theMesh%elem%Ncellnodes - - call mesh_spectral_build_elements(FILEUNIT) + call mesh_spectral_build_elements() + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) + call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -418,7 +417,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) call mesh_build_ipAreas if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) - close (FILEUNIT) call mesh_spectral_build_ipNeighborhood @@ -683,17 +681,14 @@ pure function mesh_cellCenterCoordinates(ip,el) enddo mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) - end function mesh_cellCenterCoordinates +end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!> @brief Parses geometry file !-------------------------------------------------------------------------------------------------- -function mesh_spectral_getGrid(fileUnit) +subroutine mesh_spectral_read_grid() use IO, only: & - IO_checkAndRewind, & - IO_open_file, & IO_stringPos, & IO_lc, & IO_stringValue, & @@ -703,145 +698,158 @@ function mesh_spectral_getGrid(fileUnit) use DAMASK_interface, only: & geometryFile - implicit none - integer(pInt), dimension(3) :: mesh_spectral_getGrid - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + implicit none + character(len=:), allocatable :: rawData + character(len=65536) :: line + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt), dimension(3) :: g = -1_pInt + real(pReal), dimension(3) :: s = -1_pInt + integer(pInt) :: h =- 1_pInt + integer(pInt) :: & + headerLength = -1_pInt, & + fileLength, & + fileUnit, & + startPos, endPos, & + myStat, & + l, i, j, e, c + logical :: & + gotGrid = .false., & + gotSize = .false., & + gotHomogenization = .false. - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotGrid = .false. +!-------------------------------------------------------------------------------------------------- +! read data as stream + inquire(file = trim(geometryFile), size=fileLength) + open(newunit=fileUnit, file=trim(geometryFile), access='stream',& + status='old', position='rewind', action='read',iostat=myStat) + if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(geometryFile)) + allocate(character(len=fileLength)::rawData) + read(fileUnit) rawData + close(fileUnit) + +!-------------------------------------------------------------------------------------------------- +! get header length + endPos = index(rawData,new_line('')) + if(endPos <= index(rawData,'head')) then + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid') + else + chunkPos = IO_stringPos(rawData(1:endPos)) + if (chunkPos(1) < 2_pInt) call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid') + headerLength = IO_intValue(rawData(1:endPos),chunkPos,1_pInt) + startPos = endPos + 1_pInt + endif - mesh_spectral_getGrid = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif +!-------------------------------------------------------------------------------------------------- +! read and interprete header + l = 0 + do while (l < headerLength .and. startPos < len(rawData)) + endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + line = rawData(startPos:endPos) + startPos = endPos + 1_pInt + l = l + 1_pInt - call IO_checkAndRewind(myFileUnit) + ! cycle empty lines + chunkPos = IO_stringPos(trim(line)) + select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) ) + + case ('grid') + if (chunkPos(1) > 6) gotGrid = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + g(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + g(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + g(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + + case ('size') + if (chunkPos(1) > 6) gotSize = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + s(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + s(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + s(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + + case ('homogenization') + if (chunkPos(1) > 1) gotHomogenization = .true. + h = IO_intValue(line,chunkPos,2_pInt) - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) - case ('grid') - gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo + end select - if(.not. present(fileUnit)) close(myFileUnit) + enddo - if (.not. gotGrid) & - call IO_error(error_ID = 845_pInt, ext_msg='grid') - if(any(mesh_spectral_getGrid < 1_pInt)) & - call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') +!-------------------------------------------------------------------------------------------------- +! global data + grid = g + geomSize = s + allocate(microGlobal(product(grid)), source = -1_pInt) + +!-------------------------------------------------------------------------------------------------- +! read and interprete content + e = 1_pInt + do while (startPos < len(rawData)) + endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + line = rawData(startPos:endPos) + startPos = endPos + 1_pInt + l = l + 1_pInt -end function mesh_spectral_getGrid + chunkPos = IO_stringPos(trim(line)) + if (chunkPos(1) == 3) then + if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then + c = IO_intValue(line,chunkPos,1) + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))] + else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then + c = IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1) + 1_pInt + microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3))] + else + c = chunkPos(1) + do i = 0_pInt, c - 1_pInt + microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) + enddo + endif + else + c = chunkPos(1) + do i = 0_pInt, c - 1_pInt + microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) + enddo + + endif + + e = e+c + end do + + if (e-1 /= product(grid)) print*, 'mist', e + +! if (.not. gotGrid) & +! call IO_error(error_ID = 845_pInt, ext_msg='grid') +! if(any(mesh_spectral_getGrid < 1_pInt)) & +! call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') + +! if (.not. gotSize) & +! call IO_error(error_ID = 845_pInt, ext_msg='size') +! if (any(mesh_spectral_getSize<=0.0_pReal)) & +! call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') + +! if (.not. gotHomogenization ) & +! call IO_error(error_ID = 845_pInt, ext_msg='homogenization') +! if (mesh_spectral_getHomogenization<1_pInt) & +! call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') + +end subroutine mesh_spectral_read_grid !-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!> @brief Reads homogenization information from geometry file. !-------------------------------------------------------------------------------------------------- -function mesh_spectral_getSize(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - real(pReal), dimension(3) :: mesh_spectral_getSize - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotSize = .false. - - mesh_spectral_getSize = -1.0_pReal - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('size') - gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotSize) & - call IO_error(error_ID = 845_pInt, ext_msg='size') - if (any(mesh_spectral_getSize<=0.0_pReal)) & - call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') - -end function mesh_spectral_getSize - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization(fileUnit) +integer(pInt) function mesh_spectral_getHomogenization() use IO, only: & IO_checkAndRewind, & IO_open_file, & @@ -854,7 +862,6 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) geometryFile implicit none - integer(pInt), intent(in), optional :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: headerLength = 0_pInt character(len=1024) :: line, & @@ -862,13 +869,10 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) integer(pInt) :: i, myFileUnit logical :: gotHomogenization = .false. - mesh_spectral_getHomogenization = -1_pInt - if(.not. present(fileUnit)) then + myFileUnit = 289_pInt call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif + call IO_checkAndRewind(myFileUnit) @@ -891,7 +895,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) end select enddo - if(.not. present(fileUnit)) close(myFileUnit) + close(myFileUnit) if (.not. gotHomogenization ) & call IO_error(error_ID = 845_pInt, ext_msg='homogenization') @@ -935,85 +939,21 @@ end subroutine mesh_spectral_build_nodes !! Allocates global array 'mesh_element' !> @todo does the IO_error makes sense? !-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_elements(fileUnit) +subroutine mesh_spectral_build_elements() use IO, only: & - IO_checkAndRewind, & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_continuousIntValues, & - IO_intValue, & - IO_countContinuousIntValues - + IO_error implicit none - integer(pInt), intent(in) :: & - fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & e, i, & - headerLength = 0_pInt, & - maxDataPerLine, & + homog, & elemOffset - integer(pInt), dimension(:), allocatable :: & - microstructures, & - microGlobal - integer(pInt), dimension(1,1) :: & - dummySet = 0_pInt - character(len=65536) :: & - line, & - keyword - character(len=64), dimension(1) :: & - dummyName = '' - homog = mesh_spectral_getHomogenization(fileUnit) -!-------------------------------------------------------------------------------------------------- -! get header length - call IO_checkAndRewind(fileUnit) - read(fileUnit,'(a65536)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') - endif + homog = mesh_spectral_getHomogenization() -!-------------------------------------------------------------------------------------------------- -! get maximum microstructure index - call IO_checkAndRewind(fileUnit) - do i = 1_pInt, headerLength - read(fileUnit,'(a65536)') line - enddo - maxDataPerLine = 0_pInt - i = 1_pInt - - do while (i > 0_pInt) - i = IO_countContinuousIntValues(fileUnit) - maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? - enddo allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) - allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size - allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) - -!-------------------------------------------------------------------------------------------------- -! read in microstructures - call IO_checkAndRewind(fileUnit) - do i=1_pInt,headerLength - read(fileUnit,'(a65536)') line - enddo - - e = 0_pInt - do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) - microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements - do i = 1_pInt,microstructures(1_pInt) - e = e+1_pInt ! valid element entry - microGlobal(e) = microstructures(1_pInt+i) - enddo - enddo elemOffset = product(grid(1:2))*grid3Offset From 5810dce618685deeb027645e8caf265628b2f781 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 09:29:58 +0100 Subject: [PATCH 035/154] better avoid jump marks --- src/mesh_abaqus.f90 | 54 ++++++++++++++++----------------------------- 1 file changed, 19 insertions(+), 35 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 159f2a7f6..bf5c77642 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -540,6 +540,8 @@ subroutine mesh_init(ip,el) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) contains + + !-------------------------------------------------------------------------------------------------- !> @brief check if the input file for Abaqus contains part info !-------------------------------------------------------------------------------------------------- @@ -557,10 +559,9 @@ logical function hasNoPart(fileUnit) hasNoPart = .true. -610 FORMAT(A65536) rewind(fileUnit) do - read(fileUnit,610,END=620) line + read(fileUnit,'(a65536)',END=620) line chunkPos = IO_stringPos(line) if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then hasNoPart = .false. @@ -882,12 +883,11 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt -610 FORMAT(A300) inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) 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. & @@ -942,12 +942,10 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) mesh_NelemSets = 0_pInt mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons -610 FORMAT(A300) - inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) 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. & @@ -984,12 +982,10 @@ subroutine mesh_abaqus_count_materials(fileUnit) mesh_Nmaterials = 0_pInt -610 FORMAT(A300) - inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) 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. & @@ -1031,12 +1027,10 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) -610 FORMAT(A300) - rewind(fileUnit) do - read (fileUnit,610,END=640) line + read (fileUnit,'(a300)',END=640) 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. & @@ -1083,11 +1077,10 @@ subroutine mesh_abaqus_map_materials(fileUnit) allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) 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. & @@ -1145,11 +1138,10 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) mesh_NcpElems = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1200,11 +1192,10 @@ subroutine mesh_abaqus_map_elements(fileUnit) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=660) line + read (fileUnit,'(a300)',END=660) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1263,11 +1254,9 @@ subroutine mesh_abaqus_map_nodes(fileUnit) allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) -610 FORMAT(A300) - rewind(fileUnit) do - read (fileUnit,610,END=650) line + read (fileUnit,'(a300)',END=650) 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. & @@ -1326,12 +1315,10 @@ subroutine mesh_abaqus_build_nodes(fileUnit) allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) -610 FORMAT(A300) - inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=670) line + read (fileUnit,'(a300)',END=670) 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. & @@ -1349,7 +1336,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) backspace(fileUnit) ! rewind to first entry enddo do i = 1_pInt,c - read (fileUnit,610,END=670) line + read (fileUnit,'(a300)',END=670) line chunkPos = IO_stringPos(line) m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) do j=1_pInt, 3_pInt @@ -1393,12 +1380,11 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt -610 FORMAT(A300) inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) 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. & @@ -1451,12 +1437,10 @@ subroutine mesh_abaqus_build_elements(fileUnit) allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) mesh_elemType = -1_pInt -610 FORMAT(A300) - inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) 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. & @@ -1474,8 +1458,8 @@ subroutine mesh_abaqus_build_elements(fileUnit) backspace(fileUnit) enddo do i = 1_pInt,c - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) ! limit to 64 nodes max + read (fileUnit,'(a300)',END=620) 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 @@ -1507,7 +1491,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) materialFound = .false. do - read (fileUnit,610,END=630) line + read (fileUnit,'(a300)',END=630) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) case('*material') @@ -1516,7 +1500,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) case('*user') if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & materialFound ) then - read (fileUnit,610,END=630) line ! read homogenization and microstructure + read (fileUnit,'(a300)',END=630) 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) From 9975048f2946eb7f474683b121689ac7cee92fa0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 09:56:11 +0100 Subject: [PATCH 036/154] better avoid jump marks: Abaqus, Part 2 --- src/mesh_abaqus.f90 | 168 +++++++++++++++++++++++++------------------- 1 file changed, 96 insertions(+), 72 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index bf5c77642..5c761ad7e 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -878,16 +878,17 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line + integer :: myStat logical :: inPart mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt - - + inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -915,7 +916,7 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) endif enddo -620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) + if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) end subroutine mesh_abaqus_count_nodesAndElements @@ -937,15 +938,17 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line + integer :: myStat logical :: inPart mesh_NelemSets = 0_pInt mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -955,7 +958,6 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) mesh_NelemSets = mesh_NelemSets + 1_pInt enddo -620 continue if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) end subroutine mesh_abaqus_count_elementSets @@ -978,14 +980,16 @@ subroutine mesh_abaqus_count_materials(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - logical inPart + integer :: myStat + logical :: inPart mesh_Nmaterials = 0_pInt inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -997,7 +1001,7 @@ subroutine mesh_abaqus_count_materials(fileUnit) mesh_Nmaterials = mesh_Nmaterials + 1_pInt enddo -620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) end subroutine mesh_abaqus_count_materials @@ -1021,16 +1025,20 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt,i - logical :: inPart = .false. + integer :: myStat + logical :: inPart + integer(pInt) :: elemSet,i allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + elemSet = 0_pInt + inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=640) line + 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. & @@ -1044,7 +1052,7 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) endif enddo -640 do i = 1_pInt,elemSet + do i = 1_pInt,elemSet if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) enddo @@ -1068,19 +1076,21 @@ subroutine mesh_abaqus_map_materials(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c = 0_pInt - logical :: inPart = .false. + character(len=300) :: line + integer :: myStat + logical :: inPart + integer(pInt) :: i,c character(len=64) :: elemSetName,materialName allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' - + c = 0_pInt + inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -1108,7 +1118,7 @@ subroutine mesh_abaqus_map_materials(fileUnit) endif enddo -620 if (c==0_pInt) call IO_error(error_ID=905_pInt) + 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) enddo @@ -1131,17 +1141,18 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line + character(len=300) :: line + integer :: myStat + logical :: materialFound integer(pInt) :: i,k - logical :: materialFound = .false. character(len=64) ::materialName,elemSetName mesh_NcpElems = 0_pInt - - + materialFound = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1163,7 +1174,7 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) endselect enddo -620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) end subroutine mesh_abaqus_count_cpElements @@ -1186,16 +1197,19 @@ subroutine mesh_abaqus_map_elements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) ::i,j,k,cpElem = 0_pInt - logical :: materialFound = .false. + integer :: myStat + logical :: materialFound + integer(pInt) ::i,j,k,cpElem character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - + cpElem = 0_pInt + materialFound = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=660) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1222,7 +1236,7 @@ subroutine mesh_abaqus_map_elements(fileUnit) endselect enddo -660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) @@ -1247,16 +1261,19 @@ subroutine mesh_abaqus_map_nodes(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c,cpNode = 0_pInt - logical :: inPart = .false. + character(len=300) :: line + integer :: myStat + logical :: inPart + integer(pInt) :: i,c,cpNode allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) - + + cpNode = 0_pInt + inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=650) line + 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. & @@ -1283,7 +1300,7 @@ subroutine mesh_abaqus_map_nodes(fileUnit) endif enddo -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) @@ -1309,16 +1326,18 @@ subroutine mesh_abaqus_build_nodes(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,j,m,c + integer :: myStat logical :: inPart + integer(pInt) :: i,j,m,c allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=670) line + 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. & @@ -1346,7 +1365,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) endif enddo -670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) mesh_node = mesh_node0 end subroutine mesh_abaqus_build_nodes @@ -1372,8 +1391,9 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,c,t,g + integer :: myStat logical :: inPart + integer(pInt) :: i,c,t,g mesh_maxNnodes = 0_pInt mesh_maxNips = 0_pInt @@ -1382,9 +1402,10 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -1406,7 +1427,7 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) endif enddo -620 end subroutine mesh_abaqus_count_cpSizes +end subroutine mesh_abaqus_count_cpSizes !-------------------------------------------------------------------------------------------------- @@ -1428,19 +1449,21 @@ subroutine mesh_abaqus_build_elements(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - + character(len=300) :: line + integer :: myStat + logical :: inPart integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead logical inPart,materialFound character (len=64) :: materialName,elemSetName - character(len=300) :: line allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) mesh_elemType = -1_pInt inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -1487,11 +1510,13 @@ subroutine mesh_abaqus_build_elements(fileUnit) enddo -620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" + rewind(fileUnit) ! just in case "*material" definitions apear before "*element" materialFound = .false. - do - read (fileUnit,'(a300)',END=630) line + 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))) case('*material') @@ -1525,7 +1550,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) endselect enddo -630 end subroutine mesh_abaqus_build_elements +end subroutine mesh_abaqus_build_elements @@ -1543,17 +1568,18 @@ use IO, only: & integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword + character(len=300) :: damaskOption, v + character(len=*), parameter :: keyword = '**damask' mesh_periodicSurface = .false. - keyword = '**damask' - - + myStat = 0 rewind(fileUnit) - do - read (fileUnit,610,END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read @@ -1570,9 +1596,7 @@ use IO, only: & endif enddo -610 FORMAT(A300) - -620 end subroutine mesh_get_damaskOptions +end subroutine mesh_get_damaskOptions From e17278a926de759ba65207fa007d913a7164599b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:11:18 +0100 Subject: [PATCH 037/154] using new mesh structure (initial test) --- src/constitutive.f90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 43d57a493..ac8ee0484 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -59,8 +59,6 @@ subroutine constitutive_init() IO_timeStamp use config, only: & config_phase - use mesh, only: & - FE_geomtype use config, only: & material_Nphase, & material_localFileExt, & @@ -789,8 +787,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac math_sym33to6, & math_mul33x33 use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & phasememberAt, & phase_plasticityInstance, & @@ -841,9 +838,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac el !< element real(pReal), intent(in) :: & subdt !< timestep - real(pReal), intent(in), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + real(pReal), intent(in), dimension(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & subfracArray !< subfraction of timestep - real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & FeArray, & !< elastic deformation gradient FpArray !< plastic deformation gradient real(pReal), intent(in), dimension(3,3) :: & @@ -1003,8 +1000,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) math_6toSym33, & math_mul33x33 use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & phasememberAt, & phase_plasticityInstance, & @@ -1060,7 +1056,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) constitutive_postResults real(pReal), intent(in), dimension(3,3) :: & Fi !< intermediate deformation gradient - real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & FeArray !< elastic deformation gradient real(pReal), intent(in), dimension(6) :: & S6 !< 2nd Piola Kirchhoff stress (vector notation) From f0b5b9fd593d672a9ab2cb97fcdb4bd71a7408e9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:34:16 +0100 Subject: [PATCH 038/154] unused variable --- src/homogenization.f90 | 3 +-- src/material.f90 | 6 ++---- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 20ce008fd..1c02d1088 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -73,8 +73,7 @@ subroutine homogenization_init use mesh, only: & mesh_maxNips, & mesh_NcpElems, & - mesh_element, & - FE_geomtype + mesh_element use constitutive, only: & constitutive_plasticity_maxSizePostResults, & constitutive_source_maxSizePostResults diff --git a/src/material.f90 b/src/material.f90 index 3ae6c16a4..dbf5433c6 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -306,8 +306,7 @@ subroutine material_init() use mesh, only: & mesh_homogenizationAt, & mesh_NipsPerElem, & - mesh_NcpElems, & - FE_geomtype + mesh_NcpElems implicit none integer(pInt), parameter :: FILEUNIT = 210_pInt @@ -989,8 +988,7 @@ subroutine material_populateGrains mesh_homogenizationAt, & mesh_microstructureAt, & mesh_NcpElems, & - mesh_ipVolume, & - FE_geomtype + mesh_ipVolume use config, only: & config_homogenization, & config_microstructure, & From 7a8d98d135ccd685198433bbb1d611dfe20cbb8a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:35:10 +0100 Subject: [PATCH 039/154] using theMesh (object oriented mesh description) --- src/crystallite.f90 | 62 +++++++++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 45aca46d1..db00d3ac2 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -12,8 +12,6 @@ module crystallite use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP - use mesh, only: & - mesh_element use material, only: & homogenization_Ngrains use prec, only: & @@ -155,10 +153,8 @@ subroutine crystallite_init math_inv33, & math_mul33x33 use mesh, only: & - mesh_element, & - mesh_NcpElems, & - mesh_maxNips, & - mesh_maxNipNeighbors + theMesh, & + mesh_element use IO, only: & IO_timeStamp, & IO_stringValue, & @@ -196,8 +192,8 @@ subroutine crystallite_init #include "compilation_info.f90" cMax = homogenization_maxNgrains - iMax = mesh_maxNips - eMax = mesh_NcpElems + iMax = theMesh%elem%nIPs + eMax = theMesh%nElems ! --------------------------------------------------------------------------- ! ToDo (when working on homogenization): should be 3x3 tensor called S @@ -333,7 +329,7 @@ subroutine crystallite_init case(elasmatrix_ID) mySize = 36_pInt case(neighboringip_ID,neighboringelement_ID) - mySize = mesh_maxNipNeighbors + mySize = theMesh%elem%nIPneighbors case default mySize = 0_pInt end select @@ -415,7 +411,7 @@ subroutine crystallite_init write(6,'(a42,1x,i10)') ' # of elements: ', eMax write(6,'(a42,1x,i10)') 'max # of integration points/element: ', iMax write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax - write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', mesh_maxNipNeighbors + write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', theMesh%elem%nIPneighbors write(6,'(a42,1x,i10)') ' # of nonlocal constituents: ',count(.not. crystallite_localPlasticity) flush(6) endif @@ -458,10 +454,8 @@ function crystallite_stress() math_6toSym33, & math_sym33to6 use mesh, only: & - mesh_NcpElems, & - mesh_element, & - mesh_maxNips, & - FE_geomtype + theMesh, & + mesh_element use material, only: & homogenization_Ngrains, & plasticState, & @@ -474,7 +468,7 @@ function crystallite_stress() constitutive_LiAndItsTangents implicit none - logical, dimension(mesh_maxNips,mesh_NcpElems) :: crystallite_stress + logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress real(pReal) :: & formerSubStep integer(pInt) :: & @@ -541,7 +535,7 @@ function crystallite_stress() endIP = startIP else singleRun startIP = 1_pInt - endIP = mesh_maxNips + endIP = theMesh%elem%nIPs endif singleRun NiterationCrystallite = 0_pInt @@ -727,8 +721,7 @@ subroutine crystallite_stressTangent() math_invert2, & math_det33 use mesh, only: & - mesh_element, & - FE_geomtype + mesh_element use material, only: & homogenization_Ngrains use constitutive, only: & @@ -929,7 +922,7 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33) math_inv33, & math_EulerToR use material, only: & - material_EulerAngles + material_EulerAngles ! ToDo: Why stored? We also have crystallite_orientation0 implicit none real(pReal), dimension(3,3) :: crystallite_push33ToRef @@ -960,13 +953,10 @@ function crystallite_postResults(ipc, ip, el) inDeg, & math_6toSym33 use mesh, only: & + theMesh, & mesh_element, & mesh_ipVolume, & - mesh_maxNipNeighbors, & - mesh_ipNeighborhood, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype + mesh_ipNeighborhood use material, only: & plasticState, & sourceState, & @@ -1070,14 +1060,14 @@ function crystallite_postResults(ipc, ip, el) mySize = 36_pInt crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize]) case(neighboringelement_ID) - mySize = mesh_maxNipNeighbors + mySize = theMesh%elem%nIPneighbors crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1_pInt:FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) & + forall (n = 1_pInt:mySize) & crystallite_postResults(c+n) = real(mesh_ipNeighborhood(1,n,ip,el),pReal) case(neighboringip_ID) - mySize = mesh_maxNipNeighbors + mySize = theMesh%elem%nIPneighbors crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1_pInt:FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) & + forall (n = 1_pInt:mySize) & crystallite_postResults(c+n) = real(mesh_ipNeighborhood(2,n,ip,el),pReal) end select c = c + mySize @@ -2128,7 +2118,8 @@ end subroutine nonlocalConvergenceCheck !> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria !-------------------------------------------------------------------------------------------------- subroutine setConvergenceFlag() - + use mesh, only: & + mesh_element implicit none integer(pInt) :: & e, & !< element index in element loop @@ -2168,7 +2159,8 @@ end subroutine setConvergenceFlag !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- subroutine update_stress(timeFraction) - + use mesh, only: & + mesh_element implicit none real(pReal), intent(in) :: & timeFraction @@ -2200,6 +2192,8 @@ end subroutine update_stress !> @brief tbd !-------------------------------------------------------------------------------------------------- subroutine update_dependentState() + use mesh, only: & + mesh_element use constitutive, only: & constitutive_dependentState => constitutive_microstructure @@ -2232,6 +2226,8 @@ subroutine update_state(timeFraction) sourceState, & phase_Nsources, & phaseAt, phasememberAt + use mesh, only: & + mesh_element implicit none real(pReal), intent(in) :: & @@ -2281,6 +2277,8 @@ subroutine update_dotState(timeFraction) sourceState, & phaseAt, phasememberAt, & phase_Nsources + use mesh, only: & + mesh_element use constitutive, only: & constitutive_collectDotState @@ -2334,6 +2332,8 @@ subroutine update_deltaState IEEE_arithmetic use prec, only: & dNeq0 + use mesh, only: & + mesh_element use material, only: & plasticState, & sourceState, & @@ -2429,6 +2429,8 @@ logical function stateJump(ipc,ip,el) sourceState, & phase_Nsources, & phaseAt, phasememberAt + use mesh, only: & + mesh_element use constitutive, only: & constitutive_collectDeltaState use math, only: & From 3a5a50cb03c7bd20a0caa5403c7d881d2d29e6e8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:53:55 +0100 Subject: [PATCH 040/154] use variables from theMesh --- src/crystallite.f90 | 3 ++- src/homogenization.f90 | 36 ++++++++++++++++++------------------ 2 files changed, 20 insertions(+), 19 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index db00d3ac2..1eb2dff28 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -426,7 +426,7 @@ end subroutine crystallite_init !-------------------------------------------------------------------------------------------------- !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- -function crystallite_stress() +function crystallite_stress(a) use prec, only: & tol_math_check, & dNeq0 @@ -469,6 +469,7 @@ function crystallite_stress() implicit none logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress + real(pReal), intent(in), optional :: a !ToDo: for some reason this prevents an internal compiler error in GNU. Very strange real(pReal) :: & formerSubStep integer(pInt) :: & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 1c02d1088..8edecbc88 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -71,8 +71,7 @@ subroutine homogenization_init debug_e, & debug_g use mesh, only: & - mesh_maxNips, & - mesh_NcpElems, & + theMesh, & mesh_element use constitutive, only: & constitutive_plasticity_maxSizePostResults, & @@ -242,20 +241,20 @@ subroutine homogenization_init !-------------------------------------------------------------------------------------------------- ! allocate and initialize global variables - allocate(materialpoint_dPdF(3,3,3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_F0(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - materialpoint_F0 = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity - allocate(materialpoint_F(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + 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 + 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,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subF(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_P(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subFrac(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subStep(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subdt(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_requested(mesh_maxNips,mesh_NcpElems), source=.false.) - allocate(materialpoint_converged(mesh_maxNips,mesh_NcpElems), source=.true.) - allocate(materialpoint_doneAndHappy(2,mesh_maxNips,mesh_NcpElems), source=.true.) + allocate(materialpoint_subF0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subF(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_P(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subFrac(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subStep(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subdt(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_requested(theMesh%elem%nIPs,theMesh%nElems), source=.false.) + allocate(materialpoint_converged(theMesh%elem%nIPs,theMesh%nElems), source=.true.) + allocate(materialpoint_doneAndHappy(2,theMesh%elem%nIPs,theMesh%nElems), source=.true.) !-------------------------------------------------------------------------------------------------- ! allocate and initialize global state and postresutls variables @@ -275,7 +274,7 @@ subroutine homogenization_init + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + constitutive_source_maxSizePostResults) - allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems)) + allocate(materialpoint_results(materialpoint_sizeResults,theMesh%elem%nIPs,theMesh%nElems)) write(6,'(/,a)') ' <<<+- homogenization init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -597,7 +596,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) if ( materialpoint_requested(i,e) .and. & ! process requested but... .not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points - call partitionDeformation(i,e) ! partition deformation onto constituents + call partitionDeformation(i,e) ! partition deformation onto constituents crystallite_dt(1:myNgrains,i,e) = materialpoint_subdt(i,e) ! propagate materialpoint dt to grains crystallite_requested(1:myNgrains,i,e) = .true. ! request calculation for constituents else @@ -611,7 +610,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! crystallite integration ! based on crystallite_partionedF0,.._partionedF ! incrementing by crystallite_dt - materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic + + materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic !-------------------------------------------------------------------------------------------------- ! state update From 94a24e45eeaca801c7c1e7dd0404d165865a646c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 11:46:38 +0100 Subject: [PATCH 041/154] bugfixes: theMesh%Nelems need to be set (using an intermediate function until a routine does that) spectral.geom file can have "N+n to N" (backwards counting) --- src/mesh_FEM.f90 | 1 + src/mesh_abaqus.f90 | 1 + src/mesh_base.f90 | 12 ++++++++++++ src/mesh_grid.f90 | 20 +++++++++++++------- src/mesh_marc.f90 | 2 +- 5 files changed, 28 insertions(+), 8 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index b9d171fc3..e2b08db4c 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -276,6 +276,7 @@ subroutine mesh_init() !!!!!!!!!!!!!!!!!!!!!!!! allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) call theMesh%init(dimplex,integrationOrder,mesh_node0) + call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 5c761ad7e..05e1d7c7d 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -421,6 +421,7 @@ subroutine tMesh_abaqus_init(self,elemType,nodes) integer(pInt), intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) + call theMesh%setNelems(mesh_NcpElems) end subroutine tMesh_abaqus_init diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index e0ca78c03..c0f012256 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -45,6 +45,7 @@ module mesh_base connectivity contains procedure, pass(self) :: tMesh_base_init + procedure :: setNelems => tMesh_base_setNelems ! not needed once we compute the cells from the connectivity generic, public :: init => tMesh_base_init end type tMesh @@ -68,4 +69,15 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes) end subroutine tMesh_base_init + +subroutine tMesh_base_setNelems(self,Nelems) + + implicit none + class(tMesh) :: self + integer(pInt), intent(in) :: Nelems + + self%Nelems = Nelems + +end subroutine tMesh_base_setNelems + end module mesh_base diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 942611b1f..88484a693 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -442,7 +442,7 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init !-------------------------------------------------------------------------------------------------- @@ -686,6 +686,8 @@ end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- !> @brief Parses geometry file +!> @details important variables have an implicit "save" attribute. Therefore, this function is +! supposed to be called only once! !-------------------------------------------------------------------------------------------------- subroutine mesh_spectral_read_grid() use IO, only: & @@ -706,12 +708,16 @@ subroutine mesh_spectral_read_grid() real(pReal), dimension(3) :: s = -1_pInt integer(pInt) :: h =- 1_pInt integer(pInt) :: & - headerLength = -1_pInt, & - fileLength, & + headerLength = -1_pInt, & !< length of header (in lines) + fileLength, & !< lenght of the geom file (in characters) fileUnit, & startPos, endPos, & myStat, & - l, i, j, e, c + l, & !< line counter + c, & !< counter for # microstructures in line + o, & !< order of "to" packing + e, & !< "element", i.e. spectral collocation point + i, j logical :: & gotGrid = .false., & gotSize = .false., & @@ -807,8 +813,9 @@ subroutine mesh_spectral_read_grid() c = IO_intValue(line,chunkPos,1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))] else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then - c = IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1) + 1_pInt - microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3))] + c = abs(IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1)) + 1_pInt + o = merge(+1_pInt, -1_pInt, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1)) + microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)] else c = chunkPos(1) do i = 0_pInt, c - 1_pInt @@ -822,7 +829,6 @@ subroutine mesh_spectral_read_grid() enddo endif - e = e+c end do diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 5607791fb..dd4098879 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -560,7 +560,7 @@ subroutine mesh_init(ip,el) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) - + call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init From 8962635136b26af41bca45ba290df5c1ffb4f5cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 11:50:07 +0100 Subject: [PATCH 042/154] use new elem/mesh variables --- src/plastic_nonlocal.f90 | 96 ++++++++++++++++------------------------ 1 file changed, 39 insertions(+), 57 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index e1355da8f..32cde9768 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -281,8 +281,7 @@ use IO, only: IO_read, & use debug, only: debug_level, & debug_constitutive, & debug_levelBasic -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & +use mesh, only: theMesh, & mesh_maxNipNeighbors use material, only: phase_plasticity, & homogenization_maxNgrains, & @@ -1091,23 +1090,23 @@ allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), allocate(forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(lattice2slip(1:3, 1:3, maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=2.0_pReal) -allocate(rhoDotFluxOutput(maxTotalNslip,8,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotFluxOutput(maxTotalNslip,8,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotMultiplicationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotMultiplicationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotSingle2DipoleGlideOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotSingle2DipoleGlideOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotAthermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotAthermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), & +allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) @@ -1404,10 +1403,8 @@ use IO, only: IO_error use lattice, only: lattice_maxNslipFamily use math, only: math_sampleGaussVar use mesh, only: mesh_ipVolume, & - mesh_NcpElems, & - mesh_element, & - FE_Nips, & - FE_geomtype + theMesh, & + mesh_element use material, only: material_phase, & phase_plasticityInstance, & plasticState, & @@ -1446,8 +1443,8 @@ do instance = 1_pInt,maxNinstances minimumIpVolume = huge(1.0_pReal) totalVolume = 0.0_pReal - do e = 1_pInt,mesh_NcpElems - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + do e = 1_pInt,theMesh%nElems + do i = 1_pInt,theMesh%elem%nIPs if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then totalVolume = totalVolume + mesh_ipVolume(i,e) @@ -1462,8 +1459,8 @@ do instance = 1_pInt,maxNinstances meanDensity = 0.0_pReal do while(meanDensity < rhoSglRandom(instance)) call random_number(rnd) - e = nint(rnd(1)*real(mesh_NcpElems,pReal)+0.5_pReal,pInt) - i = nint(rnd(2)*real(FE_Nips(FE_geomtype(mesh_element(2,e))),pReal)+0.5_pReal,pInt) + e = nint(rnd(1)*real(theMesh%nElems,pReal)+0.5_pReal,pInt) + i = nint(rnd(2)*real(theMesh%elem%nIPs,pReal)+0.5_pReal,pInt) if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then s = nint(rnd(3)*real(ns,pReal)+0.5_pReal,pInt) @@ -1476,8 +1473,8 @@ do instance = 1_pInt,maxNinstances enddo ! homogeneous distribution of density with some noise else - do e = 1_pInt,mesh_NcpElems - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + do e = 1_pInt,theMesh%nElems + do i = 1_pInt,theMesh%elem%nIPs if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then do f = 1_pInt,lattice_maxNslipFamily @@ -1559,16 +1556,13 @@ use debug, only: & debug_i, & debug_e use mesh, only: & + theMesh, & mesh_element, & mesh_ipNeighborhood, & mesh_ipCoordinates, & mesh_ipVolume, & mesh_ipAreaNormal, & - mesh_ipArea, & - FE_NipNeighbors, & - mesh_maxNipNeighbors, & - FE_geomtype, & - FE_celltype + mesh_ipArea use material, only: & material_phase, & phase_localPlasticity, & @@ -1628,7 +1622,7 @@ real(pReal), dimension(3,3) :: invFe, & ! inverse of elast invFp, & ! inverse of plastic deformation gradient connections, & invConnections -real(pReal), dimension(3,mesh_maxNipNeighbors) :: & +real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: & connection_latticeConf real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & rhoExcess @@ -1639,7 +1633,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))), & totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & myInteractionMatrix ! corrected slip interaction matrix -real(pReal), dimension(2,maxval(totalNslip),mesh_maxNipNeighbors) :: & +real(pReal), dimension(2,maxval(totalNslip),theMesh%elem%nIPneighbors) :: & neighbor_rhoExcess, & ! excess density at neighboring material point neighbor_rhoTotal ! total density at neighboring material point real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & @@ -1714,7 +1708,7 @@ if (.not. phase_localPlasticity(ph) .and. shortRangeStressCorrection(instance)) nRealNeighbors = 0_pInt neighbor_rhoTotal = 0.0_pReal - do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) + do n = 1_pInt,theMesh%elem%nIPneighbors neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) np = phaseAt(1,neighbor_ip,neighbor_el) @@ -2400,16 +2394,12 @@ use math, only: math_mul6x6, & math_det33, & math_transpose33, & pi -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & +use mesh, only: theMesh, & mesh_element, & mesh_ipNeighborhood, & mesh_ipVolume, & mesh_ipArea, & - mesh_ipAreaNormal, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype + mesh_ipAreaNormal use material, only: homogenization_maxNgrains, & material_phase, & phase_plasticityInstance, & @@ -2435,9 +2425,9 @@ integer(pInt), intent(in) :: ip, & real(pReal), intent(in) :: Temperature, & !< temperature timestep !< substepped crystallite time increment real(pReal), dimension(6), intent(in) :: Tstar_v !< current 2nd Piola-Kirchhoff stress in Mandel notation -real(pReal), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & subfrac !< fraction of timestep at the beginning of the substepped crystallite time increment -real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe, & !< elastic deformation gradient Fp !< plastic deformation gradient @@ -2716,8 +2706,8 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then my_Fe = Fe(1:3,1:3,1_pInt,ip,el) my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1_pInt,ip,el)) - do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) ! loop through my neighbors -! write(6,*) 'c' + do n = 1_pInt,theMesh%elem%nIPneighbors + neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) neighbor_n = mesh_ipNeighborhood(3,n,ip,el) @@ -3016,11 +3006,7 @@ use material, only: material_phase, & homogenization_maxNgrains use mesh, only: mesh_element, & mesh_ipNeighborhood, & - mesh_maxNips, & - mesh_NcpElems, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype + theMesh use lattice, only: lattice_sn, & lattice_sd, & lattice_qDisorientation @@ -3030,7 +3016,7 @@ implicit none !* input variables integer(pInt), intent(in) :: i, & ! ip index e ! element index -real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(4,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & orientation ! crystal orientation in quaternions !* local variables @@ -3049,7 +3035,7 @@ integer(pInt) Nneighbors, & real(pReal), dimension(4) :: absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& - FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e))))) :: & + theMesh%elem%nIPneighbors) :: & my_compatibility ! my_compatibility for current element and ip real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & slipNormal, & @@ -3061,7 +3047,7 @@ logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) belowThreshold -Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e)))) +Nneighbors = theMesh%elem%nIPneighbors ph = material_phase(1,i,e) textureID = material_texture(1,i,e) instance = phase_plasticityInstance(ph) @@ -3174,15 +3160,12 @@ use math, only: math_mul33x33, & math_inv33, & math_transpose33, & pi -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & +use mesh, only: theMesh, & mesh_element, & mesh_node0, & mesh_cellCenterCoordinates, & mesh_ipVolume, & - mesh_periodicSurface, & - FE_Nips, & - FE_geomtype + mesh_periodicSurface use material, only: homogenization_maxNgrains, & material_phase, & plasticState, & @@ -3197,7 +3180,7 @@ implicit none !*** input variables integer(pInt), intent(in) :: ip, & !< current integration point el !< current element -real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe !< elastic deformation gradient !*** output variables @@ -3295,8 +3278,8 @@ if (.not. phase_localPlasticity(ph)) then !* loop through all material points (also through their periodic images if present), !* but only consider nonlocal neighbors within a certain cutoff radius R - do neighbor_el = 1_pInt,mesh_NcpElems - ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))) + do neighbor_el = 1_pInt,theMesh%nElems + ipLoop: do neighbor_ip = 1_pInt,theMesh%elem%nIPs neighbor_phase = material_phase(1_pInt,neighbor_ip,neighbor_el) np = phaseAt(1,neighbor_ip,neighbor_el) no = phasememberAt(1,neighbor_ip,neighbor_el) @@ -3523,8 +3506,7 @@ function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) math_mul33x33, & pi use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & homogenization_maxNgrains, & material_phase, & @@ -3542,7 +3524,7 @@ function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) implicit none real(pReal), dimension(6), intent(in) :: & Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & + real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe !< elastic deformation gradient integer(pInt), intent(in) :: & ip, & !< integration point From dcd16dda70b2e5ff94610fbafb1417bd95cdb115 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 12:15:05 +0100 Subject: [PATCH 043/154] variables from mesh object --- src/CPFEM.f90 | 15 +++++------- src/crystallite.f90 | 16 ++++++------- src/material.f90 | 56 ++++++++++++++++++++------------------------- 3 files changed, 38 insertions(+), 49 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index b0f1641e6..ba18f7d52 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -140,8 +140,7 @@ subroutine CPFEM_init restartRead, & modelName use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & material_phase, & homogState, & @@ -168,10 +167,9 @@ subroutine CPFEM_init flush(6) endif mainProcess - ! initialize stress and jacobian to zero - allocate(CPFEM_cs(6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_cs = 0.0_pReal - allocate(CPFEM_dcsdE(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE = 0.0_pReal - allocate(CPFEM_dcsdE_knownGood(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE_knownGood = 0.0_pReal + allocate(CPFEM_cs( 6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) + allocate(CPFEM_dcsdE( 6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) + allocate(CPFEM_dcsdE_knownGood(6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) ! *** restore the last converged values of each essential variable from the binary file if (restartRead) then @@ -289,8 +287,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt math_6toSym33 use mesh, only: & mesh_FEasCP, & - mesh_NcpElems, & - mesh_maxNips, & + theMesh, & mesh_element use material, only: & microstructure_elemhomo, & @@ -401,7 +398,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt enddo; enddo if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then write(6,'(a)') '<< CPFEM >> aging states' - if (debug_e <= mesh_NcpElems .and. debug_i <= mesh_maxNips) then + if (debug_e <= theMesh%Nelems .and. debug_i <= theMesh%elem%nIPs) then write(6,'(a,1x,i8,1x,i2,1x,i4,/,(12x,6(e20.8,1x)),/)') & '<< CPFEM >> aged state of elFE ip grain',debug_e, debug_i, 1, & plasticState(phaseAt(1,debug_i,debug_e))%state(:,phasememberAt(1,debug_i,debug_e)) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 1eb2dff28..c272abd07 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1745,9 +1745,8 @@ end subroutine integrateStateEuler !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler() use mesh, only: & - mesh_element, & - mesh_NcpElems, & - mesh_maxNips + theMesh, & + mesh_element use material, only: & homogenization_Ngrains, & plasticState, & @@ -1771,11 +1770,11 @@ subroutine integrateStateAdaptiveEuler() ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_plastic real(pReal), dimension(constitutive_source_maxSizeDotState,& maxval(phase_Nsources), & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_source !-------------------------------------------------------------------------------------------------- @@ -1922,8 +1921,7 @@ end subroutine integrateStateRK4 subroutine integrateStateRKCK45() use mesh, only: & mesh_element, & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & homogenization_Ngrains, & plasticState, & @@ -1970,11 +1968,11 @@ subroutine integrateStateRKCK45() ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of RKCK45 real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_plastic ! relative residuum from evolution in microstructure real(pReal), dimension(constitutive_source_maxSizeDotState, & maxval(phase_Nsources), & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_source ! relative residuum from evolution in microstructure diff --git a/src/material.f90 b/src/material.f90 index dbf5433c6..4160c906e 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -305,8 +305,7 @@ subroutine material_init() texture_name use mesh, only: & mesh_homogenizationAt, & - mesh_NipsPerElem, & - mesh_NcpElems + theMesh implicit none integer(pInt), parameter :: FILEUNIT = 210_pInt @@ -398,10 +397,10 @@ subroutine material_init() call material_populateGrains ! BEGIN DEPRECATED - allocate(phaseAt ( homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt) - allocate(phasememberAt ( homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt) - allocate(mappingHomogenization (2, mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt) - allocate(mappingHomogenizationConst( mesh_nIPsPerElem,mesh_NcpElems),source=1_pInt) + 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) ! END DEPRECATED allocate(material_homogenizationAt,source=mesh_homogenizationAt) @@ -409,9 +408,9 @@ subroutine material_init() allocate(CounterHomogenization(size(config_homogenization)),source=0_pInt) ! BEGIN DEPRECATED - do e = 1_pInt,mesh_NcpElems + do e = 1_pInt,theMesh%Nelems myHomog = mesh_homogenizationAt(e) - do i = 1_pInt, mesh_NipsPerElem + do i = 1_pInt, theMesh%elem%nIPs CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),myHomog] do g = 1_pInt,homogenization_Ngrains(myHomog) @@ -552,7 +551,7 @@ subroutine material_parseMicrostructure microstructure_name use mesh, only: & mesh_microstructureAt, & - mesh_NcpElems + theMesh implicit none character(len=65536), dimension(:), allocatable :: & @@ -570,7 +569,7 @@ subroutine material_parseMicrostructure if(any(mesh_microstructureAt > size(config_microstructure))) & call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') - forall (e = 1_pInt:mesh_NcpElems) & + forall (e = 1_pInt:theMesh%Nelems) & microstructure_active(mesh_microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements do m=1_pInt, size(config_microstructure) @@ -983,11 +982,9 @@ subroutine material_populateGrains math_sampleFiberOri, & math_symmetricEulers use mesh, only: & - mesh_NipsPerElem, & - mesh_elemType, & mesh_homogenizationAt, & mesh_microstructureAt, & - mesh_NcpElems, & + theMesh, & mesh_ipVolume use config, only: & config_homogenization, & @@ -1024,24 +1021,24 @@ subroutine material_populateGrains myDebug = debug_level(debug_material) - allocate(material_volume(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0.0_pReal) - allocate(material_phase(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt) - allocate(material_homog(mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt) - allocate(material_texture(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt) - allocate(material_EulerAngles(3,homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0.0_pReal) + allocate(material_volume(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0.0_pReal) + allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_homog(theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal) allocate(Ngrains(size(config_homogenization),size(config_microstructure)), source=0_pInt) allocate(Nelems (size(config_homogenization),size(config_microstructure)), source=0_pInt) ! populating homogenization schemes in each !-------------------------------------------------------------------------------------------------- - do e = 1_pInt, mesh_NcpElems - material_homog(1_pInt:mesh_NipsPerElem,e) = mesh_homogenizationAt(e) + do e = 1_pInt, theMesh%Nelems + material_homog(1_pInt:theMesh%elem%nIPs,e) = mesh_homogenizationAt(e) enddo !-------------------------------------------------------------------------------------------------- ! precounting of elements for each homog/micro pair - do e = 1_pInt, mesh_NcpElems + do e = 1_pInt, theMesh%Nelems homog = mesh_homogenizationAt(e) micro = mesh_microstructureAt(e) Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt @@ -1059,8 +1056,7 @@ subroutine material_populateGrains !-------------------------------------------------------------------------------------------------- ! identify maximum grain count per IP (from element) and find grains per homog/micro pair Nelems = 0_pInt ! reuse as counter - elementLooping: do e = 1_pInt,mesh_NcpElems - t = mesh_elemType + elementLooping: do e = 1_pInt,theMesh%Nelems homog = mesh_homogenizationAt(e) micro = mesh_microstructureAt(e) if (homog < 1_pInt .or. homog > size(config_homogenization)) & ! out of bounds @@ -1070,7 +1066,7 @@ subroutine material_populateGrains if (microstructure_elemhomo(micro)) then ! how many grains are needed at this element? dGrains = homogenization_Ngrains(homog) ! only one set of Ngrains (other IPs are plain copies) else - dGrains = homogenization_Ngrains(homog) * mesh_NipsPerElem ! each IP has Ngrains + dGrains = homogenization_Ngrains(homog) * theMesh%elem%nIPs ! each IP has Ngrains endif Ngrains(homog,micro) = Ngrains(homog,micro) + dGrains ! total grain count Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt ! total element count @@ -1104,16 +1100,15 @@ subroutine material_populateGrains do hme = 1_pInt, Nelems(homog,micro) e = elemsOfHomogMicro(homog,micro)%p(hme) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex - t = mesh_elemType if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs - volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:mesh_NipsPerElem,e))/& + volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:theMesh%elem%nIPs,e))/& real(dGrains,pReal) ! each grain combines size of all IPs in that element grain = grain + dGrains ! wind forward by Ngrains@IP else - forall (i = 1_pInt:mesh_NipsPerElem) & ! loop over IPs + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over IPs volumeOfGrain(grain+(i-1)*dGrains+1_pInt:grain+i*dGrains) = & mesh_ipVolume(i,e)/real(dGrains,pReal) ! assign IPvolume/Ngrains@IP to all grains of IP - grain = grain + mesh_NipsPerElem * dGrains ! wind forward by Nips*Ngrains@IP + grain = grain + theMesh%elem%nIPs * dGrains ! wind forward by Nips*Ngrains@IP endif enddo @@ -1259,11 +1254,10 @@ subroutine material_populateGrains do hme = 1_pInt, Nelems(homog,micro) e = elemsOfHomogMicro(homog,micro)%p(hme) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex - t = mesh_elemType if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs m = 1_pInt ! process only first IP else - m = mesh_NipsPerElem + m = theMesh%elem%nIPs endif do i = 1_pInt, m ! loop over necessary IPs @@ -1301,7 +1295,7 @@ subroutine material_populateGrains enddo - do i = i, mesh_NipsPerElem ! loop over IPs to (possibly) distribute copies from first IP + do i = i, theMesh%elem%nIPs ! loop over IPs to (possibly) distribute copies from first IP material_volume (1_pInt:dGrains,i,e) = material_volume (1_pInt:dGrains,1,e) material_phase (1_pInt:dGrains,i,e) = material_phase (1_pInt:dGrains,1,e) material_texture(1_pInt:dGrains,i,e) = material_texture(1_pInt:dGrains,1,e) From 4f2a3d7f5505469e379c310fcd242d90afca890f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 12:23:53 +0100 Subject: [PATCH 044/154] unused variables --- src/mesh_FEM.f90 | 2 -- src/mesh_abaqus.f90 | 4 ---- src/mesh_grid.f90 | 9 +-------- src/mesh_marc.f90 | 4 ---- 4 files changed, 1 insertion(+), 18 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index e2b08db4c..ed80cbcba 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -27,7 +27,6 @@ use PETScis mesh_NcpElems, & !< total number of CP elements in mesh mesh_NcpElemsGlobal, & mesh_Nnodes, & !< total number of nodes in mesh - mesh_NipsPerElem, & !< number of IPs in per element mesh_maxNipNeighbors !!!! BEGIN DEPRECATED !!!!! integer(pInt), public, protected :: & @@ -269,7 +268,6 @@ subroutine mesh_init() !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 05e1d7c7d..74401e5e5 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -18,7 +18,6 @@ module mesh 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_NipsPerElem, & !< number of IPs in per element mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node @@ -33,7 +32,6 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_CPnodeID, & !< nodes forming an element 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) @@ -532,12 +530,10 @@ subroutine mesh_init(ip,el) !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) - mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) contains diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 88484a693..3d3680935 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -14,11 +14,9 @@ module mesh private integer(pInt), 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 mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh - mesh_NipsPerElem, & !< number of IPs in per element mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node @@ -35,10 +33,7 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_CPnodeID, & !< nodes forming an element - 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) + mesh_element !< entryCount and list of elements containing node integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] @@ -435,12 +430,10 @@ subroutine mesh_init(ip,el) !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) - mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index dd4098879..c20bf84d7 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -18,7 +18,6 @@ module mesh 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_NipsPerElem, & !< number of IPs in per element mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node @@ -33,7 +32,6 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_CPnodeID, & !< nodes forming an element 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) @@ -552,12 +550,10 @@ subroutine mesh_init(ip,el) !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) - mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) call theMesh%setNelems(mesh_NcpElems) From b514bf78a5f225aa0b5216978d67407678bc4aac Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 12:31:07 +0100 Subject: [PATCH 045/154] avoiding duplicated variables --- src/mesh_grid.f90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 3d3680935..875993290 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -22,7 +22,6 @@ module mesh mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! integer(pInt), 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 !!!!! @@ -393,10 +392,9 @@ subroutine mesh_init(ip,el) call theMesh%init(mesh_node) ! For compatibility - mesh_maxNips = theMesh%elem%nIPs mesh_maxNipNeighbors = theMesh%elem%nIPneighbors mesh_maxNcellnodes = theMesh%elem%Ncellnodes - +call theMesh%setNelems(mesh_NcpElems) call mesh_spectral_build_elements() @@ -435,7 +433,7 @@ subroutine mesh_init(ip,el) mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%setNelems(mesh_NcpElems) + end subroutine mesh_init !-------------------------------------------------------------------------------------------------- @@ -459,7 +457,7 @@ subroutine mesh_build_cellconnectivity matchingNodeID, & localCellnodeID - allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) + allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,mesh_NcpElems), source=0_pInt) allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) @@ -563,7 +561,7 @@ subroutine mesh_build_ipVolumes real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + allocate(mesh_ipVolume(theMesh%elem%nIPs,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) @@ -634,7 +632,7 @@ subroutine mesh_build_ipCoordinates real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) do e = 1_pInt,mesh_NcpElems ! loop over cpElems @@ -989,7 +987,7 @@ subroutine mesh_spectral_build_ipNeighborhood integer(pInt) :: & x,y,z, & e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems),source=0_pInt) e = 0_pInt do z = 0_pInt,grid3-1_pInt @@ -1136,8 +1134,8 @@ subroutine mesh_build_ipAreas 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_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,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 From 933136ec1e3486765f6373476e50ede8010380b5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 13:10:21 +0100 Subject: [PATCH 046/154] nNodes form element is used already --- src/mesh_base.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index c0f012256..5afdbc3ad 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -1,3 +1,4 @@ + !-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH @@ -66,6 +67,7 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes) self%type = meshType call self%elem%init(elemType) self%node0 = nodes + self%nNodes = size(nodes,2) end subroutine tMesh_base_init From 3edbfc1cb5759474bac68feca7de299f374b5de3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 15:10:35 +0100 Subject: [PATCH 047/154] bugfix: infinite loop for geom file without new line at end also, a lot of cleaning --- src/IO.f90 | 12 +- src/mesh_grid.f90 | 1483 ++++++++++----------------------------------- 2 files changed, 339 insertions(+), 1156 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 5c86ee966..bef14ea1e 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1329,11 +1329,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) ! DAMASK_marc errors case (700_pInt) msg = 'invalid materialpoint result requested' - case (701_pInt) - msg = 'not supported input file format, use Marc 2016 or earlier' !------------------------------------------------------------------------------------------------- -! errors related to spectral solver +! errors related to the grid solver case (809_pInt) msg = 'initializing FFTW' case (810_pInt) @@ -1355,13 +1353,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (841_pInt) msg = 'missing header length info in spectral mesh' case (842_pInt) - msg = 'homogenization in spectral mesh' - case (843_pInt) - msg = 'grid in spectral mesh' - case (844_pInt) - msg = 'size in spectral mesh' - case (845_pInt) msg = 'incomplete information in spectral mesh header' + case (843_pInt) + msg = 'microstructure count mismatch' case (846_pInt) msg = 'rotation for load case rotation ill-defined (R:RT != I)' case (847_pInt) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 875993290..d3741b766 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -13,17 +13,12 @@ module mesh implicit none private integer(pInt), public, protected :: & - mesh_NcpElems, & !< total number of CP elements in local mesh 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_NcellnodesPerElem, & !< number of cell nodes per element 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 :: & - mesh_maxNcellnodes !< max number of cell nodes in any CP element -!!!! BEGIN DEPRECATED !!!!! + integer(pInt), dimension(:), allocatable, private :: & microGlobal @@ -66,135 +61,22 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell integer(pInt), 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 FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell - real(pReal), dimension(:,:,:), allocatable, private :: & - FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes ! 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, & + integer(pInt), parameter, private :: & 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(pInt), 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) - 3, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 3, & ! element 54 (2D 8node 4ip) - 5, & ! element 134 (3D 4node 1ip) - 6, & ! element 157 (3D 5node 4ip) - 6, & ! element 127 (3D 10node 4ip) - 7, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 9, & ! element 7 (3D 8node 8ip) - 9, & ! element 57 (3D 20node 8ip) - 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 - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 4, & ! element 136 (3D 6node 6ip) - 4, & ! element 117 (3D 8node 1ip) - 4, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type - int([ & - 2, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 3, & ! element 127 (3D 10node 4ip) - 3, & ! element 136 (3D 6node 6ip) - 3, & ! element 117 (3D 8node 1ip) - 3, & ! element 7 (3D 8node 8ip) - 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 - int([ & - 3, & ! element 6 (2D 3node 1ip) - 6, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 8, & ! element 27 (2D 8node 9ip) - 8, & ! element 54 (2D 8node 4ip) - 4, & ! element 134 (3D 4node 1ip) - 5, & ! element 157 (3D 5node 4ip) - 10, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 20, & ! element 57 (3D 20node 8ip) - 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 - int([ & - 3, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 5, & ! element 136 (3D 6node 6ip) - 6, & ! element 117 (3D 8node 1ip) - 6, & ! element 7 (3D 8node 8ip) - 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 - int([ & - 3, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 8 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), 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) - 9, & ! element 11 (2D 4node 4ip) - 16, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 15, & ! element 127 (3D 10node 4ip) - 21, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 27, & ! element 7 (3D 8node 8ip) - 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 int([ & @@ -212,21 +94,8 @@ 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 - int([ & - 1, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 9, & ! element 27 (2D 8node 9ip) - 1, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 1, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 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(pInt), 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) @@ -235,21 +104,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],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 - int([ & - 3, & ! element 6 (2D 3node 1ip) - 1, & ! element 125 (2D 6node 3ip) - 1, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 1, & ! element 127 (3D 10node 4ip) - 1, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 1, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(3), public, protected :: & grid !< (global) grid integer(pInt), public, protected :: & @@ -356,8 +210,7 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - - call mesh_build_FEdata ! get properties of the different types of elements + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) @@ -381,7 +234,7 @@ subroutine mesh_init(ip,el) grid3Offset = int(local_K_offset,pInt) size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) - mesh_NcpElems= product(grid(1:2))*grid3 + mesh_NcpElemsGlobal = product(grid) mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) @@ -393,13 +246,14 @@ subroutine mesh_init(ip,el) ! For compatibility mesh_maxNipNeighbors = theMesh%elem%nIPneighbors - mesh_maxNcellnodes = theMesh%elem%Ncellnodes -call theMesh%setNelems(mesh_NcpElems) +call theMesh%setNelems(product(grid(1:2))*grid3) call mesh_spectral_build_elements() if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - + + + call mesh_build_FEdata ! get properties of the different types of elements call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -415,265 +269,26 @@ call theMesh%setNelems(mesh_NcpElems) if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + if (debug_e < 1 .or. debug_e > theMesh%nElems) & 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)))) & + 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 - 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 + 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... + forall (j = 1_pInt:theMesh%nElems) FEsolving_execIP(2,j) = theMesh%elem%nIPs ! ...up to own IP count for each element !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - + deallocate(mesh_cell) end subroutine mesh_init -!-------------------------------------------------------------------------------------------------- -!> @brief Split CP elements into cells. -!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). -!> Cell nodes that are also matching nodes are unique in the list of cell nodes, -!> all others (currently) might be stored more than once. -!> Also allocates the 'mesh_node' array. -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_cellconnectivity - - implicit none - integer(pInt), dimension(:), allocatable :: & - matchingNode2cellnode - integer(pInt), dimension(:,:), allocatable :: & - cellnodeParent - integer(pInt), dimension(mesh_maxNcellnodes) :: & - localCellnode2globalCellnode - integer(pInt) :: & - e,t,g,c,n,i, & - matchingNodeID, & - localCellnodeID - - allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,mesh_NcpElems), source=0_pInt) - allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) - -!-------------------------------------------------------------------------------------------------- -! 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 - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - localCellnode2globalCellnode = 0_pInt - 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 - 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 ... - 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 - 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 ... - 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 - endif - mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) - endif - enddo - enddo - enddo - - allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) - allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) - forall(n = 1_pInt:mesh_Ncellnodes) - mesh_cellnodeParent(1,n) = cellnodeParent(1,n) - mesh_cellnodeParent(2,n) = cellnodeParent(2,n) - endforall - -end subroutine mesh_build_cellconnectivity - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculate position of cellnodes from the given position of nodes -!> Build list of cellnodes' coordinates. -!> Cellnode coordinates are calculated from a weighted sum of node coordinates. -!-------------------------------------------------------------------------------------------------- -function mesh_build_cellnodes(nodes,Ncellnodes) - - implicit none - integer(pInt), 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) :: & - e,t,n,m, & - localCellnodeID - real(pReal), dimension(3) :: & - myCoords - - mesh_build_cellnodes = 0.0_pReal -!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) - do n = 1_pInt,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)) & - * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) - enddo - mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) - enddo -!$OMP END PARALLEL DO - -end function mesh_build_cellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' -!> @details The IP volume is calculated differently depending on the cell type. -!> 2D cells assume an element depth of one in order to calculate the volume. -!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal -!> shape with a cell face as basis and the central ip at the tip. This subvolume is -!> calculated as an average of four tetrahedals with three corners on the cell face -!> and one corner at the central ip. -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipVolumes - use math, only: & - math_volTetrahedron, & - math_areaTriangle - - implicit none - integer(pInt) :: e,t,g,c,i,m,f,n - real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - - - allocate(mesh_ipVolume(theMesh%elem%nIPs,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 - 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 - 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 - 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))) & - + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & - 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 - 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 - m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,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)) & - 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)), & - mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & - mesh_ipCoordinates(1:3,i,e)) - mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two - enddo - - end select - enddo - !$OMP END PARALLEL DO - -end subroutine mesh_build_ipVolumes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' -! Called by all solvers in mesh_init in order to initialize the ip coordinates. -! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, -! so no need to use this subroutine anymore; Marc however only provides nodal displacements, -! so in this case the ip coordinates are always calculated on the basis of this subroutine. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, -! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. -! HAS TO BE CHANGED IN A LATER VERSION. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipCoordinates - - implicit none - integer(pInt) :: e,t,g,c,i,n - real(pReal), dimension(3) :: myCoords - - if (.not. allocated(mesh_ipCoordinates)) & - allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,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 - 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 - myCoords = 0.0_pReal - do n = 1_pInt,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) - enddo - enddo - !$OMP END PARALLEL DO - -end subroutine mesh_build_ipCoordinates - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates cell center coordinates. -!-------------------------------------------------------------------------------------------------- -pure function mesh_cellCenterCoordinates(ip,el) - - implicit none - integer(pInt), 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 - - t = mesh_element(2_pInt,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 - mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) - enddo - mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) - -end function mesh_cellCenterCoordinates - !-------------------------------------------------------------------------------------------------- !> @brief Parses geometry file @@ -695,12 +310,10 @@ subroutine mesh_spectral_read_grid() character(len=:), allocatable :: rawData character(len=65536) :: line integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt), dimension(3) :: g = -1_pInt - real(pReal), dimension(3) :: s = -1_pInt integer(pInt) :: h =- 1_pInt integer(pInt) :: & headerLength = -1_pInt, & !< length of header (in lines) - fileLength, & !< lenght of the geom file (in characters) + fileLength, & !< length of the geom file (in characters) fileUnit, & startPos, endPos, & myStat, & @@ -709,10 +322,9 @@ subroutine mesh_spectral_read_grid() o, & !< order of "to" packing e, & !< "element", i.e. spectral collocation point i, j - logical :: & - gotGrid = .false., & - gotSize = .false., & - gotHomogenization = .false. + + grid = -1_pInt + geomSize = -1.0_pReal !-------------------------------------------------------------------------------------------------- ! read data as stream @@ -728,6 +340,7 @@ subroutine mesh_spectral_read_grid() ! get header length endPos = index(rawData,new_line('')) if(endPos <= index(rawData,'head')) then + startPos = len(rawData) call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid') else chunkPos = IO_stringPos(rawData(1:endPos)) @@ -741,52 +354,58 @@ subroutine mesh_spectral_read_grid() l = 0 do while (l < headerLength .and. startPos < len(rawData)) endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + if (endPos < startPos) endPos = len(rawData) ! end of file without new line line = rawData(startPos:endPos) startPos = endPos + 1_pInt l = l + 1_pInt - ! cycle empty lines chunkPos = IO_stringPos(trim(line)) - select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) ) + if (chunkPos(1) < 2) cycle ! need at least one keyword value pair + select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) ) case ('grid') - if (chunkPos(1) > 6) gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - g(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - g(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - g(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo + if (chunkPos(1) > 6) then + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + grid(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + grid(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + grid(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + endif case ('size') - if (chunkPos(1) > 6) gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - s(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - s(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - s(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo + if (chunkPos(1) > 6) then + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + geomSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + geomSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + geomSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + endif case ('homogenization') - if (chunkPos(1) > 1) gotHomogenization = .true. - h = IO_intValue(line,chunkPos,2_pInt) - + if (chunkPos(1) > 1) h = IO_intValue(line,chunkPos,2_pInt) end select enddo !-------------------------------------------------------------------------------------------------- -! global data - grid = g - geomSize = s +! sanity checks + if(h < 1_pInt) & + call IO_error(error_ID = 842_pInt, ext_msg='homogenization (mesh_spectral_read_grid)') + if(any(grid < 1_pInt)) & + call IO_error(error_ID = 842_pInt, ext_msg='grid (mesh_spectral_read_grid)') + if(any(geomSize < 0.0_pReal)) & + call IO_error(error_ID = 842_pInt, ext_msg='size (mesh_spectral_read_grid)') + allocate(microGlobal(product(grid)), source = -1_pInt) !-------------------------------------------------------------------------------------------------- @@ -794,52 +413,34 @@ subroutine mesh_spectral_read_grid() e = 1_pInt do while (startPos < len(rawData)) endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + if (endPos < startPos) endPos = len(rawData) ! end of file without new line line = rawData(startPos:endPos) startPos = endPos + 1_pInt l = l + 1_pInt - chunkPos = IO_stringPos(trim(line)) - if (chunkPos(1) == 3) then - if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then + + possibleCompression: if (chunkPos(1) /= 3) then + c = chunkPos(1) + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] + else possibleCompression + compression: if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then c = IO_intValue(line,chunkPos,1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))] - else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then + else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then compression c = abs(IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1)) + 1_pInt o = merge(+1_pInt, -1_pInt, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1)) microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)] - else + else compression c = chunkPos(1) - do i = 0_pInt, c - 1_pInt - microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) - enddo - endif - else - c = chunkPos(1) - do i = 0_pInt, c - 1_pInt - microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) - enddo + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] + endif compression + endif possibleCompression - endif e = e+c end do - if (e-1 /= product(grid)) print*, 'mist', e + if (e-1 /= product(grid)) call IO_error(error_ID = 843_pInt, el=e) -! if (.not. gotGrid) & -! call IO_error(error_ID = 845_pInt, ext_msg='grid') -! if(any(mesh_spectral_getGrid < 1_pInt)) & -! call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') - -! if (.not. gotSize) & -! call IO_error(error_ID = 845_pInt, ext_msg='size') -! if (any(mesh_spectral_getSize<=0.0_pReal)) & -! call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') - -! if (.not. gotHomogenization ) & -! call IO_error(error_ID = 845_pInt, ext_msg='homogenization') -! if (mesh_spectral_getHomogenization<1_pInt) & -! call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - end subroutine mesh_spectral_read_grid @@ -866,7 +467,6 @@ integer(pInt) function mesh_spectral_getHomogenization() integer(pInt) :: i, myFileUnit logical :: gotHomogenization = .false. - myFileUnit = 289_pInt call IO_open_file(myFileUnit,trim(geometryFile)) @@ -941,7 +541,7 @@ subroutine mesh_spectral_build_elements() IO_error implicit none integer(pInt) :: & - e, i, & + e, & homog, & elemOffset @@ -950,12 +550,12 @@ subroutine mesh_spectral_build_elements() homog = mesh_spectral_getHomogenization() - allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) + allocate(mesh_element (4_pInt+8_pInt,theMesh%nElems), source = 0_pInt) elemOffset = product(grid(1:2))*grid3Offset e = 0_pInt - do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) + do while (e < theMesh%nElems) ! fill expected number of elements, stop at end of data (or blank line!) e = e+1_pInt ! valid element entry mesh_element( 1,e) = -1_pInt ! DEPRECATED mesh_element( 2,e) = 10_pInt @@ -972,7 +572,7 @@ subroutine mesh_spectral_build_elements() mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt enddo - if (e /= mesh_NcpElems) call IO_error(880_pInt,e) + if (e /= theMesh%nElems) call IO_error(880_pInt,e) end subroutine mesh_spectral_build_elements @@ -987,7 +587,7 @@ subroutine mesh_spectral_build_ipNeighborhood integer(pInt) :: & x,y,z, & e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems),source=0_pInt) + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems),source=0_pInt) e = 0_pInt do z = 0_pInt,grid3-1_pInt @@ -1122,6 +722,260 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) end function mesh_nodesAroundCentres +!################################################################################################################# +!################################################################################################################# +!################################################################################################################# +! The following routines are not solver specific and should be included in mesh_base (most likely in modified form) +!################################################################################################################# +!################################################################################################################# +!################################################################################################################# + + + +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(theMesh%elem%Ncellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,n,i, & + matchingNodeID, & + localCellnodeID + + integer(pInt), dimension(FE_Ngeomtypes), parameter :: 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) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 8 & ! element 21 (3D 20node 27ip) + ],pInt) + + 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) + + mesh_Ncells = theMesh%nElems*theMesh%elem%nIPs +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + + do e = 1_pInt,theMesh%nElems + localCellnode2globalCellnode = 0_pInt + do i = 1_pInt,theMesh%elem%nIPs + do n = 1_pInt,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 ... + 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 + 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 ... + 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 + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), 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) :: & + e,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,myCoords) + do n = 1_pInt,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)) & + * theMesh%elem%cellNodeParentNodeWeights(m,localCellnodeID) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(theMesh%elem%cellNodeParentNodeWeights(:,localCellnodeID)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: 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 + select case (theMesh%elem%cellType) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt: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 + 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))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + 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 + 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) + c = theMesh%elem%cellType ! 3D 8node + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,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)) & + 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)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: e,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(c,myCoords) + do e = 1_pInt,theMesh%nElems ! loop over cpElems + c = theMesh%elem%cellType + do i = 1_pInt,theMesh%elem%nIPs ! 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 + myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e)) + enddo + mesh_ipCoordinates(1:3,i,e) = myCoords / real(FE_NcellnodesPerCell(c),pReal) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), 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) :: c,n + + c = theMesh%elem%cellType + mesh_cellCenterCoordinates = 0.0_pReal + do n = 1_pInt,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) + +end function mesh_cellCenterCoordinates + + !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' !-------------------------------------------------------------------------------------------------- @@ -1134,18 +988,16 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), 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 - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + do e = 1_pInt,theMesh%nElems ! loop over cpElems + c = theMesh%elem%cellType 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 i = 1_pInt,theMesh%elem%nIPs ! 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)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1158,7 +1010,7 @@ subroutine mesh_build_ipAreas enddo case (3_pInt) ! 3D 4node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1_pInt,theMesh%elem%nIPs ! 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)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1175,7 +1027,7 @@ subroutine mesh_build_ipAreas ! 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 i = 1_pInt,theMesh%elem%nIPs ! 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)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1198,678 +1050,15 @@ end subroutine mesh_build_ipAreas !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements -!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_subNodeOnIPFace !-------------------------------------------------------------------------------------------------- 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) - 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) - !*** fill FE_nodesAtIP with data *** - - me = 0_pInt - - me = me + 1_pInt - 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 - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, & - 2, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, & - 2, & - 4, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1,0, & - 1,2, & - 2,0, & - 1,4, & - 0,0, & - 2,3, & - 4,0, & - 3,4, & - 3,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - 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 - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 1, & - 2, & - 3, & - 4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 1, & - 2, & - 3, & - 4, & - 5, & - 6 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - 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 - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 1, & - 2, & - 4, & - 3, & - 5, & - 6, & - 8, & - 7 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - reshape(int([& - 1,0, 0,0, & - 1,2, 0,0, & - 2,0, 0,0, & - 1,4, 0,0, & - 1,3, 2,4, & - 2,3, 0,0, & - 4,0, 0,0, & - 3,4, 0,0, & - 3,0, 0,0, & - 1,5, 0,0, & - 1,6, 2,5, & - 2,6, 0,0, & - 1,8, 4,5, & - 0,0, 0,0, & - 2,7, 3,6, & - 4,8, 0,0, & - 3,8, 4,7, & - 3,7, 0,0, & - 5,0, 0,0, & - 5,6, 0,0, & - 6,0, 0,0, & - 5,8, 0,0, & - 5,7, 6,8, & - 6,7, 0,0, & - 8,0, 0,0, & - 7,8, 0,0, & - 7,0, 0,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - - ! *** FE_ipNeighbor *** - ! is a list of the neighborhood of each IP. - ! 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 = me + 1_pInt - 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 - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 2,-3, 3,-1, & - -2, 1, 3,-1, & - 2,-3,-2, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 2,-4, 3,-1, & - -2, 1, 4,-1, & - 4,-4,-3, 1, & - -2, 3,-3, 2 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 2,-4, 4,-1, & - 3, 1, 5,-1, & - -2, 2, 6,-1, & - 5,-4, 7, 1, & - 6, 4, 8, 2, & - -2, 5, 9, 3, & - 8,-4,-3, 4, & - 9, 7,-3, 5, & - -2, 8,-3, 6 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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 - 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, & - -2, 1, 3,-2, 4,-1, & - 2,-4,-3, 1, 4,-1, & - 2,-4, 3,-2,-3, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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, & - -3, 1, 3,-2, 5,-1, & - 2,-4,-3, 1, 6,-1, & - 5,-4, 6,-2,-5, 1, & - -3, 4, 6,-2,-5, 2, & - 5,-4,-3, 4,-5, 3 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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 - 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, & - -3, 1, 4,-2, 6,-1, & - 4,-5,-4, 1, 7,-1, & - -3, 3,-4, 2, 8,-1, & - 6,-5, 7,-2,-6, 1, & - -3, 5, 8,-2,-6, 2, & - 8,-5,-4, 5,-6, 3, & - -3, 7,-4, 6,-6, 4 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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, & - 3, 1, 5,-2,11,-1, & - -3, 2, 6,-2,12,-1, & - 5,-5, 7, 1,13,-1, & - 6, 4, 8, 2,14,-1, & - -3, 5, 9, 3,15,-1, & - 8,-5,-4, 4,16,-1, & - 9, 7,-4, 5,17,-1, & - -3, 8,-4, 6,18,-1, & - 11,-5,13,-2,19, 1, & - 12,10,14,-2,20, 2, & - -3,11,15,-2,21, 3, & - 14,-5,16,10,22, 4, & - 15,13,17,11,23, 5, & - -3,14,18,12,24, 6, & - 17,-5,-4,13,25, 7, & - 18,16,-4,14,26, 8, & - -3,17,-4,15,27, 9, & - 20,-5,22,-2,-6,10, & - 21,19,23,-2,-6,11, & - -3,20,24,-2,-6,12, & - 23,-5,25,19,-6,13, & - 24,22,26,20,-6,14, & - -3,23,27,21,-6,15, & - 26,-5,-4,22,-6,16, & - 27,25,-4,23,-6,17, & - -3,26,-4,24,-6,18 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cell *** - me = 0_pInt - - me = me + 1_pInt - 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 - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, 4, 7, 6, & - 2, 5, 7, 4, & - 3, 6, 7, 5 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, 5, 9, 8, & - 5, 2, 6, 9, & - 8, 9, 7, 4, & - 9, 6, 3, 7 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1, 5,13,12, & - 5, 6,14,13, & - 6, 2, 7,14, & - 12,13,16,11, & - 13,14,15,16, & - 14, 7, 8,15, & - 11,16,10, 4, & - 16,15, 9,10, & - 15, 8, 3, 9 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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 - 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, & - 5, 2, 6,11,12, 9,13,15, & - 7,11, 6, 3,14,15,13,10, & - 8,12,15, 4, 4, 9,13,10 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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, & - 7, 2, 8,16,17,11,18,21, & - 9,16, 8, 3,19,21,18,12, & - 10,17,21,19, 4,13,20,15, & - 17,11,18,21,13, 5,14,20, & - 19,21,18,12,15,20,14, 6 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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 - 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, & - 9, 2,10,21,22,14,23,27, & - 12,21,11, 4,25,27,24,16, & - 21,10, 3,11,27,23,15,24, & - 13,22,27,25, 5,17,26,20, & - 22,14,23,27,17, 6,18,26, & - 25,27,24,16,20,26,19, 8, & - 27,23,15,24,26,18, 7,19 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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, & - 9,10,34,33,37,38,58,57, & - 10, 2,11,34,38,18,39,58, & - 16,33,36,15,44,57,60,43, & - 33,34,35,36,57,58,59,60, & - 34,11,12,35,58,39,40,59, & - 15,36,14, 4,43,60,42,20, & - 36,35,13,14,60,59,41,42, & - 35,12, 3,13,59,40,19,41, & - 17,37,57,44,21,45,61,52, & - 37,38,58,57,45,46,62,61, & - 38,18,39,58,46,22,47,62, & - 44,57,60,43,52,61,64,51, & - 57,58,59,60,61,62,63,64, & - 58,39,40,59,62,47,48,63, & - 43,60,42,20,51,64,50,24, & - 60,59,41,42,64,63,49,50, & - 59,40,19,41,63,48,23,49, & - 21,45,61,52, 5,25,53,32, & - 45,46,62,61,25,26,54,53, & - 46,22,47,62,26, 6,27,54, & - 52,61,64,51,32,53,56,31, & - 61,62,63,64,53,54,55,56, & - 62,47,48,63,54,27,28,55, & - 51,64,50,24,31,56,30, 8, & - 64,63,49,50,56,55,29,30, & - 63,48,23,49,55,28, 7,29 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cellnodeParentnodeWeights *** - ! center of gravity of the weighted nodes gives the position of the cell node. - ! fill with 0. - ! 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 = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) - reshape(real([& - 1, 0, 0, & - 0, 1, 0, & - 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 2, 2, 2 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1, & - 1, 1, 0, 0, & - 0, 1, 1, 0, & - 0, 0, 1, 1, & - 1, 0, 0, 1, & - 1, 1, 1, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 1, 0, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 0, 2, & - 1, 0, 0, 0, 0, 0, 0, 2, & - 4, 1, 1, 1, 8, 2, 2, 8, & - 1, 4, 1, 1, 8, 8, 2, 2, & - 1, 1, 4, 1, 2, 8, 8, 2, & - 1, 1, 1, 4, 2, 2, 8, 8 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 1, 2, 2, 2, 2 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, & - 0, 0, 1, 0, 0, & - 0, 0, 0, 1, 0, & - 1, 1, 0, 0, 0, & - 0, 1, 1, 0, 0, & - 1, 0, 1, 0, 0, & - 1, 0, 0, 1, 0, & - 0, 1, 0, 1, 0, & - 0, 0, 1, 1, 0, & - 1, 1, 1, 0, 0, & - 1, 1, 0, 1, 0, & - 0, 1, 1, 1, 0, & - 1, 0, 1, 1, 0, & - 0, 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & - 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & - 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & - 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & - 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 0, 0, 0, 0, & - 0, 1, 1, 0, 0, 0, & - 1, 0, 1, 0, 0, 0, & - 1, 0, 0, 1, 0, 0, & - 0, 1, 0, 0, 1, 0, & - 0, 0, 1, 0, 0, 1, & - 0, 0, 0, 1, 1, 0, & - 0, 0, 0, 0, 1, 1, & - 0, 0, 0, 1, 0, 1, & - 1, 1, 1, 0, 0, 0, & - 1, 1, 0, 1, 1, 0, & - 0, 1, 1, 0, 1, 1, & - 1, 0, 1, 1, 0, 1, & - 0, 0, 0, 1, 1, 1, & - 1, 1, 1, 1, 1, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & ! - 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, & ! - 1, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 1, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 1, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 1, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 1, & ! - 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, & ! - 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, & ! - 1, 1, 1, 1, 1, 1, 1, 1 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! - 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! - 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 - 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, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 - 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! - 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 - 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! - 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! - 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! - 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 - 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! - 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 - 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! - 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! - 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 - 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! - 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! - 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! - 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! - 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 - 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! - 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! - 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! - 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - - ! *** FE_cellface *** me = 0_pInt From 07cca77fcefc109d2d9c96df42d452c9bb1d2600 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 17:19:12 +0100 Subject: [PATCH 048/154] left over jump marks --- src/mesh_abaqus.f90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 74401e5e5..8d6f950a5 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -1288,7 +1288,7 @@ subroutine mesh_abaqus_map_nodes(fileUnit) backspace(fileUnit) enddo do i = 1_pInt,c - read (fileUnit,610,END=650) line + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) cpNode = cpNode + 1_pInt mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) @@ -1352,7 +1352,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) backspace(fileUnit) ! rewind to first entry enddo do i = 1_pInt,c - read (fileUnit,'(a300)',END=670) line + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) do j=1_pInt, 3_pInt @@ -1448,9 +1448,8 @@ subroutine mesh_abaqus_build_elements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - logical :: inPart + logical :: inPart, materialFound integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead - logical inPart,materialFound character (len=64) :: materialName,elemSetName allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) @@ -1478,7 +1477,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) backspace(fileUnit) enddo do i = 1_pInt,c - read (fileUnit,'(a300)',END=620) line + 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 @@ -1493,7 +1492,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) enddo nNodesAlreadyRead = chunkPos(1) - 1_pInt do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) do j = 1_pInt,chunkPos(1) mesh_element(4_pInt+nNodesAlreadyRead+j,e) & @@ -1522,7 +1521,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) case('*user') if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & materialFound ) then - read (fileUnit,'(a300)',END=630) line ! read homogenization and microstructure + 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) From 819ec40b44bacba084ceec95287a5a718ebb28e0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 15:57:05 +0100 Subject: [PATCH 049/154] clearer order: 1) parse file 2) set up element 3) set up mesh --- src/mesh_abaqus.f90 | 19 +++++++++---------- src/mesh_marc.f90 | 17 +++++++++-------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 8d6f950a5..909ab1e0e 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -18,7 +18,6 @@ module mesh 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_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! @@ -419,7 +418,6 @@ subroutine tMesh_abaqus_init(self,elemType,nodes) integer(pInt), intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) - call theMesh%setNelems(mesh_NcpElems) end subroutine tMesh_abaqus_init @@ -464,7 +462,6 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) @@ -496,6 +493,12 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + close (FILEUNIT) + + call theMesh%init(mesh_element(2,1),mesh_node0) + call theMesh%setNelems(mesh_NcpElems) + call mesh_build_FEdata ! get properties of the different types of elements + call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -506,7 +509,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) call mesh_build_ipAreas if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) - close (FILEUNIT) call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems @@ -527,15 +529,12 @@ subroutine mesh_init(ip,el) 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" -!!!! COMPATIBILITY HACK !!!! -! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. -! hence, xxPerElem instead of maxXX - mesh_NcellnodesPerElem = mesh_maxNcellnodes + ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) -!!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init(mesh_element(2,1),mesh_node0) + + contains diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index c20bf84d7..601939c53 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -18,7 +18,6 @@ module mesh 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_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! @@ -478,7 +477,7 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call mesh_build_FEdata ! get properties of the different types of elements + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) @@ -513,6 +512,12 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + close (FILEUNIT) + + call theMesh%init(mesh_element(2,1),mesh_node0) + call theMesh%setNelems(mesh_NcpElems) + call mesh_build_FEdata ! get properties of the different types of elements + call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -523,7 +528,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) call mesh_build_ipAreas if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) - close (FILEUNIT) + call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) @@ -548,15 +553,11 @@ subroutine mesh_init(ip,el) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" !!!! COMPATIBILITY HACK !!!! -! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. -! hence, xxPerElem instead of maxXX - mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init(mesh_element(2,1),mesh_node0) - call theMesh%setNelems(mesh_NcpElems) + end subroutine mesh_init From d51a379376a6b2ed4fd9370b144a9c8766f82a8d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 16:17:52 +0100 Subject: [PATCH 050/154] avoid jump labels --- src/mesh_marc.f90 | 82 ++++++++++++++++++++--------------------------- 1 file changed, 35 insertions(+), 47 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 601939c53..d39f4efdb 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -863,11 +863,10 @@ subroutine mesh_marc_get_fileFormat(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then MarcVersion = IO_intValue(line,chunkPos,2_pInt) @@ -898,11 +897,10 @@ subroutine mesh_marc_get_tableStyles(fileUnit) initialcondTableStyle = 0_pInt hypoelasticTableStyle = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + 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 @@ -931,13 +929,12 @@ subroutine mesh_marc_get_matNumber(fileUnit) integer(pInt) :: i, j, data_blocks character(len=300) line -610 FORMAT(A300) rewind(fileUnit) data_blocks = 1_pInt do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then read (fileUnit,610,END=620) line @@ -981,11 +978,10 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & @@ -1021,11 +1017,10 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) mesh_NelemSets = 0_pInt mesh_maxNelemInSet = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & @@ -1061,11 +1056,10 @@ subroutine mesh_marc_map_elementSets(fileUnit) allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=640) line + 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 @@ -1101,16 +1095,15 @@ subroutine mesh_marc_count_cpElements(fileUnit) mesh_NcpElems = 0_pInt -610 FORMAT(A300) rewind(fileUnit) if (MarcVersion < 13) then ! Marc 2016 or earlier do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line enddo mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update exit @@ -1118,10 +1111,10 @@ subroutine mesh_marc_count_cpElements(fileUnit) enddo else ! Marc2017 and later do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) @@ -1158,12 +1151,11 @@ subroutine mesh_marc_map_elements(fileUnit) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) -610 FORMAT(A300) contInts = 0_pInt rewind(fileUnit) do - read (fileUnit,610,END=660) line + 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 @@ -1176,11 +1168,11 @@ subroutine mesh_marc_map_elements(fileUnit) endif else ! Marc2017 and later if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=660) line + read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then do - read (fileUnit,610,END=660) line + read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) if (verify(trim(tmp),"0123456789")/=0) then ! found keyword @@ -1228,18 +1220,17 @@ subroutine mesh_marc_map_nodes(fileUnit) allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) -610 FORMAT(A300) node_count = 0_pInt rewind(fileUnit) do - read (fileUnit,610,END=650) line + read (fileUnit,'(A300)',END=650) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=650) line ! skip crap line + read (fileUnit,'(A300)',END=650) line ! skip crap line do i = 1_pInt,mesh_Nnodes - read (fileUnit,610,END=650) line + read (fileUnit,'(A300)',END=650) line mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) mesh_mapFEtoCPnode(2_pInt,i) = i enddo @@ -1276,16 +1267,15 @@ subroutine mesh_marc_build_nodes(fileUnit) allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=670) line + read (fileUnit,'(A300)',END=670) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=670) line ! skip crap line + read (fileUnit,'(A300)',END=670) line ! skip crap line do i=1_pInt,mesh_Nnodes - read (fileUnit,610,END=670) line + read (fileUnit,'(A300)',END=670) 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) @@ -1325,15 +1315,15 @@ subroutine mesh_marc_count_cpSizes(fileUnit) mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt -610 FORMAT(A300) + rewind(fileUnit) do - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=630) line ! Garbage line + read (fileUnit,'(A300)',END=630) line ! Garbage line do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) ! limit to id and type e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then @@ -1381,16 +1371,15 @@ subroutine mesh_marc_build_elements(fileUnit) allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) mesh_elemType = -1_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=620) line ! garbage line + read (fileUnit,'(A300)',END=620) line ! garbage line do i = 1_pInt,mesh_Nelems - read (fileUnit,610,END=620) line + 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 @@ -1406,7 +1395,7 @@ subroutine mesh_marc_build_elements(fileUnit) enddo nNodesAlreadyRead = chunkPos(1) - 2_pInt do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) do j = 1_pInt,chunkPos(1) mesh_element(4_pInt+nNodesAlreadyRead+j,e) & @@ -1421,23 +1410,23 @@ subroutine mesh_marc_build_elements(fileUnit) enddo 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) 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,610,END=620) line ! read extra line for new style - read (fileUnit,610,END=630) line ! read line with index of state var + 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 - read (fileUnit,610,END=620) line ! read line with value of state var + read (fileUnit,'(A300)',END=620) 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 - read (fileUnit,610,END=630) line ! read extra line - read (fileUnit,610,END=630) line ! read extra line + 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,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) @@ -1446,12 +1435,12 @@ subroutine mesh_marc_build_elements(fileUnit) mesh_element(1_pInt+sv,e) = myVal enddo if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo endif else - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',END=630) line endif enddo @@ -1482,7 +1471,7 @@ use IO, only: & rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read @@ -1499,7 +1488,6 @@ use IO, only: & endif enddo -610 FORMAT(A300) 620 end subroutine mesh_get_damaskOptions From 16cb9ebed9037f1f0d7751fb8e208fce3d0d04d1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 16:49:12 +0100 Subject: [PATCH 051/154] no need to read homogenization info extra but currently, it is not very elegant --- src/mesh_grid.f90 | 89 ++++++----------------------------------------- 1 file changed, 11 insertions(+), 78 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index d3741b766..ec45b8def 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -124,7 +124,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & mesh_build_FEdata, & - mesh_spectral_getHomogenization, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & @@ -243,13 +242,11 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) call theMesh%init(mesh_node) - - ! For compatibility + call theMesh%setNelems(product(grid(1:2))*grid3) + mesh_homogenizationAt = mesh_homogenizationAt(product(grid(1:2))*grid3) ! reallocate/shrink in case of MPI mesh_maxNipNeighbors = theMesh%elem%nIPneighbors -call theMesh%setNelems(product(grid(1:2))*grid3) call mesh_spectral_build_elements() - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) @@ -283,7 +280,6 @@ call theMesh%setNelems(product(grid(1:2))*grid3) ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX ! better name - mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! deallocate(mesh_cell) @@ -407,6 +403,7 @@ subroutine mesh_spectral_read_grid() call IO_error(error_ID = 842_pInt, ext_msg='size (mesh_spectral_read_grid)') allocate(microGlobal(product(grid)), source = -1_pInt) + allocate(mesh_homogenizationAt(product(grid)), source = h) ! too large in case of MPI (shrink later, not very elegant) !-------------------------------------------------------------------------------------------------- ! read and interprete content @@ -419,10 +416,10 @@ subroutine mesh_spectral_read_grid() l = l + 1_pInt chunkPos = IO_stringPos(trim(line)) - possibleCompression: if (chunkPos(1) /= 3) then + noCompression: if (chunkPos(1) /= 3) then c = chunkPos(1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] - else possibleCompression + else noCompression compression: if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then c = IO_intValue(line,chunkPos,1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))] @@ -434,7 +431,7 @@ subroutine mesh_spectral_read_grid() c = chunkPos(1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] endif compression - endif possibleCompression + endif noCompression e = e+c end do @@ -444,64 +441,6 @@ subroutine mesh_spectral_read_grid() end subroutine mesh_spectral_read_grid -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization() - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, myFileUnit - logical :: gotHomogenization = .false. - - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('homogenization') - gotHomogenization = .true. - mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) - end select - enddo - - close(myFileUnit) - - if (.not. gotHomogenization ) & - call IO_error(error_ID = 845_pInt, ext_msg='homogenization') - if (mesh_spectral_getHomogenization<1_pInt) & - call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - -end function mesh_spectral_getHomogenization - - !-------------------------------------------------------------------------------------------------- !> @brief Store x,y,z coordinates of all nodes in mesh. !! Allocates global arrays 'mesh_node0' and 'mesh_node' @@ -542,24 +481,18 @@ subroutine mesh_spectral_build_elements() implicit none integer(pInt) :: & e, & - - homog, & elemOffset - homog = mesh_spectral_getHomogenization() - - allocate(mesh_element (4_pInt+8_pInt,theMesh%nElems), source = 0_pInt) - elemOffset = product(grid(1:2))*grid3Offset e = 0_pInt - do while (e < theMesh%nElems) ! fill expected number of elements, stop at end of data (or blank line!) + do while (e < theMesh%nElems) ! fill expected number of elements, stop at end of data e = e+1_pInt ! valid element entry mesh_element( 1,e) = -1_pInt ! DEPRECATED mesh_element( 2,e) = 10_pInt - mesh_element( 3,e) = homog ! homogenization + mesh_element( 3,e) = mesh_homogenizationAt(e) mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node @@ -587,7 +520,7 @@ subroutine mesh_spectral_build_ipNeighborhood integer(pInt) :: & x,y,z, & e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems),source=0_pInt) + allocate(mesh_ipNeighborhood(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems),source=0_pInt) e = 0_pInt do z = 0_pInt,grid3-1_pInt @@ -988,8 +921,8 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + 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) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) do e = 1_pInt,theMesh%nElems ! loop over cpElems From abedb5c3db5bcb909d1f36ade2e7566cfa27f80a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 17:24:00 +0100 Subject: [PATCH 052/154] ordered according to calling sequence --- src/mesh_grid.f90 | 2 +- src/mesh_marc.f90 | 1468 +++++++++++++++++++++++---------------------- 2 files changed, 738 insertions(+), 732 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index ec45b8def..d55c1cded 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -27,7 +27,7 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_element !< entryCount and list of elements containing node + mesh_element !< entryCount and list of elements containing node integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index d39f4efdb..da62a3e73 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -373,7 +373,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & FE_mapElemtype, & - mesh_faceMatch, & mesh_build_FEdata, & mesh_build_nodeTwins, & mesh_build_sharedElems, & @@ -562,53 +561,651 @@ end subroutine mesh_init !-------------------------------------------------------------------------------------------------- -!> @brief Gives the FE to CP ID mapping by binary search through lookup array -!! valid questions (what) are 'elem', 'node' +!> @brief Figures out version of Marc input file format and stores ist as MarcVersion !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) +subroutine mesh_marc_get_fileFormat(fileUnit) use IO, only: & - IO_lc + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos implicit none - character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID + integer(pInt), intent(in) :: fileUnit - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line - mesh_FEasCP = 0_pInt - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),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) - return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) - return - endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then - lower = center - elseif (lookupMap(1_pInt,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2_pInt,center) + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then + MarcVersion = IO_intValue(line,chunkPos,2_pInt) exit endif - enddo binarySearch + enddo + +620 end subroutine mesh_marc_get_fileFormat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and +!! 'hypoelasticTableStyle' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_tableStyles(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + initialcondTableStyle = 0_pInt + hypoelasticTableStyle = 0_pInt + + + 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 + initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) + hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_tableStyles + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_matNumber(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i, j, data_blocks + character(len=300) line + + + rewind(fileUnit) + + data_blocks = 1_pInt + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + read (fileUnit,'(A300)',END=620) line + if (len(trim(line))/=0_pInt) then + chunkPos = IO_stringPos(line) + data_blocks = IO_intValue(line,chunkPos,1_pInt) + endif + allocate(Marc_matNumber(data_blocks)) + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) + do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block + read (fileUnit,'(A300)') line + enddo + enddo + exit + endif + enddo + +620 end subroutine mesh_marc_get_matNumber + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores the numbers in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_nodesAndElements(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_IntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & + mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then + read (fileUnit,'(A300)') line + chunkPos = IO_stringPos(line) + mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file + endif + enddo + +620 end subroutine mesh_marc_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- + subroutine mesh_marc_count_elementSets(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = 0_pInt + + + 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 + mesh_NelemSets = mesh_NelemSets + 1_pInt + mesh_maxNelemInSet = max(mesh_maxNelemInSet, & + IO_countContinuousIntValues(fileUnit)) + endif + enddo + +620 end subroutine mesh_marc_count_elementSets + + +!******************************************************************** +! map element sets +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!******************************************************************** +subroutine mesh_marc_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) + + + 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 + mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mesh_mapElemSet(:,elemSet) = & + IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + endif + enddo + +640 end subroutine mesh_marc_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues, & + IO_error, & + IO_intValue, & + IO_countNumericalDataLines + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i + character(len=300):: line + + mesh_NcpElems = 0_pInt + + + rewind(fileUnit) + if (MarcVersion < 13) then ! Marc 2016 or earlier + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + read (fileUnit,'(A300)') line + enddo + mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update + exit + endif + enddo + else ! Marc2017 and later + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,'(A300)') line + chunkPos = IO_stringPos(line) + if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + endif + endif + enddo + end if + +620 end subroutine mesh_marc_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line, & + tmp + + integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,cpElem = 0_pInt + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + + + contInts = 0_pInt + 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+hypoelasticTableStyle ! skip three (or four if new table style!) lines + read (fileUnit,'(A300)') line + enddo + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& + mesh_mapElemSet,mesh_NelemSets) + exit + endif + else ! Marc2017 and later + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,'(A300)',END=660) line + chunkPos = IO_stringPos(line) + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + do + read (fileUnit,'(A300)',END=660) line + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + exit + else + contInts(1) = contInts(1) + 1_pInt + read (tmp,*) contInts(contInts(1)+1) + endif + enddo + endif + endif + endif + enddo +660 do i = 1_pInt,contInts(1) + cpElem = cpElem+1_pInt + mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) + mesh_mapFEtoCPelem(2,cpElem) = cpElem + enddo + +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + +end subroutine mesh_marc_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt) :: i + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + + + node_count = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=650) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,'(A300)') line ! skip crap line + do i = 1_pInt,mesh_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 + enddo + exit + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + +end subroutine mesh_marc_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_nodes(fileUnit) + + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue, & + IO_fixedNoEFloatValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=670) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,'(A300)') line ! skip crap line + do i=1_pInt,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) + enddo + enddo + exit + endif + enddo + +670 mesh_node = mesh_node0 + +end subroutine mesh_marc_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_intValue, & + IO_skipChunks + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,t,g,e,c + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=630) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,'(A300)') line ! Garbage line + do i=1_pInt,mesh_Nelems ! read all elements + read (fileUnit,'(A300)') line + chunkPos = IO_stringPos(line) ! limit to id and type + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + endif + enddo + exit + endif + enddo + +630 end subroutine mesh_marc_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per element. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_fixedNoEFloatValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead + + allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,'(A300)',END=620) line ! garbage line + do i = 1_pInt,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) & + 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 + enddo + nNodesAlreadyRead = chunkPos(1) - 2_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! 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) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + exit + endif + enddo + +620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" + read (fileUnit,'(A300)',END=620) 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,610,END=620) 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 + read (fileUnit,'(A300)',END=620) 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 + 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,mesh_NcpElems,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 + enddo + if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style + read (fileUnit,'(A300)',END=630) line + chunkPos = IO_stringPos(line) + enddo + endif + else + read (fileUnit,'(A300)',END=630) line + endif + enddo + +630 end subroutine mesh_marc_build_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief get any additional damask options from input file, sets mesh_periodicSurface +!-------------------------------------------------------------------------------------------------- +subroutine mesh_get_damaskOptions(fileUnit) + +use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) chunk, Nchunks + character(len=300) :: line, damaskOption, v + character(len=300) :: keyword + + mesh_periodicSurface = .false. + keyword = '$damask' + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + Nchunks = chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + select case(damaskOption) + case('periodic') ! damask Option that allows to specify periodic fluxes + do chunk = 3_pInt,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' + mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' + enddo + endselect + endif + enddo + + +620 end subroutine mesh_get_damaskOptions -end function mesh_FEasCP !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -847,649 +1444,7 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_fileFormat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - - - 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 - initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_tableStyles - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, j, data_blocks - character(len=300) line - - - rewind(fileUnit) - - data_blocks = 1_pInt - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - read (fileUnit,610,END=620) line - if (len(trim(line))/=0_pInt) then - chunkPos = IO_stringPos(line) - data_blocks = IO_intValue(line,chunkPos,1_pInt) - endif - allocate(Marc_matNumber(data_blocks)) - do i=1_pInt,data_blocks ! read all data blocks - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block - read (fileUnit,610,END=620) line - enddo - enddo - exit - endif - enddo - -620 end subroutine mesh_marc_get_matNumber - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_nodesAndElements(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_IntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file - endif - enddo - -620 end subroutine mesh_marc_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt - - - 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 - mesh_NelemSets = mesh_NelemSets + 1_pInt - mesh_maxNelemInSet = max(mesh_maxNelemInSet, & - IO_countContinuousIntValues(fileUnit)) - endif - enddo - -620 end subroutine mesh_marc_count_elementSets - - -!******************************************************************** -! map element sets -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!******************************************************************** -subroutine mesh_marc_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) - - - 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 - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mesh_mapElemSet(:,elemSet) = & - IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - endif - enddo - -640 end subroutine mesh_marc_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues, & - IO_error, & - IO_intValue, & - IO_countNumericalDataLines - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_NcpElems = 0_pInt - - - rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,'(A300)',END=620) line - enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update - exit - endif - enddo - else ! Marc2017 and later - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end subroutine mesh_marc_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line, & - tmp - - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - - - contInts = 0_pInt - 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+hypoelasticTableStyle ! skip three (or four if new table style!) lines - read (fileUnit,610,END=660) line - enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) - exit - endif - else ! Marc2017 and later - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,'(A300)',END=660) line - chunkPos = IO_stringPos(line) - if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - do - read (fileUnit,'(A300)',END=660) line - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),"0123456789")/=0) then ! found keyword - exit - else - contInts(1) = contInts(1) + 1_pInt - read (tmp,*) contInts(contInts(1)+1) - endif - enddo - endif - endif - endif - enddo -660 do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) - mesh_mapFEtoCPelem(2,cpElem) = cpElem - enddo - -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - -end subroutine mesh_marc_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt) :: i - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - - - node_count = 0_pInt - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=650) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,'(A300)',END=650) line ! skip crap line - do i = 1_pInt,mesh_Nnodes - read (fileUnit,'(A300)',END=650) line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) - mesh_mapFEtoCPnode(2_pInt,i) = i - enddo - exit - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - -end subroutine mesh_marc_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_nodes(fileUnit) - - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue, & - IO_fixedNoEFloatValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=670) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,'(A300)',END=670) line ! skip crap line - do i=1_pInt,mesh_Nnodes - read (fileUnit,'(A300)',END=670) 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) - enddo - enddo - exit - endif - enddo - -670 mesh_node = mesh_node0 - -end subroutine mesh_marc_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_intValue, & - IO_skipChunks - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,t,g,e,c - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=630) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,'(A300)',END=630) line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,'(A300)',END=630) line - chunkPos = IO_stringPos(line) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line - endif - enddo - exit - endif - enddo - -630 end subroutine mesh_marc_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per element. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_fixedNoEFloatValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,'(A300)',END=620) line ! garbage line - do i = 1_pInt,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) & - 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 - enddo - nNodesAlreadyRead = chunkPos(1) - 2_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! 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) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - exit - endif - enddo - -620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,'(A300)',END=620) 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,610,END=620) 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 - read (fileUnit,'(A300)',END=620) 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 - 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,mesh_NcpElems,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 - enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style - read (fileUnit,'(A300)',END=630) line - chunkPos = IO_stringPos(line) - enddo - endif - else - read (fileUnit,'(A300)',END=630) line - endif - enddo - -630 end subroutine mesh_marc_build_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief get any additional damask options from input file, sets mesh_periodicSurface -!-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) - -use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword - - mesh_periodicSurface = .false. - keyword = '$damask' - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(damaskOption) - case('periodic') ! damask Option that allows to specify periodic fluxes - do chunk = 3_pInt,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' - mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' - enddo - endselect - endif - enddo - - -620 end subroutine mesh_get_damaskOptions !-------------------------------------------------------------------------------------------------- @@ -1865,57 +1820,10 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - -end subroutine mesh_build_ipNeighborhood - - -!-------------------------------------------------------------------------------------------------- -!> @brief mapping of FE element types to internal representation -!-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) - use IO, only: IO_lc, IO_error - - implicit none - character(len=*), intent(in) :: what - - select case (IO_lc(what)) - case ( '6') - FE_mapElemtype = 1_pInt ! 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) - case ( '11') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral - case ( '54') - FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - case ( '134') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron - case ( '157') - FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations - case ( '127') - FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron - case ( '136') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( '117', & - '123') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral - case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) - end select - -end function FE_mapElemtype - - -!-------------------------------------------------------------------------------------------------- + + contains + + !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) @@ -2001,6 +1909,54 @@ enddo checkCandidate end subroutine mesh_faceMatch +end subroutine mesh_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( '6') + FE_mapElemtype = 1_pInt ! 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) + case ( '11') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( '27') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( '54') + FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration + case ( '134') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( '157') + FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations + case ( '127') + FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron + case ( '136') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( '117', & + '123') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( '7') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( '57') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( '21') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements @@ -2719,4 +2675,54 @@ subroutine mesh_build_FEdata 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) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),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) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP + end module mesh From 35c37ef9dcdff9b3bdfb6b25222b6f04def01135 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 17:37:25 +0100 Subject: [PATCH 053/154] forgotten format specifier --- src/mesh_marc.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index da62a3e73..bc6dbf133 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -1130,7 +1130,7 @@ subroutine mesh_marc_build_elements(fileUnit) 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,610,END=620) line ! read extra line for new style + if (initialcondTableStyle == 2_pInt) read (fileUnit,'(A300)',END=620) 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 @@ -1149,7 +1149,7 @@ subroutine mesh_marc_build_elements(fileUnit) e = mesh_FEasCP('elem',contInts(1_pInt+i)) mesh_element(1_pInt+sv,e) = myVal enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style + if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=620) line ! ignore IP range for old table style read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo From bb135463c43a81f271325dd1388c486482159b9c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 20:45:19 +0100 Subject: [PATCH 054/154] using data from theMesh instead of local variables --- src/mesh_marc.f90 | 46 +++++++++++++++++++++------------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index bc6dbf133..a5dede809 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -515,8 +515,8 @@ subroutine mesh_init(ip,el) call theMesh%init(mesh_element(2,1),mesh_node0) call theMesh%setNelems(mesh_NcpElems) - call mesh_build_FEdata ! get properties of the different types of elements + call mesh_build_FEdata ! get properties of the different types of elements call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -1126,7 +1126,7 @@ subroutine mesh_marc_build_elements(fileUnit) 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" read (fileUnit,'(A300)',END=620) line - do + do !ToDo: the jumps to 620 in below code might result in a never ending loop 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 @@ -1206,7 +1206,6 @@ use IO, only: & 620 end subroutine mesh_get_damaskOptions - !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. !> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). @@ -1221,31 +1220,28 @@ subroutine mesh_build_cellconnectivity matchingNode2cellnode integer(pInt), dimension(:,:), allocatable :: & cellnodeParent - integer(pInt), dimension(mesh_maxNcellnodes) :: & + integer(pInt), dimension(theMesh%elem%Ncellnodes) :: & localCellnode2globalCellnode integer(pInt) :: & - e,t,g,c,n,i, & + e,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,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) + + mesh_Ncells = theMesh%nElems*theMesh%elem%nIPs !-------------------------------------------------------------------------------------------------- ! 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 - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + + do e = 1_pInt,theMesh%nElems localCellnode2globalCellnode = 0_pInt - 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 - localCellnodeID = FE_cell(n,i,g) - if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node + do i = 1_pInt,theMesh%elem%nIPs + do n = 1_pInt,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 ... @@ -1269,6 +1265,7 @@ subroutine mesh_build_cellconnectivity allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + forall(n = 1_pInt:mesh_Ncellnodes) mesh_cellnodeParent(1,n) = cellnodeParent(1,n) mesh_cellnodeParent(2,n) = cellnodeParent(2,n) @@ -1290,23 +1287,22 @@ function mesh_build_cellnodes(nodes,Ncellnodes) real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes integer(pInt) :: & - e,t,n,m, & + e,n,m, & localCellnodeID real(pReal), dimension(3) :: & myCoords mesh_build_cellnodes = 0.0_pReal -!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,myCoords) do n = 1_pInt,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) + do m = 1_pInt,theMesh%elem%nNodes myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & - * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + * theMesh%elem%cellNodeParentNodeWeights(m,localCellnodeID) enddo - mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + mesh_build_cellnodes(1:3,n) = myCoords / sum(theMesh%elem%cellNodeParentNodeWeights(:,localCellnodeID)) enddo !$OMP END PARALLEL DO From 1eb30f3ae7506dc4a100a25ec036322e3ed1eb3b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 20:49:15 +0100 Subject: [PATCH 055/154] re-ordered according to calling sequence --- src/mesh_abaqus.f90 | 667 ++++++++++++++++++++++---------------------- 1 file changed, 339 insertions(+), 328 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 909ab1e0e..20fef4098 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -570,291 +570,10 @@ logical function hasNoPart(fileUnit) end subroutine mesh_init -!-------------------------------------------------------------------------------------------------- -!> @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) - use IO, only: & - IO_lc - - implicit none - character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID - - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center - - mesh_FEasCP = 0_pInt - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect - - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),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) - return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) - return - endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then - lower = center - elseif (lookupMap(1_pInt,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2_pInt,center) - exit - endif - enddo binarySearch - -end function mesh_FEasCP -!-------------------------------------------------------------------------------------------------- -!> @brief Split CP elements into cells. -!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). -!> Cell nodes that are also matching nodes are unique in the list of cell nodes, -!> all others (currently) might be stored more than once. -!> Also allocates the 'mesh_node' array. -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_cellconnectivity - - implicit none - integer(pInt), dimension(:), allocatable :: & - matchingNode2cellnode - integer(pInt), dimension(:,:), allocatable :: & - cellnodeParent - integer(pInt), dimension(mesh_maxNcellnodes) :: & - localCellnode2globalCellnode - integer(pInt) :: & - 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) - -!-------------------------------------------------------------------------------------------------- -! 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 - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - localCellnode2globalCellnode = 0_pInt - 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 - 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 ... - 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 - 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 ... - 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 - endif - mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) - endif - enddo - enddo - enddo - - allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) - allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) - forall(n = 1_pInt:mesh_Ncellnodes) - mesh_cellnodeParent(1,n) = cellnodeParent(1,n) - mesh_cellnodeParent(2,n) = cellnodeParent(2,n) - endforall - -end subroutine mesh_build_cellconnectivity -!-------------------------------------------------------------------------------------------------- -!> @brief Calculate position of cellnodes from the given position of nodes -!> Build list of cellnodes' coordinates. -!> Cellnode coordinates are calculated from a weighted sum of node coordinates. -!-------------------------------------------------------------------------------------------------- -function mesh_build_cellnodes(nodes,Ncellnodes) - - implicit none - integer(pInt), 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) :: & - e,t,n,m, & - localCellnodeID - real(pReal), dimension(3) :: & - myCoords - - mesh_build_cellnodes = 0.0_pReal -!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) - do n = 1_pInt,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)) & - * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) - enddo - mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) - enddo -!$OMP END PARALLEL DO - -end function mesh_build_cellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' -!> @details The IP volume is calculated differently depending on the cell type. -!> 2D cells assume an element depth of one in order to calculate the volume. -!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal -!> shape with a cell face as basis and the central ip at the tip. This subvolume is -!> calculated as an average of four tetrahedals with three corners on the cell face -!> and one corner at the central ip. -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipVolumes - use math, only: & - math_volTetrahedron, & - math_areaTriangle - - implicit none - integer(pInt) :: 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 - 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 - 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 - 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))) & - + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & - 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 - 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 - m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,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)) & - 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)), & - mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & - mesh_ipCoordinates(1:3,i,e)) - mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two - enddo - - end select - enddo - !$OMP END PARALLEL DO - -end subroutine mesh_build_ipVolumes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' -! Called by all solvers in mesh_init in order to initialize the ip coordinates. -! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, -! so no need to use this subroutine anymore; Marc however only provides nodal displacements, -! so in this case the ip coordinates are always calculated on the basis of this subroutine. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, -! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. -! HAS TO BE CHANGED IN A LATER VERSION. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipCoordinates - - implicit none - integer(pInt) :: 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 - 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 - myCoords = 0.0_pReal - do n = 1_pInt,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) - enddo - enddo - !$OMP END PARALLEL DO - -end subroutine mesh_build_ipCoordinates - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates cell center coordinates. -!-------------------------------------------------------------------------------------------------- -pure function mesh_cellCenterCoordinates(ip,el) - - implicit none - integer(pInt), 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 - - t = mesh_element(2_pInt,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 - mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) - enddo - mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) - - end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- @@ -1548,7 +1267,6 @@ subroutine mesh_abaqus_build_elements(fileUnit) end subroutine mesh_abaqus_build_elements - !-------------------------------------------------------------------------------------------------- !> @brief get any additional damask options from input file, sets mesh_periodicSurface !-------------------------------------------------------------------------------------------------- @@ -1594,6 +1312,246 @@ use IO, only: & end subroutine mesh_get_damaskOptions +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(mesh_maxNcellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + 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) + +!-------------------------------------------------------------------------------------------------- +! 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 + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + localCellnode2globalCellnode = 0_pInt + 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 + 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 ... + 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 + 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 ... + 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 + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), 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) :: & + e,t,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) + do n = 1_pInt,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)) & + * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: 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 + 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 + 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 + 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))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + 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 + 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 + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,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)) & + 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)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: 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 + 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 + myCoords = 0.0_pReal + do n = 1_pInt,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) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), 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 + + t = mesh_element(2_pInt,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 + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) + enddo + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) + + end function mesh_cellCenterCoordinates + + + + + !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' @@ -1968,52 +1926,9 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - -end subroutine mesh_build_ipNeighborhood - - -!-------------------------------------------------------------------------------------------------- -!> @brief mapping of FE element types to internal representation -!-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) - use IO, only: IO_lc, IO_error - - implicit none - character(len=*), intent(in) :: what - - select case (IO_lc(what)) - case ( 'cpe4', & - 'cpe4t') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( 'cpe8', & - 'cpe8t') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral - case ( 'c3d4', & - 'c3d4t') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron - case ( 'c3d6', & - 'c3d6t') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( 'c3d8r', & - 'c3d8rt') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( 'c3d8', & - 'c3d8t') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( 'c3d20r', & - 'c3d20rt') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( 'c3d20', & - 'c3d20t') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral - case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) - end select - -end function FE_mapElemtype - - -!-------------------------------------------------------------------------------------------------- + + contains + !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) @@ -2099,6 +2014,52 @@ enddo checkCandidate end subroutine mesh_faceMatch +end subroutine mesh_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( 'cpe4', & + 'cpe4t') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( 'cpe8', & + 'cpe8t') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( 'c3d4', & + 'c3d4t') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( 'c3d6', & + 'c3d6t') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( 'c3d8r', & + 'c3d8rt') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( 'c3d8', & + 'c3d8t') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( 'c3d20r', & + 'c3d20rt') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( 'c3d20', & + 'c3d20t') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + + + + !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements @@ -2817,4 +2778,54 @@ subroutine mesh_build_FEdata 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) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),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) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP + end module mesh From a92937a7e35af212e19fabd662cbacc42f65e3c0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:06:53 +0100 Subject: [PATCH 056/154] grid does reading in of geometry independently --- src/IO.f90 | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index bef14ea1e..29c27c567 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -44,18 +44,22 @@ module IO IO_lc, & IO_skipChunks, & IO_extractValue, & - IO_countDataLines, & - IO_countNumericalDataLines, & - IO_countContinuousIntValues, & - IO_continuousIntValues, & IO_error, & IO_warning, & IO_intOut, & IO_timeStamp #if defined(Marc4DAMASK) || defined(Abaqus) public :: & +#ifdef Abaqus + IO_countDataLines, & +#endif +#ifdef Marc4DAMASK + IO_countNumericalDataLines, & +#endif IO_open_inputFile, & - IO_open_logFile + IO_open_logFile, & + IO_countContinuousIntValues, & + IO_continuousIntValues #endif private :: & IO_fixedFloatValue, & @@ -889,6 +893,7 @@ character(len=300) pure function IO_extractValue(pair,key) end function IO_extractValue +#ifdef Abaqus !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- @@ -919,8 +924,10 @@ integer(pInt) function IO_countDataLines(fileUnit) backspace(fileUnit) end function IO_countDataLines +#endif +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- @@ -951,12 +958,14 @@ integer(pInt) function IO_countNumericalDataLines(fileUnit) backspace(fileUnit) end function IO_countNumericalDataLines +#endif + +#if defined(Abaqus) || defined(Marc4DAMASK) !-------------------------------------------------------------------------------------------------- !> @brief count items in consecutive lines depending on lines !> @details Marc: ints concatenated by "c" as last char or range of values a "to" b !> Abaqus: triplet of start,stop,inc -!> Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b !-------------------------------------------------------------------------------------------------- integer(pInt) function IO_countContinuousIntValues(fileUnit) @@ -972,7 +981,7 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) IO_countContinuousIntValues = 0_pInt line = '' -#ifndef Abaqus +#if defined(Marc4DAMASK) do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) @@ -983,11 +992,7 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & - IO_intValue(line,chunkPos,1_pInt)) line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! only one single range indicator allowed - else if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'of' ) then ! found multiple entries indicator - IO_countContinuousIntValues = IO_intValue(line,chunkPos,1_pInt) - line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! only one single multiplier allowed + exit ! only one single range indicator allowed else IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value @@ -997,14 +1002,14 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) endif endif enddo -#else +#elif defined(Abaqus) c = IO_countDataLines(fileUnit) do l = 1_pInt,c - backspace(fileUnit) ! ToDo: substitute by rewind? + backspace(fileUnit) enddo l = 1_pInt - do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct + do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct? l = l + 1_pInt line = IO_read(fileUnit) chunkPos = IO_stringPos(line) @@ -1022,7 +1027,6 @@ end function IO_countContinuousIntValues !! First integer in array is counter !> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set !! Abaqus: triplet of start,stop,inc or named set -!! Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b !-------------------------------------------------------------------------------------------------- function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) @@ -1046,7 +1050,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) IO_continuousIntValues = 0_pInt rangeGeneration = .false. -#ifndef Abaqus +#if defined(Marc4DAMASK) do read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) @@ -1068,10 +1072,6 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) IO_continuousIntValues(1+IO_continuousIntValues(1)) = i enddo exit - else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'of' ) then ! found multiple entries indicator - IO_continuousIntValues(1) = IO_intValue(line,chunkPos,1_pInt) - IO_continuousIntValues(2:IO_continuousIntValues(1)+1) = IO_intValue(line,chunkPos,3_pInt) - 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 @@ -1084,7 +1084,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) endif endif enddo -#else +#elif defined(Abaqus) c = IO_countDataLines(fileUnit) do l = 1_pInt,c backspace(fileUnit) @@ -1130,6 +1130,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) #endif 100 end function IO_continuousIntValues +#endif !-------------------------------------------------------------------------------------------------- From 40ad1aef2f12fbcad4932f3dcf205c1dd458d52f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:07:58 +0100 Subject: [PATCH 057/154] was not used --- src/IO.f90 | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 29c27c567..b4f9d1de9 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -62,7 +62,6 @@ module IO IO_continuousIntValues #endif private :: & - IO_fixedFloatValue, & IO_verifyFloatValue, & IO_verifyIntValue @@ -733,25 +732,6 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk) end function IO_floatValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads float value at myChunk from fixed format string -!-------------------------------------------------------------------------------------------------- -real(pReal) function IO_fixedFloatValue (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_fixedFloatValue: ' - character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' - - IO_fixedFloatValue = & - IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& - VALIDCHARACTERS,MYNAME) - -end function IO_fixedFloatValue - - !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string !-------------------------------------------------------------------------------------------------- From 2c7553653b6406c7d0d145ef12ba7d649a6203a4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:11:19 +0100 Subject: [PATCH 058/154] only used by MSC.Marc --- src/IO.f90 | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index b4f9d1de9..fa98ae4df 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -731,7 +731,7 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk) end function IO_floatValue - +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string !-------------------------------------------------------------------------------------------------- @@ -765,6 +765,25 @@ real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) end function IO_fixedNoEFloatValue +!-------------------------------------------------------------------------------------------------- +!> @brief reads integer value at myChunk from fixed format string +!-------------------------------------------------------------------------------------------------- +integer(pInt) 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+-' + + IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& + VALIDCHARACTERS,MYNAME) + +end function IO_fixedIntValue +#endif + + !-------------------------------------------------------------------------------------------------- !> @brief reads integer value at myChunk from string !-------------------------------------------------------------------------------------------------- @@ -789,24 +808,6 @@ integer(pInt) function IO_intValue(string,chunkPos,myChunk) end function IO_intValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads integer value at myChunk from fixed format string -!-------------------------------------------------------------------------------------------------- -integer(pInt) 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+-' - - IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& - VALIDCHARACTERS,MYNAME) - -end function IO_fixedIntValue - - !-------------------------------------------------------------------------------------------------- !> @brief changes characters in string to lower case !-------------------------------------------------------------------------------------------------- From f45ba0ff5b4dbe809967a9be6237d0c036793781 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:18:38 +0100 Subject: [PATCH 059/154] functions specific for MSC.Marc and/or Abaqus these functions are very specific for the input files and might be better located in the respective mesh module --- src/IO.f90 | 564 ++++++++++++++++++++++++++--------------------------- 1 file changed, 276 insertions(+), 288 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index fa98ae4df..b5868fa48 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -36,14 +36,9 @@ module IO IO_getTag, & IO_stringPos, & IO_stringValue, & - IO_fixedStringValue ,& IO_floatValue, & - IO_fixedNoEFloatValue, & IO_intValue, & - IO_fixedIntValue, & IO_lc, & - IO_skipChunks, & - IO_extractValue, & IO_error, & IO_warning, & IO_intOut, & @@ -51,9 +46,13 @@ module IO #if defined(Marc4DAMASK) || defined(Abaqus) public :: & #ifdef Abaqus + IO_extractValue, & IO_countDataLines, & #endif #ifdef Marc4DAMASK + IO_skipChunks, & + IO_fixedNoEFloatValue, & + IO_fixedIntValue, & IO_countNumericalDataLines, & #endif IO_open_inputFile, & @@ -93,7 +92,7 @@ end subroutine IO_init !> @details unstable and buggy !-------------------------------------------------------------------------------------------------- recursive function IO_read(fileUnit,reset) result(line) - +!ToDo: remove recursion once material.config handling is done fully via config module implicit none integer(pInt), intent(in) :: fileUnit !< file unit logical, intent(in), optional :: reset @@ -161,6 +160,7 @@ recursive function IO_read(fileUnit,reset) result(line) end function IO_read + !-------------------------------------------------------------------------------------------------- !> @brief recursively reads a text file. !! Recursion is triggered by "{path/to/inputfile}" in a line @@ -284,7 +284,7 @@ end subroutine IO_open_file !> @details Like IO_open_file, but error is handled via return value and not via call to IO_error !-------------------------------------------------------------------------------------------------- logical function IO_open_file_stat(fileUnit,path) - +!ToDo: DEPRECATED once material.config handling is done fully via config module implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: path !< relative path from working directory @@ -691,22 +691,6 @@ function IO_stringValue(string,chunkPos,myChunk,silent) end function IO_stringValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads string value at myChunk from fixed format string -!-------------------------------------------------------------------------------------------------- -pure function IO_fixedStringValue (string,ends,myChunk) - - implicit none - 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=ends(myChunk+1)-ends(myChunk)) :: IO_fixedStringValue - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - - IO_fixedStringValue = string(ends(myChunk)+1:ends(myChunk+1)) - -end function IO_fixedStringValue - - !-------------------------------------------------------------------------------------------------- !> @brief reads float value at myChunk from string !-------------------------------------------------------------------------------------------------- @@ -731,6 +715,31 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk) end function IO_floatValue + +!-------------------------------------------------------------------------------------------------- +!> @brief reads integer value at myChunk from string +!-------------------------------------------------------------------------------------------------- +integer(pInt) 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+-' + + IO_intValue = 0_pInt + + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) 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)))),& + VALIDCHARACTERS,MYNAME) + endif valuePresent + +end function IO_intValue + + #ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string @@ -784,30 +793,6 @@ end function IO_fixedIntValue #endif -!-------------------------------------------------------------------------------------------------- -!> @brief reads integer value at myChunk from string -!-------------------------------------------------------------------------------------------------- -integer(pInt) 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+-' - - IO_intValue = 0_pInt - - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) 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)))),& - VALIDCHARACTERS,MYNAME) - endif valuePresent - -end function IO_intValue - - !-------------------------------------------------------------------------------------------------- !> @brief changes characters in string to lower case !-------------------------------------------------------------------------------------------------- @@ -831,6 +816,7 @@ pure function IO_lc(string) end function IO_lc +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads file to skip (at least) N chunks (may be over multiple lines) !-------------------------------------------------------------------------------------------------- @@ -851,8 +837,10 @@ subroutine IO_skipChunks(fileUnit,N) remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt enddo end subroutine IO_skipChunks +#endif +#ifdef Abaqus !-------------------------------------------------------------------------------------------------- !> @brief extracts string value from key=value pair and check whether key matches !-------------------------------------------------------------------------------------------------- @@ -872,247 +860,7 @@ character(len=300) pure function IO_extractValue(pair,key) if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches end function IO_extractValue - - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief count lines containig data up to next *keyword -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countDataLines(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp - - IO_countDataLines = 0_pInt - line = '' - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - else - if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt - endif - enddo - backspace(fileUnit) - -end function IO_countDataLines -#endif - - -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @brief count lines containig data up to next *keyword -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countNumericalDataLines(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp - - IO_countNumericalDataLines = 0_pInt - line = '' - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),'0123456789') == 0) then ! numerical values - IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt - else - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - enddo - backspace(fileUnit) - -end function IO_countNumericalDataLines -#endif - - -#if defined(Abaqus) || defined(Marc4DAMASK) -!-------------------------------------------------------------------------------------------------- -!> @brief count items in consecutive lines depending on lines -!> @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) - - implicit none - integer(pInt), intent(in) :: fileUnit - -#ifdef Abaqus - integer(pInt) :: l,c -#endif - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line - - IO_countContinuousIntValues = 0_pInt - 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 - line = IO_read(fileUnit, .true.) ! reset IO_read - 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)) - line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! only one single range indicator allowed - else - IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! 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 - line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! data ended - endif - endif - enddo -#elif defined(Abaqus) - c = IO_countDataLines(fileUnit) - do l = 1_pInt,c - backspace(fileUnit) - enddo - - l = 1_pInt - do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct? - l = l + 1_pInt - 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)) - enddo -#endif - -end function IO_countContinuousIntValues - - -!-------------------------------------------------------------------------------------------------- -!> @brief return integer list corresponding to items in consecutive lines. -!! First integer in array is counter -!> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set -!! Abaqus: triplet of start,stop,inc or named set -!-------------------------------------------------------------------------------------------------- -function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) - - implicit none - integer(pInt), intent(in) :: maxN - integer(pInt), dimension(1+maxN) :: IO_continuousIntValues - - integer(pInt), intent(in) :: fileUnit, & - lookupMaxN - integer(pInt), dimension(:,:), intent(in) :: lookupMap - character(len=64), dimension(:), intent(in) :: lookupName - integer(pInt) :: i,first,last -#ifdef Abaqus - integer(pInt) :: j,l,c -#endif - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) line - logical rangeGeneration - - IO_continuousIntValues = 0_pInt - rangeGeneration = .false. - -#if defined(Marc4DAMASK) - do - read(fileUnit,'(A65536)',end=100) line - chunkPos = IO_stringPos(line) - if (chunkPos(1) < 1_pInt) 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 - 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 - 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 - 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)) = IO_intValue(line,chunkPos,chunkPos(1)) - exit - endif - endif - enddo -#elif defined(Abaqus) - c = IO_countDataLines(fileUnit) - do l = 1_pInt,c - backspace(fileUnit) - enddo - -!-------------------------------------------------------------------------------------------------- -! check if the element values in the elset are auto generated - backspace(fileUnit) - read(fileUnit,'(A65536)',end=100) line - chunkPos = IO_stringPos(line) - do i = 1_pInt,chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. - enddo - - do l = 1_pInt,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 (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 - 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 - 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 - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) - enddo - endif - enddo -#endif - -100 end function IO_continuousIntValues -#endif - +# endif !-------------------------------------------------------------------------------------------------- !> @brief returns format string for integer values without leading zeros @@ -1503,6 +1251,246 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) end subroutine IO_warning +#ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @brief count lines containig data up to next *keyword +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_countDataLines(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit !< file handle + + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp + + IO_countDataLines = 0_pInt + line = '' + + do while (trim(line) /= IO_EOF) + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + else + if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt + endif + enddo + backspace(fileUnit) + +end function IO_countDataLines +#endif + + +#ifdef Marc4DAMASK +!-------------------------------------------------------------------------------------------------- +!> @brief count lines containig data up to next *keyword +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_countNumericalDataLines(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit !< file handle + + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp + + IO_countNumericalDataLines = 0_pInt + line = '' + + do while (trim(line) /= IO_EOF) + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),'0123456789') == 0) then ! numerical values + IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt + else + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + enddo + backspace(fileUnit) + +end function IO_countNumericalDataLines +#endif + + +#if defined(Abaqus) || defined(Marc4DAMASK) +!-------------------------------------------------------------------------------------------------- +!> @brief count items in consecutive lines depending on lines +!> @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) + + implicit none + integer(pInt), intent(in) :: fileUnit + +#ifdef Abaqus + integer(pInt) :: l,c +#endif + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line + + IO_countContinuousIntValues = 0_pInt + 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 + line = IO_read(fileUnit, .true.) ! reset IO_read + 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)) + line = IO_read(fileUnit, .true.) ! reset IO_read + exit ! only one single range indicator allowed + else + IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! 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 + line = IO_read(fileUnit, .true.) ! reset IO_read + exit ! data ended + endif + endif + enddo +#elif defined(Abaqus) + c = IO_countDataLines(fileUnit) + do l = 1_pInt,c + backspace(fileUnit) + enddo + + l = 1_pInt + do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct? + l = l + 1_pInt + 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)) + enddo +#endif + +end function IO_countContinuousIntValues + + +!-------------------------------------------------------------------------------------------------- +!> @brief return integer list corresponding to items in consecutive lines. +!! First integer in array is counter +!> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set +!! Abaqus: triplet of start,stop,inc or named set +!-------------------------------------------------------------------------------------------------- +function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) + + implicit none + integer(pInt), intent(in) :: maxN + integer(pInt), dimension(1+maxN) :: IO_continuousIntValues + + integer(pInt), intent(in) :: fileUnit, & + lookupMaxN + integer(pInt), dimension(:,:), intent(in) :: lookupMap + character(len=64), dimension(:), intent(in) :: lookupName + integer(pInt) :: i,first,last +#ifdef Abaqus + integer(pInt) :: j,l,c +#endif + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) line + logical rangeGeneration + + IO_continuousIntValues = 0_pInt + rangeGeneration = .false. + +#if defined(Marc4DAMASK) + do + read(fileUnit,'(A65536)',end=100) line + chunkPos = IO_stringPos(line) + if (chunkPos(1) < 1_pInt) 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 + 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 + 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 + 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)) = IO_intValue(line,chunkPos,chunkPos(1)) + exit + endif + endif + enddo +#elif defined(Abaqus) + c = IO_countDataLines(fileUnit) + do l = 1_pInt,c + backspace(fileUnit) + enddo + +!-------------------------------------------------------------------------------------------------- +! check if the element values in the elset are auto generated + backspace(fileUnit) + read(fileUnit,'(A65536)',end=100) line + chunkPos = IO_stringPos(line) + do i = 1_pInt,chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. + enddo + + do l = 1_pInt,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 (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 + 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 + 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 + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) + enddo + endif + enddo +#endif + +100 end function IO_continuousIntValues +#endif + + !-------------------------------------------------------------------------------------------------- ! internal helper functions From d605adc92e222ec33c5ab02a11e4a386e3eb8943 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 11:12:23 +0100 Subject: [PATCH 060/154] avoid the use of global variables to make dependencies clear --- src/mesh_marc.f90 | 240 ++++++++++++++++++++++------------------------ 1 file changed, 117 insertions(+), 123 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index a5dede809..0421a9452 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -392,27 +392,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & type, public, extends(tMesh) :: tMesh_marc - integer(pInt), public :: & - nElemsAll, & - maxNelemInSet, & - NelemSets,& - MarcVersion, & !< Version of input file format ToDo: Better Name? - hypoelasticTableStyle, & !< Table style - initialcondTableStyle - character(len=64), dimension(:), allocatable :: & - nameElemSet,& !< names of elementSet - mesh_nameElemSet, & !< names of elementSet - mapMaterial !< name of elementSet for material - integer(pInt), dimension(:), allocatable :: & - Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) - integer(pInt) :: & - mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) - mesh_maxNnodes, & !< max number of nodes in any CP element - mesh_NelemSets, & - mesh_maxNelemInSet - integer(pInt), dimension(:,:), allocatable :: & - mesh_mapElemSet !< list of elements in elementSet - contains procedure, pass(self) :: tMesh_marc_init generic, public :: init => tMesh_marc_init @@ -467,9 +446,10 @@ 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(pInt), intent(in) :: el, ip + + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt) :: j, fileFormatVersion, elemType logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -483,38 +463,57 @@ subroutine mesh_init(ip,el) call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - call mesh_marc_get_fileFormat(FILEUNIT) + + MarcVersion = mesh_marc_get_fileFormat(FILEUNIT) + fileFormatVersion = MarcVersion if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) - call mesh_marc_get_tableStyles(FILEUNIT) + + call mesh_marc_get_tableStyles(initialcondTableStyle,hypoelasticTableStyle,FILEUNIT) if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) - if (MarcVersion > 12) then - call mesh_marc_get_matNumber(FILEUNIT) + + if (fileFormatVersion > 12) then + Marc_matNumber = mesh_marc_get_matNumber(FILEUNIT,hypoelasticTableStyle) if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) endif - call mesh_marc_count_nodesAndElements(FILEUNIT) + + call mesh_marc_count_nodesAndElements(mesh_nNodes, mesh_nElems, FILEUNIT) if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_marc_count_elementSets(FILEUNIT) + + call mesh_marc_count_elementSets(mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_marc_map_elementSets(FILEUNIT) + + allocate(mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = 'n/a' + allocate(mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,& + mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_marc_count_cpElements(FILEUNIT) + + mesh_NcpElems = mesh_marc_count_cpElements(hypoelasticTableStyle,Marc_matNumber,fileFormatVersion,FILEUNIT) if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_marc_map_elements(FILEUNIT) + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + call mesh_marc_map_elements(FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_marc_map_nodes(FILEUNIT) + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + call mesh_marc_map_nodes(FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) + + call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_marc_count_cpSizes(FILEUNIT) + + elemType = mesh_marc_count_cpSizes(FILEUNIT) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + + call theMesh%init(elemType,mesh_node0) + call theMesh%setNelems(mesh_NcpElems) + call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) - call theMesh%init(mesh_element(2,1),mesh_node0) - call theMesh%setNelems(mesh_NcpElems) call mesh_build_FEdata ! get properties of the different types of elements call mesh_build_cellconnectivity @@ -561,9 +560,9 @@ end subroutine mesh_init !-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion +!> @brief Figures out version of Marc input file format !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) +integer(pInt) function mesh_marc_get_fileFormat(fileUnit) use IO, only: & IO_lc, & IO_intValue, & @@ -583,19 +582,18 @@ subroutine mesh_marc_get_fileFormat(fileUnit) chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) + mesh_marc_get_fileFormat = IO_intValue(line,chunkPos,2_pInt) exit endif enddo -620 end subroutine mesh_marc_get_fileFormat +620 end function mesh_marc_get_fileFormat !-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' +!> @brief Figures out table styles for initial cond and hypoelastic !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) +subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) use IO, only: & IO_lc, & IO_intValue, & @@ -603,14 +601,14 @@ subroutine mesh_marc_get_tableStyles(fileUnit) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: initialcond, hypoelastic + integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - + initialcond = 0_pInt + hypoelastic = 0_pInt rewind(fileUnit) do @@ -618,18 +616,19 @@ subroutine mesh_marc_get_tableStyles(fileUnit) chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) + initialcond = IO_intValue(line,chunkPos,4_pInt) + hypoelastic = IO_intValue(line,chunkPos,5_pInt) exit endif enddo 620 end subroutine mesh_marc_get_tableStyles + !-------------------------------------------------------------------------------------------------- !> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) +function mesh_marc_get_matNumber(fileUnit,tableStyle) use IO, only: & IO_lc, & IO_intValue, & @@ -637,7 +636,8 @@ subroutine mesh_marc_get_matNumber(fileUnit) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit, tableStyle + integer(pInt), dimension(:), allocatable :: mesh_marc_get_matNumber integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: i, j, data_blocks @@ -657,12 +657,12 @@ subroutine mesh_marc_get_matNumber(fileUnit) chunkPos = IO_stringPos(line) data_blocks = IO_intValue(line,chunkPos,1_pInt) endif - allocate(Marc_matNumber(data_blocks)) - do i=1_pInt,data_blocks ! read all data blocks + allocate(mesh_marc_get_matNumber(data_blocks), source = 0_pInt) + do i=1_pInt,data_blocks ! read all data blocks read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block + 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 read (fileUnit,'(A300)') line enddo enddo @@ -670,14 +670,14 @@ subroutine mesh_marc_get_matNumber(fileUnit) endif enddo -620 end subroutine mesh_marc_get_matNumber +620 end function mesh_marc_get_matNumber !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of nodes and elements in mesh and stores the numbers in !! 'mesh_Nelems' and 'mesh_Nnodes' !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_nodesAndElements(fileUnit) +subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) use IO, only: & IO_lc, & IO_stringValue, & @@ -685,14 +685,14 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) IO_IntValue implicit none - integer(pInt), intent(in) :: fileUnit - + integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: nNodes, nElems + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - + nNodes = 0_pInt + nElems = 0_pInt rewind(fileUnit) do @@ -700,12 +700,12 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) chunkPos = IO_stringPos(line) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + nElems = IO_IntValue (line,chunkPos,3_pInt) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file + nNodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file endif enddo @@ -713,10 +713,9 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) !-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' +!> @brief Count overall number of element sets in mesh. !-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) + subroutine mesh_marc_count_elementSets(nElemSets,maxNelemInSet,fileUnit) use IO, only: & IO_lc, & IO_stringValue, & @@ -725,13 +724,13 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: nElemSets, maxNelemInSet integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt + character(len=300) :: line + nElemSets = 0_pInt + maxNelemInSet = 0_pInt rewind(fileUnit) do @@ -740,21 +739,19 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then - mesh_NelemSets = mesh_NelemSets + 1_pInt - mesh_maxNelemInSet = max(mesh_maxNelemInSet, & - IO_countContinuousIntValues(fileUnit)) + nElemSets = nElemSets + 1_pInt + maxNelemInSet = max(maxNelemInSet, IO_countContinuousIntValues(fileUnit)) endif enddo 620 end subroutine mesh_marc_count_elementSets -!******************************************************************** -! map element sets -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!******************************************************************** -subroutine mesh_marc_map_elementSets(fileUnit) +!-------------------------------------------------------------------------------------------------- +!> @brief map element sets +!! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemInSet,fileUnit) use IO, only: IO_lc, & IO_stringValue, & @@ -762,15 +759,17 @@ subroutine mesh_marc_map_elementSets(fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit,NelemSets,maxNelemInSet + character(len=64), dimension(mesh_NelemSets), intent(out) :: & + nameElemSet + integer(pInt), dimension(1_pInt+maxNelemInSet,NelemSets), intent(out) :: & + mapElemSet integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) - + integer(pInt) :: elemSet + + elemSet = 0_pInt rewind(fileUnit) do @@ -779,9 +778,8 @@ subroutine mesh_marc_map_elementSets(fileUnit) 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 - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mesh_mapElemSet(:,elemSet) = & - IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,maxNelemInSet,nameElemSet,mapElemSet,NelemSets) endif enddo @@ -791,7 +789,7 @@ subroutine mesh_marc_map_elementSets(fileUnit) !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) +integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileFormatVersion,fileUnit) use IO, only: IO_lc, & IO_stringValue, & @@ -802,48 +800,48 @@ subroutine mesh_marc_count_cpElements(fileUnit) IO_countNumericalDataLines implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit, tableStyle,fileFormatVersion + integer(pInt), dimension(:), intent(in) :: matNumber integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: i character(len=300):: line - mesh_NcpElems = 0_pInt + mesh_marc_count_cpElements = 0_pInt rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier + if (fileFormatVersion < 13) then ! Marc 2016 or earlier do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + do i=1_pInt,3_pInt+tableStyle ! Skip 3 or 4 lines read (fileUnit,'(A300)') line enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update + mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countContinuousIntValues(fileUnit) exit endif enddo - else ! Marc2017 and later + else ! Marc2017 and later do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + if (any(matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countNumericalDataLines(fileUnit) endif endif enddo end if -620 end subroutine mesh_marc_count_cpElements +620 end function mesh_marc_count_cpElements !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_map_elements(fileUnit) @@ -864,24 +862,21 @@ subroutine mesh_marc_map_elements(fileUnit) integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts integer(pInt) :: i,cpElem = 0_pInt - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - - contInts = 0_pInt rewind(fileUnit) do read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) - if (MarcVersion < 13) then ! Marc 2016 or earlier + 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+hypoelasticTableStyle ! skip three (or four if new table style!) lines + do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines read (fileUnit,'(A300)') line enddo contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& mesh_mapElemSet,mesh_NelemSets) exit endif - else ! Marc2017 and later + else ! Marc2017 and later if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) @@ -890,7 +885,7 @@ subroutine mesh_marc_map_elements(fileUnit) read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword exit else contInts(1) = contInts(1) + 1_pInt @@ -907,14 +902,13 @@ subroutine mesh_marc_map_elements(fileUnit) mesh_mapFEtoCPelem(2,cpElem) = cpElem enddo -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems end subroutine mesh_marc_map_elements !-------------------------------------------------------------------------------------------------- !> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_map_nodes(fileUnit) @@ -933,9 +927,6 @@ subroutine mesh_marc_map_nodes(fileUnit) integer(pInt), dimension (mesh_Nnodes) :: node_count integer(pInt) :: i - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - - node_count = 0_pInt rewind(fileUnit) @@ -943,10 +934,10 @@ subroutine mesh_marc_map_nodes(fileUnit) read (fileUnit,'(A300)',END=650) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,'(A300)') line ! skip crap line + read (fileUnit,'(A300)') line ! skip crap line do i = 1_pInt,mesh_Nnodes read (fileUnit,'(A300)') line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) + mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[0_pInt,10_pInt],1_pInt) mesh_mapFEtoCPnode(2_pInt,i) = i enddo exit @@ -988,7 +979,7 @@ subroutine mesh_marc_build_nodes(fileUnit) read (fileUnit,'(A300)',END=670) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,'(A300)') line ! skip crap line + read (fileUnit,'(A300)') line ! skip crap line do i=1_pInt,mesh_Nnodes read (fileUnit,'(A300)') line m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) @@ -1010,9 +1001,10 @@ end subroutine mesh_marc_build_nodes !! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', !! and 'mesh_maxNcellnodes' !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) +integer(pInt) function mesh_marc_count_cpSizes(fileUnit) use IO, only: IO_lc, & + IO_error, & IO_stringValue, & IO_stringPos, & IO_intValue, & @@ -1029,20 +1021,22 @@ subroutine mesh_marc_count_cpSizes(fileUnit) mesh_maxNips = 0_pInt mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt - + t = -1_pInt rewind(fileUnit) do read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,'(A300)') line ! Garbage line + read (fileUnit,'(A300)') line ! Garbage line do i=1_pInt,mesh_Nelems ! read all elements read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) ! limit to id and type e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + if (t == -1_pInt) t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message + mesh_marc_count_cpSizes = t g = FE_geomtype(t) c = FE_celltype(g) mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) @@ -1056,7 +1050,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) endif enddo -630 end subroutine mesh_marc_count_cpSizes +630 end function mesh_marc_count_cpSizes !-------------------------------------------------------------------------------------------------- From b9f93d5460d74c564f42f39d54f11cd1091a41cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 11:22:23 +0100 Subject: [PATCH 061/154] is now a subfunction --- src/mesh_abaqus.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 20fef4098..05a4a71af 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -367,7 +367,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & FE_mapElemtype, & - mesh_faceMatch, & mesh_build_FEdata, & mesh_build_nodeTwins, & mesh_build_sharedElems, & From 91992debf292233c1a36080ca76e8aba7b216ee1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 13:30:04 +0100 Subject: [PATCH 062/154] Marc now works also with the module reason, why it did NOT work earlier still not clear --- src/numerics.f90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/numerics.f90 b/src/numerics.f90 index 9e585dda7..1678d0c48 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -177,13 +177,8 @@ subroutine numerics_init #include use petscsys #endif -#if !defined(Marc4DAMASK) -!$ use OMP_LIB, only: omp_set_num_threads ! Standard conforming module +!$ use OMP_LIB, only: omp_set_num_threads implicit none -#else - implicit none -!$ include "omp_lib.h" ! MSC.Marc includes this file on !its own, avoid conflict with the OMP_LIB module -#endif integer(pInt), parameter :: FILEUNIT = 300_pInt !$ integer :: gotDAMASK_NUM_THREADS = 1 integer :: i, ierr ! no pInt From 2aba6faf4086a4c9b9c7558149ef8d135ed25d3a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 12:28:04 +0100 Subject: [PATCH 063/154] cleaning and making dependencies clear --- src/mesh_abaqus.f90 | 21 ++++++++++----------- src/mesh_marc.f90 | 21 ++++++++++----------- 2 files changed, 20 insertions(+), 22 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 05a4a71af..89f0eed06 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -490,7 +490,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_abaqus_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(FILEUNIT) + call mesh_get_damaskOptions(mesh_periodic_surface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) @@ -1269,7 +1269,7 @@ end subroutine mesh_abaqus_build_elements !-------------------------------------------------------------------------------------------------- !> @brief get any additional damask options from input file, sets mesh_periodicSurface !-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) +subroutine mesh_get_damaskOptions(periodic_surface,fileUnit) use IO, only: & IO_lc, & @@ -1282,24 +1282,23 @@ use IO, only: & integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - logical :: inPart - integer(pInt) chunk, Nchunks - character(len=300) :: damaskOption, v - character(len=*), parameter :: keyword = '**damask' + integer(pInt) :: chunk, Nchunks + character(len=300) :: v + logical, dimension(3) :: periodic_surface + - mesh_periodicSurface = .false. + periodic_surface = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(damaskOption) + 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))) case('periodic') ! damask Option that allows to specify periodic fluxes do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) - v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? + 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' mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 0421a9452..506f6a107 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -484,8 +484,7 @@ subroutine mesh_init(ip,el) allocate(mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = 'n/a' allocate(mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) - call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,& - mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) + call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) mesh_NcpElems = mesh_marc_count_cpElements(hypoelasticTableStyle,Marc_matNumber,fileFormatVersion,FILEUNIT) @@ -500,6 +499,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables + mesh_node = mesh_node0 if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) elemType = mesh_marc_count_cpSizes(FILEUNIT) @@ -626,7 +626,7 @@ subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) !-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!> @brief Figures out material number of hypoelastic material !-------------------------------------------------------------------------------------------------- function mesh_marc_get_matNumber(fileUnit,tableStyle) use IO, only: & @@ -751,7 +751,7 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) !> @brief map element sets !! allocate globals: mesh_nameElemSet, mesh_mapElemSet !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemInSet,fileUnit) +subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) use IO, only: IO_lc, & IO_stringValue, & @@ -759,10 +759,10 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemIn IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,NelemSets,maxNelemInSet - character(len=64), dimension(mesh_NelemSets), intent(out) :: & + integer(pInt), intent(in) :: fileUnit,NelemSets + character(len=64), dimension(:), intent(out) :: & nameElemSet - integer(pInt), dimension(1_pInt+maxNelemInSet,NelemSets), intent(out) :: & + integer(pInt), dimension(:,:), intent(out) :: & mapElemSet integer(pInt), allocatable, dimension(:) :: chunkPos @@ -779,7 +779,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemIn (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then elemSet = elemSet+1_pInt nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,maxNelemInSet,nameElemSet,mapElemSet,NelemSets) + mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,size(mapElemSet,1)-1,nameElemSet,mapElemSet,size(nameElemSet)) endif enddo @@ -860,8 +860,9 @@ subroutine mesh_marc_map_elements(fileUnit) tmp integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt + integer(pInt) :: i,cpElem + cpElem = 0_pInt contInts = 0_pInt rewind(fileUnit) do @@ -971,8 +972,6 @@ subroutine mesh_marc_build_nodes(fileUnit) integer(pInt) :: i,j,m allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - rewind(fileUnit) do From 2d0c74d7d9257d80ba4c4976bbfbecd312dbe4fd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 12:54:10 +0100 Subject: [PATCH 064/154] implicit dependencies made explicit --- src/mesh_marc.f90 | 58 +++++++++++++++++++++++------------------------ 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 506f6a107..4e4adbc36 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -61,7 +61,6 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) integer(pInt), private :: & - mesh_maxNelemInSet, & mesh_Nmaterials integer(pInt), dimension(:,:), allocatable, private :: & @@ -342,9 +341,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets character(len=64), dimension(:), allocatable, private :: & - mesh_nameElemSet, & !< names of elementSet - mesh_nameMaterial, & !< names of material in solid section - mesh_mapMaterial !< name of elementSet for material + mesh_nameElemSet + integer(pInt), dimension(:,:), allocatable, private :: & mesh_mapElemSet !< list of elements in elementSet integer(pInt), dimension(:,:), allocatable, target, private :: & @@ -450,6 +448,8 @@ subroutine mesh_init(ip,el) integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt) :: j, fileFormatVersion, elemType + integer(pInt) :: & + mesh_maxNelemInSet logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -491,7 +491,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - call mesh_marc_map_elements(FILEUNIT) !ToDo: don't work on global variables + call mesh_marc_map_elements(hypoelasticTableStyle,mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) @@ -510,7 +510,7 @@ subroutine mesh_init(ip,el) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(FILEUNIT) + call mesh_get_damaskOptions(mesh_periodicSurface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) @@ -674,8 +674,7 @@ function mesh_marc_get_matNumber(fileUnit,tableStyle) !-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' +!> @brief Count overall number of nodes and elements !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) use IO, only: & @@ -749,7 +748,6 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) !-------------------------------------------------------------------------------------------------- !> @brief map element sets -!! allocate globals: mesh_nameElemSet, mesh_mapElemSet !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) @@ -843,7 +841,7 @@ integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileForma !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) +subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) use math, only: math_qsort use IO, only: IO_lc, & @@ -853,7 +851,10 @@ subroutine mesh_marc_map_elements(fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit,tableStyle + character(len=64), intent(in), dimension(:) :: nameElemSet + integer(pInt), dimension(:,:), intent(in) :: & + mapElemSet integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line, & @@ -870,11 +871,11 @@ subroutine mesh_marc_map_elements(fileUnit) 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+hypoelasticTableStyle ! skip three (or four if new table style!) lines + do i=1_pInt,3_pInt+TableStyle ! skip three (or four if new table style!) lines read (fileUnit,'(A300)') line enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,nameElemSet,& + mapElemSet,size(nameElemSet)) exit endif else ! Marc2017 and later @@ -1158,7 +1159,7 @@ subroutine mesh_marc_build_elements(fileUnit) !-------------------------------------------------------------------------------------------------- !> @brief get any additional damask options from input file, sets mesh_periodicSurface !-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) +subroutine mesh_get_damaskOptions(periodic_surface,fileUnit) use IO, only: & IO_lc, & @@ -1168,23 +1169,23 @@ use IO, only: & implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword - - mesh_periodicSurface = .false. - keyword = '$damask' + character(len=300) :: line + integer :: myStat + integer(pInt) :: chunk, Nchunks + character(len=300) :: v + logical, dimension(3) :: periodic_surface + + periodic_surface = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(damaskOption) + 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))) case('periodic') ! damask Option that allows to specify periodic fluxes do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? @@ -1196,8 +1197,7 @@ use IO, only: & endif enddo - -620 end subroutine mesh_get_damaskOptions +end subroutine mesh_get_damaskOptions !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. From ec23fca05779f07b7e286baa74c873d66d79d270 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 14:21:42 +0100 Subject: [PATCH 065/154] it's a property of the element, not of the mesh --- src/plastic_nonlocal.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index e8562e55e..ef1dac3d9 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -234,8 +234,7 @@ use IO, only: IO_read, & use debug, only: debug_level, & debug_constitutive, & debug_levelBasic -use mesh, only: theMesh, & - mesh_maxNipNeighbors +use mesh, only: theMesh use material, only: phase_plasticity, & homogenization_maxNgrains, & phase_plasticityInstance, & @@ -829,7 +828,7 @@ allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrai allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), & +allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) From b0b1ea3b842dc7736ea2f9aa54699f61fd049d98 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 14:23:32 +0100 Subject: [PATCH 066/154] input argument not needed any more --- src/mesh_marc.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 4e4adbc36..8c53c5a2d 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -757,7 +757,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,NelemSets + integer(pInt), intent(in) :: fileUnit character(len=64), dimension(:), intent(out) :: & nameElemSet integer(pInt), dimension(:,:), intent(out) :: & From 59dd9b16e1915841417ad00378ffc7086a4feb43 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 16:40:15 +0100 Subject: [PATCH 067/154] cleaning --- src/DAMASK_marc.f90 | 6 +- src/mesh_marc.f90 | 967 ++++---------------------------------------- 2 files changed, 85 insertions(+), 888 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0c7d1adeb..d33cdd4cc 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -134,6 +134,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & debug_info, & debug_reset use mesh, only: & + theMesh, & mesh_FEasCP, & mesh_element, & mesh_node0, & @@ -141,8 +142,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & mesh_Ncellnodes, & mesh_cellnode, & mesh_build_cellnodes, & - mesh_build_ipCoordinates, & - FE_Nnodes + mesh_build_ipCoordinates use CPFEM, only: & CPFEM_general, & CPFEM_init_done, & @@ -314,7 +314,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence lastIncConverged = .false. ! reset flag endif - do node = 1,FE_Nnodes(mesh_element(2,cp_en)) + do node = 1,theMesh%elem%nNodes CPnodeID = mesh_element(4_pInt+node,cp_en) mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node) enddo diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 8c53c5a2d..a269b60e4 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -13,18 +13,11 @@ module mesh implicit none private integer(pInt), 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 mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in 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 :: & - 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 :: & mesh_homogenizationAt, & !< homogenization ID of each element @@ -70,16 +63,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell integer(pInt), 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 FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell - real(pReal), dimension(:,:,:), allocatable, private :: & - FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes - - integer(pInt), 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_" @@ -88,8 +73,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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, & @@ -99,69 +82,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & FE_maxNcellfaces = 6_pInt, & FE_maxNcellnodesPerCellface = 4_pInt - integer(pInt), 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) - 3, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 3, & ! element 54 (2D 8node 4ip) - 5, & ! element 134 (3D 4node 1ip) - 6, & ! element 157 (3D 5node 4ip) - 6, & ! element 127 (3D 10node 4ip) - 7, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 9, & ! element 7 (3D 8node 8ip) - 9, & ! element 57 (3D 20node 8ip) - 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 - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 4, & ! element 136 (3D 6node 6ip) - 4, & ! element 117 (3D 8node 1ip) - 4, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type - int([ & - 2, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 3, & ! element 127 (3D 10node 4ip) - 3, & ! element 136 (3D 6node 6ip) - 3, & ! element 117 (3D 8node 1ip) - 3, & ! element 7 (3D 8node 8ip) - 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 - int([ & - 3, & ! element 6 (2D 3node 1ip) - 6, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 8, & ! element 27 (2D 8node 9ip) - 8, & ! element 54 (2D 8node 4ip) - 4, & ! element 134 (3D 4node 1ip) - 5, & ! element 157 (3D 5node 4ip) - 10, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 20, & ! element 57 (3D 20node 8ip) - 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(pInt), 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) @@ -269,27 +191,6 @@ 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 - int([ & - 3, & ! element 6 (2D 3node 1ip) - 7, & ! element 125 (2D 6node 3ip) - 9, & ! element 11 (2D 4node 4ip) - 16, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 15, & ! element 127 (3D 10node 4ip) - 21, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 27, & ! element 7 (3D 8node 8ip) - 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 - int([ & - 3, & ! (2D 3node) - 4, & ! (2D 4node) - 4, & ! (3D 4node) - 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 int([& @@ -299,21 +200,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 - int([ & - 1, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 9, & ! element 27 (2D 8node 9ip) - 1, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 1, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 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(pInt), 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) @@ -322,23 +209,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],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 - int([ & - 3, & ! element 6 (2D 3node 1ip) - 1, & ! element 125 (2D 6node 3ip) - 1, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 1, & ! element 127 (3D 10node 4ip) - 1, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 1, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - integer(pInt), 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 character(len=64), dimension(:), allocatable, private :: & mesh_nameElemSet @@ -385,7 +257,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_map_Elements, & mesh_marc_map_nodes, & mesh_marc_build_nodes, & - mesh_marc_count_cpSizes, & mesh_marc_build_elements type, public, extends(tMesh) :: tMesh_marc @@ -449,7 +320,8 @@ subroutine mesh_init(ip,el) integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt) :: j, fileFormatVersion, elemType integer(pInt) :: & - mesh_maxNelemInSet + mesh_maxNelemInSet, & + mesh_NcpElems logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -491,14 +363,14 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - call mesh_marc_map_elements(hypoelasticTableStyle,mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) !ToDo: don't work on global variables + 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) - call mesh_marc_map_nodes(FILEUNIT) !ToDo: don't work on global variables + call mesh_marc_map_nodes(mesh_Nnodes,FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables + call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables mesh_node = mesh_node0 if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) @@ -535,18 +407,18 @@ subroutine mesh_init(ip,el) call mesh_build_ipNeighborhood if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + if (usePingPong .and. (mesh_Nelems /= theMesh%nElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements - if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + if (debug_e < 1 .or. debug_e > theMesh%nElems) & 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)))) & + 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 - 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 + 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_execIP(2,:) = theMesh%elem%nIPs - allocate(calcMode(mesh_maxNips,mesh_NcpElems)) + allocate(calcMode(theMesh%elem%nIPs,theMesh%nElems)) 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" @@ -785,7 +657,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) !-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!> @brief Count overall number of CP elements in mesh !-------------------------------------------------------------------------------------------------- integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileFormatVersion,fileUnit) @@ -841,7 +713,7 @@ integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileForma !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) +subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileUnit) use math, only: math_qsort use IO, only: IO_lc, & @@ -851,7 +723,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,tableStyle + integer(pInt), intent(in) :: fileUnit,tableStyle,nElems character(len=64), intent(in), dimension(:) :: nameElemSet integer(pInt), dimension(:,:), intent(in) :: & mapElemSet @@ -860,7 +732,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) character(len=300) :: line, & tmp - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts + integer(pInt), dimension (1_pInt+nElems) :: contInts integer(pInt) :: i,cpElem cpElem = 0_pInt @@ -874,7 +746,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) do i=1_pInt,3_pInt+TableStyle ! skip three (or four if new table style!) lines read (fileUnit,'(A300)') line enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,nameElemSet,& + contInts = IO_continuousIntValues(fileUnit,nElems,nameElemSet,& mapElemSet,size(nameElemSet)) exit endif @@ -912,7 +784,7 @@ end subroutine mesh_marc_map_elements !-------------------------------------------------------------------------------------------------- !> @brief Maps node from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) +subroutine mesh_marc_map_nodes(nNodes,fileUnit) use math, only: math_qsort use IO, only: IO_lc, & @@ -921,12 +793,12 @@ subroutine mesh_marc_map_nodes(fileUnit) IO_fixedIntValue implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit, nNodes integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt), dimension (nNodes) :: node_count integer(pInt) :: i node_count = 0_pInt @@ -937,7 +809,7 @@ subroutine mesh_marc_map_nodes(fileUnit) chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then read (fileUnit,'(A300)') line ! skip crap line - do i = 1_pInt,mesh_Nnodes + do i = 1_pInt,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 @@ -953,7 +825,6 @@ end subroutine mesh_marc_map_nodes !-------------------------------------------------------------------------------------------------- !> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_build_nodes(fileUnit) @@ -1017,10 +888,6 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) character(len=300) :: line integer(pInt) :: i,t,g,e,c - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt t = -1_pInt rewind(fileUnit) @@ -1037,13 +904,7 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) if (t == -1_pInt) t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message mesh_marc_count_cpSizes = t - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + !call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line !ToDo: this is dangerous in case of a non-CP element, everything is mixed up endif enddo exit @@ -1074,10 +935,10 @@ subroutine mesh_marc_build_elements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts + integer(pInt), dimension(1_pInt+theMesh%nElems) :: contInts integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + allocate(mesh_element(4_pInt+theMesh%elem%nNodes,theMesh%nElems), source=0_pInt) mesh_elemType = -1_pInt @@ -1103,7 +964,7 @@ subroutine mesh_marc_build_elements(fileUnit) mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes enddo nNodesAlreadyRead = chunkPos(1) - 2_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + 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) @@ -1138,7 +999,7 @@ subroutine mesh_marc_build_elements(fileUnit) read (fileUnit,'(A300)',END=630) line ! read extra line endif contInts = IO_continuousIntValues& ! get affected elements - (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + (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 @@ -1320,23 +1181,23 @@ subroutine mesh_build_ipVolumes integer(pInt) :: 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) + 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,mesh_NcpElems ! loop over cpElems + do e = 1_pInt,theMesh%nElems ! loop over cpElems t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + g = theMesh%elem%geomType + c = theMesh%elem%cellType select case (c) case (1_pInt) ! 2D 3node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + forall (i = 1_pInt: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:FE_Nips(g)) & ! loop over ips=cells in this element + forall (i = 1_pInt: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))) & @@ -1345,7 +1206,7 @@ subroutine mesh_build_ipVolumes 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 + forall (i = 1_pInt: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)), & @@ -1353,7 +1214,7 @@ subroutine mesh_build_ipVolumes case (4_pInt) ! 3D 8node m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1_pInt,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)) & subvolume(n,f) = math_volTetrahedron(& @@ -1390,19 +1251,19 @@ subroutine mesh_build_ipCoordinates real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + 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,mesh_NcpElems ! loop over cpElems + do e = 1_pInt,theMesh%nElems ! loop over cpElems t = mesh_element(2_pInt,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 + g = theMesh%elem%geomType + c = theMesh%elem%cellType + do i = 1_pInt,theMesh%elem%nIPs myCoords = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do n = 1_pInt,theMesh%elem%nCellnodesPerCell myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e)) enddo - mesh_ipCoordinates(1:3,i,e) = myCoords / real(FE_NcellnodesPerCell(c),pReal) + mesh_ipCoordinates(1:3,i,e) = myCoords / real(theMesh%elem%nCellnodesPerCell,pReal) enddo enddo !$OMP END PARALLEL DO @@ -1422,13 +1283,13 @@ pure function mesh_cellCenterCoordinates(ip,el) integer(pInt) :: t,g,c,n t = mesh_element(2_pInt,el) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + g = theMesh%elem%geomType + c = theMesh%elem%cellType mesh_cellCenterCoordinates = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do n = 1_pInt,theMesh%elem%nCellnodesPerCell mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) enddo - mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(theMesh%elem%nCellnodesPerCell,pReal) end function mesh_cellCenterCoordinates @@ -1448,18 +1309,18 @@ subroutine mesh_build_ipAreas 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_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) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems + do e = 1_pInt,theMesh%nElems ! loop over cpElems t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell 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,FE_Nips(g) ! loop over ips=cells in this element + 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)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1472,7 +1333,7 @@ subroutine mesh_build_ipAreas enddo case (3_pInt) ! 3D 4node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + 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)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1489,7 +1350,7 @@ subroutine mesh_build_ipAreas ! 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 i = 1_pInt,theMesh%elem%nIPs do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1600,8 +1461,8 @@ subroutine mesh_build_sharedElems node_count = 0_pInt - do e = 1_pInt,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + do e = 1_pInt,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 = mesh_element(4+n,e) @@ -1621,8 +1482,8 @@ subroutine mesh_build_sharedElems allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) - do e = 1_pInt,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + do e = 1_pInt,theMesh%nElems + g = theMesh%elem%geomType node_seen = 0_pInt do n = 1_pInt,FE_NmatchingNodes(g) node = mesh_element(4_pInt+n,e) @@ -1675,16 +1536,16 @@ subroutine mesh_build_ipNeighborhood matchingNodes logical checkTwins - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) + allocate(mesh_ipNeighborhood(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems)) mesh_ipNeighborhood = 0_pInt - do myElem = 1_pInt,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 myElem = 1_pInt,theMesh%nElems ! loop over cpElems + myType = theMesh%elem%geomType + do myIP = 1_pInt,theMesh%elem%nIPs - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP - neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) + do neighbor = 1_pInt,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 @@ -1701,11 +1562,11 @@ subroutine mesh_build_ipNeighborhood 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? - neighboringType = FE_geomtype(mesh_element(2,matchingElem)) + neighboringType = theMesh%elem%geomType !*** trivial solution if neighbor has only one IP - if (FE_Nips(neighboringType) == 1_pInt) then + if (theMesh%elem%nIPs == 1_pInt) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt cycle @@ -1715,8 +1576,8 @@ subroutine mesh_build_ipNeighborhood NlinkedNodes = 0_pInt linkedNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face - anchor = FE_nodesAtIP(a,myIP,myType) + do a = 1_pInt,theMesh%elem%maxNnodeAtIP + anchor = theMesh%elem%NnodeAtIP(a,myIP) if (anchor /= 0_pInt) then ! valid anchor node if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? NlinkedNodes = NlinkedNodes + 1_pInt @@ -1733,11 +1594,11 @@ 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) + checkCandidateIP: do candidateIP = 1_pInt,theMesh%elem%nIPs NmatchingNodes = 0_pInt matchingNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip - anchor = FE_nodesAtIP(a,candidateIP,neighboringType) + do a = 1_pInt,theMesh%elem%maxNnodeAtIP + anchor = theMesh%elem%NnodeAtIP(a,candidateIP) if (anchor /= 0_pInt) then ! valid anchor node if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? NmatchingNodes = NmatchingNodes + 1_pInt @@ -1787,15 +1648,15 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - do myElem = 1_pInt,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 myElem = 1_pInt,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 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 ... - 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 + neighboringType = theMesh%elem%geomType + do pointingToMe = 1_pInt,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),& @@ -1822,7 +1683,7 @@ integer(pInt), intent(out) :: matchingElem, & matchingFace ! matching face ID integer(pInt), intent(in) :: face, & ! face ID elem ! CP elem ID -integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & +integer(pInt), dimension(FE_NmatchingNodesPerFace(face,theMesh%elem%geomType)) :: & myFaceNodes ! global node ids on my face integer(pInt) :: myType, & candidateType, & @@ -1841,7 +1702,7 @@ 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 +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 @@ -1859,7 +1720,7 @@ checkCandidate: do i = 1_pInt,minNsharedElems candidateElem = mesh_sharedElem(1_pInt+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 + candidateType = theMesh%elem%geomType checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face @@ -1949,678 +1810,14 @@ end function FE_mapElemtype !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements -!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!> @details assign globals FE_cellface !-------------------------------------------------------------------------------------------------- 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) - 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) - - !*** fill FE_nodesAtIP with data *** - - me = 0_pInt - - me = me + 1_pInt - 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 - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, & - 2, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, & - 2, & - 4, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1,0, & - 1,2, & - 2,0, & - 1,4, & - 0,0, & - 2,3, & - 4,0, & - 3,4, & - 3,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - 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 - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 1, & - 2, & - 3, & - 4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 1, & - 2, & - 3, & - 4, & - 5, & - 6 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - 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 - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 1, & - 2, & - 4, & - 3, & - 5, & - 6, & - 8, & - 7 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - reshape(int([& - 1,0, 0,0, & - 1,2, 0,0, & - 2,0, 0,0, & - 1,4, 0,0, & - 1,3, 2,4, & - 2,3, 0,0, & - 4,0, 0,0, & - 3,4, 0,0, & - 3,0, 0,0, & - 1,5, 0,0, & - 1,6, 2,5, & - 2,6, 0,0, & - 1,8, 4,5, & - 0,0, 0,0, & - 2,7, 3,6, & - 4,8, 0,0, & - 3,8, 4,7, & - 3,7, 0,0, & - 5,0, 0,0, & - 5,6, 0,0, & - 6,0, 0,0, & - 5,8, 0,0, & - 5,7, 6,8, & - 6,7, 0,0, & - 8,0, 0,0, & - 7,8, 0,0, & - 7,0, 0,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - - ! *** FE_ipNeighbor *** - ! is a list of the neighborhood of each IP. - ! 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 = me + 1_pInt - 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 - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 2,-3, 3,-1, & - -2, 1, 3,-1, & - 2,-3,-2, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 2,-4, 3,-1, & - -2, 1, 4,-1, & - 4,-4,-3, 1, & - -2, 3,-3, 2 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 2,-4, 4,-1, & - 3, 1, 5,-1, & - -2, 2, 6,-1, & - 5,-4, 7, 1, & - 6, 4, 8, 2, & - -2, 5, 9, 3, & - 8,-4,-3, 4, & - 9, 7,-3, 5, & - -2, 8,-3, 6 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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 - 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, & - -2, 1, 3,-2, 4,-1, & - 2,-4,-3, 1, 4,-1, & - 2,-4, 3,-2,-3, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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, & - -3, 1, 3,-2, 5,-1, & - 2,-4,-3, 1, 6,-1, & - 5,-4, 6,-2,-5, 1, & - -3, 4, 6,-2,-5, 2, & - 5,-4,-3, 4,-5, 3 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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 - 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, & - -3, 1, 4,-2, 6,-1, & - 4,-5,-4, 1, 7,-1, & - -3, 3,-4, 2, 8,-1, & - 6,-5, 7,-2,-6, 1, & - -3, 5, 8,-2,-6, 2, & - 8,-5,-4, 5,-6, 3, & - -3, 7,-4, 6,-6, 4 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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, & - 3, 1, 5,-2,11,-1, & - -3, 2, 6,-2,12,-1, & - 5,-5, 7, 1,13,-1, & - 6, 4, 8, 2,14,-1, & - -3, 5, 9, 3,15,-1, & - 8,-5,-4, 4,16,-1, & - 9, 7,-4, 5,17,-1, & - -3, 8,-4, 6,18,-1, & - 11,-5,13,-2,19, 1, & - 12,10,14,-2,20, 2, & - -3,11,15,-2,21, 3, & - 14,-5,16,10,22, 4, & - 15,13,17,11,23, 5, & - -3,14,18,12,24, 6, & - 17,-5,-4,13,25, 7, & - 18,16,-4,14,26, 8, & - -3,17,-4,15,27, 9, & - 20,-5,22,-2,-6,10, & - 21,19,23,-2,-6,11, & - -3,20,24,-2,-6,12, & - 23,-5,25,19,-6,13, & - 24,22,26,20,-6,14, & - -3,23,27,21,-6,15, & - 26,-5,-4,22,-6,16, & - 27,25,-4,23,-6,17, & - -3,26,-4,24,-6,18 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cell *** - me = 0_pInt - - me = me + 1_pInt - 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 - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, 4, 7, 6, & - 2, 5, 7, 4, & - 3, 6, 7, 5 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, 5, 9, 8, & - 5, 2, 6, 9, & - 8, 9, 7, 4, & - 9, 6, 3, 7 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1, 5,13,12, & - 5, 6,14,13, & - 6, 2, 7,14, & - 12,13,16,11, & - 13,14,15,16, & - 14, 7, 8,15, & - 11,16,10, 4, & - 16,15, 9,10, & - 15, 8, 3, 9 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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 - 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, & - 5, 2, 6,11,12, 9,13,15, & - 7,11, 6, 3,14,15,13,10, & - 8,12,15, 4, 4, 9,13,10 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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, & - 7, 2, 8,16,17,11,18,21, & - 9,16, 8, 3,19,21,18,12, & - 10,17,21,19, 4,13,20,15, & - 17,11,18,21,13, 5,14,20, & - 19,21,18,12,15,20,14, 6 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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 - 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, & - 9, 2,10,21,22,14,23,27, & - 12,21,11, 4,25,27,24,16, & - 21,10, 3,11,27,23,15,24, & - 13,22,27,25, 5,17,26,20, & - 22,14,23,27,17, 6,18,26, & - 25,27,24,16,20,26,19, 8, & - 27,23,15,24,26,18, 7,19 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - 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, & - 9,10,34,33,37,38,58,57, & - 10, 2,11,34,38,18,39,58, & - 16,33,36,15,44,57,60,43, & - 33,34,35,36,57,58,59,60, & - 34,11,12,35,58,39,40,59, & - 15,36,14, 4,43,60,42,20, & - 36,35,13,14,60,59,41,42, & - 35,12, 3,13,59,40,19,41, & - 17,37,57,44,21,45,61,52, & - 37,38,58,57,45,46,62,61, & - 38,18,39,58,46,22,47,62, & - 44,57,60,43,52,61,64,51, & - 57,58,59,60,61,62,63,64, & - 58,39,40,59,62,47,48,63, & - 43,60,42,20,51,64,50,24, & - 60,59,41,42,64,63,49,50, & - 59,40,19,41,63,48,23,49, & - 21,45,61,52, 5,25,53,32, & - 45,46,62,61,25,26,54,53, & - 46,22,47,62,26, 6,27,54, & - 52,61,64,51,32,53,56,31, & - 61,62,63,64,53,54,55,56, & - 62,47,48,63,54,27,28,55, & - 51,64,50,24,31,56,30, 8, & - 64,63,49,50,56,55,29,30, & - 63,48,23,49,55,28, 7,29 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cellnodeParentnodeWeights *** - ! center of gravity of the weighted nodes gives the position of the cell node. - ! fill with 0. - ! 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 = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) - reshape(real([& - 1, 0, 0, & - 0, 1, 0, & - 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 2, 2, 2 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1, & - 1, 1, 0, 0, & - 0, 1, 1, 0, & - 0, 0, 1, 1, & - 1, 0, 0, 1, & - 1, 1, 1, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 1, 0, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 0, 2, & - 1, 0, 0, 0, 0, 0, 0, 2, & - 4, 1, 1, 1, 8, 2, 2, 8, & - 1, 4, 1, 1, 8, 8, 2, 2, & - 1, 1, 4, 1, 2, 8, 8, 2, & - 1, 1, 1, 4, 2, 2, 8, 8 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 1, 2, 2, 2, 2 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, & - 0, 0, 1, 0, 0, & - 0, 0, 0, 1, 0, & - 1, 1, 0, 0, 0, & - 0, 1, 1, 0, 0, & - 1, 0, 1, 0, 0, & - 1, 0, 0, 1, 0, & - 0, 1, 0, 1, 0, & - 0, 0, 1, 1, 0, & - 1, 1, 1, 0, 0, & - 1, 1, 0, 1, 0, & - 0, 1, 1, 1, 0, & - 1, 0, 1, 1, 0, & - 0, 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & - 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & - 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & - 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & - 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 0, 0, 0, 0, & - 0, 1, 1, 0, 0, 0, & - 1, 0, 1, 0, 0, 0, & - 1, 0, 0, 1, 0, 0, & - 0, 1, 0, 0, 1, 0, & - 0, 0, 1, 0, 0, 1, & - 0, 0, 0, 1, 1, 0, & - 0, 0, 0, 0, 1, 1, & - 0, 0, 0, 1, 0, 1, & - 1, 1, 1, 0, 0, 0, & - 1, 1, 0, 1, 1, 0, & - 0, 1, 1, 0, 1, 1, & - 1, 0, 1, 1, 0, 1, & - 0, 0, 0, 1, 1, 1, & - 1, 1, 1, 1, 1, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & ! - 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, & ! - 1, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 1, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 1, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 1, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 1, & ! - 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, & ! - 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, & ! - 1, 1, 1, 1, 1, 1, 1, 1 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - 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, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! - 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! - 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 - 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, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 - 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! - 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 - 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! - 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! - 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! - 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 - 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! - 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 - 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! - 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! - 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 - 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! - 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! - 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! - 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! - 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 - 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! - 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! - 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! - 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - - ! *** FE_cellface *** me = 0_pInt From a57aa7985a9d9847b6fa84d61651b492e80a397b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 18:11:16 +0100 Subject: [PATCH 068/154] wrong name --- src/mesh_abaqus.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 89f0eed06..60b1484c1 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -490,7 +490,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_abaqus_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(mesh_periodic_surface,FILEUNIT) + call mesh_get_damaskOptions(mesh_periodicSurface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) From 3f61c97dedeefd00fe8d508f7bccf36027dd65f1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Feb 2019 18:49:30 +0100 Subject: [PATCH 069/154] don't support non-DAMASK materials --- src/mesh_marc.f90 | 70 ++++++----------------------------------------- 1 file changed, 9 insertions(+), 61 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index a269b60e4..c793dc7eb 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -253,7 +253,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_count_nodesAndElements, & mesh_marc_count_elementSets, & mesh_marc_map_elementSets, & - mesh_marc_count_cpElements, & mesh_marc_map_Elements, & mesh_marc_map_nodes, & mesh_marc_build_nodes, & @@ -359,7 +358,7 @@ subroutine mesh_init(ip,el) call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - mesh_NcpElems = mesh_marc_count_cpElements(hypoelasticTableStyle,Marc_matNumber,fileFormatVersion,FILEUNIT) + mesh_NcpElems = mesh_nElems if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) @@ -656,60 +655,6 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) 640 end subroutine mesh_marc_map_elementSets -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileFormatVersion,fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues, & - IO_error, & - IO_intValue, & - IO_countNumericalDataLines - - implicit none - integer(pInt), intent(in) :: fileUnit, tableStyle,fileFormatVersion - integer(pInt), dimension(:), intent(in) :: matNumber - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_marc_count_cpElements = 0_pInt - - - rewind(fileUnit) - if (fileFormatVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+tableStyle ! Skip 3 or 4 lines - read (fileUnit,'(A300)') line - enddo - mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countContinuousIntValues(fileUnit) - exit - endif - enddo - else ! Marc2017 and later - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,'(A300)') line - chunkPos = IO_stringPos(line) - if (any(matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end function mesh_marc_count_cpElements - - !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- @@ -880,10 +825,12 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) IO_stringPos, & IO_intValue, & IO_skipChunks + use element implicit none integer(pInt), intent(in) :: fileUnit + type(tElement) :: tempEl integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: i,t,g,e,c @@ -899,13 +846,14 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) do i=1_pInt,mesh_Nelems ! read all elements read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then - if (t == -1_pInt) t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message + if (t == -1_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + call tempEl%init(t) mesh_marc_count_cpSizes = t - !call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line !ToDo: this is dangerous in case of a non-CP element, everything is mixed up + else + if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message endif + call IO_skipChunks(fileUnit,tempEl%nNodes-(chunkPos(1_pInt)-2_pInt)) enddo exit endif From 542ab946cc7db07e83d00f5d1097db1f62cd3fd7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Feb 2019 19:05:02 +0100 Subject: [PATCH 070/154] [skip ci] not needed --- src/mesh_marc.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index c793dc7eb..0e0336f99 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -53,8 +53,6 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) - integer(pInt), private :: & - mesh_Nmaterials integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID From 36662f84192ec8a6131b6d09d6d582c2326d8f98 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 05:38:24 +0100 Subject: [PATCH 071/154] more generic formulation (works for all dimensions) --- src/HDF5_utilities.f90 | 446 ++++++++++++++++++++--------------------- 1 file changed, 223 insertions(+), 223 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 2a05f101c..2a302d6ed 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -459,20 +459,20 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(1) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -482,8 +482,8 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(1) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) @@ -492,8 +492,9 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:0),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -517,7 +518,7 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5sselect_hyperslab_f') !-------------------------------------------------------------------------------------------------- @@ -554,20 +555,20 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(2) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -577,18 +578,19 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(2) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal2: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:1),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -649,20 +651,20 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(3) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -672,18 +674,19 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(3) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal3: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:2),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -744,20 +747,20 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(4) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -767,18 +770,19 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(4) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal4: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:3),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -839,20 +843,20 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(5) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -862,18 +866,19 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(5) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal5: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:4),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -934,20 +939,20 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(6) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -957,18 +962,19 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(6) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal6: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:5),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -1029,20 +1035,20 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(7) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -1052,18 +1058,19 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(7) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal7: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:6),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -1124,43 +1131,42 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(1) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(1) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt1: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:0),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1221,43 +1227,42 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(2) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(2) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt2: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:1),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1318,43 +1323,42 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(3) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(3) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt3: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:2),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1415,43 +1419,42 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(4) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(4) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt4: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:3),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1512,43 +1515,42 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(5) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(5) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt5: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:4),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1609,43 +1611,42 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(6) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(6) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt6: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:5),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1706,43 +1707,42 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(7) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(7) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt7: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:6),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) From c668260c37bfeb0407c85bff3a47d5e284651d44 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 08:05:29 +0100 Subject: [PATCH 072/154] avoiding code duplication --- src/HDF5_utilities.f90 | 1030 ++++++++++------------------------------ 1 file changed, 259 insertions(+), 771 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 2a302d6ed..39cca9502 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -449,9 +449,6 @@ end subroutine HDF5_setLink !> @brief subroutine for reading dataset of type pReal with 1 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:) :: dataset @@ -459,9 +456,7 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -469,65 +464,28 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !close types, dataspaces call h5pclose_f(plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: plist_id') @@ -545,9 +503,6 @@ end subroutine HDF5_read_pReal1 !> @brief subroutine for reading dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:) :: dataset @@ -555,9 +510,7 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -565,59 +518,22 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -641,9 +557,6 @@ end subroutine HDF5_read_pReal2 !> @brief subroutine for reading dataset of type pReal with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:) :: dataset @@ -651,9 +564,7 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -661,59 +572,22 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -737,9 +611,6 @@ end subroutine HDF5_read_pReal3 !> @brief subroutine for reading dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:) :: dataset @@ -747,9 +618,7 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -757,59 +626,22 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -833,9 +665,6 @@ end subroutine HDF5_read_pReal4 !> @brief subroutine for reading dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset @@ -843,9 +672,7 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -853,59 +680,22 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -929,9 +719,6 @@ end subroutine HDF5_read_pReal5 !> @brief subroutine for reading dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset @@ -939,9 +726,7 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -949,59 +734,22 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1025,9 +773,6 @@ end subroutine HDF5_read_pReal6 !> @brief subroutine for reading dataset of type pReal with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset @@ -1035,9 +780,7 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1045,59 +788,22 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1121,9 +827,6 @@ end subroutine HDF5_read_pReal7 !> @brief subroutine for reading dataset of type pInt with 1 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:) :: dataset @@ -1131,9 +834,7 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1141,59 +842,22 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1217,9 +881,6 @@ end subroutine HDF5_read_pInt1 !> @brief subroutine for reading dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:) :: dataset @@ -1227,9 +888,7 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1237,59 +896,22 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1313,9 +935,6 @@ end subroutine HDF5_read_pInt2 !> @brief subroutine for reading dataset of type pInt with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:) :: dataset @@ -1323,9 +942,7 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1333,59 +950,22 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1409,9 +989,6 @@ end subroutine HDF5_read_pInt3 !> @brief subroutine for reading dataset of type pInt with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset @@ -1419,9 +996,7 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1429,59 +1004,22 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1505,9 +1043,6 @@ end subroutine HDF5_read_pInt4 !> @brief subroutine for reading dataset of type pInt with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset @@ -1515,9 +1050,7 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1525,59 +1058,22 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1601,9 +1097,6 @@ end subroutine HDF5_read_pInt5 !> @brief subroutine for reading dataset of type pInt with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset @@ -1611,9 +1104,7 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1621,59 +1112,22 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1697,9 +1151,6 @@ end subroutine HDF5_read_pInt6 !> @brief subroutine for reading dataset of type pInt with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset @@ -1707,9 +1158,7 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1717,59 +1166,22 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -3050,6 +2462,82 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) end subroutine HDF5_write_pInt7 +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for reading dataset of type pReal with 1 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize + + implicit none + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel + + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), intent(in), dimension(:) :: & + localShape + integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + myStart, & + globalShape !< shape of the dataset (all processes) + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + +!------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) +!-------------------------------------------------------------------------------------------------- + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) +#ifdef PETSc + if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') + endif +#endif + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] + + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_all_coll_metadata_ops_f') +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5sselect_hyperslab_f') + + +end subroutine initialize_read + end module HDF5_Utilities From d934f2b141cf97c1935ff8ae2861b74280bdcd2c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 09:01:37 +0100 Subject: [PATCH 073/154] also modularize write --- src/HDF5_utilities.f90 | 531 +++++++++++++---------------------------- 1 file changed, 172 insertions(+), 359 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 39cca9502..d7b56a697 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -1204,9 +1204,6 @@ end subroutine HDF5_read_pInt7 !> @brief subroutine for writing dataset of type pReal with 1 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:) :: dataset @@ -1215,61 +1212,27 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(1) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(1) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal1: MPI_allreduce') - endif; endif -#endif - - myStart = int([sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:0),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1295,9 +1258,6 @@ end subroutine HDF5_write_pReal1 !> @brief subroutine for writing dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:) :: dataset @@ -1306,61 +1266,27 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(2) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(2) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal2: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:1),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1386,9 +1312,6 @@ end subroutine HDF5_write_pReal2 !> @brief subroutine for writing dataset of type pReal with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:) :: dataset @@ -1397,61 +1320,27 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(3) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(3) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal3: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:2),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1477,9 +1366,6 @@ end subroutine HDF5_write_pReal3 !> @brief subroutine for writing dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:) :: dataset @@ -1488,61 +1374,27 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(4) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(4) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal4: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:3),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1568,9 +1420,6 @@ end subroutine HDF5_write_pReal4 !> @brief subroutine for writing dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset @@ -1579,61 +1428,27 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(5) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(5) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal5: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:4),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1659,9 +1474,6 @@ end subroutine HDF5_write_pReal5 !> @brief subroutine for writing dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset @@ -1670,61 +1482,27 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(6) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(6) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal6: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:5),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1750,9 +1528,6 @@ end subroutine HDF5_write_pReal6 !> @brief subroutine for writing dataset of type pReal with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset @@ -1761,61 +1536,27 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(7) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(7) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal7: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:6),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -2513,8 +2254,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) + call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') !-------------------------------------------------------------------------------------------------- ! set I/O mode for read operations to collective @@ -2538,6 +2278,79 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ end subroutine initialize_read + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for writing dataset of type pReal with 1 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize + + implicit none + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel + + + integer(HSIZE_T), intent(in), dimension(:) :: & + localShape + integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + myStart, & + globalShape !< shape of the dataset (all processes) + integer(pInt), dimension(worldsize) :: & + outputSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + +!-------------------------------------------------------------------------------------------------- + outputSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) + +#ifdef PETSc +if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal1: MPI_allreduce') + endif +#endif + + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(outputSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(outputSize),HSIZE_T)] + + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! create dataspace in file (global shape) + call h5screate_simple_f(size(globalShape), globalShape, filespace_id, hdferr, globalShape) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! create dataset + call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dcreate_f') +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sselect_hyperslab_f') + + +end subroutine initialize_write + + end module HDF5_Utilities From 73749dd7887f58ae734ec930664ffce5eda322ce Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 09:38:49 +0100 Subject: [PATCH 074/154] merged also finalization --- src/HDF5_utilities.f90 | 1047 +++++++++++++--------------------------- 1 file changed, 342 insertions(+), 705 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index d7b56a697..ee5128e20 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -18,7 +18,7 @@ module HDF5_utilities HDF5_ERR_TYPE = 4_pInt !< kind of the integer return in the HDF5 library !-------------------------------------------------------------------------------------------------- -!> @brief reads pInt or pReal data of defined shape from file +!> @brief reads pInt or pReal data of defined shape from file ! ToDo: order of arguments wrong !-------------------------------------------------------------------------------------------------- interface HDF5_read module procedure HDF5_read_pReal1 @@ -40,7 +40,7 @@ module HDF5_utilities end interface HDF5_read !-------------------------------------------------------------------------------------------------- -!> @brief writes pInt or pReal data of defined shape to file +!> @brief writes pInt or pReal data of defined shape to file ! ToDo: order of arguments wrong !-------------------------------------------------------------------------------------------------- interface HDF5_write module procedure HDF5_write_pReal1 @@ -446,163 +446,138 @@ subroutine HDF5_setLink(loc_id,target_name,link_name) end subroutine HDF5_setLink !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 1 dimensions +!> @brief subroutine for reading dataset of type pReal with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:) :: dataset + real(pReal), intent(inout), dimension(:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f') !--------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/memspace_id') - +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + end subroutine HDF5_read_pReal1 - !-------------------------------------------------------------------------------------------------- !> @brief subroutine for reading dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:) :: dataset + real(pReal), intent(inout), dimension(:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal2 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 3 dimensions +!> @brief subroutine for reading dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal3 @@ -613,50 +588,42 @@ end subroutine HDF5_read_pReal3 subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal4 @@ -667,50 +634,42 @@ end subroutine HDF5_read_pReal4 subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal5 @@ -721,50 +680,42 @@ end subroutine HDF5_read_pReal5 subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal6 @@ -775,105 +726,85 @@ end subroutine HDF5_read_pReal6 subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal7 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 1 dimensions +!> @brief subroutine for reading dataset of type pInt with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:) :: dataset + integer(pInt), intent(inout), dimension(:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt1 @@ -883,51 +814,39 @@ end subroutine HDF5_read_pInt1 subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt2 @@ -937,51 +856,39 @@ end subroutine HDF5_read_pInt2 subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt3 @@ -991,51 +898,39 @@ end subroutine HDF5_read_pInt3 subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt4 @@ -1045,51 +940,39 @@ end subroutine HDF5_read_pInt4 subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt5 @@ -1099,51 +982,39 @@ end subroutine HDF5_read_pInt5 subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt6 @@ -1153,51 +1024,39 @@ end subroutine HDF5_read_pInt6 subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt7 !-------------------------------------------------------------------------------------------------- @@ -1219,20 +1078,20 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1273,20 +1132,20 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1327,20 +1186,20 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1381,20 +1240,20 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1435,20 +1294,20 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1489,20 +1348,20 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1543,20 +1402,20 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1584,9 +1443,6 @@ end subroutine HDF5_write_pReal7 !> @brief subroutine for writing dataset of type pInt with 1 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:) :: dataset @@ -1595,59 +1451,27 @@ subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(1) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(1) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt1: MPI_allreduce') - endif; endif -#endif - myStart = int([sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:0),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1673,9 +1497,6 @@ end subroutine HDF5_write_pInt1 !> @brief subroutine for writing dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:) :: dataset @@ -1684,59 +1505,27 @@ subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(2) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(2) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt2: MPI_allreduce') - endif; endif -#endif - myStart = int([0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:1),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1762,9 +1551,6 @@ end subroutine HDF5_write_pInt2 !> @brief subroutine for writing dataset of type pInt with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:) :: dataset @@ -1773,59 +1559,27 @@ subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(3) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(3) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt3: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:2),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1851,9 +1605,6 @@ end subroutine HDF5_write_pInt3 !> @brief subroutine for writing dataset of type pInt with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset @@ -1862,59 +1613,27 @@ subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(4) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(4) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt4: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:3),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1940,9 +1659,6 @@ end subroutine HDF5_write_pInt4 !> @brief subroutine for writing dataset of type pInt with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset @@ -1951,59 +1667,27 @@ subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(5) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(5) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt5: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:4),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -2029,9 +1713,6 @@ end subroutine HDF5_write_pInt5 !> @brief subroutine for writing dataset of type pInt with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset @@ -2040,59 +1721,27 @@ subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(6) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(6) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt6: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:5),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -2118,9 +1767,6 @@ end subroutine HDF5_write_pInt6 !> @brief subroutine for writing dataset of type pInt with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset @@ -2129,59 +1775,27 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(7) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(7) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt7: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:6),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -2204,7 +1818,7 @@ end subroutine HDF5_write_pInt7 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 1 dimensions +!> @brief !-------------------------------------------------------------------------------------------------- subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & myStart, globalShape, & @@ -2280,11 +1894,33 @@ end subroutine initialize_read !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 1 dimensions +!> @brief +!-------------------------------------------------------------------------------------------------- +subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + + implicit none + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + +!--------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/memspace_id') + +end subroutine finalize_read + +!-------------------------------------------------------------------------------------------------- +!> @brief !-------------------------------------------------------------------------------------------------- subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + loc_id,localShape,datasetName,datatype,parallel) use numerics, only: & worldrank, & worldsize @@ -2302,6 +1938,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & globalShape !< shape of the dataset (all processes) integer(pInt), dimension(worldsize) :: & outputSize !< contribution of all processes +integer(HSIZE_T), intent(in) :: datatype integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id @@ -2340,7 +1977,7 @@ if (parallel) then !-------------------------------------------------------------------------------------------------- ! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) + call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dcreate_f') !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file From 5d9c3fcf273d69042ac3cd1ec48cd6214d9ca2d7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 09:44:41 +0100 Subject: [PATCH 075/154] finalize for write --- src/HDF5_utilities.f90 | 47 ++++++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 20 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index ee5128e20..2b902c1c8 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -19,6 +19,7 @@ module HDF5_utilities !-------------------------------------------------------------------------------------------------- !> @brief reads pInt or pReal data of defined shape from file ! ToDo: order of arguments wrong +!> @details for parallel IO, all dimension except for the last need to match !-------------------------------------------------------------------------------------------------- interface HDF5_read module procedure HDF5_read_pReal1 @@ -41,6 +42,7 @@ module HDF5_utilities !-------------------------------------------------------------------------------------------------- !> @brief writes pInt or pReal data of defined shape to file ! ToDo: order of arguments wrong +!> @details for parallel IO, all dimension except for the last need to match !-------------------------------------------------------------------------------------------------- interface HDF5_write module procedure HDF5_write_pReal1 @@ -1059,8 +1061,9 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) end subroutine HDF5_read_pInt7 + !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 1 dimensions +!> @brief subroutine for writing dataset of type pReal with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) @@ -1436,11 +1439,8 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) end subroutine HDF5_write_pReal7 - - - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 1 dimensions +!> @brief subroutine for writing dataset of type pInt with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) @@ -1988,19 +1988,26 @@ if (parallel) then end subroutine initialize_write +!-------------------------------------------------------------------------------------------------- +!> @brief +!-------------------------------------------------------------------------------------------------- +subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) + + implicit none + integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id + integer(HDF5_ERR_TYPE) :: hdferr + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5sclose_f/memspace_id') + +end subroutine finalize_write + end module HDF5_Utilities - - - - - - - - - - - - - - - From 8167f09ec6f82d699b39b37ffdbb4d387a9ac25f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 11:45:02 +0100 Subject: [PATCH 076/154] using functions as far as possible --- src/HDF5_utilities.f90 | 496 +++++++++++------------------------------ 1 file changed, 128 insertions(+), 368 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 2b902c1c8..da6bd4979 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -447,8 +447,9 @@ subroutine HDF5_setLink(loc_id,target_name,link_name) end subroutine HDF5_setLink + !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 1 dimension +!> @brief read dataset of type pReal with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) @@ -480,20 +481,16 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal1 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 2 dimensions +!> @brief read dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) @@ -525,21 +522,16 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal2 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 2 dimensions +!> @brief read dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) @@ -570,22 +562,17 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & myStart, globalShape, loc_id,localShape,datasetName,.false.) endif - -!--------------------------------------------------------------------------------------------------- -! read + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal3 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 4 dimensions +!> @brief read dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) @@ -617,21 +604,16 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal4 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 5 dimensions +!> @brief read dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) @@ -663,21 +645,16 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal5 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 6 dimensions +!> @brief read dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) @@ -709,21 +686,16 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal6 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 7 dimensions +!> @brief read dataset of type pReal with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) @@ -755,21 +727,17 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal7 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 1 dimension +!> @brief read dataset of type pInt with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) @@ -801,17 +769,16 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dread_f') + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + end subroutine HDF5_read_pInt1 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 2 dimensions +!> @brief read dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) @@ -843,17 +810,16 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt2 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 3 dimensions +!> @brief read dataset of type pInt with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) @@ -885,17 +851,16 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt3 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 4 dimensions +!> @brief read dataset of type pInt withh 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) @@ -927,17 +892,16 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt4 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 5 dimensions +!> @brief read dataset of type pInt with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) @@ -969,17 +933,16 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt5 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 6 dimensions +!> @brief read dataset of type pInt with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) @@ -1011,17 +974,16 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt6 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 7 dimensions +!> @brief read dataset of type pInt with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) @@ -1053,17 +1015,17 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt7 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 1 dimension +!> @brief write dataset of type pReal with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) @@ -1088,36 +1050,22 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape,loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape,loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal1 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 2 dimensions +!> @brief write dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) @@ -1142,36 +1090,22 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal2 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 3 dimensions +!> @brief write dataset of type pReal with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) @@ -1196,36 +1130,22 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal3 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 4 dimensions +!> @brief write dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) @@ -1250,36 +1170,23 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal4 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 5 dimensions +!> @brief write dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) @@ -1304,36 +1211,22 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal5 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 6 dimensions +!> @brief write dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) @@ -1358,36 +1251,22 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal6 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 7 dimensions +!> @brief write dataset of type pReal with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) @@ -1412,35 +1291,23 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal7 + !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 1 dimension +!> @brief write dataset of type pInt with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) @@ -1465,36 +1332,22 @@ subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt1 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 2 dimensions +!> @brief write dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) @@ -1519,36 +1372,22 @@ subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt2 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 3 dimensions +!> @brief write dataset of type pInt with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) @@ -1573,36 +1412,22 @@ subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt3 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 4 dimensions +!> @brief write dataset of type pInt with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) @@ -1627,36 +1452,22 @@ subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt4 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 5 dimensions +!> @brief write dataset of type pInt with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) @@ -1681,36 +1492,22 @@ subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt5 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 6 dimensions +!> @brief write dataset of type pInt with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) @@ -1735,36 +1532,22 @@ subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt6 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 7 dimensions +!> @brief write dataset of type pInt with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) @@ -1789,36 +1572,23 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt7 !-------------------------------------------------------------------------------------------------- -!> @brief +!> @brief initialize HDF5 handles, determines global shape and start for parallel read !-------------------------------------------------------------------------------------------------- subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & myStart, globalShape, & @@ -1844,57 +1614,53 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties +! creating a property list for transfer properties (is collective for MPI) call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- readSize = 0_pInt readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_read: MPI_allreduce') endif #endif myStart = int(0,HSIZE_T) myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dopen_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5screate_simple_f/memspace_id') !-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file +! creating a property list for IO and set it to collective + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f') + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f') + +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file and get the space ID + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5dopen_f') call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dget_space_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5dget_space_f') !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5sselect_hyperslab_f') - + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5sselect_hyperslab_f') end subroutine initialize_read !-------------------------------------------------------------------------------------------------- -!> @brief +!> @brief closes HDF5 handles !-------------------------------------------------------------------------------------------------- subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -1902,21 +1668,20 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id -!--------------------------------------------------------------------------------------------------- -!close types, dataspaces call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: plist_id') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: plist_id') call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dclose_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5dclose_f') call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/filespace_id') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5sclose_f/filespace_id') call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/memspace_id') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5sclose_f/memspace_id') end subroutine finalize_read + !-------------------------------------------------------------------------------------------------- -!> @brief +!> @brief initialize HDF5 handles, determines global shape and start for parallel write !-------------------------------------------------------------------------------------------------- subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & myStart, globalShape, & @@ -1938,7 +1703,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & globalShape !< shape of the dataset (all processes) integer(pInt), dimension(worldsize) :: & outputSize !< contribution of all processes -integer(HSIZE_T), intent(in) :: datatype + integer(HID_T), intent(in) :: datatype integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id @@ -1954,9 +1719,9 @@ integer(HSIZE_T), intent(in) :: datatype #ifdef PETSc if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal1: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_write: MPI_allreduce') endif #endif @@ -1966,30 +1731,27 @@ if (parallel) then !-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) +! create dataspace in memory (local shape) and in file (global shape) call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dopen_f') call h5screate_simple_f(size(globalShape), globalShape, filespace_id, hdferr, globalShape) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dget_space_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dget_space_f') !-------------------------------------------------------------------------------------------------- ! create dataset call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dcreate_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dcreate_f') + !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sselect_hyperslab_f') - + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5sselect_hyperslab_f') end subroutine initialize_write !-------------------------------------------------------------------------------------------------- -!> @brief +!> @brief closes HDF5 handles !-------------------------------------------------------------------------------------------------- subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1997,8 +1759,6 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id integer(HDF5_ERR_TYPE) :: hdferr -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces call h5pclose_f(plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: plist_id') call h5dclose_f(dset_id, hdferr) From de26e41684a49669ec68eb4ac16ed923b656450b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 15:02:07 +0000 Subject: [PATCH 077/154] some first steps to support debugging with the PGI compiler norm2 and sum for initialization are not supported yet, need fixes --- CMakeLists.txt | 27 +++++++++++++++++++++++++++ src/compilation_info.f90 | 6 +++++- src/math.f90 | 18 ++++++++++++++++++ 3 files changed, 50 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 3aa49cd7a..6096c8824 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -445,6 +445,33 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") # Additional options # -fdefault-integer-8: Use it to set precision to 8 bytes for integer, don't use it for the standard case of pInt=4 (there is no -fdefault-integer-4) + + +################################################################################################### +# PGI Compiler +################################################################################################### +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI") + + if (OPTIMIZATION STREQUAL "OFF") + set (OPTIMIZATION_FLAGS "-O0" ) + elseif (OPTIMIZATION STREQUAL "DEFENSIVE") + set (OPTIMIZATION_FLAGS "-O2") + elseif (OPTIMIZATION STREQUAL "AGGRESSIVE") + set (OPTIMIZATION_FLAGS "-O3") + endif () + + +#------------------------------------------------------------------------------------------------ +# Fine tuning compilation options + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Mpreprocess") + # preprocessor + + set (STANDARD_CHECK "-Mallocatable=03") + +#------------------------------------------------------------------------------------------------ +# Runtime debugging + set (DEBUG_FLAGS "${DEBUG_FLAGS} -g") + # Includes debugging information in the object module; sets the optimization level to zero unless a -⁠O option is present on the command line else () message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized") endif () diff --git a/src/compilation_info.f90 b/src/compilation_info.f90 index f0ca4d4cc..77d181a38 100644 --- a/src/compilation_info.f90 +++ b/src/compilation_info.f90 @@ -1,9 +1,13 @@ +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 write(6,*) 'Compiled with ', compiler_version() write(6,*) 'With options ', compiler_options() -#else +#elif defined(__INTEL_COMPILER) write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,& ', build date ', __INTEL_COMPILER_BUILD_DATE +#elif defined(__PGI) + write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version ', __PGIC__,& + '.', __PGIC_MINOR__ #endif write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ write(6,*) diff --git a/src/math.f90 b/src/math.f90 index 28c7175e3..4d7736b31 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -118,6 +118,9 @@ module math !--------------------------------------------------------------------------------------------------- public :: & +#if defined(__PGI) + norm2, & +#endif math_init, & math_qsort, & math_expand, & @@ -2707,4 +2710,19 @@ real(pReal) pure elemental function math_clip(a, left, right) end function math_clip + +#if defined(__PGI) +!-------------------------------------------------------------------------------------------------- +!> @brief substitute for the norm2 intrinsic which is not available when using PGI 18.10 +!-------------------------------------------------------------------------------------------------- +real(pReal) pure function norm2(v) + + implicit none + real(pReal), intent(in), dimension(3) :: v + + norm2 = sqrt(sum(a**2)) + +end function norm2 +#endif + end module math From 09859f1b12157b3580ef9014dfae8599d3e92089 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 16:53:05 +0100 Subject: [PATCH 078/154] wrong variable rename (was forgotten) --- src/math.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/math.f90 b/src/math.f90 index 4d7736b31..644063d66 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -2720,7 +2720,7 @@ real(pReal) pure function norm2(v) implicit none real(pReal), intent(in), dimension(3) :: v - norm2 = sqrt(sum(a**2)) + norm2 = sqrt(sum(v**2)) end function norm2 #endif From c4eef520fcb7dd796fa092b72298e7a944be2ace Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 17:21:11 +0100 Subject: [PATCH 079/154] initialize all variables --- src/HDF5_utilities.f90 | 60 +++++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index da6bd4979..0582318ce 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -1291,10 +1291,10 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& @@ -1598,24 +1598,25 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ worldsize implicit none - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel - + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in) :: parallel + integer(HSIZE_T), intent(in), dimension(:) :: & + localShape + integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + myStart, & + globalShape !< shape of the dataset (all processes) + integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(pInt), dimension(worldsize) :: & readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr - integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), intent(in), dimension(:) :: & - localShape - integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & - myStart, & - globalShape !< shape of the dataset (all processes) - + !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties (is collective for MPI) call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f') !-------------------------------------------------------------------------------------------------- readSize = 0_pInt @@ -1665,8 +1666,8 @@ end subroutine initialize_read subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) implicit none - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HDF5_ERR_TYPE) :: hdferr call h5pclose_f(plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: plist_id') @@ -1691,44 +1692,43 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & worldsize implicit none - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel - - - integer(HSIZE_T), intent(in), dimension(:) :: & + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in) :: parallel + integer(HID_T), intent(in) :: datatype + integer(HSIZE_T), intent(in), dimension(:) :: & localShape - integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & myStart, & globalShape !< shape of the dataset (all processes) + integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id + integer(pInt), dimension(worldsize) :: & - outputSize !< contribution of all processes - integer(HID_T), intent(in) :: datatype + writeSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pcreate_f') !-------------------------------------------------------------------------------------------------- - outputSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) + writeSize = 0_pInt + writeSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_write: MPI_allreduce') endif #endif myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(outputSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(outputSize),HSIZE_T)] - + myStart(ubound(myStart)) = int(sum(writeSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(writeSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) and in file (global shape) From af28e9cdd9ed2e959cb43e3d1df2163ba9a65f28 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 17:23:56 +0100 Subject: [PATCH 080/154] not needed anymore --- src/FEM_utilities.f90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 1db950e63..fd6e90206 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -162,7 +162,6 @@ subroutine utilities_init() character(len=1024) :: petsc_optionsPhysics integer(pInt) :: dimPlex - integer(pInt) :: headerID = 205_pInt PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:) PetscInt :: dim PetscErrorCode :: ierr @@ -213,13 +212,6 @@ subroutine utilities_init() nOutputCells(worldrank+1) = count(material_homog > 0_pInt) call MPI_Allreduce(MPI_IN_PLACE,nOutputNodes,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) call MPI_Allreduce(MPI_IN_PLACE,nOutputCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) - if (worldrank == 0_pInt) then - open(unit=headerID, file=trim(getSolverJobName())//'.header', & - form='FORMATTED', status='REPLACE') - write(headerID, '(a,i0)') 'dimension : ', dimPlex - write(headerID, '(a,i0)') 'number of nodes : ', sum(nOutputNodes) - write(headerID, '(a,i0)') 'number of cells : ', sum(nOutputCells) - endif end subroutine utilities_init From 87f3e3f62114bd083f20d92de688f363a6071794 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Feb 2019 10:08:34 +0100 Subject: [PATCH 081/154] more flexible and user friendly --- src/math.f90 | 79 +++++++++++++++++++++++++++++++--------------------- 1 file changed, 47 insertions(+), 32 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 644063d66..e663103c8 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -119,7 +119,7 @@ module math public :: & #if defined(__PGI) - norm2, & + norm2, & #endif math_init, & math_qsort, & @@ -354,20 +354,38 @@ end subroutine math_check !-------------------------------------------------------------------------------------------------- !> @brief Quicksort algorithm for two-dimensional integer arrays -! Sorting is done with respect to array(1,:) -! and keeps array(2:N,:) linked to it. +! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) linked to it. +! default: sort=1 !-------------------------------------------------------------------------------------------------- -recursive subroutine math_qsort(a, istart, iend) +recursive subroutine math_qsort(a, istart, iend, sortDim) implicit none integer(pInt), dimension(:,:), intent(inout) :: a - integer(pInt), intent(in) :: istart,iend - integer(pInt) :: ipivot - - if (istart < iend) then - ipivot = qsort_partition(a,istart, iend) - call math_qsort(a, istart, ipivot-1_pInt) - call math_qsort(a, ipivot+1_pInt, iend) + integer(pInt), intent(in),optional :: istart,iend, sortDim + integer(pInt) :: ipivot,s,e,d + + if(present(istart)) then + s = istart + else + s = lbound(a,2) + endif + + if(present(iend)) then + e = iend + else + e = ubound(a,2) + endif + + if(present(sortDim)) then + d = sortDim + else + d = 1 + endif + + if (s < e) then + ipivot = qsort_partition(a,s, e, d) + call math_qsort(a, s, ipivot-1_pInt, d) + call math_qsort(a, ipivot+1_pInt, e, d) endif !-------------------------------------------------------------------------------------------------- @@ -376,37 +394,34 @@ recursive subroutine math_qsort(a, istart, iend) !------------------------------------------------------------------------------------------------- !> @brief Partitioning required for quicksort !------------------------------------------------------------------------------------------------- - integer(pInt) function qsort_partition(a, istart, iend) + integer(pInt) function qsort_partition(a, istart, iend, sort) implicit none integer(pInt), dimension(:,:), intent(inout) :: a - integer(pInt), intent(in) :: istart,iend - integer(pInt) :: i,j,k,tmp + integer(pInt), intent(in) :: istart,iend,sort + integer(pInt), dimension(size(a,1)) :: tmp + integer(pInt) :: i,j do - ! find the first element on the right side less than or equal to the pivot point + ! find the first element on the right side less than or equal to the pivot point do j = iend, istart, -1_pInt - if (a(1,j) <= a(1,istart)) exit + if (a(sort,j) <= a(sort,istart)) exit enddo - ! find the first element on the left side greater than the pivot point + ! find the first element on the left side greater than the pivot point do i = istart, iend - if (a(1,i) > a(1,istart)) exit + if (a(sort,i) > a(sort,istart)) exit enddo - if (i < j) then ! if the indexes do not cross, exchange values - do k = 1_pInt, int(size(a,1_pInt), pInt) - tmp = a(k,i) - a(k,i) = a(k,j) - a(k,j) = tmp - enddo - else ! if they do cross, exchange left value with pivot and return with the partition index - do k = 1_pInt, int(size(a,1_pInt), pInt) - tmp = a(k,istart) - a(k,istart) = a(k,j) - a(k,j) = tmp - enddo + cross: if (i >= j) then ! if the indices cross, exchange left value with pivot and return with the partition index + tmp = a(:,istart) + a(:,istart) = a(:,j) + a(:,j) = tmp qsort_partition = j return - endif + else cross ! if they do not cross, exchange values + tmp = a(:,i) + a(:,i) = a(:,j) + a(:,j) = tmp + endif cross enddo end function qsort_partition @@ -2713,7 +2728,7 @@ end function math_clip #if defined(__PGI) !-------------------------------------------------------------------------------------------------- -!> @brief substitute for the norm2 intrinsic which is not available when using PGI 18.10 +!> @brief substitute for the norm2 intrinsic which is not available in PGI 18.10 !-------------------------------------------------------------------------------------------------- real(pReal) pure function norm2(v) From b0c20beefa3c899e810aa22f3f14db8efa28cde2 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 11 Feb 2019 15:11:31 +0100 Subject: [PATCH 082/154] [skip ci] updated version information after successful test of v2.0.2-1687-gfa1c946d --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 543d23432..f8fbcdee0 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1674-g683dee82 +v2.0.2-1687-gfa1c946d From 1a471bcd8a3f2d50e13d9e403442bc8923cb06f4 Mon Sep 17 00:00:00 2001 From: Arko Jyoti Bhattacharjee Date: Mon, 11 Feb 2019 18:46:14 +0100 Subject: [PATCH 083/154] signal handling implemented allows to trigger action in running simulation, i.e. writing restart or results --- src/C_routines.c | 10 +++ src/DAMASK_interface.f90 | 44 +++++++++++- src/system_routines.f90 | 148 +++++++++++++++++++-------------------- 3 files changed, 125 insertions(+), 77 deletions(-) diff --git a/src/C_routines.c b/src/C_routines.c index e3891765a..3dccb7644 100644 --- a/src/C_routines.c +++ b/src/C_routines.c @@ -6,9 +6,11 @@ #include #include #include +#include /* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */ + int isdirectory_c(const char *dir){ struct stat statbuf; if(stat(dir, &statbuf) != 0) /* error */ @@ -44,3 +46,11 @@ void gethostname_c(char hostname[], int *stat){ int chdir_c(const char *dir){ return chdir(dir); } + +void signalusr1_c(void (*handler)(int)){ + signal(SIGUSR1, handler); +} + +void signalusr2_c(void (*handler)(int)){ + signal(SIGUSR2, handler); +} \ No newline at end of file diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index a2b4f53f2..7a8e77f62 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -12,9 +12,9 @@ module DAMASK_interface use prec, only: & pInt - implicit none private + logical, public, protected :: SIGUSR1,SIGUSR2 integer(pInt), public, protected :: & interface_restartInc = 0_pInt !< Increment at which calculation starts character(len=1024), public, protected :: & @@ -42,6 +42,8 @@ contains subroutine DAMASK_interface_init() use, intrinsic :: & iso_fortran_env + use :: & + iso_c_binding #include #if defined(__GFORTRAN__) && __GNUC__ < 5 =================================================================================================== @@ -81,6 +83,8 @@ subroutine DAMASK_interface_init() use PETScSys use system_routines, only: & + signalusr1_C, & + signalusr2_C, & getHostName, & getCWD @@ -229,6 +233,12 @@ subroutine DAMASK_interface_init() if (interface_restartInc > 0_pInt) & write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc + call signalusr1_c(c_funloc(setSIGUSR1)) + call signalusr2_c(c_funloc(setSIGUSR2)) + SIGUSR1 = .false. + SIGUSR2 = .false. + + end subroutine DAMASK_interface_init @@ -412,6 +422,35 @@ character(len=1024) function makeRelativePath(a,b) end function makeRelativePath +!-------------------------------------------------------------------------------------------------- +!> @brief sets global variable SIGUSR1 to .true. if program receives SIGUSR1 +!-------------------------------------------------------------------------------------------------- +subroutine setSIGUSR1(signal) bind(C) + use :: iso_c_binding + + implicit none + integer(C_INT), value :: signal + SIGUSR1 = .true. + + write(6,*) 'received signal ',signal, 'set SIGUSR1' + +end subroutine setSIGUSR1 + + +!-------------------------------------------------------------------------------------------------- +!> @brief sets global variable SIGUSR2 to .true. if program receives SIGUSR2 +!-------------------------------------------------------------------------------------------------- +subroutine setSIGUSR2(signal) bind(C) + use :: iso_c_binding + + implicit none + integer(C_INT), value :: signal + SIGUSR2 = .true. + + write(6,*) 'received signal ',signal, 'set SIGUSR2' + +end subroutine setSIGUSR2 + !-------------------------------------------------------------------------------------------------- !> @brief taken from IO, check IO_stringValue for documentation @@ -469,11 +508,10 @@ pure function IIO_stringPos(string) do while (verify(string(right+1:),SEP)>0) left = right + verify(string(right+1:),SEP) right = left + scan(string(left:),SEP) - 2 - if ( string(left:left) == '#' ) exit IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)] IIO_stringPos(1) = IIO_stringPos(1)+1_pInt enddo end function IIO_stringPos -end module +end module \ No newline at end of file diff --git a/src/system_routines.f90 b/src/system_routines.f90 index bea777a3d..27f0cae34 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -3,11 +3,17 @@ !> @brief provides wrappers to C routines !-------------------------------------------------------------------------------------------------- module system_routines - + use, intrinsic :: ISO_C_Binding, only: & + C_INT, & + C_CHAR, & + C_NULL_CHAR + implicit none private public :: & + signalusr1_C, & + signalusr2_C, & isDirectory, & getCWD, & getHostName, & @@ -27,7 +33,7 @@ interface use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR - character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array + character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array integer(C_INT),intent(out) :: stat end subroutine getCurrentWorkDir_C @@ -35,7 +41,7 @@ interface use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR - character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array + character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array integer(C_INT),intent(out) :: stat end subroutine getHostName_C @@ -46,31 +52,38 @@ interface integer(C_INT) :: chdir_C character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array end function chdir_C + + subroutine signalusr1_C(handler) bind(C) + use, intrinsic :: ISO_C_Binding, only: & + C_FUNPTR + type(C_FUNPTR), intent(in), value :: handler + end subroutine signalusr1_C + + subroutine signalusr2_C(handler) bind(C) + use, intrinsic :: ISO_C_Binding, only: & + C_FUNPTR + type(C_FUNPTR), intent(in), value :: handler + end subroutine signalusr2_C end interface - contains !-------------------------------------------------------------------------------------------------- !> @brief figures out if a given path is a directory (and not an ordinary file) !-------------------------------------------------------------------------------------------------- logical function isDirectory(path) - use, intrinsic :: ISO_C_Binding, only: & - C_INT, & - C_CHAR, & - C_NULL_CHAR - implicit none - character(len=*), intent(in) :: path - character(kind=C_CHAR), dimension(1024) :: strFixedLength - integer :: i + implicit none + character(len=*), intent(in) :: path + character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string as array + integer :: i - strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) - do i=1,len(path) ! copy array components - strFixedLength(i)=path(i:i) - enddo - isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT) + strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) + do i=1,len(path) ! copy array components + strFixedLength(i)=path(i:i) + enddo + isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT) end function isDirectory @@ -79,29 +92,25 @@ end function isDirectory !> @brief gets the current working directory !-------------------------------------------------------------------------------------------------- character(len=1024) function getCWD() - use, intrinsic :: ISO_C_Binding, only: & - C_INT, & - C_CHAR, & - C_NULL_CHAR - implicit none - character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array - integer(C_INT) :: stat - integer :: i + implicit none + character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array + integer(C_INT) :: stat + integer :: i - call getCurrentWorkDir_C(charArray,stat) - if (stat /= 0_C_INT) then - getCWD = 'Error occured when getting currend working directory' - else - getCWD = repeat('',len(getCWD)) - arrayToString: do i=1,len(getCWD) - if (charArray(i) /= C_NULL_CHAR) then - getCWD(i:i)=charArray(i) - else - exit - endif - enddo arrayToString - endif + call getCurrentWorkDir_C(charArray,stat) + if (stat /= 0_C_INT) then + getCWD = 'Error occured when getting currend working directory' + else + getCWD = repeat('',len(getCWD)) + arrayToString: do i=1,len(getCWD) + if (charArray(i) /= C_NULL_CHAR) then + getCWD(i:i)=charArray(i) + else + exit + endif + enddo arrayToString + endif end function getCWD @@ -110,51 +119,42 @@ end function getCWD !> @brief gets the current host name !-------------------------------------------------------------------------------------------------- character(len=1024) function getHostName() - use, intrinsic :: ISO_C_Binding, only: & - C_INT, & - C_CHAR, & - C_NULL_CHAR + implicit none + character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array + integer(C_INT) :: stat + integer :: i - implicit none - character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array - integer(C_INT) :: stat - integer :: i - - call getHostName_C(charArray,stat) - if (stat /= 0_C_INT) then - getHostName = 'Error occured when getting host name' - else - getHostName = repeat('',len(getHostName)) - arrayToString: do i=1,len(getHostName) - if (charArray(i) /= C_NULL_CHAR) then - getHostName(i:i)=charArray(i) - else - exit - endif - enddo arrayToString - endif + call getHostName_C(charArray,stat) + if (stat /= 0_C_INT) then + getHostName = 'Error occured when getting host name' + else + getHostName = repeat('',len(getHostName)) + arrayToString: do i=1,len(getHostName) + if (charArray(i) /= C_NULL_CHAR) then + getHostName(i:i)=charArray(i) + else + exit + endif + enddo arrayToString + endif end function getHostName + !-------------------------------------------------------------------------------------------------- !> @brief changes the current working directory !-------------------------------------------------------------------------------------------------- logical function setCWD(path) - use, intrinsic :: ISO_C_Binding, only: & - C_INT, & - C_CHAR, & - C_NULL_CHAR + implicit none + character(len=*), intent(in) :: path + character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array + integer :: i - implicit none - character(len=*), intent(in) :: path - character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array - integer :: i - - strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) - do i=1,len(path) ! copy array components - strFixedLength(i)=path(i:i) - enddo - setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT) + strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) + do i=1,len(path) ! copy array components + strFixedLength(i)=path(i:i) + enddo + setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT) end function setCWD From 79b7ae1b3ef94a744089d226be8670775b39deb1 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 12 Feb 2019 01:12:16 +0100 Subject: [PATCH 084/154] [skip ci] updated version information after successful test of v2.0.2-1689-g1a471bcd --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f8fbcdee0..6e1ce244f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1687-gfa1c946d +v2.0.2-1689-g1a471bcd From 55cef533f1cba72a540a663bd6da838f0123db16 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 23:56:04 +0100 Subject: [PATCH 085/154] conversion 3x3-matrix <-> 6-vector not helpful --- src/constitutive.f90 | 6 +++--- src/kinematics_cleavage_opening.f90 | 19 ++++++++++--------- src/kinematics_slipplane_opening.f90 | 26 ++++++++++---------------- src/lattice.f90 | 11 +---------- src/source_damage_anisoBrittle.f90 | 16 +++++++++------- 5 files changed, 33 insertions(+), 45 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6c096ecd0..ef6004109 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -611,9 +611,9 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e KinematicsLoop: do k = 1_pInt, phase_Nkinematics(material_phase(ipc,ip,el)) kinematicsType: select case (phase_kinematics(k,material_phase(ipc,ip,el))) case (KINEMATICS_cleavage_opening_ID) kinematicsType - call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el) + call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6), ipc, ip, el) case (KINEMATICS_slipplane_opening_ID) kinematicsType - call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el) + call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6), ipc, ip, el) case (KINEMATICS_thermal_expansion_ID) kinematicsType call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el) case default kinematicsType @@ -901,7 +901,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac sourceType: select case (phase_source(s,material_phase(ipc,ip,el))) case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState (S6, ipc, ip, el) !< correct stress? + call source_damage_anisoBrittle_dotState (math_6toSym33(S6), ipc, ip, el) !< correct stress? case (SOURCE_damage_isoDuctile_ID) sourceType call source_damage_isoDuctile_dotState ( ipc, ip, el) diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 89d9dcd68..89c2f6ff0 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -113,10 +113,10 @@ subroutine kinematics_cleavage_opening_init() tempInt = config_phase(p)%getInts('ncleavage') kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt - tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredShape=shape(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_criticalload',requiredShape=shape(tempInt)) + 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) = & @@ -138,9 +138,11 @@ end subroutine kinematics_cleavage_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, ip, el) +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: & material_phase, & material_homog, & @@ -148,7 +150,6 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, damageMapping use lattice, only: & lattice_Scleavage, & - lattice_Scleavage_v, & lattice_maxNcleavageFamily, & lattice_NcleavageSystem @@ -157,8 +158,8 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, & !< grain number ip, & !< integration point number el !< element number - real(pReal), intent(in), dimension(6) :: & - Tstar_v !< 2nd Piola-Kirchhoff stress + 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) :: & @@ -181,9 +182,9 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, 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 - traction_d = dot_product(Tstar_v,lattice_Scleavage_v(1:6,1,index_myFamily+i,phase)) - traction_t = dot_product(Tstar_v,lattice_Scleavage_v(1:6,2,index_myFamily+i,phase)) - traction_n = dot_product(Tstar_v,lattice_Scleavage_v(1:6,3,index_myFamily+i,phase)) + 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 = & diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 573fe7d78..33714d573 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -113,10 +113,10 @@ subroutine kinematics_slipplane_opening_init() tempInt = config_phase(p)%getInts('ncleavage') kinematics_slipplane_opening_Nslip(1:size(tempInt),instance) = tempInt - tempFloat = config_phase(p)%getFloats('anisoductile_criticalplasticstrain',requiredShape=shape(tempInt)) + tempFloat = config_phase(p)%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(tempInt)) kinematics_slipplane_opening_critPlasticStrain(1:size(tempInt),instance) = tempFloat - tempFloat = config_phase(p)%getFloats('anisoductile_criticalload',requiredShape=shape(tempInt)) + tempFloat = config_phase(p)%getFloats('anisoductile_criticalload',requiredSize=size(tempInt)) kinematics_slipplane_opening_critLoad(1:size(tempInt),instance) = tempFloat kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance) = & @@ -136,9 +136,11 @@ end subroutine kinematics_slipplane_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, ip, el) +subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) use prec, only: & tol_math_check + use math, only: & + math_mul33xx33 use lattice, only: & lattice_maxNslipFamily, & lattice_NslipSystem, & @@ -151,9 +153,6 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, damage, & damageMapping use math, only: & - math_Plain3333to99, & - math_symmetric33, & - math_Mandel33to6, & math_tensorproduct33 implicit none @@ -161,16 +160,14 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, & !< grain number ip, & !< integration point number el !< element number - real(pReal), intent(in), dimension(6) :: & - Tstar_v !< 2nd Piola-Kirchhoff stress + 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) real(pReal), dimension(3,3) :: & projection_d, projection_t, projection_n !< projection modes 3x3 tensor - real(pReal), dimension(6) :: & - projection_d_v, projection_t_v, projection_n_v !< projection modes 3x3 vector integer(pInt) :: & instance, phase, & homog, damageOffset, & @@ -196,13 +193,10 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, projection_n = math_tensorproduct33(lattice_sn(1:3,index_myFamily+i,phase),& lattice_sn(1:3,index_myFamily+i,phase)) - projection_d_v(1:6) = math_Mandel33to6(math_symmetric33(projection_d(1:3,1:3))) - projection_t_v(1:6) = math_Mandel33to6(math_symmetric33(projection_t(1:3,1:3))) - projection_n_v(1:6) = math_Mandel33to6(math_symmetric33(projection_n(1:3,1:3))) - traction_d = dot_product(Tstar_v,projection_d_v(1:6)) - traction_t = dot_product(Tstar_v,projection_t_v(1:6)) - traction_n = dot_product(Tstar_v,projection_n_v(1:6)) + traction_d = math_mul33xx33(S,projection_d) + traction_t = math_mul33xx33(S,projection_t) + traction_n = math_mul33xx33(S,projection_n) traction_crit = kinematics_slipplane_opening_critLoad(f,instance)* & damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage diff --git a/src/lattice.f90 b/src/lattice.f90 index 9be30a5d3..410c14628 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -31,8 +31,7 @@ module lattice lattice_Scleavage !< Schmid matrices for cleavage systems real(pReal), allocatable, dimension(:,:,:,:), protected, public :: & - lattice_Sslip_v, & !< Mandel notation of lattice_Sslip - lattice_Scleavage_v !< Mandel notation of lattice_Scleavege + lattice_Sslip_v !< Mandel notation of lattice_Sslip real(pReal), allocatable, dimension(:,:,:), protected, public :: & lattice_sn, & !< normal direction of slip system @@ -776,7 +775,6 @@ subroutine lattice_init allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me allocate(lattice_Scleavage(3,3,3,lattice_maxNslip,Nphases),source=0.0_pReal) - allocate(lattice_Scleavage_v(6,3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt) allocate(CoverA(Nphases),source=0.0_pReal) @@ -1060,13 +1058,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA) enddo enddo - do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure - do j = 1_pInt,3_pInt - lattice_Scleavage_v(1:6,j,i,myPhase) = & - math_sym33to6(math_symmetric33(lattice_Scleavage(1:3,1:3,j,i,myPhase))) - enddo - enddo - end subroutine lattice_initializeStructure diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index b8bd3246d..eabf43799 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -309,7 +309,9 @@ end subroutine source_damage_anisoBrittle_init !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el) +subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) + use math, only: & + math_mul33xx33 use material, only: & phaseAt, phasememberAt, & sourceState, & @@ -317,7 +319,7 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el) damage, & damageMapping use lattice, only: & - lattice_Scleavage_v, & + lattice_Scleavage, & lattice_maxNcleavageFamily, & lattice_NcleavageSystem @@ -326,8 +328,8 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(6) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel) + real(pReal), intent(in), dimension(3,3) :: & + S integer(pInt) :: & phase, & constituent, & @@ -350,9 +352,9 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el) 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 - traction_d = dot_product(Tstar_v,lattice_Scleavage_v(1:6,1,index_myFamily+i,phase)) - traction_t = dot_product(Tstar_v,lattice_Scleavage_v(1:6,2,index_myFamily+i,phase)) - traction_n = dot_product(Tstar_v,lattice_Scleavage_v(1:6,3,index_myFamily+i,phase)) + 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 = source_damage_anisoBrittle_critLoad(f,instance)* & damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) From 9574dfae2d04957b655fd09172f7c40173efae20 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 06:28:29 +0100 Subject: [PATCH 086/154] avoiding repeated reading of material.config --- src/source_damage_anisoBrittle.f90 | 64 ++++++++++++++++++------------ src/source_damage_anisoDuctile.f90 | 55 ++++++++++++++----------- src/source_damage_isoBrittle.f90 | 54 ++++++++++++------------- src/source_damage_isoDuctile.f90 | 53 ++++++++++++------------- 4 files changed, 123 insertions(+), 103 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index eabf43799..fc2cade78 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -32,10 +32,7 @@ module source_damage_anisoBrittle source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoBrittle_aTol, & - source_damage_anisoBrittle_sdot_0, & - source_damage_anisoBrittle_N - + source_damage_anisoBrittle_sdot_0 real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_critDisp, & source_damage_anisoBrittle_critLoad @@ -85,6 +82,8 @@ subroutine source_damage_anisoBrittle_init(fileUnit) compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -127,10 +126,13 @@ subroutine source_damage_anisoBrittle_init(fileUnit) integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase,p - integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j + integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j + character(len=pStringLen) :: & + extmsg = '' character(len=65536) :: & tag = '', & line = '' + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoBrittle_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -163,12 +165,30 @@ subroutine source_damage_anisoBrittle_init(fileUnit) allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) allocate(source_damage_anisoBrittle_totalNcleavage(Ninstance), source=0_pInt) - allocate(source_damage_anisoBrittle_aTol(Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_sdot_0(Ninstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_N(Ninstance), source=0.0_pReal) + allocate(param(Ninstance)) + do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_damage_anisoBrittle_ID)) cycle + 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) + + end associate + enddo rewind(fileUnit) @@ -201,16 +221,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit) source_damage_anisoBrittle_output(source_damage_anisoBrittle_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - - case ('anisobrittle_atol') - source_damage_anisoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisobrittle_sdot0') source_damage_anisoBrittle_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('anisobrittle_ratesensitivity') - source_damage_anisoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('ncleavage') ! Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_CleavageFamilies @@ -240,16 +254,14 @@ subroutine source_damage_anisoBrittle_init(fileUnit) min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance)) source_damage_anisoBrittle_totalNcleavage(instance) = sum(source_damage_anisoBrittle_Ncleavage(:,instance)) ! how many cleavage systems altogether - if (source_damage_anisoBrittle_aTol(instance) < 0.0_pReal) & - source_damage_anisoBrittle_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 - if (source_damage_anisoBrittle_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//SOURCE_damage_anisoBrittle_LABEL//')') + + if (any(source_damage_anisoBrittle_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//SOURCE_damage_anisoBrittle_LABEL//')') if (any(source_damage_anisoBrittle_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//SOURCE_damage_anisoBrittle_LABEL//')') - if (source_damage_anisoBrittle_N(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//SOURCE_damage_anisoBrittle_LABEL//')') + + endif myPhase enddo sanityChecks @@ -284,7 +296,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoBrittle_sizePostResults(instance) allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=source_damage_anisoBrittle_aTol(instance)) + source=param(instance)%aTol) allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -350,8 +362,8 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 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,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family + 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 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)) @@ -361,9 +373,9 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & source_damage_anisoBrittle_sdot_0(instance)* & - ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance) + & - (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance) + & - (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance))/ & + ((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)/ & source_damage_anisoBrittle_critDisp(f,instance) enddo diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index c52dd4ff4..94d587166 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -31,15 +31,11 @@ module source_damage_anisoDuctile integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_Nslip !< number of slip systems per family - real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoDuctile_aTol - real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_critPlasticStrain real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoDuctile_sdot_0, & - source_damage_anisoDuctile_N + source_damage_anisoDuctile_sdot_0 real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_critLoad @@ -89,6 +85,8 @@ subroutine source_damage_anisoDuctile_init(fileUnit) compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -132,9 +130,12 @@ subroutine source_damage_anisoDuctile_init(fileUnit) integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase,p integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j + character(len=pStringLen) :: & + extmsg = '' character(len=65536) :: & tag = '', & line = '' + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoDuctile_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -166,13 +167,31 @@ subroutine source_damage_anisoDuctile_init(fileUnit) allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) - allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) - allocate(source_damage_anisoDuctile_N(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) allocate(source_damage_anisoDuctile_sdot_0(Ninstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_aTol(Ninstance), source=0.0_pReal) + allocate(param(Ninstance)) + do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_damage_anisoDuctile_ID)) cycle + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISODUCTILE_ID)) cycle + associate(prm => param(source_damage_anisoDuctile_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('anisoductile_atol',defaultVal = 1.0e-3_pReal) + + prm%N = config%getFloat('anisoductile_ratesensitivity') + prm%sdot_0 = config%getFloat('anisoductile_sdot0') + + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_ratesensitivity' + if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_sdot0' + + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) + + end associate + enddo rewind(fileUnit) @@ -205,9 +224,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) source_damage_anisoDuctile_output(source_damage_anisoDuctile_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - - case ('anisoductile_atol') - source_damage_anisoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('nslip') ! Nchunks_SlipFamilies = chunkPos(1) - 1_pInt @@ -222,9 +238,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) do j = 1_pInt, Nchunks_SlipFamilies source_damage_anisoDuctile_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo - - case ('anisoductile_ratesensitivity') - source_damage_anisoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisoductile_criticalload') do j = 1_pInt, Nchunks_SlipFamilies @@ -244,14 +257,10 @@ subroutine source_damage_anisoDuctile_init(fileUnit) min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance)) source_damage_anisoDuctile_totalNslip(instance) = sum(source_damage_anisoDuctile_Nslip(:,instance)) - if (source_damage_anisoDuctile_aTol(instance) < 0.0_pReal) & - source_damage_anisoDuctile_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 - if (source_damage_anisoDuctile_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//SOURCE_damage_anisoDuctile_LABEL//')') + if (any(source_damage_anisoDuctile_critPlasticStrain(:,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//SOURCE_damage_anisoDuctile_LABEL//')') - if (source_damage_anisoDuctile_N(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//SOURCE_damage_anisoDuctile_LABEL//')') + endif myPhase enddo sanityChecks @@ -286,7 +295,7 @@ subroutine source_damage_anisoDuctile_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoDuctile_sizePostResults(instance) allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=source_damage_anisoDuctile_aTol(instance)) + source=param(instance)%aTol) allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -349,7 +358,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & plasticState(phase)%slipRate(index,constituent)/ & - ((damage(homog)%p(damageOffset))**source_damage_anisoDuctile_N(instance))/ & + ((damage(homog)%p(damageOffset))**param(instance)%N)/ & source_damage_anisoDuctile_critPlasticStrain(f,instance) index = index + 1_pInt diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index cb62bc9f9..5e45b4e4c 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -26,8 +26,6 @@ module source_damage_isoBrittle source_damage_isoBrittle_Noutput !< number of outputs per instance of this damage real(pReal), dimension(:), allocatable, private :: & - source_damage_isoBrittle_aTol, & - source_damage_isoBrittle_N, & source_damage_isoBrittle_critStrainEnergy enum, bind(c) @@ -68,6 +66,8 @@ subroutine source_damage_isoBrittle_init(fileUnit) compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -107,6 +107,8 @@ subroutine source_damage_isoBrittle_init(fileUnit) integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase,p + character(len=pStringLen) :: & + extmsg = '' character(len=65536) :: & tag = '', & line = '' @@ -139,11 +141,27 @@ subroutine source_damage_isoBrittle_init(fileUnit) allocate(source_damage_isoBrittle_Noutput(Ninstance), source=0_pInt) allocate(source_damage_isoBrittle_critStrainEnergy(Ninstance), source=0.0_pReal) - allocate(source_damage_isoBrittle_N(Ninstance), source=1.0_pReal) - allocate(source_damage_isoBrittle_aTol(Ninstance), source=0.0_pReal) + allocate(param(Ninstance)) + do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_damage_isoBrittle_ID)) cycle + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISOBRITTLE_ID)) cycle + associate(prm => param(source_damage_isoBrittle_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('isobrittle_atol',defaultVal = 1.0e-3_pReal) + + prm%N = config%getFloat('isobrittle_n') + prm%critStrainEnergy = config%getFloat('isobrittle_criticalstrainenergy') + + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_n' + if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_criticalstrainenergy' + + end associate + enddo rewind(fileUnit) @@ -180,29 +198,11 @@ subroutine source_damage_isoBrittle_init(fileUnit) case ('isobrittle_criticalstrainenergy') source_damage_isoBrittle_critStrainEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('isobrittle_n') - source_damage_isoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('isobrittle_atol') - source_damage_isoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) - end select endif; endif enddo parsingFile -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then - instance = source_damage_isoBrittle_instance(phase) - if (source_damage_isoBrittle_aTol(instance) < 0.0_pReal) & - source_damage_isoBrittle_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 - if (source_damage_isoBrittle_critStrainEnergy(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='criticalStrainEnergy ('//SOURCE_damage_isoBrittle_LABEL//')') - endif myPhase - enddo sanityChecks - initializeInstances: do phase = 1_pInt, material_Nphase if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then NofMyPhase=count(material_phase==phase) @@ -231,7 +231,7 @@ subroutine source_damage_isoBrittle_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoBrittle_sizePostResults(instance) allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=source_damage_isoBrittle_aTol(instance)) + source=param(instance)%aTol) allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -330,10 +330,10 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) - localphiDot = (1.0_pReal - phi)**(source_damage_isoBrittle_N(instance) - 1.0_pReal) - & + localphiDot = (1.0_pReal - phi)**(param(instance)%N - 1.0_pReal) - & phi*sourceState(phase)%p(sourceOffset)%state(1,constituent) - dLocalphiDot_dPhi = - (source_damage_isoBrittle_N(instance) - 1.0_pReal)* & - (1.0_pReal - phi)**max(0.0_pReal,source_damage_isoBrittle_N(instance) - 2.0_pReal) & + dLocalphiDot_dPhi = - (param(instance)%N - 1.0_pReal)* & + (1.0_pReal - phi)**max(0.0_pReal,param(instance)%N - 2.0_pReal) & - sourceState(phase)%p(sourceOffset)%state(1,constituent) end subroutine source_damage_isoBrittle_getRateAndItsTangent diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index b4ecb53e4..182726fa3 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -26,9 +26,7 @@ module source_damage_isoDuctile source_damage_isoDuctile_Noutput !< number of outputs per instance of this damage real(pReal), dimension(:), allocatable, private :: & - source_damage_isoDuctile_aTol, & - source_damage_isoDuctile_critPlasticStrain, & - source_damage_isoDuctile_N + source_damage_isoDuctile_critPlasticStrain enum, bind(c) enumerator :: undefined_ID, & @@ -68,6 +66,8 @@ subroutine source_damage_isoDuctile_init(fileUnit) compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -108,6 +108,8 @@ subroutine source_damage_isoDuctile_init(fileUnit) integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase,p + character(len=pStringLen) :: & + extmsg = '' character(len=65536) :: & tag = '', & line = '' @@ -140,11 +142,27 @@ subroutine source_damage_isoDuctile_init(fileUnit) allocate(source_damage_isoDuctile_Noutput(Ninstance), source=0_pInt) allocate(source_damage_isoDuctile_critPlasticStrain(Ninstance), source=0.0_pReal) - allocate(source_damage_isoDuctile_N(Ninstance), source=0.0_pReal) - allocate(source_damage_isoDuctile_aTol(Ninstance), source=0.0_pReal) + allocate(param(Ninstance)) + do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_damage_isoDuctile_ID)) cycle + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISODUCTILE_ID)) cycle + associate(prm => param(source_damage_isoDuctile_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('isoductile_atol',defaultVal = 1.0e-3_pReal) + + prm%N = config%getFloat('isoductile_ratesensitivity') + prm%critPlasticStrain = config%getFloat('isoductile_criticalplasticstrain') + + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' isoductile_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_ratesensitivity' + if (prm%critPlasticStrain <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_criticalplasticstrain' + + end associate + enddo rewind(fileUnit) @@ -181,29 +199,10 @@ subroutine source_damage_isoDuctile_init(fileUnit) case ('isoductile_criticalplasticstrain') source_damage_isoDuctile_critPlasticStrain(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('isoductile_ratesensitivity') - source_damage_isoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('isoductile_atol') - source_damage_isoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) - end select endif; endif enddo parsingFile - -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then - instance = source_damage_isoDuctile_instance(phase) - if (source_damage_isoDuctile_aTol(instance) < 0.0_pReal) & - source_damage_isoDuctile_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 - if (source_damage_isoDuctile_critPlasticStrain(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='critical plastic strain ('//SOURCE_damage_isoDuctile_LABEL//')') - endif myPhase - enddo sanityChecks - initializeInstances: do phase = 1_pInt, material_Nphase if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then NofMyPhase=count(material_phase==phase) @@ -232,7 +231,7 @@ subroutine source_damage_isoDuctile_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoDuctile_sizePostResults(instance) allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=source_damage_isoDuctile_aTol(instance)) + source=param(instance)%aTol) allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -283,7 +282,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sum(plasticState(phase)%slipRate(:,constituent))/ & - ((damage(homog)%p(damageOffset))**source_damage_isoDuctile_N(instance))/ & + ((damage(homog)%p(damageOffset))**param(instance)%N)/ & source_damage_isoDuctile_critPlasticStrain(instance) end subroutine source_damage_isoDuctile_dotState From 61baa66c385f6340eb0437bd67e0fb8901fd9576 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:22:37 +0100 Subject: [PATCH 087/154] avoid code duplication --- src/material.f90 | 42 ++++++++++++++++++++++++++++++ src/source_damage_anisoBrittle.f90 | 28 +++----------------- src/source_damage_anisoDuctile.f90 | 28 +++----------------- src/source_damage_isoBrittle.f90 | 29 +++------------------ src/source_damage_isoDuctile.f90 | 31 ++++------------------ 5 files changed, 57 insertions(+), 101 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 3ae6c16a4..76753273c 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -235,6 +235,7 @@ module material public :: & material_init, & material_allocatePlasticState, & + material_allocateSourceState, & ELASTICITY_hooke_ID ,& PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & @@ -966,6 +967,47 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,& end subroutine material_allocatePlasticState +!-------------------------------------------------------------------------------------------------- +!> @brief allocates the source state of a phase +!-------------------------------------------------------------------------------------------------- +subroutine material_allocateSourceState(phase,of,NofMyPhase,sizeState) + use numerics, only: & + numerics_integrator2 => numerics_integrator ! compatibility hack + + implicit none + integer(pInt), intent(in) :: & + phase, & + of, & + NofMyPhase, & + sizeState + integer(pInt) :: numerics_integrator ! compatibility hack + numerics_integrator = numerics_integrator2(1) ! compatibility hack + + sourceState(phase)%p(of)%sizeState = sizeState + sourceState(phase)%p(of)%sizeDotState = sizeState + sourceState(phase)%p(of)%sizeDeltaState = 0_pInt + + allocate(sourceState(phase)%p(of)%aTolState (sizeState), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(of)%dotState (sizeState,NofMyPhase), source=0.0_pReal) + if (numerics_integrator == 1_pInt) then + allocate(sourceState(phase)%p(of)%previousDotState (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%previousDotState2 (sizeState,NofMyPhase), source=0.0_pReal) + endif + if (numerics_integrator == 4_pInt) & + allocate(sourceState(phase)%p(of)%RK4dotState (sizeState,NofMyPhase), source=0.0_pReal) + if (numerics_integrator == 5_pInt) & + allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeState,NofMyPhase), source=0.0_pReal) + + allocate(plasticState(phase)%deltaState (0,NofMyPhase), source=0.0_pReal) + +end subroutine material_allocateSourceState + + !-------------------------------------------------------------------------------------------------- !> @brief populates the grains !> @details populates the grains by identifying active microstructure/homogenization pairs, diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index fc2cade78..06e7480eb 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -102,6 +102,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) IO_timeStamp, & IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -285,33 +286,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit) endif enddo outputsLoop -!-------------------------------------------------------------------------------------------------- -! Determine size of state array - sizeDotState = 1_pInt - sizeDeltaState = 0_pInt - sizeState = 1_pInt - - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoBrittle_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=param(instance)%aTol) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) endif diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 94d587166..d2a4e8aa1 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -105,6 +105,7 @@ subroutine source_damage_anisoDuctile_init(fileUnit) IO_timeStamp, & IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -285,32 +286,9 @@ subroutine source_damage_anisoDuctile_init(fileUnit) endif enddo outputsLoop -!-------------------------------------------------------------------------------------------------- -! Determine size of state array - sizeDotState = 1_pInt - sizeDeltaState = 0_pInt - sizeState = 1_pInt - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoDuctile_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=param(instance)%aTol) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol endif diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 5e45b4e4c..7b9f76009 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -86,6 +86,7 @@ subroutine source_damage_isoBrittle_init(fileUnit) IO_timeStamp, & IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -221,32 +222,10 @@ subroutine source_damage_isoBrittle_init(fileUnit) source_damage_isoBrittle_sizePostResults(instance) = source_damage_isoBrittle_sizePostResults(instance) + mySize endif enddo outputsLoop -! Determine size of state array - sizeDotState = 1_pInt - sizeDeltaState = 1_pInt - sizeState = 1_pInt - - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoBrittle_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=param(instance)%aTol) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol endif diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 182726fa3..3613a29a9 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -86,6 +86,7 @@ subroutine source_damage_isoDuctile_init(fileUnit) IO_timeStamp, & IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -221,33 +222,11 @@ subroutine source_damage_isoDuctile_init(fileUnit) source_damage_isoDuctile_sizePostResults(instance) = source_damage_isoDuctile_sizePostResults(instance) + mySize endif enddo outputsLoop -! Determine size of state array - sizeDotState = 1_pInt - sizeDeltaState = 0_pInt - sizeState = 1_pInt - - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoDuctile_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=param(instance)%aTol) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) - + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + endif enddo initializeInstances From 6a0d739d48ec72150c2f1854ee71b4dc85b0a456 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:24:48 +0100 Subject: [PATCH 088/154] use parameters from param structure --- src/source_damage_isoBrittle.f90 | 10 +--------- src/source_damage_isoDuctile.f90 | 9 +-------- 2 files changed, 2 insertions(+), 17 deletions(-) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 7b9f76009..20dc6eaa3 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -25,9 +25,6 @@ module source_damage_isoBrittle integer(pInt), dimension(:), allocatable, target, public :: & source_damage_isoBrittle_Noutput !< number of outputs per instance of this damage - real(pReal), dimension(:), allocatable, private :: & - source_damage_isoBrittle_critStrainEnergy - enum, bind(c) enumerator :: undefined_ID, & damage_drivingforce_ID @@ -141,8 +138,6 @@ subroutine source_damage_isoBrittle_init(fileUnit) allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) allocate(source_damage_isoBrittle_Noutput(Ninstance), source=0_pInt) - allocate(source_damage_isoBrittle_critStrainEnergy(Ninstance), source=0.0_pReal) - allocate(param(Ninstance)) do p=1, size(config_phase) @@ -196,9 +191,6 @@ subroutine source_damage_isoBrittle_init(fileUnit) IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - case ('isobrittle_criticalstrainenergy') - source_damage_isoBrittle_critStrainEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) - end select endif; endif enddo parsingFile @@ -275,7 +267,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) strain = 0.5_pReal*math_Mandel33to6(math_mul33x33(math_transpose33(Fe),Fe)-math_I3) strainenergy = 2.0_pReal*sum(strain*math_mul66x6(stiffness,strain))/ & - source_damage_isoBrittle_critStrainEnergy(instance) + param(instances)%critStrainEnergy if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 3613a29a9..7186f8749 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -25,8 +25,6 @@ module source_damage_isoDuctile integer(pInt), dimension(:), allocatable, target, public :: & source_damage_isoDuctile_Noutput !< number of outputs per instance of this damage - real(pReal), dimension(:), allocatable, private :: & - source_damage_isoDuctile_critPlasticStrain enum, bind(c) enumerator :: undefined_ID, & @@ -142,8 +140,6 @@ subroutine source_damage_isoDuctile_init(fileUnit) allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) allocate(source_damage_isoDuctile_Noutput(Ninstance), source=0_pInt) - allocate(source_damage_isoDuctile_critPlasticStrain(Ninstance), source=0.0_pReal) - allocate(param(Ninstance)) do p=1, size(config_phase) @@ -197,9 +193,6 @@ subroutine source_damage_isoDuctile_init(fileUnit) IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - case ('isoductile_criticalplasticstrain') - source_damage_isoDuctile_critPlasticStrain(instance) = IO_floatValue(line,chunkPos,2_pInt) - end select endif; endif enddo parsingFile @@ -262,7 +255,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sum(plasticState(phase)%slipRate(:,constituent))/ & ((damage(homog)%p(damageOffset))**param(instance)%N)/ & - source_damage_isoDuctile_critPlasticStrain(instance) + param(instance)%critPlasticStrain end subroutine source_damage_isoDuctile_dotState From aa8d218ce757a0c0b3776f11c6503dc2be3fae42 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:28:28 +0100 Subject: [PATCH 089/154] was never used --- src/source_damage_anisoDuctile.f90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index d2a4e8aa1..7abc751d6 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -34,9 +34,6 @@ module source_damage_anisoDuctile real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_critPlasticStrain - real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoDuctile_sdot_0 - real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_critLoad @@ -52,7 +49,6 @@ module source_damage_anisoDuctile type, private :: tParameters !< container type for internal constitutive parameters real(pReal) :: & aTol, & - sdot_0, & N real(pReal), dimension(:), allocatable :: & critPlasticStrain, & @@ -169,7 +165,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) - allocate(source_damage_anisoDuctile_sdot_0(Ninstance), source=0.0_pReal) allocate(param(Ninstance)) @@ -181,13 +176,11 @@ subroutine source_damage_anisoDuctile_init(fileUnit) prm%aTol = config%getFloat('anisoductile_atol',defaultVal = 1.0e-3_pReal) prm%N = config%getFloat('anisoductile_ratesensitivity') - prm%sdot_0 = config%getFloat('anisoductile_sdot0') ! sanity checks if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_atol' if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_ratesensitivity' - if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_sdot0' prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) @@ -231,9 +224,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) do j = 1_pInt, Nchunks_SlipFamilies source_damage_anisoDuctile_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo - - case ('anisoductile_sdot0') - source_damage_anisoDuctile_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisoductile_criticalplasticstrain') do j = 1_pInt, Nchunks_SlipFamilies From b3e705e628dacf4c37fa7ea027815c6dda9ef963 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:34:16 +0100 Subject: [PATCH 090/154] polishing, fixed typo --- src/source_damage_isoBrittle.f90 | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 20dc6eaa3..3a2481639 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -235,10 +235,9 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) phase_NstiffnessDegradations, & phase_stiffnessDegradation use math, only : & + math_sym33to6, & math_mul33x33, & math_mul66x6, & - math_Mandel33to6, & - math_transpose33, & math_I3 implicit none @@ -254,7 +253,6 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) phase, constituent, instance, sourceOffset, mech real(pReal) :: & strain(6), & - stiffness(6,6), & strainenergy phase = phaseAt(ipc,ip,el) !< phase ID at ipc,ip,el @@ -263,11 +261,11 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source sourceOffset = source_damage_isoBrittle_offset(phase) - stiffness = C - strain = 0.5_pReal*math_Mandel33to6(math_mul33x33(math_transpose33(Fe),Fe)-math_I3) + + strain = 0.5_pReal*math_sym33to6(math_mul33x33(transpose(Fe),Fe)-math_I3) - strainenergy = 2.0_pReal*sum(strain*math_mul66x6(stiffness,strain))/ & - param(instances)%critStrainEnergy + strainenergy = 2.0_pReal*sum(strain*math_mul66x6(C,strain))/ & + param(instance)%critStrainEnergy if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) From f34c10a477faaf4686d9c2256ff8437988a53946 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:36:36 +0100 Subject: [PATCH 091/154] sdot_0 already available as parameter --- src/source_damage_anisoBrittle.f90 | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 06e7480eb..a8f9de6f6 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -31,8 +31,6 @@ module source_damage_anisoBrittle integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family - real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoBrittle_sdot_0 real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_critDisp, & source_damage_anisoBrittle_critLoad @@ -166,7 +164,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) allocate(source_damage_anisoBrittle_totalNcleavage(Ninstance), source=0_pInt) - allocate(source_damage_anisoBrittle_sdot_0(Ninstance), source=0.0_pReal) allocate(param(Ninstance)) @@ -223,9 +220,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - case ('anisobrittle_sdot0') - source_damage_anisoBrittle_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('ncleavage') ! Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_CleavageFamilies @@ -350,7 +344,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & - source_damage_anisoBrittle_sdot_0(instance)* & + 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)/ & From a421525d15b843331f8e84947fdc5e63baf975bb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 08:06:22 +0100 Subject: [PATCH 092/154] preparing storage of output parameters --- src/source_damage_anisoBrittle.f90 | 37 ++++++++++++++++++++++------ src/source_damage_anisoDuctile.f90 | 39 ++++++++++++++++++++++++------ src/source_damage_isoBrittle.f90 | 37 ++++++++++++++++++++++------ src/source_damage_isoDuctile.f90 | 38 +++++++++++++++++++++++------ 4 files changed, 121 insertions(+), 30 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index a8f9de6f6..d9ec6f34c 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -56,6 +56,8 @@ module source_damage_anisoBrittle totalNcleavage integer(pInt), 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) @@ -112,8 +114,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - numerics_integrator use lattice, only: & lattice_maxNcleavageFamily, & lattice_NcleavageSystem @@ -123,17 +123,22 @@ subroutine source_damage_anisoBrittle_init(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,p + integer(pInt) :: NofMyPhase,p ,i integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j - character(len=pStringLen) :: & - extmsg = '' character(len=65536) :: & tag = '', & line = '' integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoBrittle_LABEL//' init -+>>>' + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -185,6 +190,24 @@ subroutine source_damage_anisoBrittle_init(fileUnit) prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray) +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,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) + outputID = undefined_ID + select case(outputs(i)) + case ('anisobrittle_drivingforce') + + end select + + enddo + end associate enddo diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 7abc751d6..925588594 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -57,6 +57,8 @@ module source_damage_anisoDuctile totalNslip integer(pInt), dimension(:), allocatable :: & Nslip + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID end type tParameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -113,8 +115,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - numerics_integrator use lattice, only: & lattice_maxNslipFamily, & lattice_NslipSystem @@ -124,17 +124,22 @@ subroutine source_damage_anisoDuctile_init(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,p - integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j - character(len=pStringLen) :: & - extmsg = '' + integer(pInt) :: NofMyPhase,p ,i + integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j character(len=65536) :: & tag = '', & line = '' integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoDuctile_LABEL//' init -+>>>' + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -184,6 +189,24 @@ subroutine source_damage_anisoDuctile_init(fileUnit) prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,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) + outputID = undefined_ID + select case(outputs(i)) + case ('anisoductile_drivingforce') + + end select + + enddo + end associate enddo diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 3a2481639..e09d79056 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -39,6 +39,8 @@ module source_damage_isoBrittle critStrainEnergy, & N, & aTol + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID end type tParameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -95,23 +97,26 @@ subroutine source_damage_isoBrittle_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - numerics_integrator implicit none integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,p - character(len=pStringLen) :: & - extmsg = '' + integer(pInt) :: NofMyPhase,p,i character(len=65536) :: & tag = '', & line = '' + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoBrittle_label//' init -+>>>' + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -156,6 +161,24 @@ subroutine source_damage_isoBrittle_init(fileUnit) if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_n' if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_criticalstrainenergy' +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,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) + outputID = undefined_ID + select case(outputs(i)) + case ('isobrittle_drivingforce') + + end select + + enddo + end associate enddo diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 7186f8749..3b4b06727 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -40,6 +40,8 @@ module source_damage_isoDuctile critPlasticStrain, & N, & aTol + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID end type tParameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -96,24 +98,26 @@ subroutine source_damage_isoDuctile_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - - use numerics,only: & - numerics_integrator implicit none integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,p - character(len=pStringLen) :: & - extmsg = '' + integer(pInt) :: NofMyPhase,p,i character(len=65536) :: & tag = '', & line = '' + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoDuctile_label//' init -+>>>' + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -157,6 +161,24 @@ subroutine source_damage_isoDuctile_init(fileUnit) if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_ratesensitivity' if (prm%critPlasticStrain <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_criticalplasticstrain' + +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,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) + outputID = undefined_ID + select case(outputs(i)) + case ('isoductile_drivingforce') + + end select + + enddo end associate From 3ca34c8f805b5021fcae20f61917ca9d13a4721d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 09:05:07 +0100 Subject: [PATCH 093/154] simplified --- src/constitutive.f90 | 4 +- src/source_damage_anisoBrittle.f90 | 82 +++++---------------- src/source_damage_anisoDuctile.f90 | 76 +++++-------------- src/source_damage_isoBrittle.f90 | 114 ++++++----------------------- src/source_damage_isoDuctile.f90 | 112 +++++----------------------- 5 files changed, 81 insertions(+), 307 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ef6004109..66f0cab2f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -163,8 +163,8 @@ subroutine constitutive_init() call IO_checkAndRewind(FILEUNIT) if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init(FILEUNIT) if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(FILEUNIT) - if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init(FILEUNIT) - if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init(FILEUNIT) + if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init + if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init(FILEUNIT) if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init(FILEUNIT) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index d9ec6f34c..c380e9790 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -12,7 +12,6 @@ module source_damage_anisoBrittle implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - source_damage_anisoBrittle_sizePostResults, & !< cumulative size of post results source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? source_damage_anisoBrittle_instance !< instance of source mechanism @@ -22,12 +21,6 @@ module source_damage_anisoBrittle character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_anisoBrittle_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & - source_damage_anisoBrittle_Noutput !< number of outputs per instance of this source - - integer(pInt), dimension(:), allocatable, private :: & - source_damage_anisoBrittle_totalNcleavage !< total number of cleavage systems - integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family @@ -39,9 +32,6 @@ module source_damage_anisoBrittle enumerator :: undefined_ID, & damage_drivingforce_ID end enum - - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - source_damage_anisoBrittle_outputID !< ID of each post result output type, private :: tParameters !< container type for internal constitutive parameters @@ -157,18 +147,14 @@ subroutine source_damage_anisoBrittle_init(fileUnit) source_damage_anisoBrittle_offset(phase) = source enddo enddo - - allocate(source_damage_anisoBrittle_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0_pInt) allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) - allocate(source_damage_anisoBrittle_Noutput(Ninstance), source=0_pInt) allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) - allocate(source_damage_anisoBrittle_totalNcleavage(Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -202,7 +188,11 @@ subroutine source_damage_anisoBrittle_init(fileUnit) do i=1_pInt, 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_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] end select @@ -210,6 +200,16 @@ subroutine source_damage_anisoBrittle_init(fileUnit) 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_pInt) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + enddo rewind(fileUnit) @@ -234,15 +234,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('anisobrittle_drivingforce') - source_damage_anisoBrittle_Noutput(instance) = source_damage_anisoBrittle_Noutput(instance) + 1_pInt - source_damage_anisoBrittle_outputID(source_damage_anisoBrittle_Noutput(instance),instance) = damage_drivingforce_ID - source_damage_anisoBrittle_output(source_damage_anisoBrittle_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - + case ('ncleavage') ! Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_CleavageFamilies @@ -268,11 +260,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) sanityChecks: do phase = 1_pInt, material_Nphase myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then instance = source_damage_anisoBrittle_instance(phase) - source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & - min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested - source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance)) - source_damage_anisoBrittle_totalNcleavage(instance) = sum(source_damage_anisoBrittle_Ncleavage(:,instance)) ! how many cleavage systems altogether - if (any(source_damage_anisoBrittle_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//SOURCE_damage_anisoBrittle_LABEL//')') @@ -283,34 +270,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) endif myPhase enddo sanityChecks - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_damage_anisoBrittle_instance(phase) - sourceOffset = source_damage_anisoBrittle_offset(phase) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,source_damage_anisoBrittle_Noutput(instance) - select case(source_damage_anisoBrittle_outputID(o,instance)) - case(damage_drivingforce_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - source_damage_anisoBrittle_sizePostResult(o,instance) = mySize - source_damage_anisoBrittle_sizePostResults(instance) = source_damage_anisoBrittle_sizePostResults(instance) + mySize - endif - enddo outputsLoop - - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) - sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoBrittle_sizePostResults(instance) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - - - endif - - enddo initializeInstances end subroutine source_damage_anisoBrittle_init !-------------------------------------------------------------------------------------------------- @@ -417,8 +376,8 @@ function source_damage_anisoBrittle_postResults(phase, constituent) integer(pInt), intent(in) :: & phase, & constituent - real(pReal), dimension(source_damage_anisoBrittle_sizePostResults( & - source_damage_anisoBrittle_instance(phase))) :: & + real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, & + source_damage_anisoBrittle_instance(phase)))) :: & source_damage_anisoBrittle_postResults integer(pInt) :: & @@ -428,10 +387,9 @@ function source_damage_anisoBrittle_postResults(phase, constituent) sourceOffset = source_damage_anisoBrittle_offset(phase) c = 0_pInt - source_damage_anisoBrittle_postResults = 0.0_pReal - do o = 1_pInt,source_damage_anisoBrittle_Noutput(instance) - select case(source_damage_anisoBrittle_outputID(o,instance)) + do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) source_damage_anisoBrittle_postResults(c+1_pInt) = & sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 925588594..46898ecf5 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -12,7 +12,6 @@ module source_damage_anisoDuctile implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - source_damage_anisoDuctile_sizePostResults, & !< cumulative size of post results source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? source_damage_anisoDuctile_instance !< instance of damage source mechanism @@ -22,11 +21,6 @@ module source_damage_anisoDuctile character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_anisoDuctile_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & - source_damage_anisoDuctile_Noutput !< number of outputs per instance of this damage - - integer(pInt), dimension(:), allocatable, private :: & - source_damage_anisoDuctile_totalNslip !< total number of slip systems integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_Nslip !< number of slip systems per family @@ -41,9 +35,6 @@ module source_damage_anisoDuctile enumerator :: undefined_ID, & damage_drivingforce_ID end enum - - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - source_damage_anisoDuctile_outputID !< ID of each post result output type, private :: tParameters !< container type for internal constitutive parameters @@ -159,17 +150,13 @@ subroutine source_damage_anisoDuctile_init(fileUnit) enddo enddo - allocate(source_damage_anisoDuctile_sizePostResults(Ninstance), source=0_pInt) allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoDuctile_output = '' - allocate(source_damage_anisoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) - allocate(source_damage_anisoDuctile_Noutput(Ninstance), source=0_pInt) allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) - allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -201,7 +188,11 @@ subroutine source_damage_anisoDuctile_init(fileUnit) do i=1_pInt, 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_output(i,source_damage_anisoDuctile_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] end select @@ -209,6 +200,16 @@ subroutine source_damage_anisoDuctile_init(fileUnit) end associate + phase = p + + NofMyPhase=count(material_phase==phase) + instance = source_damage_anisoDuctile_instance(phase) + sourceOffset = source_damage_anisoDuctile_offset(phase) + + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + enddo rewind(fileUnit) @@ -233,14 +234,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('anisoductile_drivingforce') - source_damage_anisoDuctile_Noutput(instance) = source_damage_anisoDuctile_Noutput(instance) + 1_pInt - source_damage_anisoDuctile_outputID(source_damage_anisoDuctile_Noutput(instance),instance) = damage_drivingforce_ID - source_damage_anisoDuctile_output(source_damage_anisoDuctile_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select case ('nslip') ! Nchunks_SlipFamilies = chunkPos(1) - 1_pInt @@ -267,10 +260,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) sanityChecks: do phase = 1_pInt, size(phase_source) myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then instance = source_damage_anisoDuctile_instance(phase) - source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested - source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance)) - source_damage_anisoDuctile_totalNslip(instance) = sum(source_damage_anisoDuctile_Nslip(:,instance)) if (any(source_damage_anisoDuctile_critPlasticStrain(:,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//SOURCE_damage_anisoDuctile_LABEL//')') @@ -278,34 +267,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) endif myPhase enddo sanityChecks - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_damage_anisoDuctile_instance(phase) - sourceOffset = source_damage_anisoDuctile_offset(phase) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,source_damage_anisoDuctile_Noutput(instance) - select case(source_damage_anisoDuctile_outputID(o,instance)) - case(damage_drivingforce_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - source_damage_anisoDuctile_sizePostResult(o,instance) = mySize - source_damage_anisoDuctile_sizePostResults(instance) = source_damage_anisoDuctile_sizePostResults(instance) + mySize - endif - enddo outputsLoop - - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) - sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoDuctile_sizePostResults(instance) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - - endif - - enddo initializeInstances end subroutine source_damage_anisoDuctile_init !-------------------------------------------------------------------------------------------------- @@ -398,8 +359,8 @@ function source_damage_anisoDuctile_postResults(phase, constituent) integer(pInt), intent(in) :: & phase, & constituent - real(pReal), dimension(source_damage_anisoDuctile_sizePostResults( & - source_damage_anisoDuctile_instance(phase))) :: & + real(pReal), dimension(sum(source_damage_anisoDuctile_sizePostResult(:, & + source_damage_anisoDuctile_instance(phase)))) :: & source_damage_anisoDuctile_postResults integer(pInt) :: & @@ -409,10 +370,9 @@ function source_damage_anisoDuctile_postResults(phase, constituent) sourceOffset = source_damage_anisoDuctile_offset(phase) c = 0_pInt - source_damage_anisoDuctile_postResults = 0.0_pReal - do o = 1_pInt,source_damage_anisoDuctile_Noutput(instance) - select case(source_damage_anisoDuctile_outputID(o,instance)) + do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) source_damage_anisoDuctile_postResults(c+1_pInt) = & sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index e09d79056..702ce8833 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -12,7 +12,6 @@ module source_damage_isoBrittle implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - source_damage_isoBrittle_sizePostResults, & !< cumulative size of post results source_damage_isoBrittle_offset, & !< which source is my current damage mechanism? source_damage_isoBrittle_instance !< instance of damage source mechanism @@ -21,17 +20,11 @@ module source_damage_isoBrittle character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_isoBrittle_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - source_damage_isoBrittle_Noutput !< number of outputs per instance of this damage enum, bind(c) enumerator :: undefined_ID, & damage_drivingforce_ID end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo - - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - source_damage_isoBrittle_outputID !< ID of each post result output type, private :: tParameters !< container type for internal constitutive parameters @@ -59,7 +52,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoBrittle_init(fileUnit) +subroutine source_damage_isoBrittle_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -72,14 +65,6 @@ subroutine source_damage_isoBrittle_init(fileUnit) debug_constitutive,& debug_levelBasic use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & IO_timeStamp, & @@ -99,14 +84,9 @@ subroutine source_damage_isoBrittle_init(fileUnit) MATERIAL_partPhase implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset,o integer(pInt) :: NofMyPhase,p,i - character(len=65536) :: & - tag = '', & - line = '' character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -136,12 +116,9 @@ subroutine source_damage_isoBrittle_init(fileUnit) enddo enddo - allocate(source_damage_isoBrittle_sizePostResults(Ninstance), source=0_pInt) allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_isoBrittle_output = '' - allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) - allocate(source_damage_isoBrittle_Noutput(Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -173,78 +150,30 @@ subroutine source_damage_isoBrittle_init(fileUnit) do i=1_pInt, 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_output(i,source_damage_isoBrittle_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] + end select enddo end associate - enddo - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = source_damage_isoBrittle_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('isobrittle_drivingforce') - source_damage_isoBrittle_Noutput(instance) = source_damage_isoBrittle_Noutput(instance) + 1_pInt - source_damage_isoBrittle_outputID(source_damage_isoBrittle_Noutput(instance),instance) = damage_drivingforce_ID - source_damage_isoBrittle_output(source_damage_isoBrittle_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingFile - - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_damage_isoBrittle_instance(phase) - sourceOffset = source_damage_isoBrittle_offset(phase) -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,source_damage_isoBrittle_Noutput(instance) - select case(source_damage_isoBrittle_outputID(o,instance)) - case(damage_drivingforce_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - source_damage_isoBrittle_sizePostResult(o,instance) = mySize - source_damage_isoBrittle_sizePostResults(instance) = source_damage_isoBrittle_sizePostResults(instance) + mySize - endif - enddo outputsLoop + phase = p + + NofMyPhase=count(material_phase==phase) + instance = source_damage_isoBrittle_instance(phase) + sourceOffset = source_damage_isoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) - sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoBrittle_sizePostResults(instance) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - - endif + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + + enddo - enddo initializeInstances end subroutine source_damage_isoBrittle_init !-------------------------------------------------------------------------------------------------- @@ -341,8 +270,8 @@ function source_damage_isoBrittle_postResults(phase, constituent) integer(pInt), intent(in) :: & phase, & constituent - real(pReal), dimension(source_damage_isoBrittle_sizePostResults( & - source_damage_isoBrittle_instance(phase))) :: & + real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, & + source_damage_isoBrittle_instance(phase)))) :: & source_damage_isoBrittle_postResults integer(pInt) :: & @@ -352,10 +281,9 @@ function source_damage_isoBrittle_postResults(phase, constituent) sourceOffset = source_damage_isoBrittle_offset(phase) c = 0_pInt - source_damage_isoBrittle_postResults = 0.0_pReal - do o = 1_pInt,source_damage_isoBrittle_Noutput(instance) - select case(source_damage_isoBrittle_outputID(o,instance)) + do o = 1_pInt,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) c = c + 1 diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 3b4b06727..4c01f1d9a 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -12,7 +12,6 @@ module source_damage_isoDuctile implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - source_damage_isoDuctile_sizePostResults, & !< cumulative size of post results source_damage_isoDuctile_offset, & !< which source is my current damage mechanism? source_damage_isoDuctile_instance !< instance of damage source mechanism @@ -21,19 +20,12 @@ module source_damage_isoDuctile character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_isoDuctile_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - source_damage_isoDuctile_Noutput !< number of outputs per instance of this damage enum, bind(c) enumerator :: undefined_ID, & damage_drivingforce_ID end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo - - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - source_damage_isoDuctile_outputID !< ID of each post result output - type, private :: tParameters !< container type for internal constitutive parameters real(pReal) :: & @@ -60,7 +52,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoDuctile_init(fileUnit) +subroutine source_damage_isoDuctile_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -73,14 +65,6 @@ subroutine source_damage_isoDuctile_init(fileUnit) debug_constitutive,& debug_levelBasic use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & IO_timeStamp, & @@ -100,14 +84,9 @@ subroutine source_damage_isoDuctile_init(fileUnit) MATERIAL_partPhase implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset,o integer(pInt) :: NofMyPhase,p,i - character(len=65536) :: & - tag = '', & - line = '' character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -137,12 +116,9 @@ subroutine source_damage_isoDuctile_init(fileUnit) enddo enddo - allocate(source_damage_isoDuctile_sizePostResults(Ninstance), source=0_pInt) allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_isoDuctile_output = '' - allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) - allocate(source_damage_isoDuctile_Noutput(Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -174,77 +150,30 @@ subroutine source_damage_isoDuctile_init(fileUnit) do i=1_pInt, 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_output(i,source_damage_isoDuctile_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] + end select enddo end associate - enddo + phase = p + NofMyPhase=count(material_phase==phase) + instance = source_damage_isoDuctile_instance(phase) + sourceOffset = source_damage_isoDuctile_offset(phase) - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = source_damage_isoDuctile_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('isoductile_drivingforce') - source_damage_isoDuctile_Noutput(instance) = source_damage_isoDuctile_Noutput(instance) + 1_pInt - source_damage_isoDuctile_outputID(source_damage_isoDuctile_Noutput(instance),instance) = damage_drivingforce_ID - source_damage_isoDuctile_output(source_damage_isoDuctile_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingFile - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_damage_isoDuctile_instance(phase) - sourceOffset = source_damage_isoDuctile_offset(phase) -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,source_damage_isoDuctile_Noutput(instance) - select case(source_damage_isoDuctile_outputID(o,instance)) - case(damage_drivingforce_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - source_damage_isoDuctile_sizePostResult(o,instance) = mySize - source_damage_isoDuctile_sizePostResults(instance) = source_damage_isoDuctile_sizePostResults(instance) + mySize - endif - enddo outputsLoop - - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) - sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoDuctile_sizePostResults(instance) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoDuctile_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - endif - enddo initializeInstances + enddo + end subroutine source_damage_isoDuctile_init !-------------------------------------------------------------------------------------------------- @@ -321,8 +250,8 @@ function source_damage_isoDuctile_postResults(phase, constituent) integer(pInt), intent(in) :: & phase, & constituent - real(pReal), dimension(source_damage_isoDuctile_sizePostResults( & - source_damage_isoDuctile_instance(phase))) :: & + real(pReal), dimension(sum(source_damage_isoDuctile_sizePostResult(:, & + source_damage_isoDuctile_instance(phase)))) :: & source_damage_isoDuctile_postResults integer(pInt) :: & @@ -332,10 +261,9 @@ function source_damage_isoDuctile_postResults(phase, constituent) sourceOffset = source_damage_isoDuctile_offset(phase) c = 0_pInt - source_damage_isoDuctile_postResults = 0.0_pReal - do o = 1_pInt,source_damage_isoDuctile_Noutput(instance) - select case(source_damage_isoDuctile_outputID(o,instance)) + do o = 1_pInt,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) c = c + 1 From 47a9d88a15ebeea3dba0ce22c01954a266368b8c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 09:16:06 +0100 Subject: [PATCH 094/154] read vector-parameters --- src/source_damage_anisoBrittle.f90 | 11 ++++++++++- src/source_damage_anisoDuctile.f90 | 9 +++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index c380e9790..4a9ae1f68 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -91,6 +91,8 @@ subroutine source_damage_anisoBrittle_init(fileUnit) IO_error, & IO_timeStamp, & IO_EOF + use math, only: & + math_expand use material, only: & material_allocateSourceState, & phase_source, & @@ -175,7 +177,14 @@ subroutine source_damage_anisoBrittle_init(fileUnit) 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)) + + ! expand: family => system + prm%critDisp = math_expand(prm%critDisp, prm%Ncleavage) + prm%critLoad = math_expand(prm%critLoad, prm%Ncleavage) + !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 46898ecf5..94e2b3a4a 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -93,6 +93,8 @@ subroutine source_damage_anisoDuctile_init(fileUnit) IO_error, & IO_timeStamp, & IO_EOF + use math, only: & + math_expand use material, only: & material_allocateSourceState, & phase_source, & @@ -176,6 +178,13 @@ subroutine source_damage_anisoDuctile_init(fileUnit) prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) + prm%critPlasticStrain = config%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(prm%Nslip)) + prm%critLoad = config%getFloats('anisoductile_criticalload', requiredSize=size(prm%Nslip)) + + ! expand: family => system + prm%critPlasticStrain = math_expand(prm%critPlasticStrain, prm%Nslip) + prm%critLoad = math_expand(prm%critLoad, prm%Nslip) + !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & From d36665187397d5cebcc8e6741be66d259230e181 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 09:57:12 +0100 Subject: [PATCH 095/154] file reading not required anymore --- src/constitutive.f90 | 6 +- src/source_damage_anisoBrittle.f90 | 97 ++++------------------------- src/source_damage_anisoDuctile.f90 | 99 ++++-------------------------- 3 files changed, 27 insertions(+), 175 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 66f0cab2f..7a28fd268 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -165,9 +165,9 @@ subroutine constitutive_init() if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(FILEUNIT) if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init - if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init(FILEUNIT) - if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init(FILEUNIT) - + if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init + if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init + !-------------------------------------------------------------------------------------------------- ! parse kinematic mechanisms from config file call IO_checkAndRewind(FILEUNIT) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 4a9ae1f68..713f63081 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -23,10 +23,6 @@ module source_damage_anisoBrittle integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family - - real(pReal), dimension(:,:), allocatable, private :: & - source_damage_anisoBrittle_critDisp, & - source_damage_anisoBrittle_critLoad enum, bind(c) enumerator :: undefined_ID, & @@ -66,7 +62,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoBrittle_init(fileUnit) +subroutine source_damage_anisoBrittle_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -79,14 +75,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) debug_constitutive,& debug_levelBasic use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & IO_timeStamp, & @@ -107,19 +95,12 @@ subroutine source_damage_anisoBrittle_init(fileUnit) material_Nphase, & MATERIAL_partPhase use lattice, only: & - lattice_maxNcleavageFamily, & - lattice_NcleavageSystem + lattice_maxNcleavageFamily implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p ,i - integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j - character(len=65536) :: & - tag = '', & - line = '' integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & @@ -154,8 +135,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -185,6 +164,8 @@ subroutine source_damage_anisoBrittle_init(fileUnit) 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 /= '') & @@ -219,65 +200,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit) 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 - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = source_damage_anisoBrittle_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - - case ('ncleavage') ! - Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_CleavageFamilies - source_damage_anisoBrittle_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisobrittle_criticaldisplacement') - do j = 1_pInt, Nchunks_CleavageFamilies - source_damage_anisoBrittle_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisobrittle_criticalload') - do j = 1_pInt, Nchunks_CleavageFamilies - source_damage_anisoBrittle_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - end select - endif; endif - enddo parsingFile - -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then - instance = source_damage_anisoBrittle_instance(phase) - - if (any(source_damage_anisoBrittle_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//SOURCE_damage_anisoBrittle_LABEL//')') - if (any(source_damage_anisoBrittle_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//SOURCE_damage_anisoBrittle_LABEL//')') - - - endif myPhase - enddo sanityChecks end subroutine source_damage_anisoBrittle_init @@ -312,7 +238,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) sourceOffset, & damageOffset, & homog, & - f, i, index_myFamily + f, i, index_myFamily, index real(pReal) :: & traction_d, traction_t, traction_n, traction_crit @@ -324,6 +250,8 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) damageOffset = damageMapping(homog)%p(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 @@ -331,7 +259,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) 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 = source_damage_anisoBrittle_critLoad(f,instance)* & + 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) + & @@ -339,8 +267,9 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) ((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)/ & - source_damage_anisoBrittle_critDisp(f,instance) + param(instance)%critDisp(index) + index = index + 1_pInt enddo enddo diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 94e2b3a4a..b7a8f4ad2 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -25,12 +25,6 @@ module source_damage_anisoDuctile integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_Nslip !< number of slip systems per family - real(pReal), dimension(:,:), allocatable, private :: & - source_damage_anisoDuctile_critPlasticStrain - - real(pReal), dimension(:,:), allocatable, private :: & - source_damage_anisoDuctile_critLoad - enum, bind(c) enumerator :: undefined_ID, & damage_drivingforce_ID @@ -42,8 +36,7 @@ module source_damage_anisoDuctile aTol, & N real(pReal), dimension(:), allocatable :: & - critPlasticStrain, & - critLoad + critPlasticStrain integer(pInt) :: & totalNslip integer(pInt), dimension(:), allocatable :: & @@ -68,7 +61,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoDuctile_init(fileUnit) +subroutine source_damage_anisoDuctile_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -81,14 +74,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) debug_constitutive,& debug_levelBasic use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & IO_timeStamp, & @@ -109,19 +94,13 @@ subroutine source_damage_anisoDuctile_init(fileUnit) material_Nphase, & MATERIAL_partPhase use lattice, only: & - lattice_maxNslipFamily, & - lattice_NslipSystem - + lattice_maxNslipFamily + implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p ,i - integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j - character(len=65536) :: & - tag = '', & - line = '' + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & @@ -156,8 +135,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoDuctile_output = '' - allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,Ninstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -179,11 +156,11 @@ subroutine source_damage_anisoDuctile_init(fileUnit) prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%critPlasticStrain = config%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(prm%Nslip)) - prm%critLoad = config%getFloats('anisoductile_criticalload', requiredSize=size(prm%Nslip)) ! expand: family => system prm%critPlasticStrain = math_expand(prm%critPlasticStrain, prm%Nslip) - prm%critLoad = math_expand(prm%critLoad, prm%Nslip) + + if (any(prm%critPlasticStrain < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_criticalplasticstrain' !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range @@ -219,62 +196,9 @@ subroutine source_damage_anisoDuctile_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + source_damage_anisoDuctile_Nslip(1:size(param(instance)%Nslip),instance) = param(instance)%Nslip + enddo - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = source_damage_anisoDuctile_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - - case ('nslip') ! - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_SlipFamilies - source_damage_anisoDuctile_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisoductile_criticalplasticstrain') - do j = 1_pInt, Nchunks_SlipFamilies - source_damage_anisoDuctile_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisoductile_criticalload') - do j = 1_pInt, Nchunks_SlipFamilies - source_damage_anisoDuctile_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - end select - endif; endif - enddo parsingFile - -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, size(phase_source) - myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then - instance = source_damage_anisoDuctile_instance(phase) - - if (any(source_damage_anisoDuctile_critPlasticStrain(:,instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//SOURCE_damage_anisoDuctile_LABEL//')') - - endif myPhase - enddo sanityChecks end subroutine source_damage_anisoDuctile_init @@ -319,8 +243,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & plasticState(phase)%slipRate(index,constituent)/ & - ((damage(homog)%p(damageOffset))**param(instance)%N)/ & - source_damage_anisoDuctile_critPlasticStrain(f,instance) + ((damage(homog)%p(damageOffset))**param(instance)%N)/param(instance)%critPlasticStrain(index) index = index + 1_pInt enddo From dc6f18c3f8497e8aa4ec29c5ab121b2468ce2f49 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 10:03:28 +0100 Subject: [PATCH 096/154] cleaning --- src/source_damage_anisoBrittle.f90 | 6 +----- src/source_damage_anisoDuctile.f90 | 6 +----- src/source_damage_isoBrittle.f90 | 19 ++++++------------- src/source_damage_isoDuctile.f90 | 5 +---- 4 files changed, 9 insertions(+), 27 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 713f63081..e218730d5 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -75,10 +75,7 @@ subroutine source_damage_anisoBrittle_init debug_constitutive,& debug_levelBasic use IO, only: & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_error use math, only: & math_expand use material, only: & @@ -112,7 +109,6 @@ subroutine source_damage_anisoBrittle_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index b7a8f4ad2..66960ad01 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -74,10 +74,7 @@ subroutine source_damage_anisoDuctile_init debug_constitutive,& debug_levelBasic use IO, only: & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_error use math, only: & math_expand use material, only: & @@ -112,7 +109,6 @@ subroutine source_damage_anisoDuctile_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 702ce8833..f94a568c9 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -65,10 +65,7 @@ subroutine source_damage_isoBrittle_init debug_constitutive,& debug_levelBasic use IO, only: & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_error use material, only: & material_allocateSourceState, & phase_source, & @@ -85,7 +82,7 @@ subroutine source_damage_isoBrittle_init implicit none - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p,i character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & @@ -97,7 +94,6 @@ subroutine source_damage_isoBrittle_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) @@ -182,10 +178,7 @@ end subroutine source_damage_isoBrittle_init subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) use material, only: & phaseAt, phasememberAt, & - sourceState, & - material_homog, & - phase_NstiffnessDegradations, & - phase_stiffnessDegradation + sourceState use math, only : & math_sym33to6, & math_mul33x33, & @@ -202,7 +195,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) real(pReal), intent(in), dimension(6,6) :: & C integer(pInt) :: & - phase, constituent, instance, sourceOffset, mech + phase, constituent, instance, sourceOffset real(pReal) :: & strain(6), & strainenergy @@ -216,8 +209,8 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) strain = 0.5_pReal*math_sym33to6(math_mul33x33(transpose(Fe),Fe)-math_I3) - strainenergy = 2.0_pReal*sum(strain*math_mul66x6(C,strain))/ & - param(instance)%critStrainEnergy + strainenergy = 2.0_pReal*sum(strain*math_mul66x6(C,strain))/param(instance)%critStrainEnergy + if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 4c01f1d9a..ffc4408f8 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -66,9 +66,7 @@ subroutine source_damage_isoDuctile_init debug_levelBasic use IO, only: & IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_error use material, only: & material_allocateSourceState, & phase_source, & @@ -97,7 +95,6 @@ subroutine source_damage_isoDuctile_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt) From 5b0cdf294ddf62069c83bbe66688b1743fc2410d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 10:11:25 +0100 Subject: [PATCH 097/154] delta state is needed not sure if the offset handling is correct --- src/material.f90 | 22 ++++++++++++---------- src/source_damage_anisoBrittle.f90 | 2 +- src/source_damage_anisoDuctile.f90 | 2 +- src/source_damage_isoBrittle.f90 | 2 +- src/source_damage_isoDuctile.f90 | 4 ++-- 5 files changed, 17 insertions(+), 15 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 76753273c..2d3079030 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -970,7 +970,8 @@ end subroutine material_allocatePlasticState !-------------------------------------------------------------------------------------------------- !> @brief allocates the source state of a phase !-------------------------------------------------------------------------------------------------- -subroutine material_allocateSourceState(phase,of,NofMyPhase,sizeState) +subroutine material_allocateSourceState(phase,of,NofMyPhase,& + sizeState,sizeDotState,sizeDeltaState) use numerics, only: & numerics_integrator2 => numerics_integrator ! compatibility hack @@ -979,13 +980,14 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,sizeState) phase, & of, & NofMyPhase, & - sizeState + sizeState, sizeDotState,sizeDeltaState integer(pInt) :: numerics_integrator ! compatibility hack numerics_integrator = numerics_integrator2(1) ! compatibility hack sourceState(phase)%p(of)%sizeState = sizeState - sourceState(phase)%p(of)%sizeDotState = sizeState - sourceState(phase)%p(of)%sizeDeltaState = 0_pInt + sourceState(phase)%p(of)%sizeDotState = sizeDotState + sourceState(phase)%p(of)%sizeDeltaState = sizeDeltaState + plasticState(phase)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition allocate(sourceState(phase)%p(of)%aTolState (sizeState), source=0.0_pReal) allocate(sourceState(phase)%p(of)%state0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -993,17 +995,17 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,sizeState) allocate(sourceState(phase)%p(of)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(of)%dotState (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) if (numerics_integrator == 1_pInt) then - allocate(sourceState(phase)%p(of)%previousDotState (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(of)%previousDotState2 (sizeState,NofMyPhase), source=0.0_pReal) + 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) & - allocate(sourceState(phase)%p(of)%RK4dotState (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) if (numerics_integrator == 5_pInt) & - allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (0,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) end subroutine material_allocateSourceState diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index e218730d5..5f915c5bc 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -192,7 +192,7 @@ subroutine source_damage_anisoBrittle_init sourceOffset = source_damage_anisoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 66960ad01..c4c26b9f9 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -188,7 +188,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) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index f94a568c9..ae0f2a0d2 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -164,7 +164,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) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index ffc4408f8..26d97e1fb 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -83,7 +83,7 @@ subroutine source_damage_isoDuctile_init implicit none - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p,i character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & @@ -164,7 +164,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) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol From bc0bc06aea00debbfe2877f2132eca11b07901a2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 10:16:06 +0100 Subject: [PATCH 098/154] polishing --- src/source_damage_anisoBrittle.f90 | 4 ++-- src/source_damage_anisoDuctile.f90 | 5 ++--- src/source_damage_isoDuctile.f90 | 5 ++--- 3 files changed, 6 insertions(+), 8 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 5f915c5bc..98aec49b3 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -292,8 +292,8 @@ subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalph sourceOffset = source_damage_anisoBrittle_offset(phase) - localphiDot = 1.0_pReal - & - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi + localphiDot = 1.0_pReal & + - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index c4c26b9f9..945688e8a 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -268,9 +268,8 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph sourceOffset = source_damage_anisoDuctile_offset(phase) - localphiDot = 1.0_pReal - & - sourceState(phase)%p(sourceOffset)%state(1,constituent)* & - phi + localphiDot = 1.0_pReal & + - sourceState(phase)%p(sourceOffset)%state(1,constituent) * phi dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 26d97e1fb..f29d60226 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -228,9 +228,8 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD sourceOffset = source_damage_isoDuctile_offset(phase) - localphiDot = 1.0_pReal - & - sourceState(phase)%p(sourceOffset)%state(1,constituent)* & - phi + localphiDot = 1.0_pReal & + - sourceState(phase)%p(sourceOffset)%state(1,constituent) * phi dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) From 889cfc8ba039559f028b24dfeb4b102e33aa1c37 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 01:39:54 +0100 Subject: [PATCH 099/154] vtk script only work with python3 on new testing --- processing/post/vtk_addGridData.py | 2 +- processing/post/vtk_addPointcloudData.py | 2 +- processing/post/vtk_addRectilinearGridData.py | 2 +- processing/post/vtk_pointcloud.py | 2 +- processing/post/vtk_rectilinearGrid.py | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index e0c274dc7..315071a4b 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,vtk diff --git a/processing/post/vtk_addPointcloudData.py b/processing/post/vtk_addPointcloudData.py index 3937413c6..d75eb97b4 100755 --- a/processing/post/vtk_addPointcloudData.py +++ b/processing/post/vtk_addPointcloudData.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,vtk diff --git a/processing/post/vtk_addRectilinearGridData.py b/processing/post/vtk_addRectilinearGridData.py index 9ec384e4d..83a1451a0 100755 --- a/processing/post/vtk_addRectilinearGridData.py +++ b/processing/post/vtk_addRectilinearGridData.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,vtk diff --git a/processing/post/vtk_pointcloud.py b/processing/post/vtk_pointcloud.py index 54f02d300..a9ce1f81f 100755 --- a/processing/post/vtk_pointcloud.py +++ b/processing/post/vtk_pointcloud.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys,vtk diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index d01d118cb..c94f44228 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys,vtk From c36e6cbbf6b9e630fb70b67b7970fb16b5e2c363 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 00:10:24 +0000 Subject: [PATCH 100/154] current software version --- .gitlab-ci.yml | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f1af6259f..d80e91654 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -9,7 +9,7 @@ stages: - spectral - compileMarc2018_1 - marc - - compileAbaqus2017 + - compileAbaqus2019 - example - performance - createPackage @@ -51,34 +51,32 @@ variables: # Names of module files to load # =============================================================================================== # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ - IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016" IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4" - IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017" - IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018" - GNUCompiler7_3: "Compiler/GNU/7.3" + IntelCompiler17_8: "Compiler/Intel/17.8 Libraries/IMKL/2017" + IntelCompiler18_4: "Compiler/Intel/18.4 Libraries/IMKL/2018" + GNUCompiler8_2: "Compiler/GNU/8.2" # ------------ Defaults ---------------------------------------------- - IntelCompiler: "$IntelCompiler18_1" - GNUCompiler: "$GNUCompiler7_3" + IntelCompiler: "$IntelCompiler18_4" + GNUCompiler: "$GNUCompiler8_2" # ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++ - MPICH3_2Intel18_1: "MPI/Intel/18.1/MPICH/3.2.1" - MPICH3_2GNU7_3: "MPI/GNU/7.3/MPICH/3.2.1" + IMPI2018Intel18_4: "MPI/Intel/18.4/IntelMPI/2018" + MPICH3_3GNU8_2: "MPI/GNU/8.2/MPICH/3.3" # ------------ Defaults ---------------------------------------------- - MPICH_Intel: "$MPICH3_2Intel18_1" - MPICH_GNU: "$MPICH3_2GNU7_3" + MPICH_Intel: "$IMPI2018Intel18_4" + MPICH_GNU: "$MPICH3_3GNU8_2" # ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++ - PETSc3_10_0MPICH3_2Intel18_1: "Libraries/PETSc/3.10.0/Intel-18.1-MPICH-3.2.1" - PETSc3_10_0MPICH3_2GNU7_3: "Libraries/PETSc/3.10.0/GNU-7.3-MPICH-3.2.1" + PETSc3_10_3IMPI2018Intel18_4: "Libraries/PETSc/3.10.3/Intel-18.4-IntelMPI-2018" + PETSc3_10_3MPICH3_3GNU8_2: "Libraries/PETSc/3.10.3/GNU-8.2-MPICH-3.3" # ------------ Defaults ---------------------------------------------- - PETSc_MPICH_Intel: "$PETSc3_10_0MPICH3_2Intel18_1" - PETSc_MPICH_GNU: "$PETSc3_10_0MPICH3_2GNU7_3" + PETSc_MPICH_Intel: "$PETSc3_10_3IMPI2018Intel18_4" + PETSc_MPICH_GNU: "$PETSc3_10_3MPICH3_3GNU8_2" # ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++ - Abaqus2017: "FEM/Abaqus/2017" + Abaqus2019: "FEM/Abaqus/2019" MSC2018_1: "FEM/MSC/2018.1" - MSC2017: "FEM/MSC/2017" # ------------ Defaults ---------------------------------------------- - Abaqus: "$Abaqus2017" + Abaqus: "$Abaqus2019" MSC: "$MSC2018_1" - IntelMarc: "$IntelCompiler17_0" + IntelMarc: "$IntelCompiler17_8" IntelAbaqus: "$IntelCompiler16_4" # ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++ Doxygen1_8_13: "Documentation/Doxygen/1.8.13" From 535639d933b79418353747aa02a11d4ded7ac828 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 19:08:56 +0000 Subject: [PATCH 101/154] new doxygen --- .gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index d80e91654..62e243505 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -79,9 +79,9 @@ variables: IntelMarc: "$IntelCompiler17_8" IntelAbaqus: "$IntelCompiler16_4" # ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++ - Doxygen1_8_13: "Documentation/Doxygen/1.8.13" + Doxygen1_8_15: "Documentation/Doxygen/1.8.15" # ------------ Defaults ---------------------------------------------- - Doxygen: "$Doxygen1_8_13" + Doxygen: "$Doxygen1_8_15" ################################################################################################### From 415b668e829e036b098d3286cc8859244a489828 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 19:12:31 +0000 Subject: [PATCH 102/154] tests for new server --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index beb9682ff..4909d74e0 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b +Subproject commit 4909d74e08f8f0065e2ad71ab35030e2e104d403 From dd491027486403e6a9eebed6cb41dc7b0e49cdc4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 20:37:39 +0100 Subject: [PATCH 103/154] missing update of stages --- .gitlab-ci.yml | 12 ++++++------ PRIVATE | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 62e243505..1f5536445 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -7,9 +7,9 @@ stages: - compilePETScGNU - prepareSpectral - spectral - - compileMarc2018_1 + - compileMarc - marc - - compileAbaqus2019 + - compileAbaqus - example - performance - createPackage @@ -381,9 +381,9 @@ TextureComponents: ################################################################################################### Marc_compileIfort2018_1: - stage: compileMarc2018_1 + stage: compileMarc script: - - module load $IntelCompiler17_0 $MSC2018_1 + - module load $IntelMarc $MSC - Marc_compileIfort/test.py -m 2018.1 except: - master @@ -429,9 +429,9 @@ J2_plasticBehavior: ################################################################################################### Abaqus_compile2017: - stage: compileAbaqus2017 + stage: compileAbaqus script: - - module load $IntelCompiler16_4 $Abaqus2017 + - module load $IntelCompiler16_4 $Abaqus - Abaqus_compileIfort/test.py -a 2017 except: - master diff --git a/PRIVATE b/PRIVATE index 4909d74e0..406d482f8 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 4909d74e08f8f0065e2ad71ab35030e2e104d403 +Subproject commit 406d482f8059b4459634af729ce85491a9a3245c From 2cda3cd0f9bd325d265111e442dc183e803824ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 20:41:37 +0100 Subject: [PATCH 104/154] only test for most recent version anyway --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 1f5536445..621db50ae 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -431,7 +431,7 @@ J2_plasticBehavior: Abaqus_compile2017: stage: compileAbaqus script: - - module load $IntelCompiler16_4 $Abaqus + - module load $IntelAbaqus $Abaqus - Abaqus_compileIfort/test.py -a 2017 except: - master From 6988047df46c8d76b83189203e3260c2aaac463a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 21:22:12 +0100 Subject: [PATCH 105/154] added repository --- README | 1 + 1 file changed, 1 insertion(+) diff --git a/README b/README index 5c5d976b6..7fc372881 100644 --- a/README +++ b/README @@ -10,3 +10,4 @@ Germany Email: DAMASK@mpie.de https://damask.mpie.de +https://magit1.mpie.de From 6abc8e7ebf7f62751ad486370dbbb53ecdc15d4e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 21:53:20 +0100 Subject: [PATCH 106/154] Abaqus 2019 is out --- CONFIG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONFIG b/CONFIG index 13b75a768..31a9c34c8 100644 --- a/CONFIG +++ b/CONFIG @@ -8,6 +8,6 @@ set DAMASK_NUM_THREADS = 4 set MSC_ROOT = /opt/msc set MARC_VERSION = 2018.1 -set ABAQUS_VERSION = 2017 +set ABAQUS_VERSION = 2019 set DAMASK_HDF5 = OFF From c4cb35891cccbed2f2d51f60e5253a8c12ea2757 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 22:56:39 +0100 Subject: [PATCH 107/154] all fine with python3 --- processing/post/addCumulative.py | 2 +- processing/post/addDerivative.py | 2 +- processing/post/blowUp.py | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/processing/post/addCumulative.py b/processing/post/addCumulative.py index 4588d915c..dfa8059dc 100755 --- a/processing/post/addCumulative.py +++ b/processing/post/addCumulative.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/post/addDerivative.py b/processing/post/addDerivative.py index dc97c09ea..35ca7130b 100755 --- a/processing/post/addDerivative.py +++ b/processing/post/addDerivative.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index 5a0d631e0..22de70d5b 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys From 1adffb0debf3e60277d26d334a0df9432bc4674a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 23:04:28 +0100 Subject: [PATCH 108/154] tests for python3 compatible scripts --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 406d482f8..c6db7cee2 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 406d482f8059b4459634af729ce85491a9a3245c +Subproject commit c6db7cee2d9349e2d463f5ef6284446007fc7915 From 68ebb121eabd08c3afd07e9203be94d8a941c631 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 23:32:30 +0100 Subject: [PATCH 109/154] python3 test --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index c6db7cee2..999c63092 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c6db7cee2d9349e2d463f5ef6284446007fc7915 +Subproject commit 999c63092647de5e951382ba15d64b1a3f1e89be From 742d58cfcedfa3029ec1c2cc0e36f694ebf496e5 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 14 Feb 2019 18:24:09 -0500 Subject: [PATCH 110/154] added ASCIItable tests to CI pipelining --- .gitlab-ci.yml | 7 ++++ PRIVATE | 2 +- processing/post/addLinked.py | 6 +-- processing/post/addTable.py | 2 +- processing/pre/geom_grainGrowth.py | 47 ++++++++++++------------ processing/pre/seeds_fromDistribution.py | 17 +++++---- 6 files changed, 45 insertions(+), 36 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 621db50ae..e883ac986 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -156,6 +156,13 @@ Post_AverageDown: - master - release +Post_ASCIItable: + stage: postprocessing + script: ASCIItable/test.py + except: + - master + - release + Post_General: stage: postprocessing script: PostProcessing/test.py diff --git a/PRIVATE b/PRIVATE index c6db7cee2..3d12562fb 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c6db7cee2d9349e2d463f5ef6284446007fc7915 +Subproject commit 3d12562fbfb3a57dbb3777ac045a12376b3400e8 diff --git a/processing/post/addLinked.py b/processing/post/addLinked.py index d60307bc2..e0569324b 100755 --- a/processing/post/addLinked.py +++ b/processing/post/addLinked.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys @@ -21,7 +21,7 @@ Add data of selected column(s) from (first) row of linked ASCIItable that shares parser.add_option('--link', dest = 'link', nargs = 2, type = 'string', metavar = 'string string', - help = 'column labels containing linked values') + help = 'column labels of table and linked table containing linking values') parser.add_option('-l','--label', dest = 'label', action = 'extend', metavar = '', @@ -105,7 +105,7 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table try: - table.data_append(data[np.argwhere(np.all((map(float,table.data[myLink:myLink+myLinkDim]) - index)==0,axis=1))[0]]) # add data of first matching line + table.data_append(data[np.argwhere(np.all((list(map(float,table.data[myLink:myLink+myLinkDim])) - index)==0,axis=1))[0]]) # add data of first matching line except IndexError: table.data_append(np.nan*np.ones_like(data[0])) # or add NaNs outputAlive = table.data_write() # output processed line diff --git a/processing/post/addTable.py b/processing/post/addTable.py index 82799b4f5..126db6f65 100755 --- a/processing/post/addTable.py +++ b/processing/post/addTable.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/pre/geom_grainGrowth.py b/processing/pre/geom_grainGrowth.py index f1394cb5f..1afb02715 100755 --- a/processing/pre/geom_grainGrowth.py +++ b/processing/pre/geom_grainGrowth.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys,math @@ -49,7 +49,7 @@ parser.set_defaults(d = 1, (options, filenames) = parser.parse_args() -options.immutable = map(int,options.immutable) +options.immutable = list(map(int,options.immutable)) getInterfaceEnergy = lambda A,B: np.float32((A*B != 0)*(A != B)*1.0) # 1.0 if A & B are distinct & nonzero, 0.0 otherwise struc = ndimage.generate_binary_structure(3,1) # 3D von Neumann neighborhood @@ -70,9 +70,9 @@ 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']))), + 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']), ]) @@ -102,9 +102,9 @@ for name in filenames: gauss = np.exp(-(X*X + Y*Y + Z*Z)/(2.0*options.d*options.d),dtype=np.float32) \ /np.power(2.0*np.pi*options.d*options.d,(3.0 - np.count_nonzero(info['grid'] == 1))/2.,dtype=np.float32) - gauss[:,:,:grid[2]/2:-1] = gauss[:,:,1:(grid[2]+1)/2] # trying to cope with uneven (odd) grid size - gauss[:,:grid[1]/2:-1,:] = gauss[:,1:(grid[1]+1)/2,:] - gauss[:grid[0]/2:-1,:,:] = gauss[1:(grid[0]+1)/2,:,:] + gauss[:,:,:grid[2]//2:-1] = gauss[:,:,1:(grid[2]+1)//2] # trying to cope with uneven (odd) grid size + gauss[:,:grid[1]//2:-1,:] = gauss[:,1:(grid[1]+1)//2,:] + gauss[:grid[0]//2:-1,:,:] = gauss[1:(grid[0]+1)//2,:,:] gauss = np.fft.rfftn(gauss).astype(np.complex64) for smoothIter in range(options.N): @@ -119,9 +119,9 @@ for name in filenames: microstructure,i,axis=0), j,axis=1), k,axis=2))) # periodically extend interfacial energy array by half a grid size in positive and negative directions - periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] + periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # transform bulk volume (i.e. where interfacial energy remained zero), store index of closest boundary voxel index = ndimage.morphology.distance_transform_edt(periodic_interfaceEnergy == 0., @@ -148,15 +148,15 @@ for name in filenames: ndimage.morphology.binary_dilation(interfaceEnergy > 0., structure = struc, iterations = int(round(options.d*2.))-1),# fat boundary - periodic_bulkEnergy[grid[0]/2:-grid[0]/2, # retain filled energy on fat boundary... - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2], # ...and zero everywhere else + periodic_bulkEnergy[grid[0]//2:-grid[0]//2, # retain filled energy on fat boundary... + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2], # ...and zero everywhere else 0.)).astype(np.complex64) * gauss).astype(np.float32) - periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] # periodically extend the smoothed bulk energy + periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # periodically extend the smoothed bulk energy # transform voxels close to interface region @@ -164,15 +164,15 @@ for name in filenames: return_distances = False, return_indices = True) # want index of closest bulk grain - periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] # periodically extend the microstructure + periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # periodically extend the microstructure microstructure = periodic_microstructure[index[0], index[1], - index[2]].reshape(2*grid)[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] # extent grains into interface region + index[2]].reshape(2*grid)[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # extent grains into interface region # replace immutable microstructures with closest mutable ones index = ndimage.morphology.distance_transform_edt(np.in1d(microstructure,options.immutable).reshape(grid), @@ -236,3 +236,4 @@ for name in filenames: # --- output finalization -------------------------------------------------------------------------- table.close() + \ No newline at end of file diff --git a/processing/pre/seeds_fromDistribution.py b/processing/pre/seeds_fromDistribution.py index 3b9005032..2e8936f27 100755 --- a/processing/pre/seeds_fromDistribution.py +++ b/processing/pre/seeds_fromDistribution.py @@ -1,10 +1,11 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import threading,time,os,sys,random import numpy as np from optparse import OptionParser -from cStringIO import StringIO +from io import StringIO +import binascii import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] @@ -96,7 +97,7 @@ class myThread (threading.Thread): perturbedGeomVFile = StringIO() perturbedSeedsVFile.reset() perturbedGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+ - ' -g '+' '.join(map(str, options.grid)),streamIn=perturbedSeedsVFile)[0]) + ' -g '+' '.join(list(map(str, options.grid))),streamIn=perturbedSeedsVFile)[0]) perturbedGeomVFile.reset() #--- evaluate current seeds file ---------------------------------------------------------------------- @@ -214,7 +215,7 @@ options = parser.parse_args()[0] damask.util.report(scriptName,options.seedFile) if options.randomSeed is None: - options.randomSeed = int(os.urandom(4).encode('hex'), 16) + options.randomSeed = int(binascii.hexlify(os.urandom(4)),16) damask.util.croak(options.randomSeed) delta = (options.scale/options.grid[0],options.scale/options.grid[1],options.scale/options.grid[2]) baseFile=os.path.splitext(os.path.basename(options.seedFile))[0] @@ -240,17 +241,17 @@ if os.path.isfile(os.path.splitext(options.seedFile)[0]+'.seeds'): for line in initialSeedFile: bestSeedsVFile.write(line) else: bestSeedsVFile.write(damask.util.execute('seeds_fromRandom'+\ - ' -g '+' '.join(map(str, options.grid))+\ + ' -g '+' '.join(list(map(str, options.grid)))+\ ' -r {:d}'.format(options.randomSeed)+\ ' -N '+str(nMicrostructures))[0]) bestSeedsUpdate = time.time() # ----------- tessellate initial seed file to get and evaluate geom file -bestSeedsVFile.reset() +bestSeedsVFile.seek(0) initialGeomVFile = StringIO() initialGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+ - ' -g '+' '.join(map(str, options.grid)),bestSeedsVFile)[0]) -initialGeomVFile.reset() + ' -g '+' '.join(list(map(str, options.grid))),bestSeedsVFile)[0]) +initialGeomVFile.seek(0) initialGeomTable = damask.ASCIItable(initialGeomVFile,None,labeled=False,readonly=True) initialGeomTable.head_read() info,devNull = initialGeomTable.head_getGeom() From dc133344b65537d97372c38a9d493d363e81a169 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 14 Feb 2019 18:43:34 -0500 Subject: [PATCH 111/154] [skip ci] migrated to python3 compatibility --- processing/pre/geom_toTable.py | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/processing/pre/geom_toTable.py b/processing/pre/geom_toTable.py index eb6bdde61..a29ef7afb 100755 --- a/processing/pre/geom_toTable.py +++ b/processing/pre/geom_toTable.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys @@ -48,11 +48,11 @@ 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.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']), ]) errors = [] From 5ef219cdb9420e0b6a6797cebeca88058d727c08 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 06:05:12 +0100 Subject: [PATCH 112/154] module name was renamed --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index e883ac986..bcb0952db 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -51,7 +51,7 @@ variables: # Names of module files to load # =============================================================================================== # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ - IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4" + IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016" IntelCompiler17_8: "Compiler/Intel/17.8 Libraries/IMKL/2017" IntelCompiler18_4: "Compiler/Intel/18.4 Libraries/IMKL/2018" GNUCompiler8_2: "Compiler/GNU/8.2" From 31b3cca1ad825ed4009551bbe8f63e46acb8fc7c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 06:42:19 +0100 Subject: [PATCH 113/154] [skip ci] also python3 compatible --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 3d12562fb..3358be226 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3d12562fbfb3a57dbb3777ac045a12376b3400e8 +Subproject commit 3358be226989780b4969554e688a1bdff3d02c70 From c50078bafceec285354d88adadf817dd3f2d949a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 14:22:26 +0100 Subject: [PATCH 114/154] short version not needed any more Abaqus version is year --- python/damask/solver/abaqus.py | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index bf8691533..6826ad24b 100644 --- a/python/damask/solver/abaqus.py +++ b/python/damask/solver/abaqus.py @@ -15,14 +15,13 @@ class Abaqus(Solver): def return_run_command(self,model): env=damask.Environment() - shortVersion = re.sub('[\.,-]', '',self.version) try: - cmd='abq'+shortVersion - subprocess.check_output(['abq'+shortVersion,'information=release']) + cmd='abq'+self.version + subprocess.check_output([cmd,'information=release']) except OSError: # link to abqXXX not existing cmd='abaqus' process = subprocess.Popen(['abaqus','information=release'],stdout = subprocess.PIPE,stderr = subprocess.PIPE) detectedVersion = process.stdout.readlines()[1].split()[1] if self.version != detectedVersion: - raise Exception('found Abaqus version %s, but requested %s'%(detectedVersion,self.version)) - return '%s -job %s -user %s/src/DAMASK_abaqus interactive'%(cmd,model,env.rootDir()) + raise Exception('found Abaqus version {}, but requested {}'.format(detectedVersion,self.version)) + return '{} -job {} -user {}/src/DAMASK_abaqus interactive'.format(cmd,model,env.rootDir()) From 8b829410142d6f0f50e67dce25cac5d9ba0bdc6a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 14:23:16 +0100 Subject: [PATCH 115/154] only Abaqus 2019 is available --- .gitlab-ci.yml | 4 ++-- python/damask/solver/abaqus.py | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index bcb0952db..25616cc99 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -435,11 +435,11 @@ J2_plasticBehavior: - release ################################################################################################### -Abaqus_compile2017: +Abaqus_compile: stage: compileAbaqus script: - module load $IntelAbaqus $Abaqus - - Abaqus_compileIfort/test.py -a 2017 + - Abaqus_compileIfort/test.py except: - master - release diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index 6826ad24b..305e5cbe1 100644 --- a/python/damask/solver/abaqus.py +++ b/python/damask/solver/abaqus.py @@ -2,7 +2,7 @@ from .solver import Solver import damask -import subprocess,re +import subprocess class Abaqus(Solver): From 88fc37d8a7c723cf529e30cdbda406734ba7db43 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 16:22:52 +0100 Subject: [PATCH 116/154] some more work on python3 compatible scripts --- PRIVATE | 2 +- python/damask/solver/abaqus.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index 3358be226..5d43a56aa 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3358be226989780b4969554e688a1bdff3d02c70 +Subproject commit 5d43a56aa25e90462660056a45648caedd99dac6 diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index 305e5cbe1..22dbab045 100644 --- a/python/damask/solver/abaqus.py +++ b/python/damask/solver/abaqus.py @@ -21,7 +21,7 @@ class Abaqus(Solver): except OSError: # link to abqXXX not existing cmd='abaqus' process = subprocess.Popen(['abaqus','information=release'],stdout = subprocess.PIPE,stderr = subprocess.PIPE) - detectedVersion = process.stdout.readlines()[1].split()[1] + detectedVersion = process.stdout.readlines()[1].split()[1].decode('utf-8') if self.version != detectedVersion: raise Exception('found Abaqus version {}, but requested {}'.format(detectedVersion,self.version)) return '{} -job {} -user {}/src/DAMASK_abaqus interactive'.format(cmd,model,env.rootDir()) From 566099ad810ec6d3821d25dcb93fcb36dde661d5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 18:52:47 +0100 Subject: [PATCH 117/154] automatic documentation for some post processing scripts --- .gitlab-ci.yml | 21 +++++++++++++++++++++ PRIVATE | 2 +- processing/post/addAPS34IDEstrainCoords.py | 13 ++++--------- processing/post/addCurl.py | 2 +- processing/post/addDivergence.py | 2 +- processing/post/addGradient.py | 2 +- 6 files changed, 29 insertions(+), 13 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f1af6259f..6ee973092 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -496,6 +496,27 @@ Spectral: only: - development +Processing: + stage: createDocumentation + script: + - cd $DAMASKROOT/processing/post + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py + addAPS34IDEstrainCoords.py + addCauchy.py addCumulative.py addCurl.py + addDerivative.py addDeterminant.py addDeviator.py addDivergence.py + addEhkl.py + addGradient.py + addIndexed.py + addInfo.py + addLinked.py + addMises.py + addNorm.py + addPK2.py + addSpectralDecomposition.py addStrainTensors.py > post.html + except: + - master + - release + ################################################################################################## backupData: stage: saveDocumentation diff --git a/PRIVATE b/PRIVATE index beb9682ff..30434a528 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b +Subproject commit 30434a528f69d77eef1be91e8a2f2fc5e0f85054 diff --git a/processing/post/addAPS34IDEstrainCoords.py b/processing/post/addAPS34IDEstrainCoords.py index 1071baa91..78202d9a9 100755 --- a/processing/post/addAPS34IDEstrainCoords.py +++ b/processing/post/addAPS34IDEstrainCoords.py @@ -19,15 +19,10 @@ Transform X,Y,Z,F APS BeamLine 34 coordinates to x,y,z APS strain coordinates. """, version = scriptID) -parser.add_option('-f', - '--frame', - dest='frame', - metavar='string', - help='APS X,Y,Z coords') -parser.add_option('--depth', - dest='depth', - metavar='string', - help='depth') +parser.add_option('-f','--frame',dest='frame', nargs=3, metavar='string string string', + help='APS X,Y,Z coords') +parser.add_option('--depth', dest='depth', metavar='string', + help='depth') (options,filenames) = parser.parse_args() diff --git a/processing/post/addCurl.py b/processing/post/addCurl.py index 2716849b4..cae1ef8b0 100755 --- a/processing/post/addCurl.py +++ b/processing/post/addCurl.py @@ -49,7 +49,7 @@ def curlFFT(geomdim,field): curl_fourier = np.einsum(einsums[n],e,k_s,field_fourier)*TWOPIIMG - return np.fft.irfftn(curl_fourier,s=shapeFFT,axes=(0,1,2)).reshape([N,n]) + return np.fft.irfftn(curl_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n]) # -------------------------------------------------------------------- diff --git a/processing/post/addDivergence.py b/processing/post/addDivergence.py index 0aa4b05ae..73eb4ed9e 100755 --- a/processing/post/addDivergence.py +++ b/processing/post/addDivergence.py @@ -45,7 +45,7 @@ def divFFT(geomdim,field): div_fourier = np.einsum(einsums[n],k_s,field_fourier)*TWOPIIMG - return np.fft.irfftn(div_fourier,s=shapeFFT,axes=(0,1,2)).reshape([N,n//3]) + return np.fft.irfftn(div_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n/3]) # -------------------------------------------------------------------- diff --git a/processing/post/addGradient.py b/processing/post/addGradient.py index 83cb54064..676efb27e 100755 --- a/processing/post/addGradient.py +++ b/processing/post/addGradient.py @@ -45,7 +45,7 @@ def gradFFT(geomdim,field): k_s = np.concatenate((ki[:,:,:,None],kj[:,:,:,None],kk[:,:,:,None]),axis = 3).astype('c16') grad_fourier = np.einsum(einsums[n],field_fourier,k_s)*TWOPIIMG - return np.fft.irfftn(grad_fourier,s=shapeFFT,axes=(0,1,2)).reshape([N,3*n]) + return np.fft.irfftn(grad_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,3*n]) # -------------------------------------------------------------------- From d53d1224b8d56bf5b5c6e5b006a6d08d2b84919e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 19:01:11 +0100 Subject: [PATCH 118/154] python3 compatible test --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 5d43a56aa..18ba1ba6a 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 5d43a56aa25e90462660056a45648caedd99dac6 +Subproject commit 18ba1ba6a5e9ba446dc9311acf2acf2781614db1 From 787fc9583dd73dfec4974b1d234d9534ebd1dee6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 19:17:16 +0100 Subject: [PATCH 119/154] documenting most post processing scripts --- .gitlab-ci.yml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6ee973092..b98d5ba5e 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -512,7 +512,13 @@ Processing: addMises.py addNorm.py addPK2.py - addSpectralDecomposition.py addStrainTensors.py > post.html + addSpectralDecomposition.py addStrainTensors.py + addTable.py + filterTable.py + perceptualUniformColorMap.py + reLabel.py + scaleData.py shiftData.py sortTable.py + viewTable.py > post.html except: - master - release From cced449dd3c0b2b270682c43436734c08ec64208 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 20:43:48 +0100 Subject: [PATCH 120/154] more scripts for autodocumentation --- .gitlab-ci.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index b98d5ba5e..47a7ca94e 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -502,10 +502,10 @@ Processing: - cd $DAMASKROOT/processing/post - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py addAPS34IDEstrainCoords.py - addCauchy.py addCumulative.py addCurl.py - addDerivative.py addDeterminant.py addDeviator.py addDivergence.py - addEhkl.py - addGradient.py + addCauchy.py addCalculation.py addCompatibilityMismatch.py addCumulative.py addCurl.py + addDerivative.py addDeterminant.py addDeviator.py addDisplacement.py addDivergence.py + addEhkl.py addEuclideanDistance.py + addGaussian.py addGradient.py addGrainID.py addIndexed.py addInfo.py addLinked.py From afdaac47af4f4675a594cd219b354c61aa82bca9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 22:54:38 +0100 Subject: [PATCH 121/154] avoid disturbing reporting --- src/DAMASK_abaqus.f | 29 ++++++++++++++++++---------- src/DAMASK_interface.f90 | 41 ++++++++++++++++++++++++++-------------- src/DAMASK_marc.f90 | 31 +++++++++++++++++++----------- src/compilation_info.f90 | 14 -------------- 4 files changed, 66 insertions(+), 49 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index 9072de95d..f17b5bb25 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -40,16 +40,25 @@ subroutine DAMASK_interface_init character(len=256) :: wd call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' + write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>' + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' + write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(a,/)') ' Version: '//DAMASKVERSION + +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md +#if __INTEL_COMPILER >= 1800 + write(6,*) 'Compiled with: ', compiler_version() + write(6,*) 'Compiler options: ', compiler_options() +#else + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE +#endif + + write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) call getoutdir(wd, lenOutDir) ierr = CHDIR(wd) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index 7a8e77f62..630b5b921 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -143,16 +143,27 @@ subroutine DAMASK_interface_init() call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' - write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize -#include "compilation_info.f90" + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' + write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(a,/)') ' Version: '//DAMASKVERSION + +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + write(6,*) 'Compiled with: ', compiler_version() + write(6,*) 'Compiler options: ', compiler_options() +#elif defined(__INTEL_COMPILER) + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE +#elif defined(__PGI) + write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version :', __PGIC__,& + '.', __PGIC_MINOR__ +#endif + + write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) call get_command(commandLine) chunkPos = IIO_stringPos(commandLine) @@ -219,9 +230,11 @@ subroutine DAMASK_interface_init() call get_environment_variable('USER',userName) ! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux - write(6,'(a,a)') ' Host name: ', trim(getHostName()) - write(6,'(a,a)') ' User name: ', trim(userName) - write(6,'(a,a)') ' Command line call: ', trim(commandLine) + write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize + write(6,'(a,a)') ' Host name: ', trim(getHostName()) + write(6,'(a,a)') ' User name: ', trim(userName) + + write(6,'(/a,a)') ' Command line call: ', trim(commandLine) if (len(trim(workingDirArg)) > 0) & write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) @@ -514,4 +527,4 @@ pure function IIO_stringPos(string) end function IIO_stringPos -end module \ No newline at end of file +end module diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0c7d1adeb..845441e57 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -53,17 +53,26 @@ subroutine DAMASK_interface_init character(len=1024) :: wd call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' -#include "compilation_info.f90" + write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>' + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' + write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(a,/)') ' Version: '//DAMASKVERSION + +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md +#if __INTEL_COMPILER >= 1800 + write(6,*) 'Compiled with: ', compiler_version() + write(6,*) 'Compiler options: ', compiler_options() +#else + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE +#endif + + write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) + inquire(5, name=wd) ! determine inputputfile wd = wd(1:scan(wd,'/',back=.true.)) ierr = CHDIR(wd) diff --git a/src/compilation_info.f90 b/src/compilation_info.f90 index 77d181a38..e69de29bb 100644 --- a/src/compilation_info.f90 +++ b/src/compilation_info.f90 @@ -1,14 +0,0 @@ -! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - write(6,*) 'Compiled with ', compiler_version() - write(6,*) 'With options ', compiler_options() -#elif defined(__INTEL_COMPILER) - write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,& - ', build date ', __INTEL_COMPILER_BUILD_DATE -#elif defined(__PGI) - write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version ', __PGIC__,& - '.', __PGIC_MINOR__ -#endif -write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ -write(6,*) -flush(6) From 4ce151c96715c0c2a3f9414e9e1204698d383b52 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 23:22:51 +0100 Subject: [PATCH 122/154] camel casing (easer for foswiki) --- processing/post/{vtk_pointcloud.py => vtk_pointCloud.py} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename processing/post/{vtk_pointcloud.py => vtk_pointCloud.py} (100%) diff --git a/processing/post/vtk_pointcloud.py b/processing/post/vtk_pointCloud.py similarity index 100% rename from processing/post/vtk_pointcloud.py rename to processing/post/vtk_pointCloud.py From 0fd547688301fda63597f402c45a225af7e89fd5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 06:42:08 +0100 Subject: [PATCH 123/154] doxygen interprets comment as doc string --- src/kinematics_thermal_expansion.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 3d1de3d0a..3696593ad 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -24,10 +24,10 @@ module kinematics_thermal_expansion integer(pInt), dimension(:), allocatable, target, public :: & kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage -! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult -! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output -! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... -! end enum + enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult + enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output + thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... + end enum public :: & kinematics_thermal_expansion_init, & kinematics_thermal_expansion_initialStrain, & From 73235ab64a296164e8faaa17191fd65dc8efe2b4 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 16 Feb 2019 08:16:37 +0000 Subject: [PATCH 124/154] [skip ci] updated version information after successful test of v2.0.2-1713-g0fd54768 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6e1ce244f..c778e617c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1689-g1a471bcd +v2.0.2-1713-g0fd54768 From 9a3921ea84c16d2516ea4aaf10b13ea0416222cd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 10:20:53 +0100 Subject: [PATCH 125/154] ifdef statements grouped together unless they belong to a group of functions, like opening files or interpreting lines --- src/IO.f90 | 103 ++++++++++++++++++++++++----------------------------- 1 file changed, 47 insertions(+), 56 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index b5868fa48..04b32d396 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -68,20 +68,14 @@ contains !-------------------------------------------------------------------------------------------------- -!> @brief only outputs revision number +!> @brief does nothing. +! ToDo: needed? !-------------------------------------------------------------------------------------------------- subroutine IO_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif implicit none write(6,'(/,a)') ' <<<+- IO init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" end subroutine IO_init @@ -816,52 +810,6 @@ pure function IO_lc(string) end function IO_lc -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @brief reads file to skip (at least) N chunks (may be over multiple lines) -!-------------------------------------------------------------------------------------------------- -subroutine IO_skipChunks(fileUnit,N) - - implicit none - integer(pInt), intent(in) :: fileUnit, & !< file handle - N !< minimum number of chunks to skip - - integer(pInt) :: 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 - enddo -end subroutine IO_skipChunks -#endif - - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief extracts string value from key=value pair and check whether key matches -!-------------------------------------------------------------------------------------------------- -character(len=300) pure function IO_extractValue(pair,key) - - implicit none - character(len=*), intent(in) :: pair, & !< key=value pair - key !< key to be expected - - character(len=*), parameter :: SEP = achar(61) ! '=' - - integer :: myChunk !< position number of desired chunk - - IO_extractValue = '' - - myChunk = scan(pair,SEP) - if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches - -end function IO_extractValue -# endif - !-------------------------------------------------------------------------------------------------- !> @brief returns format string for integer values without leading zeros !-------------------------------------------------------------------------------------------------- @@ -1251,7 +1199,30 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) end subroutine IO_warning +#if defined(Abaqus) || defined(Marc4DAMASK) + #ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @brief extracts string value from key=value pair and check whether key matches +!-------------------------------------------------------------------------------------------------- +character(len=300) pure function IO_extractValue(pair,key) + + implicit none + character(len=*), intent(in) :: pair, & !< key=value pair + key !< key to be expected + + character(len=*), parameter :: SEP = achar(61) ! '=' + + integer :: myChunk !< position number of desired chunk + + IO_extractValue = '' + + myChunk = scan(pair,SEP) + if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches + +end function IO_extractValue + + !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- @@ -1316,10 +1287,31 @@ integer(pInt) function IO_countNumericalDataLines(fileUnit) backspace(fileUnit) end function IO_countNumericalDataLines + + +!-------------------------------------------------------------------------------------------------- +!> @brief reads file to skip (at least) N chunks (may be over multiple lines) +!-------------------------------------------------------------------------------------------------- +subroutine IO_skipChunks(fileUnit,N) + + implicit none + integer(pInt), intent(in) :: fileUnit, & !< file handle + N !< minimum number of chunks to skip + + integer(pInt) :: 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 + enddo +end subroutine IO_skipChunks #endif -#if defined(Abaqus) || defined(Marc4DAMASK) !-------------------------------------------------------------------------------------------------- !> @brief count items in consecutive lines depending on lines !> @details Marc: ints concatenated by "c" as last char or range of values a "to" b @@ -1490,7 +1482,6 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) 100 end function IO_continuousIntValues #endif - !-------------------------------------------------------------------------------------------------- ! internal helper functions From 61032b5fd8d2a7fc2ada7ef89b5d5648acdce4f5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 10:24:12 +0100 Subject: [PATCH 126/154] wrong jump position probably a copy and paste error --- src/mesh_marc.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 0e0336f99..f9ba0378b 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -926,17 +926,17 @@ subroutine mesh_marc_build_elements(fileUnit) enddo 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,'(A300)',END=620) line - do !ToDo: the jumps to 620 in below code might result in a never ending loop + 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=620) line ! read extra line for new style + if (initialcondTableStyle == 2_pInt) 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 - read (fileUnit,'(A300)',END=620) line ! read line with value of state var + 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 @@ -950,7 +950,7 @@ subroutine mesh_marc_build_elements(fileUnit) e = mesh_FEasCP('elem',contInts(1_pInt+i)) mesh_element(1_pInt+sv,e) = myVal enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=620) line ! ignore IP range for old table style + if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=630) line ! ignore IP range for old table style read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo From efe9823e620ddc92fbd48f07f7843ab8b3cccca3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 10:43:02 +0100 Subject: [PATCH 127/154] clearer logic for preprocessor statements --- src/IO.f90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 04b32d396..42ba479cd 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -45,20 +45,19 @@ module IO IO_timeStamp #if defined(Marc4DAMASK) || defined(Abaqus) public :: & -#ifdef Abaqus - IO_extractValue, & - IO_countDataLines, & -#endif -#ifdef Marc4DAMASK - IO_skipChunks, & - IO_fixedNoEFloatValue, & - IO_fixedIntValue, & - IO_countNumericalDataLines, & -#endif IO_open_inputFile, & IO_open_logFile, & IO_countContinuousIntValues, & - IO_continuousIntValues + IO_continuousIntValues, & +#if defined(Abaqus) + IO_extractValue, & + IO_countDataLines +#elif defined(Marc4DAMASK) + IO_skipChunks, & + IO_fixedNoEFloatValue, & + IO_fixedIntValue, & + IO_countNumericalDataLines +#endif #endif private :: & IO_verifyFloatValue, & @@ -356,7 +355,7 @@ subroutine IO_open_inputFile(fileUnit,modelName) integer(pInt) :: myStat character(len=1024) :: path -#ifdef Abaqus +#if defined(Abaqus) integer(pInt) :: fileType fileType = 1_pInt ! assume .pes @@ -427,8 +426,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) 200 createSuccess =.false. end function abaqus_assembleInputFile -#endif -#ifdef Marc4DAMASK +#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) From 77d60be1279299c3f5d113be7eef31b30c325646 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 11:30:56 +0100 Subject: [PATCH 128/154] avoid superfluous reporting --- src/DAMASK_abaqus.f | 5 +++++ src/DAMASK_marc.f90 | 5 +++++ src/mesh_abaqus.f90 | 8 -------- src/mesh_grid.f90 | 8 -------- src/mesh_marc.f90 | 9 --------- 5 files changed, 10 insertions(+), 25 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index f17b5bb25..8cd3a4930 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -30,6 +30,11 @@ contains !> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init +#if __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use ifport, only: & CHDIR diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 9b1427d78..892b2cbc4 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -43,6 +43,11 @@ contains !> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init +#if __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use ifport, only: & CHDIR diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 60b1484c1..4e923606e 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -6,7 +6,6 @@ !> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver !-------------------------------------------------------------------------------------------------- module mesh - use, intrinsic :: iso_c_binding use prec, only: pReal, pInt use mesh_base @@ -425,11 +424,6 @@ end subroutine tMesh_abaqus_init !! Order and routines strongly depend on type of solver !-------------------------------------------------------------------------------------------------- subroutine mesh_init(ip,el) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use DAMASK_interface use IO, only: & IO_open_InputFile, & @@ -458,8 +452,6 @@ subroutine mesh_init(ip,el) logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index d55c1cded..424456e3a 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -169,11 +169,6 @@ end subroutine tMesh_grid_init !! Order and routines strongly depend on type of solver !-------------------------------------------------------------------------------------------------- subroutine mesh_init(ip,el) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif #include use PETScsys @@ -206,9 +201,6 @@ subroutine mesh_init(ip,el) logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index f9ba0378b..0c7d332c9 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -6,7 +6,6 @@ !> @brief Sets up the mesh for the solver MSC.Marc !-------------------------------------------------------------------------------------------------- module mesh - use, intrinsic :: iso_c_binding use prec, only: pReal, pInt use mesh_base @@ -284,11 +283,6 @@ end subroutine tMesh_marc_init !! Order and routines strongly depend on type of solver !-------------------------------------------------------------------------------------------------- subroutine mesh_init(ip,el) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use DAMASK_interface use IO, only: & IO_open_InputFile, & @@ -322,9 +316,6 @@ subroutine mesh_init(ip,el) logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh From 63e2ea7d8f5eac38ae3ac095c8cb5eb9ed201dbe Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 12:49:28 +0100 Subject: [PATCH 129/154] was not use (anymore) --- src/IO.f90 | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 42ba479cd..3d330a2df 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -27,7 +27,6 @@ module IO IO_open_file_stat, & IO_open_jobFile_stat, & IO_open_file, & - IO_open_jobFile, & IO_write_jobFile, & IO_write_jobRealFile, & IO_read_realFile, & @@ -291,30 +290,6 @@ logical function IO_open_file_stat(fileUnit,path) end function IO_open_file_stat -!-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. File is named after solver job name -!! plus given extension and located in current working directory -!> @details like IO_open_jobFile_stat, but error is handled via call to IO_error and not via return -!! value -!-------------------------------------------------------------------------------------------------- -subroutine IO_open_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(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverJobName())//'.'//ext - 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) - -end subroutine IO_open_jobFile - - !-------------------------------------------------------------------------------------------------- !> @brief opens existing file for reading to given unit. File is named after solver job name !! plus given extension and located in current working directory From fa003e8077043352181bd0f2b1f3541f4ffa0c9b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 14:53:56 +0100 Subject: [PATCH 130/154] small adjustments for autodoc --- processing/post/addCalculation.py | 17 +++++++---------- processing/post/addCumulative.py | 5 +---- processing/post/addDisplacement.py | 1 - processing/post/addGaussian.py | 5 ++--- processing/post/addGrainID.py | 6 +++--- processing/post/addInfo.py | 5 +++-- processing/post/addMises.py | 6 +----- processing/post/addNorm.py | 7 ++++++- processing/post/addOrientations.py | 5 ++--- processing/post/addPole.py | 1 - processing/post/addSchmidfactors.py | 2 +- processing/post/addStrainTensors.py | 9 ++++----- processing/post/addTable.py | 4 ++++ processing/post/averageDown.py | 8 +++----- processing/post/binXY.py | 9 +++------ processing/post/blowUp.py | 4 ++-- processing/post/rotateData.py | 2 +- 17 files changed, 43 insertions(+), 53 deletions(-) diff --git a/processing/post/addCalculation.py b/processing/post/addCalculation.py index d19855753..ebc0d95a4 100755 --- a/processing/post/addCalculation.py +++ b/processing/post/addCalculation.py @@ -41,10 +41,7 @@ parser.add_option('-f','--formula', parser.add_option('-c','--condition', dest = 'condition', metavar='string', - help = 'condition to alter existing column data') - -parser.set_defaults(condition = None, - ) + help = 'condition to alter existing column data (optional)') (options,filenames) = parser.parse_args() @@ -80,7 +77,7 @@ for name in filenames: condition = options.condition # copy per file, since might be altered inline breaker = False - for position,(all,marker,column) in enumerate(set(re.findall(r'#(([s]#)?(.+?))#',condition))): # find three groups + for position,(all,marker,column) in enumerate(set(re.findall(r'#(([s]#)?(.+?))#',condition))): # find three groups idx = table.label_index(column) dim = table.label_dimension(column) if idx < 0 and column not in specials: @@ -89,15 +86,15 @@ for name in filenames: else: if column in specials: replacement = 'specials["{}"]'.format(column) - elif dim == 1: # scalar input + elif dim == 1: # scalar input replacement = '{}(table.data[{}])'.format({ '':'float', - 's#':'str'}[marker],idx) # take float or string value of data column - elif dim > 1: # multidimensional input (vector, tensor, etc.) - replacement = 'np.array(table.data[{}:{}],dtype=float)'.format(idx,idx+dim) # use (flat) array representation + 's#':'str'}[marker],idx) # take float or string value of data column + elif dim > 1: # multidimensional input (vector, tensor, etc.) + replacement = 'np.array(table.data[{}:{}],dtype=float)'.format(idx,idx+dim) # use (flat) array representation condition = condition.replace('#'+all+'#',replacement) - if breaker: continue # found mistake in condition evaluation --> next file + if breaker: continue # found mistake in condition evaluation --> next file # ------------------------------------------ build formulas ---------------------------------------- diff --git a/processing/post/addCumulative.py b/processing/post/addCumulative.py index dfa8059dc..37ad6e0ce 100755 --- a/processing/post/addCumulative.py +++ b/processing/post/addCumulative.py @@ -22,12 +22,9 @@ parser.add_option('-l','--label', action = 'extend', metavar = '', help = 'columns to cumulate') -parser.set_defaults(label = [], - ) - (options,filenames) = parser.parse_args() -if len(options.label) == 0: +if options.label is None: parser.error('no data column(s) specified.') # --- loop over input files ------------------------------------------------------------------------- diff --git a/processing/post/addDisplacement.py b/processing/post/addDisplacement.py index ff9d251f7..76b044106 100755 --- a/processing/post/addDisplacement.py +++ b/processing/post/addDisplacement.py @@ -111,7 +111,6 @@ parser.add_option('--nodal', parser.set_defaults(defgrad = 'f', pos = 'pos', - nodal = False, ) (options,filenames) = parser.parse_args() diff --git a/processing/post/addGaussian.py b/processing/post/addGaussian.py index f468790ef..cb610ba67 100755 --- a/processing/post/addGaussian.py +++ b/processing/post/addGaussian.py @@ -34,12 +34,12 @@ parser.add_option('-o','--order', dest = 'order', type = int, metavar = 'int', - help = 'order of the filter') + help = 'order of the filter [%default]') parser.add_option('--sigma', dest = 'sigma', type = float, metavar = 'float', - help = 'standard deviation') + help = 'standard deviation [%default]') parser.add_option('--periodic', dest = 'periodic', action = 'store_true', @@ -50,7 +50,6 @@ parser.add_option('--periodic', parser.set_defaults(pos = 'pos', order = 0, sigma = 1, - periodic = False, ) (options,filenames) = parser.parse_args() diff --git a/processing/post/addGrainID.py b/processing/post/addGrainID.py index 3c4eaf4fa..6493736d8 100755 --- a/processing/post/addGrainID.py +++ b/processing/post/addGrainID.py @@ -28,9 +28,9 @@ parser.add_option('-d', help = 'disorientation threshold in degrees [%default]') parser.add_option('-s', '--symmetry', - dest = 'symmetry', + dest = 'symmetry', type = 'choice', choices = damask.Symmetry.lattices[1:], metavar = 'string', - help = 'crystal symmetry [%default]') + help = 'crystal symmetry [%default] {{{}}} '.format(', '.join(damask.Symmetry.lattices[1:]))) parser.add_option('-o', '--orientation', dest = 'quaternion', @@ -49,7 +49,7 @@ parser.add_option('--quiet', parser.set_defaults(disorientation = 5, verbose = True, quaternion = 'orientation', - symmetry = 'cubic', + symmetry = damask.Symmetry.lattices[-1], pos = 'pos', ) diff --git a/processing/post/addInfo.py b/processing/post/addInfo.py index 59efcd973..feb316f45 100755 --- a/processing/post/addInfo.py +++ b/processing/post/addInfo.py @@ -23,11 +23,12 @@ parser.add_option('-i', dest = 'info', action = 'extend', metavar = '', help = 'items to add') -parser.set_defaults(info = [], - ) (options,filenames) = parser.parse_args() +if options.info is None: + parser.error('no info specified.') + # --- loop over input files ------------------------------------------------------------------------ if filenames == []: filenames = [None] diff --git a/processing/post/addMises.py b/processing/post/addMises.py index 7e757ed9d..789540072 100755 --- a/processing/post/addMises.py +++ b/processing/post/addMises.py @@ -38,13 +38,9 @@ parser.add_option('-s','--stress', action = 'extend', metavar = '', help = 'heading(s) of columns containing stress tensors') -parser.set_defaults(strain = [], - stress = [], - ) - (options,filenames) = parser.parse_args() -if len(options.stress+options.strain) == 0: +if options.stress is None and options.strain is None: parser.error('no data column specified...') # --- loop over input files ------------------------------------------------------------------------- diff --git a/processing/post/addNorm.py b/processing/post/addNorm.py index f90cd4b31..6f879e935 100755 --- a/processing/post/addNorm.py +++ b/processing/post/addNorm.py @@ -9,6 +9,7 @@ scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) # definition of element-wise p-norms for matrices +# ToDo: better use numpy.linalg.norm def norm(which,object): @@ -18,6 +19,8 @@ def norm(which,object): return math.sqrt(sum([x*x for x in object])) elif which == 'Max': # p = inf return max(map(abs, object)) + else: + return -1 # -------------------------------------------------------------------- # MAIN @@ -43,6 +46,8 @@ parser.set_defaults(norm = 'frobenius', (options,filenames) = parser.parse_args() +if options.norm.lower() not in normChoices: + parser.error('invalid norm ({}) specified.'.format(options.norm)) if options.label is None: parser.error('no data column specified.') @@ -74,7 +79,7 @@ for name in filenames: else: dims.append(dim) columns.append(table.label_index(what)) - table.labels_append('norm{}({})'.format(options.norm.capitalize(),what)) # extend ASCII header with new labels + table.labels_append('norm{}({})'.format(options.norm.capitalize(),what)) # extend ASCII header with new labels if remarks != []: damask.util.croak(remarks) if errors != []: diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index a33f96b91..41fa7a5df 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -68,12 +68,12 @@ parser.add_option('-R', '--labrotation', dest='labrotation', type = 'float', nargs = 4, metavar = ' '.join(['float']*4), - help = 'angle and axis of additional lab frame rotation') + help = 'angle and axis of additional lab frame rotation [%default]') parser.add_option('-r', '--crystalrotation', dest='crystalrotation', type = 'float', nargs = 4, metavar = ' '.join(['float']*4), - help = 'angle and axis of additional crystal frame rotation') + help = 'angle and axis of additional crystal frame rotation [%default]') parser.add_option('--eulers', dest = 'eulers', metavar = 'string', @@ -106,7 +106,6 @@ parser.add_option('-z', parser.set_defaults(output = [], labrotation = (0.,1.,1.,1.), # no rotation about 1,1,1 crystalrotation = (0.,1.,1.,1.), # no rotation about 1,1,1 - degrees = False, ) (options, filenames) = parser.parse_args() diff --git a/processing/post/addPole.py b/processing/post/addPole.py index 3098effc7..27e44e2a1 100755 --- a/processing/post/addPole.py +++ b/processing/post/addPole.py @@ -35,7 +35,6 @@ parser.add_option('-o', parser.set_defaults(pole = (1.0,0.0,0.0), quaternion = 'orientation', - polar = False, ) (options, filenames) = parser.parse_args() diff --git a/processing/post/addSchmidfactors.py b/processing/post/addSchmidfactors.py index 6335b419e..6ef6a71a0 100755 --- a/processing/post/addSchmidfactors.py +++ b/processing/post/addSchmidfactors.py @@ -115,7 +115,7 @@ parser.add_option('-l', help = 'type of lattice structure [%default] {}'.format(latticeChoices)) parser.add_option('--covera', dest = 'CoverA', type = 'float', metavar = 'float', - help = 'C over A ratio for hexagonal systems') + help = 'C over A ratio for hexagonal systems [%default]') parser.add_option('-f', '--force', dest = 'force', diff --git a/processing/post/addStrainTensors.py b/processing/post/addStrainTensors.py index bffc92f9a..7e16d976c 100755 --- a/processing/post/addStrainTensors.py +++ b/processing/post/addStrainTensors.py @@ -56,16 +56,15 @@ parser.add_option('-f','--defgrad', metavar = '', help = 'heading(s) of columns containing deformation tensor values [%default]') -parser.set_defaults(right = False, - left = False, - logarithmic = False, - biot = False, - green = False, +parser.set_defaults( defgrad = ['f'], ) (options,filenames) = parser.parse_args() +if len(options.defgrad) > 1: + options.defgrad = options.defgrad[1:] + stretches = [] strains = [] diff --git a/processing/post/addTable.py b/processing/post/addTable.py index 126db6f65..8bcb43d70 100755 --- a/processing/post/addTable.py +++ b/processing/post/addTable.py @@ -24,6 +24,10 @@ parser.add_option('-a', '--add','--table', (options,filenames) = parser.parse_args() +if options.table is None: + parser.error('no table specified.') + + # --- loop over input files ------------------------------------------------------------------------- if filenames == []: filenames = [None] diff --git a/processing/post/averageDown.py b/processing/post/averageDown.py index 96520a789..ac7cc00dd 100755 --- a/processing/post/averageDown.py +++ b/processing/post/averageDown.py @@ -34,16 +34,14 @@ parser.add_option('--shift', parser.add_option('-g', '--grid', dest = 'grid', type = 'int', nargs = 3, metavar = 'int int int', - help = 'grid in x,y,z [autodetect]') + help = 'grid in x,y,z (optional)') parser.add_option('-s', '--size', dest = 'size', type = 'float', nargs = 3, metavar = 'float float float', - help = 'size in x,y,z [autodetect]') + help = 'size in x,y,z (optional)') parser.set_defaults(pos = 'pos', packing = (2,2,2), shift = (0,0,0), - grid = (0,0,0), - size = (0.0,0.0,0.0), ) (options,filenames) = parser.parse_args() @@ -92,7 +90,7 @@ for name in filenames: table.data_readArray() - if (any(options.grid) == 0 or any(options.size) == 0.0): + if (options.grid is None or options.size is None): grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) else: grid = np.array(options.grid,'i') diff --git a/processing/post/binXY.py b/processing/post/binXY.py index ea73d13b9..2c148e69a 100755 --- a/processing/post/binXY.py +++ b/processing/post/binXY.py @@ -37,15 +37,15 @@ parser.add_option('-t','--type', parser.add_option('-x','--xrange', dest = 'xrange', type = 'float', nargs = 2, metavar = 'float float', - help = 'min max value in x direction [autodetect]') + help = 'min max limits in x direction (optional)') parser.add_option('-y','--yrange', dest = 'yrange', type = 'float', nargs = 2, metavar = 'float float', - help = 'min max value in y direction [autodetect]') + help = 'min max limits in y direction (optional)') parser.add_option('-z','--zrange', dest = 'zrange', type = 'float', nargs = 2, metavar = 'float float', - help = 'min max value in z direction [autodetect]') + help = 'min max limits in z direction (optional)') parser.add_option('-i','--invert', dest = 'invert', action = 'store_true', @@ -64,9 +64,6 @@ parser.set_defaults(bins = (10,10), xrange = (0.0,0.0), yrange = (0.0,0.0), zrange = (0.0,0.0), - invert = False, - normRow = False, - normCol = False, ) (options,filenames) = parser.parse_args() diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index 22de70d5b..e06791afe 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -27,10 +27,10 @@ parser.add_option('-p','--packing', help = 'dimension of packed group [%default]') parser.add_option('-g','--grid', dest = 'resolution', type = 'int', nargs = 3, metavar = 'int int int', - help = 'resolution in x,y,z [autodetect]') + help = 'grid in x,y,z (optional)') parser.add_option('-s','--size', dest = 'dimension', type = 'float', nargs = 3, metavar = 'int int int', - help = 'dimension in x,y,z [autodetect]') + help = 'size in x,y,z (optional)') parser.set_defaults(pos = 'pos', packing = (2,2,2), grid = (0,0,0), diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 95102345b..1ac4a9354 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -29,7 +29,7 @@ parser.add_option('-r', '--rotation', parser.add_option('--degrees', dest = 'degrees', action = 'store_true', - help = 'angles are given in degrees [%default]') + help = 'angles are given in degrees') parser.set_defaults(rotation = (0.,1.,1.,1.), # no rotation about 1,1,1 degrees = False, From aaf243b3daf19a138d45d0c2fcad54436dab8ace Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 15:27:01 +0100 Subject: [PATCH 131/154] simpler logic: define exceptions --- .gitlab-ci.yml | 21 ++------------------- PRIVATE | 2 +- 2 files changed, 3 insertions(+), 20 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 58e74a0fd..a021455e1 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -505,25 +505,8 @@ Processing: stage: createDocumentation script: - cd $DAMASKROOT/processing/post - - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py - addAPS34IDEstrainCoords.py - addCauchy.py addCalculation.py addCompatibilityMismatch.py addCumulative.py addCurl.py - addDerivative.py addDeterminant.py addDeviator.py addDisplacement.py addDivergence.py - addEhkl.py addEuclideanDistance.py - addGaussian.py addGradient.py addGrainID.py - addIndexed.py - addInfo.py - addLinked.py - addMises.py - addNorm.py - addPK2.py - addSpectralDecomposition.py addStrainTensors.py - addTable.py - filterTable.py - perceptualUniformColorMap.py - reLabel.py - scaleData.py shiftData.py sortTable.py - viewTable.py > post.html + - rm marc_to_vtk.py vtk2ang.py + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py * except: - master - release diff --git a/PRIVATE b/PRIVATE index 18ba1ba6a..6b968ff1c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 18ba1ba6a5e9ba446dc9311acf2acf2781614db1 +Subproject commit 6b968ff1ce03333c2db386167f9740ce6e22443b From 29fc53fdcbda6071061d6711ae813a5bc09d828d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 17:41:56 +0100 Subject: [PATCH 132/154] more specific about invocation --- processing/post/addAPS34IDEstrainCoords.py | 2 +- processing/post/addCalculation.py | 2 +- processing/post/addCauchy.py | 4 ++-- processing/post/addCompatibilityMismatch.py | 2 +- processing/post/addCumulative.py | 2 +- processing/post/addCurl.py | 2 +- processing/post/addDerivative.py | 2 +- processing/post/addDeterminant.py | 2 +- processing/post/addDeviator.py | 2 +- processing/post/addDisplacement.py | 2 +- processing/post/addEhkl.py | 2 +- processing/post/addEuclideanDistance.py | 2 +- processing/post/addGaussian.py | 2 +- processing/post/addGradient.py | 2 +- processing/post/addIPFcolor.py | 2 +- processing/post/addIndexed.py | 2 +- processing/post/addInfo.py | 2 +- processing/post/reLabel.py | 2 +- processing/post/viewTable.py | 2 +- processing/post/vtk_pointCloud.py | 2 +- processing/post/vtk_rectilinearGrid.py | 2 +- 21 files changed, 22 insertions(+), 22 deletions(-) diff --git a/processing/post/addAPS34IDEstrainCoords.py b/processing/post/addAPS34IDEstrainCoords.py index 78202d9a9..8bfca35d3 100755 --- a/processing/post/addAPS34IDEstrainCoords.py +++ b/processing/post/addAPS34IDEstrainCoords.py @@ -14,7 +14,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Transform X,Y,Z,F APS BeamLine 34 coordinates to x,y,z APS strain coordinates. """, version = scriptID) diff --git a/processing/post/addCalculation.py b/processing/post/addCalculation.py index ebc0d95a4..73edde9e8 100755 --- a/processing/post/addCalculation.py +++ b/processing/post/addCalculation.py @@ -18,7 +18,7 @@ def listify(x): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add or alter column(s) with derived values according to user-defined arithmetic operation between column(s). Column labels are tagged by '#label#' in formulas. Use ';' for ',' in functions. Numpy is available as 'np'. diff --git a/processing/post/addCauchy.py b/processing/post/addCauchy.py index 3c873f2aa..c7b95f562 100755 --- a/processing/post/addCauchy.py +++ b/processing/post/addCauchy.py @@ -13,8 +13,8 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ -Add column(s) containing Cauchy stress based on given column(s) of deformation gradient and first Piola--Kirchhoff stress. +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ +Add column containing Cauchy stress based on deformation gradient and first Piola--Kirchhoff stress. """, version = scriptID) diff --git a/processing/post/addCompatibilityMismatch.py b/processing/post/addCompatibilityMismatch.py index 7d2a89fa0..1fe84bf2b 100755 --- a/processing/post/addCompatibilityMismatch.py +++ b/processing/post/addCompatibilityMismatch.py @@ -209,7 +209,7 @@ def shapeMismatch(size,F,nodes,centres): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options file[s]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing the shape and volume mismatch resulting from given deformation gradient. Operates on periodic three-dimensional x,y,z-ordered data sets. diff --git a/processing/post/addCumulative.py b/processing/post/addCumulative.py index 37ad6e0ce..392cbd69e 100755 --- a/processing/post/addCumulative.py +++ b/processing/post/addCumulative.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add cumulative (sum of first to current row) values for given label(s). """, version = scriptID) diff --git a/processing/post/addCurl.py b/processing/post/addCurl.py index cae1ef8b0..5c9d46e2f 100755 --- a/processing/post/addCurl.py +++ b/processing/post/addCurl.py @@ -56,7 +56,7 @@ def curlFFT(geomdim,field): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing curl of requested column(s). Operates on periodic ordered three-dimensional data sets of vector and tensor fields. diff --git a/processing/post/addDerivative.py b/processing/post/addDerivative.py index 35ca7130b..7967af4b2 100755 --- a/processing/post/addDerivative.py +++ b/processing/post/addDerivative.py @@ -34,7 +34,7 @@ def derivative(coordinates,what): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing numerical derivative of requested column(s) with respect to given coordinates. """, version = scriptID) diff --git a/processing/post/addDeterminant.py b/processing/post/addDeterminant.py index b8b177e37..897f2364b 100755 --- a/processing/post/addDeterminant.py +++ b/processing/post/addDeterminant.py @@ -20,7 +20,7 @@ def determinant(m): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing determinant of requested tensor column(s). """, version = scriptID) diff --git a/processing/post/addDeviator.py b/processing/post/addDeviator.py index 1f97ca467..220b29ec8 100755 --- a/processing/post/addDeviator.py +++ b/processing/post/addDeviator.py @@ -23,7 +23,7 @@ def deviator(m,spherical = False): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(2)]', description = """ Add column(s) containing deviator of requested tensor column(s). """, version = scriptID) diff --git a/processing/post/addDisplacement.py b/processing/post/addDisplacement.py index 76b044106..aa12ba2b1 100755 --- a/processing/post/addDisplacement.py +++ b/processing/post/addDisplacement.py @@ -87,7 +87,7 @@ def displacementFluctFFT(F,grid,size,nodal=False,transformed=False): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog [options] [ASCIItable(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add displacments resulting from deformation gradient field. Operates on periodic three-dimensional x,y,z-ordered data sets. Outputs at cell centers or cell nodes (into separate file). diff --git a/processing/post/addEhkl.py b/processing/post/addEhkl.py index 3cfec69af..573484617 100755 --- a/processing/post/addEhkl.py +++ b/processing/post/addEhkl.py @@ -30,7 +30,7 @@ def E_hkl(stiffness,vec): # stiffness = (c11,c12,c44) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing directional stiffness based on given cubic stiffness values C11, C12, and C44 in consecutive columns. """, version = scriptID) diff --git a/processing/post/addEuclideanDistance.py b/processing/post/addEuclideanDistance.py index f759b7a8f..b11f46fd8 100755 --- a/processing/post/addEuclideanDistance.py +++ b/processing/post/addEuclideanDistance.py @@ -83,7 +83,7 @@ neighborhoods = { ]) } -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing Euclidean distance to grain structural features: boundaries, triple lines, and quadruple points. """, version = scriptID) diff --git a/processing/post/addGaussian.py b/processing/post/addGaussian.py index cb610ba67..3f237a3e6 100755 --- a/processing/post/addGaussian.py +++ b/processing/post/addGaussian.py @@ -15,7 +15,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog option [ASCIItable(s)]', description = """ Add column(s) containing Gaussian filtered values of requested column(s). Operates on periodic and non-periodic ordered three-dimensional data sets. For details see scipy.ndimage documentation. diff --git a/processing/post/addGradient.py b/processing/post/addGradient.py index 676efb27e..d3910d2ad 100755 --- a/processing/post/addGradient.py +++ b/processing/post/addGradient.py @@ -52,7 +52,7 @@ def gradFFT(geomdim,field): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog option [ASCIItable(s)]', description = """ Add column(s) containing gradient of requested column(s). Operates on periodic ordered three-dimensional data sets of vector and scalar fields. diff --git a/processing/post/addIPFcolor.py b/processing/post/addIPFcolor.py index c5a59a63a..9c191b3ad 100755 --- a/processing/post/addIPFcolor.py +++ b/processing/post/addIPFcolor.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add RGB color value corresponding to TSL-OIM scheme for inverse pole figures. """, version = scriptID) diff --git a/processing/post/addIndexed.py b/processing/post/addIndexed.py index 63206d329..9a73f5572 100755 --- a/processing/post/addIndexed.py +++ b/processing/post/addIndexed.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add data in column(s) of mapped ASCIItable selected from the row indexed by the value in a mapping column. Row numbers start at 1. diff --git a/processing/post/addInfo.py b/processing/post/addInfo.py index feb316f45..fbfa8c3dd 100755 --- a/processing/post/addInfo.py +++ b/processing/post/addInfo.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options file[s]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add info lines to ASCIItable header. """, version = scriptID) diff --git a/processing/post/reLabel.py b/processing/post/reLabel.py index 0c6ef8dc9..a8d0e1556 100755 --- a/processing/post/reLabel.py +++ b/processing/post/reLabel.py @@ -12,7 +12,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog [options] dfile[s]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Rename scalar, vectorial, and/or tensorial data header labels. """, version = scriptID) diff --git a/processing/post/viewTable.py b/processing/post/viewTable.py index d661e4727..514ea40d9 100755 --- a/processing/post/viewTable.py +++ b/processing/post/viewTable.py @@ -12,7 +12,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(usage='%prog [options] [file[s]]', description = """ +parser = OptionParser(usage='%prog options [ASCIItable(s)]', description = """ Show components of given ASCIItable(s). """, version = scriptID) diff --git a/processing/post/vtk_pointCloud.py b/processing/post/vtk_pointCloud.py index a9ce1f81f..44168fb60 100755 --- a/processing/post/vtk_pointCloud.py +++ b/processing/post/vtk_pointCloud.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Produce a VTK point cloud dataset based on coordinates given in an ASCIItable. """, version = scriptID) diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index c94f44228..36218d68d 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Create regular voxel grid from points in an ASCIItable. """, version = scriptID) From e1525cc529aa1ed0b09ec1d2b5842499c4be724f Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 16 Feb 2019 16:58:23 +0000 Subject: [PATCH 133/154] [skip ci] updated version information after successful test of v2.0.2-1789-g524bfb8c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c778e617c..e1be2bda8 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1713-g0fd54768 +v2.0.2-1789-g524bfb8c From 97460692972bc864f40fe4eb5a96ede52b3ef487 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 17:59:57 +0100 Subject: [PATCH 134/154] updated script for documentation generation --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 6b968ff1c..3e1467f13 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 6b968ff1ce03333c2db386167f9740ce6e22443b +Subproject commit 3e1467f13ace5bf9002b211d1302c80e6f85cec3 From c3e3fe14004749aaaf3119d23e9855d972624db0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 18:00:53 +0100 Subject: [PATCH 135/154] allow non-confirming scripts at the moment --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index a021455e1..f64b1bb13 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -506,7 +506,7 @@ Processing: script: - cd $DAMASKROOT/processing/post - rm marc_to_vtk.py vtk2ang.py - - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py * + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug \*.py except: - master - release From 0b1bfdfd4e5dc29169d347629f14a42eb02997c6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 18:17:05 +0100 Subject: [PATCH 136/154] was only working with python2 --- PRIVATE | 2 +- processing/post/addDivergence.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index 3e1467f13..a76f03d99 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3e1467f13ace5bf9002b211d1302c80e6f85cec3 +Subproject commit a76f03d99492ff14b7942124d76952c675aa85c3 diff --git a/processing/post/addDivergence.py b/processing/post/addDivergence.py index 73eb4ed9e..f579a0a49 100755 --- a/processing/post/addDivergence.py +++ b/processing/post/addDivergence.py @@ -45,7 +45,7 @@ def divFFT(geomdim,field): div_fourier = np.einsum(einsums[n],k_s,field_fourier)*TWOPIIMG - return np.fft.irfftn(div_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n/3]) + return np.fft.irfftn(div_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n//3]) # -------------------------------------------------------------------- From c6781e415af80518f07a39519ae41153b872a09e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 18:23:00 +0100 Subject: [PATCH 137/154] using default notation for vector access --- processing/post/addAPS34IDEstrainCoords.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/processing/post/addAPS34IDEstrainCoords.py b/processing/post/addAPS34IDEstrainCoords.py index 8bfca35d3..67231a368 100755 --- a/processing/post/addAPS34IDEstrainCoords.py +++ b/processing/post/addAPS34IDEstrainCoords.py @@ -19,8 +19,8 @@ Transform X,Y,Z,F APS BeamLine 34 coordinates to x,y,z APS strain coordinates. """, version = scriptID) -parser.add_option('-f','--frame',dest='frame', nargs=3, metavar='string string string', - help='APS X,Y,Z coords') +parser.add_option('-f','--frame',dest='frame', metavar='string', + help='label of APS X,Y,Z coords') parser.add_option('--depth', dest='depth', metavar='string', help='depth') From 802ef6fe5c28aebea7b1eae10c780400a856cb12 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 18:25:41 +0100 Subject: [PATCH 138/154] more precise help --- processing/post/addNorm.py | 2 +- processing/post/addPK2.py | 2 +- processing/post/addSchmidfactors.py | 2 +- processing/post/addTable.py | 2 +- processing/post/groupTable.py | 2 +- processing/post/permuteData.py | 2 +- processing/post/sortTable.py | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/processing/post/addNorm.py b/processing/post/addNorm.py index 6f879e935..efadc0f52 100755 --- a/processing/post/addNorm.py +++ b/processing/post/addNorm.py @@ -26,7 +26,7 @@ def norm(which,object): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing norm of requested column(s) being either vectors or tensors. """, version = scriptID) diff --git a/processing/post/addPK2.py b/processing/post/addPK2.py index 3c615295d..cddcd7002 100755 --- a/processing/post/addPK2.py +++ b/processing/post/addPK2.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing Second Piola--Kirchhoff stress based on given column(s) of deformation gradient and first Piola--Kirchhoff stress. diff --git a/processing/post/addSchmidfactors.py b/processing/post/addSchmidfactors.py index 6ef6a71a0..056d4d678 100755 --- a/processing/post/addSchmidfactors.py +++ b/processing/post/addSchmidfactors.py @@ -103,7 +103,7 @@ slipSystems = { # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add columns listing Schmid factors (and optional trace vector of selected system) for given Euler angles. """, version = scriptID) diff --git a/processing/post/addTable.py b/processing/post/addTable.py index 8bcb43d70..eb61b43dc 100755 --- a/processing/post/addTable.py +++ b/processing/post/addTable.py @@ -12,7 +12,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Append data of ASCIItable(s). """, version = scriptID) diff --git a/processing/post/groupTable.py b/processing/post/groupTable.py index f78566304..d97861495 100755 --- a/processing/post/groupTable.py +++ b/processing/post/groupTable.py @@ -20,7 +20,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Apply a user-specified function to condense into a single row all those rows for which columns 'label' have identical values. Output table will contain as many rows as there are different (unique) values in the grouping column(s). Periodic domain averaging of coordinate values is supported. diff --git a/processing/post/permuteData.py b/processing/post/permuteData.py index 1843c9f57..d263e42b8 100755 --- a/processing/post/permuteData.py +++ b/processing/post/permuteData.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Permute all values in given column(s). """, version = scriptID) diff --git a/processing/post/sortTable.py b/processing/post/sortTable.py index 92fa81672..bf23193bb 100755 --- a/processing/post/sortTable.py +++ b/processing/post/sortTable.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Sort rows by given (or all) column label(s). Examples: From 5c20609e81a4783ca390964c8f3f56740f42bec3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 22:20:10 +0100 Subject: [PATCH 139/154] more verbose help, drop support for really old vtk --- PRIVATE | 2 +- processing/post/addLinked.py | 2 +- processing/post/addMises.py | 2 +- processing/post/addOrientations.py | 2 +- processing/post/addPole.py | 2 +- processing/post/addSpectralDecomposition.py | 2 +- processing/post/addStrainTensors.py | 2 +- processing/post/averageDown.py | 2 +- processing/post/binXY.py | 2 +- processing/post/blowUp.py | 2 +- processing/post/filterTable.py | 2 +- processing/post/vtk_addGridData.py | 5 ++--- processing/post/vtk_addPointcloudData.py | 8 ++------ processing/post/vtk_pointCloud.py | 5 ++--- processing/post/vtk_rectilinearGrid.py | 3 +-- 15 files changed, 18 insertions(+), 25 deletions(-) diff --git a/PRIVATE b/PRIVATE index a76f03d99..7e51c3e08 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit a76f03d99492ff14b7942124d76952c675aa85c3 +Subproject commit 7e51c3e08655261ec9bd43c6841575e323927de7 diff --git a/processing/post/addLinked.py b/processing/post/addLinked.py index 097f8f2c5..bed3da30a 100755 --- a/processing/post/addLinked.py +++ b/processing/post/addLinked.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add data of selected column(s) from (first) row of linked ASCIItable that shares the linking column value. """, version = scriptID) diff --git a/processing/post/addMises.py b/processing/post/addMises.py index 789540072..35a6922c3 100755 --- a/processing/post/addMises.py +++ b/processing/post/addMises.py @@ -24,7 +24,7 @@ def Mises(what,tensor): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add vonMises equivalent values for symmetric part of requested strains and/or stresses. """, version = scriptID) diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index 41fa7a5df..bcb292ef9 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -38,7 +38,7 @@ def check_matrix(M): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add quaternion and/or Bunge Euler angle representation of crystal lattice orientation. Orientation is given by quaternion, Euler angles, rotation matrix, or crystal frame coordinates (i.e. component vectors of rotation matrix). diff --git a/processing/post/addPole.py b/processing/post/addPole.py index 27e44e2a1..628d64d5e 100755 --- a/processing/post/addPole.py +++ b/processing/post/addPole.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add coordinates of stereographic projection of given direction (pole) in crystal frame. """, version = scriptID) diff --git a/processing/post/addSpectralDecomposition.py b/processing/post/addSpectralDecomposition.py index e7d552c70..f3c25b117 100755 --- a/processing/post/addSpectralDecomposition.py +++ b/processing/post/addSpectralDecomposition.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing eigenvalues and eigenvectors of requested symmetric tensor column(s). """, version = scriptID) diff --git a/processing/post/addStrainTensors.py b/processing/post/addStrainTensors.py index 7e16d976c..375b0b5e8 100755 --- a/processing/post/addStrainTensors.py +++ b/processing/post/addStrainTensors.py @@ -25,7 +25,7 @@ def operator(stretch,strain,eigenvalues): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing given strains based on given stretches of requested deformation gradient column(s). """, version = scriptID) diff --git a/processing/post/averageDown.py b/processing/post/averageDown.py index ac7cc00dd..3a70cf314 100755 --- a/processing/post/averageDown.py +++ b/processing/post/averageDown.py @@ -14,7 +14,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Average each data block of size 'packing' into single values thus reducing the former grid to grid/packing. """, version = scriptID) diff --git a/processing/post/binXY.py b/processing/post/binXY.py index 2c148e69a..dc286b7ac 100755 --- a/processing/post/binXY.py +++ b/processing/post/binXY.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Produces a binned grid of two columns from an ASCIItable, i.e. a two-dimensional probability density map. """, version = scriptID) diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index e06791afe..d596bb751 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Blows up each value to a surrounding data block of size 'packing' thus increasing the former resolution to resolution*packing. diff --git a/processing/post/filterTable.py b/processing/post/filterTable.py index 865df6c03..2703ea274 100755 --- a/processing/post/filterTable.py +++ b/processing/post/filterTable.py @@ -30,7 +30,7 @@ def sortingList(labels,whitelistitems): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Filter rows according to condition and columns by either white or black listing. Examples: diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index 315071a4b..a1713afb1 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -17,7 +17,7 @@ scriptID = ' '.join([scriptName,damask.version]) msg = "Add scalars, vectors, and/or an RGB tuple from" msg += "an ASCIItable to existing VTK grid (.vtr/.vtk/.vtu)." parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', + usage='%prog options [ASCIItable(s)]', description = msg, version = scriptID) @@ -172,8 +172,7 @@ for name in filenames: writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid) - else: writer.SetInputData(rGrid) + writer.SetInputData(rGrid) writer.Write() # ------------------------------------------ render result --------------------------------------- diff --git a/processing/post/vtk_addPointcloudData.py b/processing/post/vtk_addPointcloudData.py index d75eb97b4..369320d3d 100755 --- a/processing/post/vtk_addPointcloudData.py +++ b/processing/post/vtk_addPointcloudData.py @@ -15,7 +15,7 @@ scriptID = ' '.join([scriptName,damask.version]) # -------------------------------------------------------------------- parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', + usage='%prog options [ASCIItable(s)]', description = """Add scalar and RGB tuples from ASCIItable to existing VTK point cloud (.vtp).""", version = scriptID) @@ -46,8 +46,6 @@ parser.add_option('-c', '--color', dest='color', action='extend', parser.set_defaults(data = [], tensor = [], color = [], - inplace = False, - render = False, ) (options, filenames) = parser.parse_args() @@ -151,14 +149,12 @@ for name in filenames: # ------------------------------------------ output result --------------------------------------- Polydata.Modified() - if vtk.VTK_MAJOR_VERSION <= 5: Polydata.Update() writer = vtk.vtkXMLPolyDataWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtp' if options.inplace else '_added.vtp')) - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(Polydata) - else: writer.SetInputData(Polydata) + writer.SetInputData(Polydata) writer.Write() # ------------------------------------------ render result --------------------------------------- diff --git a/processing/post/vtk_pointCloud.py b/processing/post/vtk_pointCloud.py index 44168fb60..2aad22479 100755 --- a/processing/post/vtk_pointCloud.py +++ b/processing/post/vtk_pointCloud.py @@ -78,7 +78,6 @@ for name in filenames: Polydata.SetPoints(Points) Polydata.SetVerts(Vertices) Polydata.Modified() - if vtk.VTK_MAJOR_VERSION <= 5: Polydata.Update() # ------------------------------------------ output result --------------------------------------- @@ -94,8 +93,8 @@ for name in filenames: writer.SetHeader('# powered by '+scriptID) writer.WriteToOutputStringOn() - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(Polydata) - else: writer.SetInputData(Polydata) + + writer.SetInputData(Polydata) writer.Write() diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index 36218d68d..2e7c66ad5 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -125,8 +125,7 @@ for name in filenames: writer.SetHeader('# powered by '+scriptID) writer.WriteToOutputStringOn() - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid) - else: writer.SetInputData(rGrid) + writer.SetInputData(rGrid) writer.Write() From 27ebe1f665bd8f01663ef6de3919abb87fd41dd8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 08:00:26 +0100 Subject: [PATCH 140/154] improved documentation --- .gitlab-ci.yml | 20 +++++++++++++------- PRIVATE | 2 +- processing/post/rotateData.py | 2 +- processing/post/scaleData.py | 2 +- processing/post/shiftData.py | 2 +- processing/pre/geom_addPrimitive.py | 2 +- processing/pre/geom_clean.py | 2 +- processing/pre/seeds_fromRandom.py | 2 +- 8 files changed, 20 insertions(+), 14 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f64b1bb13..ce822fea1 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -482,31 +482,37 @@ AbaqusStd: script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT abaqus - only: - - development + except: + - master + - release Marc: stage: createDocumentation script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT marc - only: - - development + except: + - master + - release Spectral: stage: createDocumentation script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT spectral - only: - - development + except: + - master + - release Processing: stage: createDocumentation script: + - cd $DAMASKROOT/processing/pre + - rm 3DRVEfrom2Dang.py abq_addUserOutput.py marc_addUserOutput.py + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py - cd $DAMASKROOT/processing/post - rm marc_to_vtk.py vtk2ang.py - - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug \*.py + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py except: - master - release diff --git a/PRIVATE b/PRIVATE index 7e51c3e08..ddb0dae72 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 7e51c3e08655261ec9bd43c6841575e323927de7 +Subproject commit ddb0dae72af9012cca45d9fa5665da41815e88f7 diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 1ac4a9354..41783636c 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Rotate vector and/or tensor column data by given angle around given axis. """, version = scriptID) diff --git a/processing/post/scaleData.py b/processing/post/scaleData.py index 381485a8a..368180f93 100755 --- a/processing/post/scaleData.py +++ b/processing/post/scaleData.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Uniformly scale column values by given factor. """, version = scriptID) diff --git a/processing/post/shiftData.py b/processing/post/shiftData.py index 4ad1cbd0d..f490ee66e 100755 --- a/processing/post/shiftData.py +++ b/processing/post/shiftData.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Uniformly shift column values by given offset. """, version = scriptID) diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index 54de558f7..a013cbb84 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -25,7 +25,7 @@ mappings = { 'microstructures': lambda x: int(x), } -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [geomfile(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog option [geomfile(s)]', description = """ Positions a geometric object within the (three-dimensional) canvas of a spectral geometry description. Depending on the sign of the dimension parameters, these objects can be boxes, cylinders, or ellipsoids. diff --git a/processing/pre/geom_clean.py b/processing/pre/geom_clean.py index e3fa59dd8..907431146 100755 --- a/processing/pre/geom_clean.py +++ b/processing/pre/geom_clean.py @@ -18,7 +18,7 @@ def mostFrequent(arr): # MAIN #-------------------------------------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [geomfile(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [geomfile(s)]', description = """ Smooth geometry by selecting most frequent microstructure index within given stencil at each location. """, version=scriptID) diff --git a/processing/pre/seeds_fromRandom.py b/processing/pre/seeds_fromRandom.py index 6ec221e25..b17335e03 100755 --- a/processing/pre/seeds_fromRandom.py +++ b/processing/pre/seeds_fromRandom.py @@ -28,7 +28,7 @@ def kdtree_search(cloud, queryPoints): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog [options]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options', description = """ Distribute given number of points randomly within (a fraction of) the three-dimensional cube [0.0,0.0,0.0]--[1.0,1.0,1.0]. Reports positions with random crystal orientations in seeds file format to STDOUT. From db9d5c898a5dae2505831d4b7aabb422a305cbd1 Mon Sep 17 00:00:00 2001 From: Franz Roters Date: Sun, 17 Feb 2019 10:08:02 +0100 Subject: [PATCH 141/154] [skip ci] typo --- src/kinematics_cleavage_opening.f90 | 2 +- src/kinematics_slipplane_opening.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 89c2f6ff0..7a3677ec1 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -22,7 +22,7 @@ module kinematics_cleavage_opening sdot0, & n real(pReal), dimension(:), allocatable :: & - critDip, & + critDisp, & critLoad end type diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 33714d573..86be20c9d 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -22,7 +22,7 @@ module kinematics_slipplane_opening sdot0, & n real(pReal), dimension(:), allocatable :: & - critDip, & + critDisp, & critPlasticStrain end type From 47a42c12f63605637ccc8a86ecd853bc27cf28a6 Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 17 Feb 2019 11:38:13 +0000 Subject: [PATCH 142/154] [skip ci] updated version information after successful test of v2.0.2-1808-g530f4f28 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index e1be2bda8..777f5cfdb 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1789-g524bfb8c +v2.0.2-1808-g530f4f28 From 40b0386b5f744397ab2874188cf31c9323f862ec Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 16:36:13 +0100 Subject: [PATCH 143/154] caused segmentation fault in doxygen seems like enum has a special meaning will be used soon with new thermal --- src/kinematics_thermal_expansion.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 3d1de3d0a..3696593ad 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -24,10 +24,10 @@ module kinematics_thermal_expansion integer(pInt), dimension(:), allocatable, target, public :: & kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage -! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult -! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output -! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... -! end enum + enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult + enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output + thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... + end enum public :: & kinematics_thermal_expansion_init, & kinematics_thermal_expansion_initialStrain, & From 27cf60e64d3abb253023fd36e3188840f40b4779 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 22:59:51 +0100 Subject: [PATCH 144/154] backup relevant documentation --- .gitlab-ci.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ce822fea1..9b992136c 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -524,11 +524,10 @@ backupData: - cd $TESTROOT/performance # location of new runtime results - git commit -am"${CI_PIPELINE_ID}_${CI_COMMIT_SHA}" - mkdir $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA} - - cp $TESTROOT/performance/time.txt $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ - mv $TESTROOT/performance/time.png $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ - - cp $TESTROOT/performance/memory.txt $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ - mv $TESTROOT/performance/memory.png $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ - mv $DAMASKROOT/PRIVATE/documenting/DAMASK_* $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ + - mv $DAMASKROOT/processing $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ only: - development From 77ac0d647e9ef606adb7752db4d65433ae4366d8 Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 17 Feb 2019 22:19:52 +0000 Subject: [PATCH 145/154] [skip ci] updated version information after successful test of v2.0.2-1826-gd2a9f55a --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 777f5cfdb..0bd4d9b5b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1808-g530f4f28 +v2.0.2-1826-gd2a9f55a From 2ac60dabd94116f37357a222dd89e1e453249f9d Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 18 Feb 2019 08:27:30 +0000 Subject: [PATCH 146/154] [skip ci] updated version information after successful test of v2.0.2-1829-ga0afed46 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 0bd4d9b5b..ccca69d77 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1826-gd2a9f55a +v2.0.2-1829-ga0afed46 From 43a451b2e17a989355a8c8d55f342192e5b60313 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 18 Feb 2019 14:35:10 +0100 Subject: [PATCH 147/154] inplace not useful use shell script if you want to keep an backup of your old data --- PRIVATE | 2 +- processing/post/vtk_addGridData.py | 10 ++-------- ..._addPointcloudData.py => vtk_addPointCloudData.py} | 6 +----- processing/post/vtk_addRectilinearGridData.py | 11 ++--------- 4 files changed, 6 insertions(+), 23 deletions(-) rename processing/post/{vtk_addPointcloudData.py => vtk_addPointCloudData.py} (96%) diff --git a/PRIVATE b/PRIVATE index ddb0dae72..dc9722c3c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit ddb0dae72af9012cca45d9fa5665da41815e88f7 +Subproject commit dc9722c3c9787bbb0f63308a7015b6709e6d4f94 diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index a1713afb1..c458b1f07 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -25,10 +25,6 @@ parser.add_option( '--vtk', dest = 'vtk', type = 'string', metavar = 'string', help = 'VTK file name') -parser.add_option( '--inplace', - dest = 'inplace', - action = 'store_true', - help = 'modify VTK file in-place') parser.add_option('-r', '--render', dest = 'render', action = 'store_true', @@ -49,7 +45,6 @@ parser.add_option('-c', '--color', parser.set_defaults(data = [], tensor = [], color = [], - inplace = False, render = False, ) @@ -64,24 +59,23 @@ if os.path.splitext(options.vtk)[1] == '.vtr': reader.Update() rGrid = reader.GetOutput() writer = vtk.vtkXMLRectilinearGridWriter() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr')) elif os.path.splitext(options.vtk)[1] == '.vtk': reader = vtk.vtkGenericDataObjectReader() reader.SetFileName(options.vtk) reader.Update() rGrid = reader.GetRectilinearGridOutput() writer = vtk.vtkXMLRectilinearGridWriter() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr')) elif os.path.splitext(options.vtk)[1] == '.vtu': reader = vtk.vtkXMLUnstructuredGridReader() reader.SetFileName(options.vtk) reader.Update() rGrid = reader.GetOutput() writer = vtk.vtkXMLUnstructuredGridWriter() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtu' if options.inplace else '_added.vtu')) else: parser.error('Unsupported VTK file type extension.') +writer.SetFileName(options.vtk) + Npoints = rGrid.GetNumberOfPoints() Ncells = rGrid.GetNumberOfCells() diff --git a/processing/post/vtk_addPointcloudData.py b/processing/post/vtk_addPointCloudData.py similarity index 96% rename from processing/post/vtk_addPointcloudData.py rename to processing/post/vtk_addPointCloudData.py index 369320d3d..5ab1d419e 100755 --- a/processing/post/vtk_addPointcloudData.py +++ b/processing/post/vtk_addPointCloudData.py @@ -23,10 +23,6 @@ parser.add_option( '--vtk', dest = 'vtk', type = 'string', metavar = 'string', help = 'VTK file name') -parser.add_option( '--inplace', - dest = 'inplace', - action = 'store_true', - help = 'modify VTK file in-place') parser.add_option('-r', '--render', dest = 'render', action = 'store_true', @@ -153,7 +149,7 @@ for name in filenames: writer = vtk.vtkXMLPolyDataWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtp' if options.inplace else '_added.vtp')) + writer.SetFileName(options.vtk) writer.SetInputData(Polydata) writer.Write() diff --git a/processing/post/vtk_addRectilinearGridData.py b/processing/post/vtk_addRectilinearGridData.py index 83a1451a0..e445214fd 100755 --- a/processing/post/vtk_addRectilinearGridData.py +++ b/processing/post/vtk_addRectilinearGridData.py @@ -25,10 +25,6 @@ parser.add_option( '--vtk', dest = 'vtk', type = 'string', metavar = 'string', help = 'VTK file name') -parser.add_option( '--inplace', - dest = 'inplace', - action = 'store_true', - help = 'modify VTK file in-place') parser.add_option('-r', '--render', dest = 'render', action = 'store_true', @@ -49,7 +45,6 @@ parser.add_option('-c', '--color', parser.set_defaults(data = [], tensor = [], color = [], - inplace = False, render = False, ) @@ -158,16 +153,14 @@ for name in filenames: elif mode == 'point': rGrid.GetPointData().AddArray(VTKarray[me]) rGrid.Modified() - if vtk.VTK_MAJOR_VERSION <= 5: rGrid.Update() # ------------------------------------------ output result --------------------------------------- writer = vtk.vtkXMLRectilinearGridWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr')) - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid) - else: writer.SetInputData(rGrid) + writer.SetFileName(options.vtk) + writer.SetInputData(rGrid) writer.Write() # ------------------------------------------ render result --------------------------------------- From 95ec0f5cd03a71f8ed1bcd7bd4e3d0af3840b1c7 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 18 Feb 2019 16:07:11 +0000 Subject: [PATCH 148/154] [skip ci] updated version information after successful test of v2.0.2-1831-g43a451b2 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index ccca69d77..4b293256e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1829-ga0afed46 +v2.0.2-1831-g43a451b2 From a58dd17df19f868a84edd4a56608af6311506aa0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 18 Feb 2019 20:58:58 +0100 Subject: [PATCH 149/154] adjusting documentation format --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index dc9722c3c..75fbf8c1d 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit dc9722c3c9787bbb0f63308a7015b6709e6d4f94 +Subproject commit 75fbf8c1d9eb9b08fa15b55b7caaa4c4f7c167e0 From 9b0251428413aea182585dffbc1c50dd0dc43162 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 18 Feb 2019 22:29:07 +0000 Subject: [PATCH 150/154] [skip ci] updated version information after successful test of v2.0.2-1833-ga58dd17d --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 4b293256e..19dea3847 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1831-g43a451b2 +v2.0.2-1833-ga58dd17d From 25727bfa525a2c651e7660d26016594f406958d2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Feb 2019 10:32:18 +0100 Subject: [PATCH 151/154] using CamelCase --- processing/pre/seeds_check.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/processing/pre/seeds_check.sh b/processing/pre/seeds_check.sh index 9bc054406..025c9eb90 100755 --- a/processing/pre/seeds_check.sh +++ b/processing/pre/seeds_check.sh @@ -2,9 +2,9 @@ for seeds in "$@" do - vtk_pointcloud $seeds + vtk_pointCloud $seeds - vtk_addPointcloudData $seeds \ + vtk_addPointCloudData $seeds \ --data microstructure,weight \ --inplace \ --vtk ${seeds%.*}.vtp \ From 29a7f8e939493873d62fe407628eb7f1ae53efc5 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 19 Feb 2019 13:16:11 +0000 Subject: [PATCH 152/154] [skip ci] updated version information after successful test of v2.0.2-1835-g25727bfa --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 19dea3847..4eb9c509c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1833-ga58dd17d +v2.0.2-1835-g25727bfa From 3bec76e781cb48db38524e8225eda286ae95f04c Mon Sep 17 00:00:00 2001 From: Satyapriya Gupta Date: Tue, 19 Feb 2019 12:06:46 -0500 Subject: [PATCH 153/154] can now deal with 1x1x1 geoms --- processing/pre/geom_toTable.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/processing/pre/geom_toTable.py b/processing/pre/geom_toTable.py index a29ef7afb..73e4888d1 100755 --- a/processing/pre/geom_toTable.py +++ b/processing/pre/geom_toTable.py @@ -86,7 +86,7 @@ for name in filenames: yy = np.tile(np.repeat(y,info['grid'][0] ),info['grid'][2]) zz = np.repeat(z,info['grid'][0]*info['grid'][1]) - table.data = np.squeeze(np.dstack((xx,yy,zz,microstructure))) + table.data = np.squeeze(np.dstack((xx,yy,zz,microstructure)),axis=0) table.data_writeArray() # ------------------------------------------ finalize output --------------------------------------- From cc0e65c3b000ac1524a8da5db32c12b7c947723d Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 19 Feb 2019 19:35:57 +0000 Subject: [PATCH 154/154] [skip ci] updated version information after successful test of v2.0.2-1837-g3bec76e7 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 4eb9c509c..7d075db3e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1835-g25727bfa +v2.0.2-1837-g3bec76e7