diff --git a/VERSION b/VERSION index 63005f482..bf6ea2a02 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.1-976-g035215e +v2.0.1-1004-g2c4df2f diff --git a/examples/AbaqusStandard/SX_PX_compression.cae b/examples/AbaqusStandard/SX_PX_compression.cae index 39ef89a6c..fed4472b3 100644 Binary files a/examples/AbaqusStandard/SX_PX_compression.cae and b/examples/AbaqusStandard/SX_PX_compression.cae differ diff --git a/examples/AbaqusStandard/SX_PX_compression.jnl b/examples/AbaqusStandard/SX_PX_compression.jnl index cb8406df1..4e33e1fc7 100644 --- a/examples/AbaqusStandard/SX_PX_compression.jnl +++ b/examples/AbaqusStandard/SX_PX_compression.jnl @@ -1 +1,23 @@ -# Save by abaqususer on Thu May 12 10:22:10 2011 +# Save by m.diehl on 2017_12_06-18.38.26; build 2017 2016_09_27-23.54.59 126836 +from abaqus import * +upgradeMdb( + '/nethome/storage/raid4/m.diehl/DAMASK/examples/AbaqusStandard/SX_PX_compression-6.9-1.cae' + , + '/nethome/storage/raid4/m.diehl/DAMASK/examples/AbaqusStandard/SX_PX_compression.cae') +# Save by m.diehl on 2017_12_06-18.38.26; build 2017 2016_09_27-23.54.59 126836 +from part import * +from material import * +from section import * +from assembly import * +from step import * +from interaction import * +from load import * +from mesh import * +from optimization import * +from job import * +from sketch import * +from visualization import * +from connectorBehavior import * +mdb.jobs['Job_sx-px'].setValues(description='compression', userSubroutine= + '$HOME/DAMASK/src/DAMASK_abaqus_std.f') +# Save by m.diehl on 2017_12_06-18.39.44; build 2017 2016_09_27-23.54.59 126836 diff --git a/examples/ConfigFiles/numerics.config b/examples/ConfigFiles/numerics.config index 580b58e57..ab8903927 100644 --- a/examples/ConfigFiles/numerics.config +++ b/examples/ConfigFiles/numerics.config @@ -49,7 +49,7 @@ maxVolDiscrepancy_RGC 1.0e-5 # maximum allowable relative volume discr volDiscrepancyMod_RGC 1.0e+12 discrepancyPower_RGC 5.0 -fixed_seed 0 # put any number larger than zero, integer, if you want to have a pseudo random distribution +random_seed 0 # any integer larger than zero seeds the random generator, otherwise random seeding ## spectral parameters ## err_div_tolAbs 1.0e-3 # absolute tolerance for fulfillment of stress equilibrium diff --git a/installation/patch/PETSc3.8 b/installation/patch/PETSc3.8 index c6b95f775..f66ee6d09 100644 --- a/installation/patch/PETSc3.8 +++ b/installation/patch/PETSc3.8 @@ -1,38 +1,23 @@ -From 2355d41203f829e5a24154184ab1a1a05e40b5e2 Mon Sep 17 00:00:00 2001 +From 87e307a9c511f3f40598edbd5996297d7804ce62 Mon Sep 17 00:00:00 2001 From: Martin Diehl -Date: Sun, 5 Nov 2017 12:48:31 +0100 -Subject: [PATCH 1/3] adjusted calling of PETSc routines. Compiles but crashes - conditional prints for worldrank not needed (redirected to /dev/null) failing - during compilation is faster than during runtime +Date: Tue, 21 Nov 2017 15:12:04 +0100 +Subject: [PATCH] due to changes in interface of PETSc --- - src/DAMASK_spectral.f90 | 27 ++++++------------ - src/constitutive.f90 | 6 ++-- - src/damage_local.f90 | 8 ++---- - src/damage_none.f90 | 8 ++---- - src/damage_nonlocal.f90 | 8 ++---- - src/homogenization_RGC.f90 | 8 ++---- - src/homogenization_isostrain.f90 | 8 ++---- - src/homogenization_none.f90 | 10 ++----- - src/hydrogenflux_cahnhilliard.f90 | 8 ++---- - src/hydrogenflux_isoconc.f90 | 10 ++----- - src/kinematics_cleavage_opening.f90 | 8 ++---- - src/kinematics_slipplane_opening.f90 | 8 ++---- - src/kinematics_thermal_expansion.f90 | 8 ++---- - src/kinematics_vacancy_strain.f90 | 8 ++---- - src/mesh.f90 | 10 +++---- - src/numerics.f90 | 13 ++++----- - src/spectral_damage.f90 | 37 +++++++----------------- - src/spectral_interface.f90 | 31 ++++++++++---------- - src/spectral_mech_AL.f90 | 43 +++++++++------------------- - src/spectral_mech_Basic.f90 | 48 +++++++++++-------------------- - src/spectral_mech_Polarisation.f90 | 49 +++++++++++--------------------- - src/spectral_thermal.f90 | 55 ++++++++++++++++-------------------- - src/spectral_utilities.f90 | 34 ++++++++-------------- - 23 files changed, 156 insertions(+), 297 deletions(-) + src/DAMASK_spectral.f90 | 27 +++++--------- + src/mesh.f90 | 12 +++--- + src/numerics.f90 | 13 +++---- + src/spectral_damage.f90 | 39 ++++++-------------- + src/spectral_interface.f90 | 31 ++++++++-------- + src/spectral_mech_AL.f90 | 46 ++++++++--------------- + src/spectral_mech_Basic.f90 | 52 +++++++++----------------- + src/spectral_mech_Polarisation.f90 | 52 ++++++++++---------------- + src/spectral_thermal.f90 | 75 ++++++++++++++++++-------------------- + src/spectral_utilities.f90 | 34 ++++++----------- + 10 files changed, 146 insertions(+), 235 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 -index dc529b2e..ee6b20fc 100644 +index f32bfb7b..c315b1b8 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -12,6 +12,8 @@ program DAMASK_spectral @@ -82,9 +67,9 @@ index dc529b2e..ee6b20fc 100644 @@ -448,7 +440,7 @@ program DAMASK_spectral call MPI_file_write(resUnit, & reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & - [(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults]), & -- (outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults, & -+ int((outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults), & + [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & +- (outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt), & ++ int(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults, & MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') enddo @@ -101,360 +86,14 @@ index dc529b2e..ee6b20fc 100644 @@ -646,7 +637,7 @@ program DAMASK_spectral min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& - [(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults]), & -- (outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults,& -+ int((outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults), & + [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & +- (outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt),& ++ int(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults,& MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write') enddo -diff --git a/src/constitutive.f90 b/src/constitutive.f90 -index 202242ae..f124e545 100644 ---- a/src/constitutive.f90 -+++ b/src/constitutive.f90 -@@ -186,11 +186,11 @@ subroutine constitutive_init() - if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) - close(FILEUNIT) - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- constitutive init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- constitutive init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" - -+ mainProcess: if (worldrank == 0) then - !-------------------------------------------------------------------------------------------------- - ! write description file for constitutive output - call IO_write_jobFile(FILEUNIT,'outputConstitutive') -diff --git a/src/damage_local.f90 b/src/damage_local.f90 -index a24f0b1a..2f301493 100644 ---- a/src/damage_local.f90 -+++ b/src/damage_local.f90 -@@ -72,8 +72,6 @@ subroutine damage_local_init(fileUnit) - damage, & - damage_initialPhi, & - material_partHomogenization -- use numerics,only: & -- worldrank - - implicit none - integer(pInt), intent(in) :: fileUnit -@@ -86,11 +84,9 @@ subroutine damage_local_init(fileUnit) - tag = '', & - line = '' - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt) - if (maxNinstance == 0_pInt) return -diff --git a/src/damage_none.f90 b/src/damage_none.f90 -index 746de340..4750f594 100644 ---- a/src/damage_none.f90 -+++ b/src/damage_none.f90 -@@ -26,19 +26,15 @@ subroutine damage_none_init() - use IO, only: & - IO_timeStamp - use material -- use numerics, only: & -- worldrank - - implicit none - integer(pInt) :: & - homog, & - NofMyHomog - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - initializeInstances: do homog = 1_pInt, material_Nhomogenization - -diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 -index fb960ed7..cd6ba8a5 100644 ---- a/src/damage_nonlocal.f90 -+++ b/src/damage_nonlocal.f90 -@@ -77,8 +77,6 @@ subroutine damage_nonlocal_init(fileUnit) - damage, & - damage_initialPhi, & - material_partHomogenization -- use numerics,only: & -- worldrank - - implicit none - integer(pInt), intent(in) :: fileUnit -@@ -91,11 +89,9 @@ subroutine damage_nonlocal_init(fileUnit) - tag = '', & - line = '' - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt) - if (maxNinstance == 0_pInt) return -diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 -index 43c16a39..84cb594d 100644 ---- a/src/homogenization_RGC.f90 -+++ b/src/homogenization_RGC.f90 -@@ -100,8 +100,6 @@ subroutine homogenization_RGC_init(fileUnit) - FE_geomtype - use IO - use material -- use numerics, only: & -- worldrank - - implicit none - integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration -@@ -117,11 +115,9 @@ subroutine homogenization_RGC_init(fileUnit) - tag = '', & - line = '' - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - maxNinstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) - if (maxNinstance == 0_pInt) return -diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 -index aeb77c27..055bfbb4 100644 ---- a/src/homogenization_isostrain.f90 -+++ b/src/homogenization_isostrain.f90 -@@ -62,8 +62,6 @@ subroutine homogenization_isostrain_init(fileUnit) - debug_levelBasic - use IO - use material -- use numerics, only: & -- worldrank - - implicit none - integer(pInt), intent(in) :: fileUnit -@@ -80,11 +78,9 @@ subroutine homogenization_isostrain_init(fileUnit) - tag = '', & - line = '' - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - maxNinstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) - if (maxNinstance == 0) return -diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 -index 11bed781..75d8bcd3 100644 ---- a/src/homogenization_none.f90 -+++ b/src/homogenization_none.f90 -@@ -29,21 +29,17 @@ subroutine homogenization_none_init() - use IO, only: & - IO_timeStamp - use material -- use numerics, only: & -- worldrank - - implicit none - integer(pInt) :: & - homog, & - NofMyHomog - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - -- initializeInstances: do homog = 1_pInt, material_Nhomogenization -+ initializeInstances: do homog = 1_pInt, material_Nhomogenization - - myhomog: if (homogenization_type(homog) == HOMOGENIZATION_none_ID) then - NofMyHomog = count(material_homog == homog) -diff --git a/src/hydrogenflux_cahnhilliard.f90 b/src/hydrogenflux_cahnhilliard.f90 -index db08bf5d..89479a9c 100644 ---- a/src/hydrogenflux_cahnhilliard.f90 -+++ b/src/hydrogenflux_cahnhilliard.f90 -@@ -84,8 +84,6 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) - hydrogenflux_initialCh, & - material_partHomogenization, & - material_partPhase -- use numerics,only: & -- worldrank - - implicit none - integer(pInt), intent(in) :: fileUnit -@@ -98,11 +96,9 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) - tag = '', & - line = '' - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - maxNinstance = int(count(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID),pInt) - if (maxNinstance == 0_pInt) return -diff --git a/src/hydrogenflux_isoconc.f90 b/src/hydrogenflux_isoconc.f90 -index df5c01e6..bef2a843 100644 ---- a/src/hydrogenflux_isoconc.f90 -+++ b/src/hydrogenflux_isoconc.f90 -@@ -27,21 +27,17 @@ subroutine hydrogenflux_isoconc_init() - use IO, only: & - IO_timeStamp - use material -- use numerics, only: & -- worldrank - - implicit none - integer(pInt) :: & - homog, & - NofMyHomog - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - -- initializeInstances: do homog = 1_pInt, material_Nhomogenization -+ initializeInstances: do homog = 1_pInt, material_Nhomogenization - - myhomog: if (hydrogenflux_type(homog) == HYDROGENFLUX_isoconc_ID) then - NofMyHomog = count(material_homog == homog) -diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 -index 146918f5..fffa2616 100644 ---- a/src/kinematics_cleavage_opening.f90 -+++ b/src/kinematics_cleavage_opening.f90 -@@ -81,8 +81,6 @@ subroutine kinematics_cleavage_opening_init(fileUnit) - KINEMATICS_cleavage_opening_ID, & - material_Nphase, & - MATERIAL_partPhase -- use numerics,only: & -- worldrank - use lattice, only: & - lattice_maxNcleavageFamily, & - lattice_NcleavageSystem -@@ -97,11 +95,9 @@ subroutine kinematics_cleavage_opening_init(fileUnit) - tag = '', & - line = '' - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt) - if (maxNinstance == 0_pInt) return -diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 -index f32efa92..07b98aa2 100644 ---- a/src/kinematics_slipplane_opening.f90 -+++ b/src/kinematics_slipplane_opening.f90 -@@ -81,8 +81,6 @@ subroutine kinematics_slipplane_opening_init(fileUnit) - KINEMATICS_slipplane_opening_ID, & - material_Nphase, & - MATERIAL_partPhase -- use numerics,only: & -- worldrank - use lattice, only: & - lattice_maxNslipFamily, & - lattice_NslipSystem -@@ -97,11 +95,9 @@ subroutine kinematics_slipplane_opening_init(fileUnit) - tag = '', & - line = '' - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - maxNinstance = int(count(phase_kinematics == KINEMATICS_slipplane_opening_ID),pInt) - if (maxNinstance == 0_pInt) return -diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 -index 30c267d3..e7cbca67 100644 ---- a/src/kinematics_thermal_expansion.f90 -+++ b/src/kinematics_thermal_expansion.f90 -@@ -71,8 +71,6 @@ subroutine kinematics_thermal_expansion_init(fileUnit) - KINEMATICS_thermal_expansion_ID, & - material_Nphase, & - MATERIAL_partPhase -- use numerics,only: & -- worldrank - - implicit none - integer(pInt), intent(in) :: fileUnit -@@ -83,11 +81,9 @@ subroutine kinematics_thermal_expansion_init(fileUnit) - tag = '', & - line = '' - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - maxNinstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) - if (maxNinstance == 0_pInt) return -diff --git a/src/kinematics_vacancy_strain.f90 b/src/kinematics_vacancy_strain.f90 -index 791c0e3c..9558f506 100644 ---- a/src/kinematics_vacancy_strain.f90 -+++ b/src/kinematics_vacancy_strain.f90 -@@ -71,8 +71,6 @@ subroutine kinematics_vacancy_strain_init(fileUnit) - KINEMATICS_vacancy_strain_ID, & - material_Nphase, & - MATERIAL_partPhase -- use numerics,only: & -- worldrank - - implicit none - integer(pInt), intent(in) :: fileUnit -@@ -83,11 +81,9 @@ subroutine kinematics_vacancy_strain_init(fileUnit) - tag = '', & - line = '' - -- mainProcess: if (worldrank == 0) then -- write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' -- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -+ write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' -+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() - #include "compilation_info.f90" -- endif mainProcess - - maxNinstance = int(count(phase_kinematics == KINEMATICS_vacancy_strain_ID),pInt) - if (maxNinstance == 0_pInt) return diff --git a/src/mesh.f90 b/src/mesh.f90 -index 87160f2c..6e3b4823 100644 +index 666fe1e3..a314c22c 100644 --- a/src/mesh.f90 +++ b/src/mesh.f90 @@ -115,11 +115,6 @@ module mesh @@ -488,8 +127,17 @@ index 87160f2c..6e3b4823 100644 integer(C_INTPTR_T) :: devNull, local_K, local_K_offset integer :: ierr, worldsize #endif +@@ -518,8 +518,6 @@ subroutine mesh_init(ip,el) + integer(pInt), intent(in) :: el, ip + integer(pInt) :: j + logical :: myDebug +- +- external :: MPI_comm_size + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() diff --git a/src/numerics.f90 b/src/numerics.f90 -index 2085e221..d2d00f3e 100644 +index 70c7f3c3..e7d54893 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -10,9 +10,6 @@ module numerics @@ -527,7 +175,7 @@ index 2085e221..d2d00f3e 100644 call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr) diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 -index 72765987..cea6f69c 100644 +index 72765987..11da3b96 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -4,8 +4,10 @@ @@ -597,8 +245,12 @@ index 72765987..cea6f69c 100644 DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & !< cut off stencil at boundary DMDA_STENCIL_BOX, & !< Moore (26) neighborhood around central point grid(1),grid(2),grid(3), & !< global grid -@@ -126,7 +116,7 @@ subroutine spectral_damage_init() +@@ -124,9 +114,11 @@ subroutine spectral_damage_init() + damage_grid,ierr) !< handle, error + CHKERRQ(ierr) call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da ++ call DMsetFromOptions(damage_grid,ierr); CHKERRQ(ierr) ++ call DMsetUp(damage_grid,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor) call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,& - PETSC_NULL_OBJECT,ierr) !< residual vector of same shape as solution vector @@ -606,16 +258,16 @@ index 72765987..cea6f69c 100644 CHKERRQ(ierr) call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional cli arguments call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr) -@@ -214,7 +204,7 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC +@@ -214,7 +206,7 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC params%timeinc = timeinc params%timeincOld = timeinc_old - call SNESSolve(damage_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) -+ call SNESSolve(damage_snes,PETSC_NULL_SNES,solution,ierr); CHKERRQ(ierr) ++ call SNESSolve(damage_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr) if (reason < 1) then -@@ -360,9 +350,6 @@ subroutine spectral_damage_forward() +@@ -360,9 +352,6 @@ subroutine spectral_damage_forward() PetscScalar, dimension(:,:,:), pointer :: x_scal PetscErrorCode :: ierr @@ -625,7 +277,7 @@ index 72765987..cea6f69c 100644 if (cutBack) then damage_current = damage_lastInc damage_stagInc = damage_lastInc -@@ -405,10 +392,6 @@ subroutine spectral_damage_destroy() +@@ -405,10 +394,6 @@ subroutine spectral_damage_destroy() implicit none PetscErrorCode :: ierr @@ -716,7 +368,7 @@ index 3c8489d0..51360ac1 100644 getGeometryFile = geometryParameter posExt = scan(getGeometryFile,'.',back=.true.) diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 -index 6d0fff28..e7ff0fbe 100644 +index 6d0fff28..dc221f6c 100644 --- a/src/spectral_mech_AL.f90 +++ b/src/spectral_mech_AL.f90 @@ -5,6 +5,8 @@ @@ -778,9 +430,12 @@ index 6d0fff28..e7ff0fbe 100644 write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" -@@ -166,9 +161,9 @@ subroutine AL_init +@@ -165,10 +160,12 @@ subroutine AL_init + da,ierr) ! handle, error CHKERRQ(ierr) call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) - call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_OBJECT,ierr) + call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_SNES,ierr) @@ -790,7 +445,7 @@ index 6d0fff28..e7ff0fbe 100644 CHKERRQ(ierr) call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) -@@ -280,8 +275,7 @@ type(tSolutionState) function & +@@ -280,8 +277,7 @@ type(tSolutionState) function & SNESConvergedReason :: reason external :: & @@ -800,16 +455,17 @@ index 6d0fff28..e7ff0fbe 100644 incInfo = incInfoIn -@@ -304,7 +298,7 @@ type(tSolutionState) function & +@@ -304,8 +300,7 @@ type(tSolutionState) function & !-------------------------------------------------------------------------------------------------- ! solve BVP - call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) -+ call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) - CHKERRQ(ierr) +- CHKERRQ(ierr) ++ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) !-------------------------------------------------------------------------------------------------- -@@ -383,10 +377,6 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) + ! check convergence +@@ -383,10 +378,6 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) integer(pInt) :: & i, j, k, e @@ -820,7 +476,7 @@ index 6d0fff28..e7ff0fbe 100644 F => x_scal(1:3,1:3,1,& XG_RANGE,YG_RANGE,ZG_RANGE) F_lambda => x_scal(1:3,1:3,2,& -@@ -697,11 +687,6 @@ subroutine AL_destroy() +@@ -697,11 +688,6 @@ subroutine AL_destroy() implicit none PetscErrorCode :: ierr @@ -833,7 +489,7 @@ index 6d0fff28..e7ff0fbe 100644 call SNESDestroy(snes,ierr); CHKERRQ(ierr) call DMDestroy(da,ierr); CHKERRQ(ierr) diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 -index cfb72712..b02cfd8c 100644 +index 55403ee7..fe9eb493 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -5,6 +5,8 @@ @@ -888,7 +544,7 @@ index cfb72712..b02cfd8c 100644 write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" -@@ -152,14 +146,14 @@ subroutine basicPETSc_init +@@ -152,19 +146,20 @@ subroutine basicPETSc_init grid(1),grid(2),localK, & ! local grid da,ierr) ! handle, error CHKERRQ(ierr) @@ -896,6 +552,8 @@ index cfb72712..b02cfd8c 100644 - call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) - call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector + call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) + call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) + call DMDASNESsetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector CHKERRQ(ierr) @@ -909,7 +567,12 @@ index cfb72712..b02cfd8c 100644 !-------------------------------------------------------------------------------------------------- ! init fields -@@ -253,8 +247,7 @@ type(tSolutionState) function & + call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with +- + restart: if (restartInc > 1_pInt) then + if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & + write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & +@@ -253,8 +248,7 @@ type(tSolutionState) function & SNESConvergedReason :: reason external :: & @@ -919,16 +582,17 @@ index cfb72712..b02cfd8c 100644 incInfo = incInfoIn -@@ -274,7 +267,7 @@ type(tSolutionState) function & +@@ -274,8 +268,7 @@ type(tSolutionState) function & !-------------------------------------------------------------------------------------------------- ! solve BVP - call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) -+ call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) - CHKERRQ(ierr) +- CHKERRQ(ierr) ++ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) !-------------------------------------------------------------------------------------------------- -@@ -337,10 +330,6 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) + ! check convergence +@@ -336,10 +329,6 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) PetscObject :: dummy PetscErrorCode :: ierr @@ -939,7 +603,7 @@ index cfb72712..b02cfd8c 100644 call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) -@@ -556,11 +545,6 @@ subroutine BasicPETSc_destroy() +@@ -555,11 +544,6 @@ subroutine BasicPETSc_destroy() implicit none PetscErrorCode :: ierr @@ -952,7 +616,7 @@ index cfb72712..b02cfd8c 100644 call SNESDestroy(snes,ierr); CHKERRQ(ierr) call DMDestroy(da,ierr); CHKERRQ(ierr) diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 -index ecf707d4..2b9dddc0 100644 +index ecf707d4..3b024f56 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -5,6 +5,8 @@ @@ -1014,7 +678,7 @@ index ecf707d4..2b9dddc0 100644 write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" -@@ -164,13 +159,13 @@ subroutine Polarisation_init +@@ -164,13 +159,15 @@ subroutine Polarisation_init grid(1),grid(2),localK, & ! local grid da,ierr) ! handle, error CHKERRQ(ierr) @@ -1022,6 +686,8 @@ index ecf707d4..2b9dddc0 100644 - call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) - call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_OBJECT,ierr) + call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) + call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) + call DMDASNESsetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_SNES,ierr) CHKERRQ(ierr) @@ -1033,7 +699,7 @@ index ecf707d4..2b9dddc0 100644 !-------------------------------------------------------------------------------------------------- ! init fields -@@ -280,8 +275,7 @@ type(tSolutionState) function & +@@ -280,8 +277,7 @@ type(tSolutionState) function & SNESConvergedReason :: reason external :: & @@ -1043,16 +709,17 @@ index ecf707d4..2b9dddc0 100644 incInfo = incInfoIn -@@ -304,7 +298,7 @@ type(tSolutionState) function & +@@ -304,8 +300,7 @@ type(tSolutionState) function & !-------------------------------------------------------------------------------------------------- ! solve BVP - call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) -+ call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) - CHKERRQ(ierr) +- CHKERRQ(ierr) ++ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) !-------------------------------------------------------------------------------------------------- -@@ -383,10 +377,6 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr) + ! check convergence +@@ -383,10 +378,6 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr) integer(pInt) :: & i, j, k, e @@ -1063,7 +730,7 @@ index ecf707d4..2b9dddc0 100644 F => x_scal(1:3,1:3,1,& XG_RANGE,YG_RANGE,ZG_RANGE) F_tau => x_scal(1:3,1:3,2,& -@@ -698,11 +688,6 @@ subroutine Polarisation_destroy() +@@ -698,11 +689,6 @@ subroutine Polarisation_destroy() implicit none PetscErrorCode :: ierr @@ -1076,7 +743,7 @@ index ecf707d4..2b9dddc0 100644 call SNESDestroy(snes,ierr); CHKERRQ(ierr) call DMDestroy(da,ierr); CHKERRQ(ierr) diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 -index 322f1203..cc0f7678 100644 +index 322f1203..2374d83b 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -4,6 +4,8 @@ @@ -1151,25 +818,64 @@ index 322f1203..cc0f7678 100644 !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc -@@ -127,7 +122,7 @@ subroutine spectral_thermal_init - call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da - call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) - call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& +@@ -124,16 +119,18 @@ subroutine spectral_thermal_init + grid (1),grid(2),localK, & ! local grid + thermal_grid,ierr) ! handle, error + CHKERRQ(ierr) +- call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da +- call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) +- call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& - PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector ++ call SNESsetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da ++ call DMsetFromOptions(thermal_grid,ierr); CHKERRQ(ierr) ++ call DMsetUp(thermal_grid,ierr); CHKERRQ(ierr) ++ call DMcreateGlobalVector(thermal_grid,solution,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) ++ call DMDASNESsetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& + PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector CHKERRQ(ierr) - call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments +- call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments ++ call SNESsetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments -@@ -215,7 +210,7 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load + !-------------------------------------------------------------------------------------------------- + ! init fields +- call DMDAGetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) ++ call DMDAgetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) + CHKERRQ(ierr) + xend = xstart + xend - 1 + yend = ystart + yend - 1 +@@ -149,9 +146,9 @@ subroutine spectral_thermal_init + temperature_lastInc(i,j,k) = temperature_current(i,j,k) + temperature_stagInc(i,j,k) = temperature_current(i,j,k) + enddo; enddo; enddo +- call DMDAVecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with ++ call DMDAvecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with + x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current +- call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) ++ call DMDAvecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! thermal reference diffusion update +@@ -205,8 +202,8 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load + external :: & + VecMin, & + VecMax, & +- SNESSolve, & +- SNESGetConvergedReason ++ SNESsolve, & ++ SNESgetConvergedReason + + spectral_thermal_solution%converged =.false. + +@@ -215,7 +212,7 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load params%timeinc = timeinc params%timeincOld = timeinc_old - call SNESSolve(thermal_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) -+ call SNESSolve(thermal_snes,PETSC_NULL_SNES,solution,ierr); CHKERRQ(ierr) ++ call SNESsolve(thermal_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) call SNESGetConvergedReason(thermal_snes,reason,ierr); CHKERRQ(ierr) if (reason < 1) then -@@ -245,14 +240,12 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load +@@ -245,14 +242,12 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load call VecMin(solution,position,minTemperature,ierr); CHKERRQ(ierr) call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr) @@ -1191,7 +897,7 @@ index 322f1203..cc0f7678 100644 end function spectral_thermal_solution diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 -index 1ad25174..bbef337f 100644 +index 1bbf2e60..52bb07fd 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -5,15 +5,16 @@ @@ -1282,7 +988,7 @@ index 1ad25174..bbef337f 100644 write(6,'(/,a)') ' ... calculating curl ......................................................' flush(6) -@@ -1096,9 +1089,6 @@ function utilities_forwardField(timeinc,field_lastInc,rate,aim) +@@ -1099,9 +1092,6 @@ function utilities_forwardField(timeinc,field_lastInc,rate,aim) real(pReal), dimension(3,3) :: fieldDiff !< - aim PetscErrorCode :: ierr @@ -1292,7 +998,7 @@ index 1ad25174..bbef337f 100644 utilities_forwardField = field_lastInc + rate*timeinc if (present(aim)) then !< correct to match average fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt -@@ -1190,8 +1180,6 @@ subroutine utilities_updateIPcoords(F) +@@ -1193,8 +1183,6 @@ subroutine utilities_updateIPcoords(F) integer(pInt) :: i, j, k, m, ierr real(pReal), dimension(3) :: step, offset_coords real(pReal), dimension(3,3) :: Favg @@ -1304,225 +1010,3 @@ index 1ad25174..bbef337f 100644 -- 2.15.0 - -From 237f199bbf574bb2509123ce8b037ac751abd15d Mon Sep 17 00:00:00 2001 -From: Martin Diehl -Date: Sun, 5 Nov 2017 13:45:52 +0100 -Subject: [PATCH 2/3] extra function calls for da needed - (https://lists.mcs.anl.gov/pipermail/petsc-users/2017-February/031538.html) - SNESsolve requires PETSC_NULL_VEC not PETSC_NULL_SNES (indicating b=0) - ---- - src/spectral_damage.f90 | 4 +++- - src/spectral_mech_AL.f90 | 5 +++-- - src/spectral_mech_Basic.f90 | 6 +++--- - src/spectral_mech_Polarisation.f90 | 5 +++-- - src/spectral_thermal.f90 | 22 ++++++++++++---------- - 5 files changed, 24 insertions(+), 18 deletions(-) - -diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 -index cea6f69c..2c195c56 100644 ---- a/src/spectral_damage.f90 -+++ b/src/spectral_damage.f90 -@@ -114,6 +114,8 @@ subroutine spectral_damage_init() - damage_grid,ierr) !< handle, error - CHKERRQ(ierr) - call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da -+ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) -+ call DMsetUp(da,ierr); CHKERRQ(ierr) - call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor) - call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,& - PETSC_NULL_SNES,ierr) !< residual vector of same shape as solution vector -@@ -204,7 +206,7 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC - params%timeinc = timeinc - params%timeincOld = timeinc_old - -- call SNESSolve(damage_snes,PETSC_NULL_SNES,solution,ierr); CHKERRQ(ierr) -+ call SNESSolve(damage_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) - call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr) - - if (reason < 1) then -diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 -index e7ff0fbe..dc221f6c 100644 ---- a/src/spectral_mech_AL.f90 -+++ b/src/spectral_mech_AL.f90 -@@ -160,6 +160,8 @@ subroutine AL_init - da,ierr) ! handle, error - CHKERRQ(ierr) - call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) -+ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) -+ call DMsetUp(da,ierr); CHKERRQ(ierr) - call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) - call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_SNES,ierr) - CHKERRQ(ierr) -@@ -298,8 +300,7 @@ type(tSolutionState) function & - - !-------------------------------------------------------------------------------------------------- - ! solve BVP -- call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) -- CHKERRQ(ierr) -+ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) - - !-------------------------------------------------------------------------------------------------- - ! check convergence -diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 -index b02cfd8c..c335f2d7 100644 ---- a/src/spectral_mech_Basic.f90 -+++ b/src/spectral_mech_Basic.f90 -@@ -147,6 +147,8 @@ subroutine basicPETSc_init - da,ierr) ! handle, error - CHKERRQ(ierr) - call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) -+ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) -+ call DMsetUp(da,ierr); CHKERRQ(ierr) - call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) - call DMDASNESsetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector - CHKERRQ(ierr) -@@ -158,7 +160,6 @@ subroutine basicPETSc_init - !-------------------------------------------------------------------------------------------------- - ! init fields - call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with -- - restart: if (restartInc > 1_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & - write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & -@@ -267,8 +268,7 @@ type(tSolutionState) function & - - !-------------------------------------------------------------------------------------------------- - ! solve BVP -- call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) -- CHKERRQ(ierr) -+ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) - - !-------------------------------------------------------------------------------------------------- - ! check convergence -diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 -index 2b9dddc0..3b024f56 100644 ---- a/src/spectral_mech_Polarisation.f90 -+++ b/src/spectral_mech_Polarisation.f90 -@@ -160,6 +160,8 @@ subroutine Polarisation_init - da,ierr) ! handle, error - CHKERRQ(ierr) - call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) -+ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) -+ call DMsetUp(da,ierr); CHKERRQ(ierr) - call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) - call DMDASNESsetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_SNES,ierr) - CHKERRQ(ierr) -@@ -298,8 +300,7 @@ type(tSolutionState) function & - - !-------------------------------------------------------------------------------------------------- - ! solve BVP -- call SNESSolve(snes,PETSC_NULL_SNES,solution_vec,ierr) -- CHKERRQ(ierr) -+ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) - - !-------------------------------------------------------------------------------------------------- - ! check convergence -diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 -index cc0f7678..7115538c 100644 ---- a/src/spectral_thermal.f90 -+++ b/src/spectral_thermal.f90 -@@ -119,16 +119,18 @@ subroutine spectral_thermal_init - grid (1),grid(2),localK, & ! local grid - thermal_grid,ierr) ! handle, error - CHKERRQ(ierr) -- call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da -- call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) -- call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& -+ call SNESsetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da -+ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) -+ call DMsetUp(da,ierr); CHKERRQ(ierr) -+ call DMcreateGlobalVector(thermal_grid,solution,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) -+ call DMDASNESsetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& - PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector - CHKERRQ(ierr) -- call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments -+ call SNESsetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments - - !-------------------------------------------------------------------------------------------------- - ! init fields -- call DMDAGetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) -+ call DMDAgetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) - CHKERRQ(ierr) - xend = xstart + xend - 1 - yend = ystart + yend - 1 -@@ -144,9 +146,9 @@ subroutine spectral_thermal_init - temperature_lastInc(i,j,k) = temperature_current(i,j,k) - temperature_stagInc(i,j,k) = temperature_current(i,j,k) - enddo; enddo; enddo -- call DMDAVecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with -+ call DMDAvecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with - x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current -- call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) -+ call DMDAvecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) - - !-------------------------------------------------------------------------------------------------- - ! thermal reference diffusion update -@@ -200,8 +202,8 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load - external :: & - VecMin, & - VecMax, & -- SNESSolve, & -- SNESGetConvergedReason -+ SNESsolve, & -+ SNESgetConvergedReason - - spectral_thermal_solution%converged =.false. - -@@ -210,7 +212,7 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load - params%timeinc = timeinc - params%timeincOld = timeinc_old - -- call SNESSolve(thermal_snes,PETSC_NULL_SNES,solution,ierr); CHKERRQ(ierr) -+ call SNESsolve(thermal_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) - call SNESGetConvergedReason(thermal_snes,reason,ierr); CHKERRQ(ierr) - - if (reason < 1) then --- -2.15.0 - - -From 1af2e332a1b86f388aa9e481255f4405874d7960 Mon Sep 17 00:00:00 2001 -From: Martin Diehl -Date: Sun, 5 Nov 2017 14:18:45 +0100 -Subject: [PATCH 3/3] named better in thermal and damage - ---- - src/spectral_damage.f90 | 4 ++-- - src/spectral_thermal.f90 | 4 ++-- - 2 files changed, 4 insertions(+), 4 deletions(-) - -diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 -index 2c195c56..11da3b96 100644 ---- a/src/spectral_damage.f90 -+++ b/src/spectral_damage.f90 -@@ -114,8 +114,8 @@ subroutine spectral_damage_init() - damage_grid,ierr) !< handle, error - CHKERRQ(ierr) - call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da -- call DMsetFromOptions(da,ierr); CHKERRQ(ierr) -- call DMsetUp(da,ierr); CHKERRQ(ierr) -+ call DMsetFromOptions(damage_grid,ierr); CHKERRQ(ierr) -+ call DMsetUp(damage_grid,ierr); CHKERRQ(ierr) - call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor) - call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,& - PETSC_NULL_SNES,ierr) !< residual vector of same shape as solution vector -diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 -index 7115538c..2374d83b 100644 ---- a/src/spectral_thermal.f90 -+++ b/src/spectral_thermal.f90 -@@ -120,8 +120,8 @@ subroutine spectral_thermal_init - thermal_grid,ierr) ! handle, error - CHKERRQ(ierr) - call SNESsetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da -- call DMsetFromOptions(da,ierr); CHKERRQ(ierr) -- call DMsetUp(da,ierr); CHKERRQ(ierr) -+ call DMsetFromOptions(thermal_grid,ierr); CHKERRQ(ierr) -+ call DMsetUp(thermal_grid,ierr); CHKERRQ(ierr) - call DMcreateGlobalVector(thermal_grid,solution,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) - call DMDASNESsetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& - PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector --- -2.15.0 - diff --git a/installation/patch/README.md b/installation/patch/README.md index cd4549b2b..69b9176ee 100644 --- a/installation/patch/README.md +++ b/installation/patch/README.md @@ -16,3 +16,10 @@ patch -p1 < installation/patch/nameOfPatch * **PETSc-3.8** adjusts all includes nad calls to PETSc to the 3.8.x API This allows to use the current version of PETSc + +## Create patch +commit your changes + +```bash +git format-patch PATH_TO_COMPARE --stdout > +``` diff --git a/lib/damask/DS_HDF5.xml b/lib/damask/DS_HDF5.xml deleted file mode 100644 index 1277ce8d2..000000000 --- a/lib/damask/DS_HDF5.xml +++ /dev/null @@ -1,198 +0,0 @@ - - - - - attr - / - - store cmd history - - - - attr - / - - - - - - - Scalar - /Geometry/Vx - Geometry - Vector along x define the spectral mesh - - - - Scalar - /Geometry/Vy - Geometry - Vector along y defines the spectral mesh - - - - Scalar - /Geometry/Vz - Geometry - Vector along z defines the spectral mesh - - - - Scalar - /Geometry/ip - Geometry - - - - - Scalar - /Geometry/node - Geometry - - - - - Scalar - /Geometry/grain - Geometry - - - - - Vector - /Geometry/pos - Geometry - - - - - Scalar - /Geometry/elem - Geometry - - - - - - Scalar - /Crystallite/phase - Crystallite - - - - - Scalar - /Crystallite/texture - Crystallite - - - - - Scalar - /Crystallite/volume - Crystallite - - - - - Vector - /Crystallite/orientation - Crystallite - - - - - Vector - /Crystallite/eulerangles - Crystallite - Bunnge Euler angles in degrees - - - - Vector - /Crystallite/grainrotation - Crystallite - - - - - Tensor - /Crystallite/f - Crystallite - deformation gradient (F) - - -

- Tensor - /Crystallite/p - Crystallite - Pikola Kirkhoff stress -

- - - Tensor - /Crystallite/Cauchy - Crystallite - Cauchy stress tensor - - - - Tensor - /Crystallite/lnV - Crystallite - - - - - Scalar - /Crystallite/MisesCauchy - Crystallite - von Mises equivalent of Cauchy stress - - - - Scalar - /Crystallite/MiseslnV - Crystallite - left von Mises strain - - - - - Vector - /Constitutive/resistance_slip - Constitutive - - - - - Vector - /Constitutive/shearrate_slip - Constitutive - - - - - Vector - /Constitutive/resolvedstress_slip - Constitutive - - - - - Scalar - /Constitutive/totalshear - Constitutive - - - - - Matrix - /Constitutive/accumulatedshear_slip - Constitutive - vector contains accumulated shear per slip system - - - - - \ No newline at end of file diff --git a/lib/damask/__init__.py b/lib/damask/__init__.py index 1875ffdae..379b23547 100644 --- a/lib/damask/__init__.py +++ b/lib/damask/__init__.py @@ -1,31 +1,13 @@ # -*- coding: UTF-8 no BOM -*- """Main aggregator""" -import os,sys,time - -h5py_flag = os.path.join(os.path.dirname(__file__),'../../.noH5py') -h5py_grace = 7200 # only complain once every 7200 sec (2 hours) -h5py_msg = "h5py module not found." - -now = time.time() +import os with open(os.path.join(os.path.dirname(__file__),'../../VERSION')) as f: version = f.readline()[:-1] from .environment import Environment # noqa from .asciitable import ASCIItable # noqa -try: - from .h5table import H5Table # noqa - if os.path.exists(h5py_flag): os.remove(h5py_flag) # delete flagging file on success -except ImportError: - if os.path.exists(h5py_flag): - if now - os.path.getmtime(h5py_flag) > h5py_grace: # complain (again) every so-and-so often - sys.stderr.write(h5py_msg+'\n') - with open(h5py_flag, 'a'): - os.utime(h5py_flag,(now,now)) # update flag modification time to "now" - else: - open(h5py_flag, 'a').close() # create flagging file - sys.stderr.write(h5py_msg+'\n') # complain for the first time from .config import Material # noqa from .colormaps import Colormap, Color # noqa diff --git a/lib/damask/h5table.py b/lib/damask/h5table.py deleted file mode 100644 index 67d5853b6..000000000 --- a/lib/damask/h5table.py +++ /dev/null @@ -1,146 +0,0 @@ -# -*- coding: UTF-8 no BOM -*- - -# ----------------------------------------------------------- # -# Ideally the h5py should be enough to serve as the data # -# interface for future DAMASK, but since we are still not # -# sure when this major shift will happen, it seems to be a # -# good idea to provide a interface class that help user ease # -# into using HDF5 as the new daily storage driver. # -# ----------------------------------------------------------- # - -import os -import h5py -import numpy as np -import xml.etree.cElementTree as ET - -# ---------------------------------------------------------------- # -# python 3 has no unicode object, this ensures that the code works # -# on Python 2&3 # -# ---------------------------------------------------------------- # -try: - test = isinstance('test', unicode) -except(NameError): - unicode = str - - -def lables_to_path(label, dsXMLPath=None): - """Read the XML definition file and return the path.""" - if dsXMLPath is None: - # use the default storage layout in DS_HDF5.xml - if "h5table.pyc" in __file__: - dsXMLPath = os.path.abspath(__file__).replace("h5table.pyc", - "DS_HDF5.xml") - else: - dsXMLPath = os.path.abspath(__file__).replace("h5table.py", - "DS_HDF5.xml") - # This current implementation requires that all variables - # stay under the root node, the nesting is defined through the - # h5path. - # Allow new derived data to be put under the root - tree = ET.parse(dsXMLPath) - try: - dataType = tree.find('{}/type'.format(label)).text - h5path = tree.find('{}/h5path'.format(label)).text - except: - dataType = "Scalar" - h5path = "/{}".format(label) # just put it under root - return (dataType, h5path) - - -class H5Table(object): - """ - Lightweight interface class for h5py - - DESCRIPTION - ----------- - Interface/wrapper class for manipulating data in HDF5 with DAMASK - specialized data structure. - --> try to maintain a minimal API design. - PARAMETERS - ---------- - h5f_path: str - Absolute path of the HDF5 file - METHOD - ------ - del_entry() -- Force delete attributes/group/datasets (dangerous) - get_attr() -- Return attributes if possible - add_attr() -- Add NEW attributes to dataset/group (no force overwrite) - get_data() -- Retrieve data in numpy.ndarray - add_data() -- Add dataset to H5 file - get_cmdlog() -- Return the command used to generate the data if possible - NOTE - ---- - 1. As an interface class, it uses the lazy evaluation design - that reads the data only when it is absolutely necessary. - 2. The command line used to generate each new feature is stored with - each dataset as dataset attribute. - - """ - - def __init__(self, h5f_path, new_file=False, dsXMLFile=None): - self.h5f_path = h5f_path - self.dsXMLFile = dsXMLFile - msg = 'Created by H5Talbe from DAMASK' - mode = 'w' if new_file else 'a' - with h5py.File(self.h5f_path, mode) as h5f: - h5f['/'].attrs['description'] = msg - - def del_entry(self, feature_name): - """Delete entry in HDF5 table""" - dataType, h5f_path = lables_to_path(feature_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - del h5f[h5f_path] - - def get_attr(self, attr_name): - dataType, h5f_path = lables_to_path(attr_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - rst_attr = h5f[h5f_path].attrs[attr_name] - return rst_attr - - def add_attr(self, attr_name, attr_data): - dataType, h5f_path = lables_to_path(attr_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - h5f[h5f_path].attrs[attr_name] = attr_data - h5f.flush() - - def get_data(self, feature_name=None): - """Extract dataset from HDF5 table and return it in a numpy array""" - dataType, h5f_path = lables_to_path(feature_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - h5f_dst = h5f[h5f_path] # get the handle for target dataset(table) - rst_data = np.zeros(h5f_dst.shape) - h5f_dst.read_direct(rst_data) - return rst_data - - def add_data(self, feature_name, dataset, cmd_log=None): - """Adding new feature into existing HDF5 file""" - dataType, h5f_path = lables_to_path(feature_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - # NOTE: - # --> If dataset exists, delete the old one so as to write - # a new one. For brand new dataset. For brand new one, - # record its state as fresh in the cmd log. - try: - del h5f[h5f_path] - print("***deleting old {} from {}".format(feature_name,self.h5f_path)) - except: - # if no cmd log, None will used - cmd_log = str(cmd_log) + " [FRESH]" - h5f.create_dataset(h5f_path, data=dataset) - # store the cmd in log is possible - if cmd_log is not None: - h5f[h5f_path].attrs['log'] = str(cmd_log) - h5f.flush() - - def get_cmdlog(self, feature_name): - """Get cmd history used to generate the feature""" - dataType, h5f_path = lables_to_path(feature_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - cmd_logs = h5f[h5f_path].attrs['log'] - return cmd_logs diff --git a/processing/post/addDerivative.py b/processing/post/addDerivative.py new file mode 100755 index 000000000..dc97c09ea --- /dev/null +++ b/processing/post/addDerivative.py @@ -0,0 +1,121 @@ +#!/usr/bin/env python2.7 +# -*- coding: UTF-8 no BOM -*- + +import os,sys +import numpy as np +from optparse import OptionParser +import damask + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName,damask.version]) + +def derivative(coordinates,what): + + result = np.empty_like(what) + + # use differentiation by interpolation + # as described in http://www2.math.umd.edu/~dlevy/classes/amsc466/lecture-notes/differentiation-chap.pdf + + result[1:-1,:] = + what[1:-1,:] * (2.*coordinates[1:-1]-coordinates[:-2]-coordinates[2:]) / \ + ((coordinates[1:-1]-coordinates[:-2])*(coordinates[1:-1]-coordinates[2:])) \ + + what[2:,:] * (coordinates[1:-1]-coordinates[:-2]) / \ + ((coordinates[2:]-coordinates[1:-1])*(coordinates[2:]-coordinates[:-2])) \ + + what[:-2,:] * (coordinates[1:-1]-coordinates[2:]) / \ + ((coordinates[:-2]-coordinates[1:-1])*(coordinates[:-2]-coordinates[2:])) \ + + result[0,:] = (what[0,:] - what[1,:]) / \ + (coordinates[0] - coordinates[1]) + result[-1,:] = (what[-1,:] - what[-2,:]) / \ + (coordinates[-1] - coordinates[-2]) + + return result + +# -------------------------------------------------------------------- +# MAIN +# -------------------------------------------------------------------- + +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +Add column(s) containing numerical derivative of requested column(s) with respect to given coordinates. + +""", version = scriptID) + +parser.add_option('-c','--coordinates', + dest = 'coordinates', + type = 'string', metavar='string', + help = 'heading of coordinate column') +parser.add_option('-l','--label', + dest = 'label', + action = 'extend', metavar = '', + help = 'heading of column(s) to differentiate') + + +(options,filenames) = parser.parse_args() + +if options.coordinates is None: + parser.error('no coordinate column specified.') +if options.label is None: + parser.error('no data column specified.') + +# --- loop over input files ------------------------------------------------------------------------- + +if filenames == []: filenames = [None] + +for name in filenames: + try: table = damask.ASCIItable(name = name, + buffered = False) + except: continue + damask.util.report(scriptName,name) + +# ------------------------------------------ read header ------------------------------------------ + + table.head_read() + +# ------------------------------------------ sanity checks ---------------------------------------- + + errors = [] + remarks = [] + columns = [] + dims = [] + + if table.label_dimension(options.coordinates) != 1: + errors.append('coordinate column {} is not scalar.'.format(options.coordinates)) + + for what in options.label: + dim = table.label_dimension(what) + if dim < 0: remarks.append('column {} not found...'.format(what)) + else: + dims.append(dim) + columns.append(table.label_index(what)) + table.labels_append('d({})/d({})'.format(what,options.coordinates) if dim == 1 else + ['{}_d({})/d({})'.format(i+1,what,options.coordinates) for i in range(dim)] ) # extend ASCII header with new labels + + if remarks != []: damask.util.croak(remarks) + if errors != []: + damask.util.croak(errors) + table.close(dismiss = True) + continue + +# ------------------------------------------ assemble header -------------------------------------- + + table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) + table.head_write() + +# ------------------------------------------ process data ------------------------------------------ + + table.data_readArray() + + mask = [] + for col,dim in zip(columns,dims): mask += range(col,col+dim) # isolate data columns to differentiate + + differentiated = derivative(table.data[:,table.label_index(options.coordinates)].reshape((len(table.data),1)), + table.data[:,mask]) # calculate numerical derivative + + table.data = np.hstack((table.data,differentiated)) + +# ------------------------------------------ output result ----------------------------------------- + + table.data_writeArray() + +# ------------------------------------------ output finalization ----------------------------------- + + table.close() # close ASCII tables diff --git a/processing/post/h5_addCalculation.py b/processing/post/h5_addCalculation.py deleted file mode 100755 index 0ce1981a1..000000000 --- a/processing/post/h5_addCalculation.py +++ /dev/null @@ -1,72 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -# import re -# import sys -import collections -# import math -import damask -# import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# ----- Helper functions ----- # -def listify(x): - return x if isinstance(x, collections.Iterable) else [x] - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -usageEx = """ -usage_in_details: - Column labels are tagged by '#label#' in formulas. - Use ';' for ',' in functions. Numpy is available as 'np'. - Special variables: #_row_# -- row index - - Examples: - (1) magnitude of vector -- "np.linalg.norm(#vec#)" - (2) rounded root of row number -- "round(math.sqrt(#_row_#);3)" -""" -desp = "Add or alter column(s) with derived values according to " -desp += "user-defined arithmetic operation between column(s)." - -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]' + usageEx, - description=desp, - version=scriptID) -parser.add_option('-l', '--label', - dest='labels', - action='extend', metavar='', - help='(list of) new column labels') -parser.add_option('-f', '--formula', - dest='formulas', - action='extend', metavar='', - help='(list of) formulas corresponding to labels') -parser.add_option('-c', '--condition', - dest='condition', metavar='string', - help='condition to filter rows') - -parser.set_defaults(condition=None) - -(options, filenames) = parser.parse_args() - -# ----- parse formulas ----- # -for i in range(len(options.formulas)): - options.formulas[i] = options.formulas[i].replace(';', ',') - -# ----- loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - print("!!!Cannot process {}".format(name)) - continue - damask.util.report(scriptName, name) - -# Note: -# --> not immediately needed, come back later diff --git a/processing/post/h5_addCauchy.py b/processing/post/h5_addCauchy.py deleted file mode 100755 index 84145d99d..000000000 --- a/processing/post/h5_addCauchy.py +++ /dev/null @@ -1,61 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import damask -import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -def getCauchy(f, p): - """Return Cauchy stress for given f and p""" - # [Cauchy] = (1/det(F)) * [P].[F_transpose] - f = f.reshape((3, 3)) - p = p.reshape((3, 3)) - return 1.0/np.linalg.det(f)*np.dot(p, f.T).reshape(9) - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -desp = "Add column(s) containing Cauchy stress based on given column(s)" -desp += "of deformation gradient and first Piola--Kirchhoff stress." -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=desp, - version=scriptID) -parser.add_option('-f', '--defgrad', - dest='defgrad', - type='string', metavar='string', - help='heading for deformation gradient [%default]') -parser.add_option('-p', '--stress', - dest='stress', - type='string', metavar='string', - help='heading for first Piola--Kirchhoff stress [%default]') - -parser.set_defaults(defgrad='f', - stress='p') - -(options, filenames) = parser.parse_args() - -# ----- loop over input H5 files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # ----- read in data ----- # - f = h5f.get_data("f") - p = h5f.get_data("p") - - # ----- calculate Cauchy stress ----- # - cauchy = [getCauchy(f_i, p_i) for f_i, p_i in zip(f, p)] - - # ----- write to HDF5 file ----- # - cmd_log = " ".join([scriptID, name]) - h5f.add_data('Cauchy', np.array(cauchy), cmd_log=cmd_log) diff --git a/processing/post/h5_addIPFcolor.py b/processing/post/h5_addIPFcolor.py deleted file mode 100755 index c92483fa5..000000000 --- a/processing/post/h5_addIPFcolor.py +++ /dev/null @@ -1,145 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import sys -import math -import damask -import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - -# TODO -# This implementation will have to iterate through the array one -# element at a time, maybe there are some other ways to make this -# faster. - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -desp = "Add RGB color value corresponding to TSL-OIM scheme for IPF." -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=desp, - version=scriptID) -parser.add_option('-p', '--pole', - dest='pole', - type='float', nargs=3, metavar='float float float', - help='lab frame direction for IPF [%default]') -msg = ', '.join(damask.Symmetry.lattices[1:]) -parser.add_option('-s', '--symmetry', - dest='symmetry', - type='choice', choices=damask.Symmetry.lattices[1:], - metavar='string', - help='crystal symmetry [%default] {{{}}} '.format(msg)) -parser.add_option('-e', '--eulers', - dest='eulers', - type='string', metavar='string', - help='Euler angles label') -parser.add_option('-d', '--degrees', - dest='degrees', - action='store_true', - help='Euler angles are given in degrees [%default]') -parser.add_option('-m', '--matrix', - dest='matrix', - type='string', metavar='string', - help='orientation matrix label') -parser.add_option('-a', - dest='a', - type='string', metavar='string', - help='crystal frame a vector label') -parser.add_option('-b', - dest='b', - type='string', metavar='string', - help='crystal frame b vector label') -parser.add_option('-c', - dest='c', - type='string', metavar='string', - help='crystal frame c vector label') -parser.add_option('-q', '--quaternion', - dest='quaternion', - type='string', metavar='string', - help='quaternion label') - -parser.set_defaults(pole=(0.0, 0.0, 1.0), - symmetry=damask.Symmetry.lattices[-1], - degrees=False) - -(options, filenames) = parser.parse_args() - -# safe guarding to have only one orientation representation -# use dynamic typing to group a,b,c into frame -options.frame = [options.a, options.b, options.c] -input = [options.eulers is not None, - all(options.frame), - options.matrix is not None, - options.quaternion is not None] - -if np.sum(input) != 1: - parser.error('needs exactly one input format.') - -# select input label that was requested (active) -label_active = np.where(input)[0][0] -(label, dim, inputtype) = [(options.eulers, 3, 'eulers'), - (options.frame, [3, 3, 3], 'frame'), - (options.matrix, 9, 'matrix'), - (options.quaternion, 4, 'quaternion')][label_active] - -# rescale degrees to radians -toRadians = math.pi/180.0 if options.degrees else 1.0 - -# only use normalized pole -pole = np.array(options.pole) -pole /= np.linalg.norm(pole) - -# ----- Loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # extract data from HDF5 file - if inputtype == 'eulers': - orieData = h5f.get_data(label) - elif inputtype == 'matrix': - orieData = h5f.get_data(label) - orieData = orieData.reshape(orieData.shape[0], 3, 3) - elif inputtype == 'frame': - vctr_a = h5f.get_data(label[0]) - vctr_b = h5f.get_data(label[1]) - vctr_c = h5f.get_data(label[2]) - frame = np.column_stack((vctr_a, vctr_b, vctr_c)) - orieData = frame.reshape(frame.shape[0], 3, 3) - elif inputtype == 'quaternion': - orieData = h5f.get_data(label) - - # calculate the IPF color - rgbArrays = np.zeros((orieData.shape[0], 3)) - for ci in range(rgbArrays.shape[0]): - if inputtype == 'eulers': - o = damask.Orientation(Eulers=np.array(orieData[ci, :])*toRadians, - symmetry=options.symmetry).reduced() - elif inputtype == 'matrix': - o = damask.Orientation(matrix=orieData[ci, :, :].transpose(), - symmetry=options.symmetry).reduced() - elif inputtype == 'frame': - o = damask.Orientation(matrix=orieData[ci, :, :], - symmetry=options.symmetry).reduced() - elif inputtype == 'quaternion': - o = damask.Orientation(quaternion=orieData[ci, :], - symmetry=options.symmetry).reduced() - rgbArrays[ci, :] = o.IPFcolor(pole) - - # compose labels/headers for IPF color (RGB) - labelIPF = 'IPF_{:g}{:g}{:g}_{sym}'.format(*options.pole, - sym=options.symmetry.lower()) - - # compose cmd history (go with dataset) - cmd_log = scriptID + '\t' + ' '.join(sys.argv[1:]) - - # write data to HDF5 file - h5f.add_data(labelIPF, rgbArrays, cmd_log=cmd_log) diff --git a/processing/post/h5_addMises.py b/processing/post/h5_addMises.py deleted file mode 100755 index 99367cd80..000000000 --- a/processing/post/h5_addMises.py +++ /dev/null @@ -1,85 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import sys -import math -import damask -import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# ----- Helper functions ----- # -def calcMises(what, tensor): - """Calculate von Mises equivalent""" - dev = tensor - np.trace(tensor)/3.0*np.eye(3) - symdev = 0.5*(dev+dev.T) - return math.sqrt(np.sum(symdev*symdev.T) * - { - 'stress': 3.0/2.0, - 'strain': 2.0/3.0, - }[what.lower()]) - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -desp = "Add von Mises equivalent values for symmetric part of requested" -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=desp, - version=scriptID) -parser.add_option('-e', '--strain', - dest='strain', - metavar='string', - help='name of dataset containing strain tensors') -parser.add_option('-s', '--stress', - dest='stress', - metavar='string', - help='name of dataset containing stress tensors') - -parser.set_defaults(strain=None, stress=None) - -(options, filenames) = parser.parse_args() - -# ----- Loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # TODO: - # Could use some refactoring here - if options.stress is not None: - # extract stress tensor from HDF5 - tnsr = h5f.get_data(options.stress) - - # calculate von Mises equivalent row by row - vmStress = np.zeros(tnsr.shape[0]) - for ri in range(tnsr.shape[0]): - stressTnsr = tnsr[ri, :].reshape(3, 3) - vmStress[ri] = calcMises('stress', stressTnsr) - - # compose label - label = "Mises{}".format(options.stress) - - # prepare log info - cmd_log = scriptID + '\t' + ' '.join(sys.argv[1:]) - - # write data to HDF5 file - h5f.add_data(label, vmStress, cmd_log=cmd_log) - - if options.strain is not None: - tnsr = h5f.get_data(options.strain) - vmStrain = np.zeros(tnsr.shape[0]) - for ri in range(tnsr.shape[0]): - strainTnsr = tnsr[ri, :].reshape(3, 3) - vmStrain[ri] = calcMises('strain', strainTnsr) - label = "Mises{}".format(options.strain) - cmd_log = scriptID + '\t' + ' '.join(sys.argv[1:]) - h5f.add_data(label, vmStrain, cmd_log=cmd_log) diff --git a/processing/post/h5_addStrainTensors.py b/processing/post/h5_addStrainTensors.py deleted file mode 100755 index 9e3f49233..000000000 --- a/processing/post/h5_addStrainTensors.py +++ /dev/null @@ -1,156 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import sys -import damask -import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# ----- Helper functions ----- # -def operator(stretch, strain, eigenvalues): - # Albrecht Bertram: Elasticity and Plasticity of Large Deformations - # An Introduction (3rd Edition, 2012), p. 102 - return {'V#ln': np.log(eigenvalues), - 'U#ln': np.log(eigenvalues), - 'V#Biot': (np.ones(3, 'd') - 1.0/eigenvalues), - 'U#Biot': (eigenvalues - np.ones(3, 'd')), - 'V#Green': (np.ones(3, 'd') - 1.0/eigenvalues/eigenvalues)*0.5, - 'U#Green': (eigenvalues*eigenvalues - np.ones(3, 'd'))*0.5, - }[stretch+'#'+strain] - - -def calcEPS(defgrads, stretchType, strainType): - """Calculate specific type of strain tensor""" - eps = np.zeros(defgrads.shape) # initialize container - - # TODO: - # this loop can use some performance boost - # (multi-threading?) - for ri in range(defgrads.shape[0]): - f = defgrads[ri, :].reshape(3, 3) - U, S, Vh = np.linalg.svd(f) - R = np.dot(U, Vh) # rotation of polar decomposition - if stretchType == 'U': - stretch = np.dot(np.linalg.inv(R), f) # F = RU - elif stretchType == 'V': - stretch = np.dot(f, np.linalg.inv(R)) # F = VR - - # kill nasty noisy data - stretch = np.where(abs(stretch) < 1e-12, 0, stretch) - - (D, V) = np.linalg.eig(stretch) - # flip principal component with negative Eigen values - neg = np.where(D < 0.0) - D[neg] *= -1. - V[:, neg] *= -1. - - # check each vector for orthogonality - # --> brutal force enforcing orthogonal base - # and re-normalize - for i, eigval in enumerate(D): - if np.dot(V[:, i], V[:, (i+1) % 3]) != 0.0: - V[:, (i+1) % 3] = np.cross(V[:, (i+2) % 3], V[:, i]) - V[:, (i+1) % 3] /= np.sqrt(np.dot(V[:, (i+1) % 3], - V[:, (i+1) % 3].conj())) - - # calculate requested version of strain tensor - d = operator(stretchType, strainType, D) - eps[ri] = (np.dot(V, np.dot(np.diag(d), V.T)).real).reshape(9) - - return eps - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -desp = "Add column(s) containing given strains based on given stretches" -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=desp, - version=scriptID) -msg = 'material strains based on right Cauchy-Green deformation, i.e., C and U' -parser.add_option('-u', '--right', - dest='right', - action='store_true', - help=msg) -msg = 'spatial strains based on left Cauchy--Green deformation, i.e., B and V' -parser.add_option('-v', '--left', - dest='left', - action='store_true', - help=msg) -parser.add_option('-0', '--logarithmic', - dest='logarithmic', - action='store_true', - help='calculate logarithmic strain tensor') -parser.add_option('-1', '--biot', - dest='biot', - action='store_true', - help='calculate biot strain tensor') -parser.add_option('-2', '--green', - dest='green', - action='store_true', - help='calculate green strain tensor') -# NOTE: -# It might be easier to just calculate one type of deformation gradient -# at a time. -msg = 'heading(s) of columns containing deformation tensor values' -parser.add_option('-f', '--defgrad', - dest='defgrad', - action='extend', - metavar='', - help=msg) - -parser.set_defaults(right=False, left=False, - logarithmic=False, biot=False, green=False, - defgrad='f') - -(options, filenames) = parser.parse_args() - -stretches = [] -strains = [] - -if options.right: - stretches.append('U') -if options.left: - stretches.append('V') - -if options.logarithmic: - strains.append('ln') -if options.biot: - strains.append('Biot') -if options.green: - strains.append('Green') - -if options.defgrad is None: - parser.error('no data column specified.') - -# ----- Loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # extract defgrads from HDF5 storage - F = h5f.get_data(options.defgrad) - - # allow calculate multiple types of strain within the - # same cmd call - for stretchType in stretches: - for strainType in strains: - # calculate strain tensor for this type - eps = calcEPS(F, stretchType, strainType) - - # compose labels/headers for this strain tensor - labelsStrain = strainType + stretchType - - # prepare log info - cmd_log = scriptID + '\t' + ' '.join(sys.argv[1:]) - - # write data to HDF5 file - h5f.add_data(labelsStrain, eps, cmd_log=cmd_log) diff --git a/processing/post/h5_addXdmfWapper.py b/processing/post/h5_addXdmfWapper.py deleted file mode 100755 index e5588a069..000000000 --- a/processing/post/h5_addXdmfWapper.py +++ /dev/null @@ -1,130 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -# ------------------------------------------------------------------- # -# NOTE: # -# 1. Current Xdmf rendering in Paraview has some memory issue where # -# large number of polyvertices will cause segmentation fault. By # -# default, paraview output a cell based xdmf description, which # -# is working for small and medium mesh (<10,000) points. Hence a # -# rectangular mesh is used as the de facto Geometry description # -# here. # -# 2. Due to the unstable state Xdmf, it is safer to use port data # -# to VTR rather than using xdmf as interpretive layer for data # -# visualization. # -# ------------------------------------------------------------------- # - - -import os -import damask -import h5py -import xml.etree.cElementTree as ET -from optparse import OptionParser -from xml.dom import minidom -from damask.h5table import lables_to_path - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName,damask.version]) - - -# ----- HELPER FUNCTIONS -----# -def addTopLvlCmt(xmlstr, topLevelCmt): - """Add top level comment to string from ET""" - # a quick hack to add the top level comment to XML file - # --> somehow Elementtree does not provide this functionality - # --> by default - strList = xmlstr.split("\n") - strList[0] += "\n"+topLevelCmt - return "\n".join(strList) - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- - -msg = 'Generate Xdmf wrapper for HDF5 file.' -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description = msg, - version = scriptID) - -(options, filenames) = parser.parse_args() - -h5f = filenames[0] -h5f_base = h5f.split("/")[-1] - -# ----- parse HDF5 file ----- # -h5f_dataDim = {} -h5f_dataPath = {} -h5f_dataType = {} -with h5py.File(h5f, 'a') as f: - labels = f.keys() - labels += f['/Constitutive'].keys() - labels += f['/Crystallite'].keys() - labels += ['Vx', 'Vy', "Vz"] - # remove group names as they do not contain real data - # TODO: use h5py/H5table API to detect dataset name to - # avoid necessary name space pruning. - labels.remove('Constitutive') - labels.remove('Crystallite') - labels.remove('Geometry') - # loop through remaining labels - for label in labels: - dataType, h5Path = lables_to_path(label) - h5f_dataType[label] = dataType - h5f_dataDim[label] = " ".join(map(str,f[h5Path].shape)) - h5f_dataPath[label] = h5Path - -# ----- constructing xdmf elements ----- # -root = ET.Element("Xdmf", version='3.3') -root.set('xmlns:xi', "http://www.w3.org/2001/XInclude") -root.append(ET.Comment('Generated Xdmf wapper for DAMASH H5 output')) - -# usually there should only be ONE domain -domain = ET.SubElement(root, 'Domain', - Name=h5f_base.split(".")[0]) - -# use global topology through reference -grid = ET.SubElement(domain, 'Grid', GridType="Uniform") -# geometry section -geometry = ET.SubElement(grid, 'Geometry', GeometryType="VXVYVZ") -for vector in ["Vz", "Vy", "Vx"]: - dataitem = ET.SubElement(geometry, "DataItem", - DataType="Float", - Dimensions=h5f_dataDim[vector], - Name=vector, - Format="HDF") - dataitem.text = h5f_base.split("/")[-1] + ":{}".format(h5f_dataPath[vector]) -# topology section -# TODO: support for other format based on given option -meshDim = [h5f_dataDim["Vz"], h5f_dataDim["Vy"], h5f_dataDim["Vx"]] -topology = ET.SubElement(grid, 'Topology', - TopologyType="3DRectMesh", - Dimensions=" ".join(map(str, meshDim))) - -# attributes section -# Question: how to properly handle data mapping for multiphase situations -labelsProcessed = ['Vx', 'Vy', 'Vz'] -# walk through each attributes -for label in labels: - if label in labelsProcessed: continue - print("adding {}...".format(label)) - attr = ET.SubElement(grid, 'Attribute', - Name=label, - Type="None", - Center="Cell") - dataitem = ET.SubElement(attr, 'DataItem', - Name=label, - Format='HDF', - Dimensions=h5f_dataDim[label]) - dataitem.text = h5f_base + ":" + h5f_dataPath[label] - # update progress list - labelsProcessed.append(label) - - -# pretty print the xdmf(xml) file content -xmlstr = minidom.parseString(ET.tostring(root)).toprettyxml(indent="\t") -xmlstr = addTopLvlCmt(xmlstr, '') -# write str to file through native python API -with open(h5f.replace(".h5", ".xmf"), 'w') as f: - f.write(xmlstr) diff --git a/processing/post/h5_vtkAddRectilinearGridData.py b/processing/post/h5_vtkAddRectilinearGridData.py deleted file mode 100755 index 1c0492f53..000000000 --- a/processing/post/h5_vtkAddRectilinearGridData.py +++ /dev/null @@ -1,191 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import vtk -import damask -from vtk.util import numpy_support -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -msg = "Add scalars, vectors, and/or an RGB tuple from" -msg += "an HDF5 to existing VTK rectilinear grid (.vtr/.vtk)." -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=msg, - version=scriptID) -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', - help='open output in VTK render window') -parser.add_option('-d', '--data', - dest='data', - action='extend', metavar='', - help='scalar/vector value(s) label(s)') -parser.add_option('-t', '--tensor', - dest='tensor', - action='extend', metavar='', - help='tensor (3x3) value label(s)') -parser.add_option('-c', '--color', - dest='color', - action='extend', metavar='', - help='RGB color tuple label') -parser.add_option('-m', - '--mode', - dest='mode', - metavar='string', - type='choice', choices=['cell', 'point'], - help='cell-centered or point-centered coordinates') - -parser.set_defaults(data=[], - tensor=[], - color=[], - mode='cell', - inplace=False, - render=False) - -(options, filenames) = parser.parse_args() - -# ----- Legacy VTK format support ----- # -if os.path.splitext(options.vtk)[1] == '.vtr': - reader = vtk.vtkXMLRectilinearGridReader() - reader.SetFileName(options.vtk) - reader.Update() - rGrid = reader.GetOutput() -elif os.path.splitext(options.vtk)[1] == '.vtk': - reader = vtk.vtkGenericDataObjectReader() - reader.SetFileName(options.vtk) - reader.Update() - rGrid = reader.GetRectilinearGridOutput() -else: - parser.error('Unsupported VTK file type extension.') - -Npoints = rGrid.GetNumberOfPoints() -Ncells = rGrid.GetNumberOfCells() - -# ----- Summary output (Sanity Check) ----- # -msg = '{}: {} points and {} cells...'.format(options.vtk, - Npoints, - Ncells) -damask.util.croak(msg) - -# ----- Read HDF5 file ----- # -# NOTE: -# --> It is possible in the future we are trying to add data -# from different increment into the same VTK file, but -# this feature is not supported for the moment. -# --> Let it fail, if the HDF5 is invalid, python interpretor -# --> should be able to catch this error. -h5f = damask.H5Table(filenames[0], new_file=False) - -# ----- Process data ----- # -featureToAdd = {'data': options.data, - 'tensor': options.tensor, - 'color': options.color} -VTKarray = {} # store all vtkData in dict, then ship them to file -for dataType in featureToAdd.keys(): - featureNames = featureToAdd[dataType] - for featureName in featureNames: - VTKtype = vtk.VTK_DOUBLE - VTKdata = h5f.get_data(featureName) - if dataType == 'color': - VTKtype = vtk.VTK_UNSIGNED_CHAR - VTKdata = (VTKdata*255).astype(int) - elif dataType == 'tensor': - # Force symmetries tensor type data - VTKdata[:, 1] = VTKdata[:, 3] = 0.5*(VTKdata[:, 1]+VTKdata[:, 3]) - VTKdata[:, 2] = VTKdata[:, 6] = 0.5*(VTKdata[:, 2]+VTKdata[:, 6]) - VTKdata[:, 5] = VTKdata[:, 7] = 0.5*(VTKdata[:, 5]+VTKdata[:, 7]) - # use vtk build-in numpy support to add data (much faster) - # NOTE: - # --> deep copy is necessary here, otherwise memory leak could occur - VTKarray[featureName] = numpy_support.numpy_to_vtk(num_array=VTKdata, - deep=True, - array_type=VTKtype) - VTKarray[featureName].SetName(featureName) - -# ----- ship data to vtkGrid ----- # -mode = options.mode -damask.util.croak('{} mode...'.format(mode)) - -# NOTE: -# --> For unknown reason, Paraview only recognize one -# tensor attributes per cell, thus it would be safe -# to only add one attributes as tensor. -for dataType in featureToAdd.keys(): - featureNames = featureToAdd[dataType] - for featureName in featureNames: - if dataType == 'color': - if mode == 'cell': - rGrid.GetCellData().SetScalars(VTKarray[featureName]) - elif mode == 'point': - rGrid.GetPointData().SetScalars(VTKarray[featureName]) - elif dataType == 'tensor': - if mode == 'cell': - rGrid.GetCellData().SetTensors(VTKarray[featureName]) - elif mode == 'point': - rGrid.GetPointData().SetTensors(VTKarray[featureName]) - else: - if mode == 'cell': - rGrid.GetCellData().AddArray(VTKarray[featureName]) - elif mode == 'point': - rGrid.GetPointData().AddArray(VTKarray[featureName]) - -rGrid.Modified() -if vtk.VTK_MAJOR_VERSION <= 5: - rGrid.Update() - -# ----- write Grid to VTK file ----- # -writer = vtk.vtkXMLRectilinearGridWriter() -writer.SetDataModeToBinary() -writer.SetCompressorTypeToZLib() -vtkFileN = os.path.splitext(options.vtk)[0] -vtkExtsn = '.vtr' if options.inplace else '_added.vtr' -writer.SetFileName(vtkFileN+vtkExtsn) -if vtk.VTK_MAJOR_VERSION <= 5: - writer.SetInput(rGrid) -else: - writer.SetInputData(rGrid) -writer.Write() - -# ----- render results from script ----- # -if options.render: - mapper = vtk.vtkDataSetMapper() - mapper.SetInputData(rGrid) - actor = vtk.vtkActor() - actor.SetMapper(mapper) - - # Create the graphics structure. The renderer renders into the - # render window. The render window interactor captures mouse events - # and will perform appropriate camera or actor manipulation - # depending on the nature of the events. - - ren = vtk.vtkRenderer() - - renWin = vtk.vtkRenderWindow() - renWin.AddRenderer(ren) - - ren.AddActor(actor) - ren.SetBackground(1, 1, 1) - renWin.SetSize(200, 200) - - iren = vtk.vtkRenderWindowInteractor() - iren.SetRenderWindow(renWin) - - iren.Initialize() - renWin.Render() - iren.Start() diff --git a/processing/post/h5_vtkRectilinearGrid.py b/processing/post/h5_vtkRectilinearGrid.py deleted file mode 100755 index b08070b84..000000000 --- a/processing/post/h5_vtkRectilinearGrid.py +++ /dev/null @@ -1,135 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -# ------------------------------------------------------------------ # -# NOTE: # -# 1. It might be a good idea to separate IO and calculation. # -# 2. Some of the calculation could be useful in other situations, # -# why not build a math_util, or math_sup module that contains # -# all the useful functions. # -# ------------------------------------------------------------------ # - -import os -import vtk -import numpy as np -import damask -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# ----- HELPER FUNCTION ----- # -def getMeshFromXYZ(xyzArray, mode): - """Calc Vx,Vy,Vz vectors for vtk rectangular mesh""" - # NOTE: - # --> np.unique will automatically sort the list - # --> although not exactly n(1), but since mesh dimension should - # small anyway, so this is still light weight. - dim = xyzArray.shape[1] # 2D:2, 3D:3 - coords = [np.unique(xyzArray[:, i]) for i in range(dim)] - - if mode == 'cell': - # since x, y, z might now have the same number of elements, - # we have to deal with them individually - for ri in range(dim): - vctr_pt = coords[ri] - vctr_cell = np.empty(len(vctr_pt)+1) - # calculate first and last end point - vctr_cell[0] = vctr_pt[0] - 0.5*abs(vctr_pt[1] - vctr_pt[0]) - vctr_cell[-1] = vctr_pt[-1] + 0.5*abs(vctr_pt[-2] - vctr_pt[-1]) - for cj in range(1, len(vctr_cell)-1): - vctr_cell[cj] = 0.5*(vctr_pt[cj-1] + vctr_pt[cj]) - # update the coords - coords[ri] = vctr_cell - - if dim < 3: - coords.append([0]) # expand to a 3D with 0 for z - - # auxiliary description - grid = np.array(map(len, coords), 'i') - N = grid.prod() if mode == 'point' else (grid-1).prod() - return coords, grid, N - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- - -msg = "Create regular voxel grid from points in an ASCIItable." -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=msg, - version=scriptID) - -parser.add_option('-m', - '--mode', - dest='mode', - metavar='string', - type='choice', choices=['cell', 'point'], - help='cell-centered or point-centered coordinates') -parser.add_option('-p', - '--pos', '--position', - dest='pos', - type='string', metavar='string', - help='label of coordinates [%default]') - -parser.set_defaults(mode='cell', - pos='pos') - -(options, filenames) = parser.parse_args() - -# ----- loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # ----- read xyzArray from HDF5 file ----- # - xyzArray = h5f.get_data(options.pos) - - # ----- figure out size and grid ----- # - coords, grid, N = getMeshFromXYZ(xyzArray, options.mode) - - # ----- process data ----- # - rGrid = vtk.vtkRectilinearGrid() - # WARNING: list expansion does not work here as these are - # just pointers for a vtk instance. Simply put, - # DON't USE - # [] * - coordArray = [vtk.vtkDoubleArray(), - vtk.vtkDoubleArray(), - vtk.vtkDoubleArray()] - - rGrid.SetDimensions(*grid) - for i, points in enumerate(coords): - for point in points: - coordArray[i].InsertNextValue(point) - - rGrid.SetXCoordinates(coordArray[0]) - rGrid.SetYCoordinates(coordArray[1]) - rGrid.SetZCoordinates(coordArray[2]) - - # ----- output result ----- # - dirPath = os.path.split(name)[0] - if name: - writer = vtk.vtkXMLRectilinearGridWriter() - writer.SetCompressorTypeToZLib() - writer.SetDataModeToBinary() - # getting the name is a little bit tricky - vtkFileName = os.path.splitext(os.path.split(name)[1])[0] - vtkFileName += '_{}({})'.format(options.pos, options.mode) - vtkFileName += '.' + writer.GetDefaultFileExtension() - writer.SetFileName(os.path.join(dirPath, vtkFileName)) - else: - writer = vtk.vtkDataSetWriter() - writer.SetHeader('# powered by '+scriptID) - writer.WriteToOutputStringOn() - - if vtk.VTK_MAJOR_VERSION <= 5: - writer.SetInput(rGrid) - else: - writer.SetInputData(rGrid) - - writer.Write() diff --git a/processing/post/marc_to_vtk.py b/processing/post/marc_to_vtk.py new file mode 100755 index 000000000..a232d1219 --- /dev/null +++ b/processing/post/marc_to_vtk.py @@ -0,0 +1,167 @@ +#!/usr/bin/env python2.7 +# -*- coding: UTF-8 no BOM -*- + +import os,re +import argparse +import damask +import vtk, numpy as np + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName, damask.version]) + +parser = argparse.ArgumentParser(description='Convert from Marc input file format to VTK', version = scriptID) +parser.add_argument('filename', type=str, nargs='+', help='files to convert') + +args = parser.parse_args() +files = args.filename +if type(files) is str: + files = [files] + + +for f in files: + with open(f, 'r') as marcfile: + marctext = marcfile.read(); + # Extract connectivity chunk from file... + connectivity_text = re.findall(r'connectivity[\n\r]+(.*?)[\n\r]+[a-zA-Z]', marctext, flags=(re.MULTILINE | re.DOTALL))[0] + connectivity_lines = re.split(r'[\n\r]+', connectivity_text, flags=(re.MULTILINE | re.DOTALL)) + connectivity_header = connectivity_lines[0] + connectivity_lines = connectivity_lines[1:] + # Construct element map + elements = dict(map(lambda line: + ( + int(line[0:10]), # index + { + 'type': int(line[10:20]), + 'verts': list(map(int, re.split(r' +', line[20:].strip()))) + } + ), connectivity_lines)) + # Extract coordinate chunk from file + coordinates_text = re.findall(r'coordinates[\n\r]+(.*?)[\n\r]+[a-zA-Z]', marctext, flags=(re.MULTILINE | re.DOTALL))[0] + coordinates_lines = re.split(r'[\n\r]+', coordinates_text, flags=(re.MULTILINE | re.DOTALL)) + coordinates_header = coordinates_lines[0] + coordinates_lines = coordinates_lines[1:] + # marc input file does not use "e" in scientific notation, this adds it and converts + fl_format = lambda string: float(re.sub(r'(\d)([\+\-])', r'\1e\2', string)) + # Construct coordinate map + coordinates = dict(map(lambda line: + ( + int(line[0:10]), + np.array([ + fl_format(line[10:30]), + fl_format(line[30:50]), + fl_format(line[50:70]) + ]) + ), coordinates_lines)) + + # Subdivide volumes + grid = vtk.vtkUnstructuredGrid() + vertex_count = len(coordinates) + edge_to_vert = dict() # when edges are subdivided, a new vertex in the middle is produced and placed in here + ordered_pair = lambda a, b: (a, b) if a < b else (b, a) # edges are bidirectional + + def subdivide_edge(vert1, vert2): + edge = ordered_pair(vert1, vert2) + + if edge in edge_to_vert: + return edge_to_vert[edge] + + newvert = len(coordinates) + 1 + coordinates[newvert] = 0.5 * (coordinates[vert1] + coordinates[vert2]) # Average + edge_to_vert[edge] = newvert; + return newvert; + + + + for el_id in range(1, len(elements) + 1): + el = elements[el_id] + if el['type'] == 7: + # Hexahedron, subdivided + + # There may be a better way to iterate over these, but this is consistent + # with the ordering scheme provided at https://damask.mpie.de/pub/Documentation/ElementType + + subverts = np.zeros((3,3,3), dtype=int) + # Get corners + subverts[0, 0, 0] = el['verts'][0] + subverts[2, 0, 0] = el['verts'][1] + subverts[2, 2, 0] = el['verts'][2] + subverts[0, 2, 0] = el['verts'][3] + subverts[0, 0, 2] = el['verts'][4] + subverts[2, 0, 2] = el['verts'][5] + subverts[2, 2, 2] = el['verts'][6] + subverts[0, 2, 2] = el['verts'][7] + + # lower edges + subverts[1, 0, 0] = subdivide_edge(subverts[0, 0, 0], subverts[2, 0, 0]) + subverts[2, 1, 0] = subdivide_edge(subverts[2, 0, 0], subverts[2, 2, 0]) + subverts[1, 2, 0] = subdivide_edge(subverts[2, 2, 0], subverts[0, 2, 0]) + subverts[0, 1, 0] = subdivide_edge(subverts[0, 2, 0], subverts[0, 0, 0]) + + # middle edges + subverts[0, 0, 1] = subdivide_edge(subverts[0, 0, 0], subverts[0, 0, 2]) + subverts[2, 0, 1] = subdivide_edge(subverts[2, 0, 0], subverts[2, 0, 2]) + subverts[2, 2, 1] = subdivide_edge(subverts[2, 2, 0], subverts[2, 2, 2]) + subverts[0, 2, 1] = subdivide_edge(subverts[0, 2, 0], subverts[0, 2, 2]) + + # top edges + subverts[1, 0, 2] = subdivide_edge(subverts[0, 0, 2], subverts[2, 0, 2]) + subverts[2, 1, 2] = subdivide_edge(subverts[2, 0, 2], subverts[2, 2, 2]) + subverts[1, 2, 2] = subdivide_edge(subverts[2, 2, 2], subverts[0, 2, 2]) + subverts[0, 1, 2] = subdivide_edge(subverts[0, 2, 2], subverts[0, 0, 2]) + + # then faces... The edge_to_vert addition is due to there being two ways + # to calculate a face, depending which opposite vertices are used to subdivide + subverts[1, 1, 0] = subdivide_edge(subverts[1, 0, 0], subverts[1, 2, 0]) + edge_to_vert[ordered_pair(subverts[0, 1, 0], subverts[2, 1, 0])] = subverts[1, 1, 0] + + subverts[1, 0, 1] = subdivide_edge(subverts[1, 0, 0], subverts[1, 0, 2]) + edge_to_vert[ordered_pair(subverts[0, 0, 1], subverts[2, 0, 1])] = subverts[1, 0, 1] + + subverts[2, 1, 1] = subdivide_edge(subverts[2, 1, 0], subverts[2, 1, 2]) + edge_to_vert[ordered_pair(subverts[2, 0, 1], subverts[2, 2, 1])] = subverts[2, 1, 1] + + subverts[1, 2, 1] = subdivide_edge(subverts[1, 2, 0], subverts[1, 2, 2]) + edge_to_vert[ordered_pair(subverts[0, 2, 1], subverts[2, 2, 1])] = subverts[1, 2, 1] + + subverts[0, 1, 1] = subdivide_edge(subverts[0, 1, 0], subverts[0, 1, 2]) + edge_to_vert[ordered_pair(subverts[0, 0, 1], subverts[0, 2, 1])] = subverts[0, 1, 1] + + subverts[1, 1, 2] = subdivide_edge(subverts[1, 0, 2], subverts[1, 2, 2]) + edge_to_vert[ordered_pair(subverts[0, 1, 2], subverts[2, 1, 2])] = subverts[1, 1, 2] + + # and finally the center. There are three ways to calculate, but elements should + # not intersect, so the edge_to_vert part isn't needed here. + subverts[1, 1, 1] = subdivide_edge(subverts[1, 1, 0], subverts[1, 1, 2]) + + + # Now make the hexahedron subelements + # order in which vtk expects vertices for a hexahedron + order = np.array([(0,0,0),(1,0,0),(1,1,0),(0,1,0),(0,0,1),(1,0,1),(1,1,1),(0,1,1)]) + for z in range(2): + for y in range(2): + for x in range(2): + hex_ = vtk.vtkHexahedron() + for vert_id in range(8): + coord = order[vert_id] + (x, y, z) + hex_.GetPointIds().SetId(vert_id, subverts[coord[0], coord[1], coord[2]] - 1) # minus one, since vtk starts at zero but marc starts at one + grid.InsertNextCell(hex_.GetCellType(), hex_.GetPointIds()) + + + else: + damask.util.croak('Unsupported Marc element type: {} (skipping)'.format(el['type'])) + + # Load all points + points = vtk.vtkPoints() + for point in range(1, len(coordinates) + 1): # marc indices start at 1 + points.InsertNextPoint(coordinates[point].tolist()) + + grid.SetPoints(points) + + # grid now contains the elements from the given marc file + writer = vtk.vtkXMLUnstructuredGridWriter() + writer.SetFileName(re.sub(r'\..+', ".vtu", f)) # *.vtk extension does not work in paraview + #writer.SetCompressorTypeToZLib() + + if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(grid) + else: writer.SetInputData(grid) + writer.Write() diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py new file mode 100755 index 000000000..e0c274dc7 --- /dev/null +++ b/processing/post/vtk_addGridData.py @@ -0,0 +1,206 @@ +#!/usr/bin/env python2.7 +# -*- coding: UTF-8 no BOM -*- + +import os,vtk +import damask +from vtk.util import numpy_support +from collections import defaultdict +from optparse import OptionParser + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName,damask.version]) + +# -------------------------------------------------------------------- +# MAIN +# -------------------------------------------------------------------- + +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]]', + description = msg, + version = scriptID) + +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', + help = 'open output in VTK render window') +parser.add_option('-d', '--data', + dest = 'data', + action = 'extend', metavar = '', + help = 'scalar/vector value(s) label(s)') +parser.add_option('-t', '--tensor', + dest = 'tensor', + action = 'extend', metavar = '', + help = 'tensor (3x3) value label(s)') +parser.add_option('-c', '--color', + dest = 'color', + action = 'extend', metavar = '', + help = 'RGB color tuple label') + +parser.set_defaults(data = [], + tensor = [], + color = [], + inplace = False, + render = False, +) + +(options, filenames) = parser.parse_args() + +if not options.vtk: parser.error('No VTK file specified.') +if not os.path.exists(options.vtk): parser.error('VTK file does not exist.') + +if os.path.splitext(options.vtk)[1] == '.vtr': + reader = vtk.vtkXMLRectilinearGridReader() + reader.SetFileName(options.vtk) + 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.') + +Npoints = rGrid.GetNumberOfPoints() +Ncells = rGrid.GetNumberOfCells() + +damask.util.croak('{}: {} points and {} cells...'.format(options.vtk,Npoints,Ncells)) + +# --- loop over input files ------------------------------------------------------------------------- + +if filenames == []: filenames = [None] + +for name in filenames: + try: table = damask.ASCIItable(name = name, + buffered = False, + readonly = True) + except: continue + damask.util.report(scriptName, name) + +# --- interpret header ---------------------------------------------------------------------------- + + table.head_read() + + remarks = [] + errors = [] + VTKarray = {} + active = defaultdict(list) + + for datatype,dimension,label in [['data',99,options.data], + ['tensor',9,options.tensor], + ['color' ,3,options.color], + ]: + for i,dim in enumerate(table.label_dimension(label)): + me = label[i] + if dim == -1: remarks.append('{} "{}" not found...'.format(datatype,me)) + elif dim > dimension: remarks.append('"{}" not of dimension {}...'.format(me,dimension)) + else: + remarks.append('adding {} "{}"...'.format(datatype,me)) + active[datatype].append(me) + + if remarks != []: damask.util.croak(remarks) + if errors != []: + damask.util.croak(errors) + table.close(dismiss = True) + continue + +# ------------------------------------------ process data --------------------------------------- + + table.data_readArray([item for sublist in active.values() for item in sublist]) # read all requested data + + for datatype,labels in active.items(): # loop over scalar,color + for me in labels: # loop over all requested items + VTKtype = vtk.VTK_DOUBLE + VTKdata = table.data[:, table.label_indexrange(me)].copy() # copy to force contiguous layout + + if datatype == 'color': + VTKtype = vtk.VTK_UNSIGNED_CHAR + VTKdata = (VTKdata*255).astype(int) # translate to 0..255 UCHAR + elif datatype == 'tensor': + VTKdata[:,1] = VTKdata[:,3] = 0.5*(VTKdata[:,1]+VTKdata[:,3]) + VTKdata[:,2] = VTKdata[:,6] = 0.5*(VTKdata[:,2]+VTKdata[:,6]) + VTKdata[:,5] = VTKdata[:,7] = 0.5*(VTKdata[:,5]+VTKdata[:,7]) + + VTKarray[me] = numpy_support.numpy_to_vtk(num_array=VTKdata,deep=True,array_type=VTKtype) + VTKarray[me].SetName(me) + + table.close() # close input ASCII table + +# ------------------------------------------ add data --------------------------------------- + + if len(table.data) == Npoints: mode = 'point' + elif len(table.data) == Ncells: mode = 'cell' + else: + damask.util.croak('Data count is incompatible with grid...') + continue + + damask.util.croak('{} mode...'.format(mode)) + + for datatype,labels in active.items(): # loop over scalar,color + if datatype == 'color': + if mode == 'cell': rGrid.GetCellData().SetScalars(VTKarray[active['color'][0]]) + elif mode == 'point': rGrid.GetPointData().SetScalars(VTKarray[active['color'][0]]) + for me in labels: # loop over all requested items + if mode == 'cell': rGrid.GetCellData().AddArray(VTKarray[me]) + elif mode == 'point': rGrid.GetPointData().AddArray(VTKarray[me]) + + rGrid.Modified() + if vtk.VTK_MAJOR_VERSION <= 5: rGrid.Update() + +# ------------------------------------------ output result --------------------------------------- + + writer.SetDataModeToBinary() + writer.SetCompressorTypeToZLib() + if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid) + else: writer.SetInputData(rGrid) + writer.Write() + +# ------------------------------------------ render result --------------------------------------- + +if options.render: + mapper = vtk.vtkDataSetMapper() + mapper.SetInputData(rGrid) + actor = vtk.vtkActor() + actor.SetMapper(mapper) + +# Create the graphics structure. The renderer renders into the +# render window. The render window interactor captures mouse events +# and will perform appropriate camera or actor manipulation +# depending on the nature of the events. + + ren = vtk.vtkRenderer() + + renWin = vtk.vtkRenderWindow() + renWin.AddRenderer(ren) + + ren.AddActor(actor) + ren.SetBackground(1, 1, 1) + renWin.SetSize(200, 200) + + iren = vtk.vtkRenderWindowInteractor() + iren.SetRenderWindow(renWin) + + iren.Initialize() + renWin.Render() + iren.Start() diff --git a/processing/pre/3DRVEfrom2Dang.py b/processing/pre/3DRVEfrom2Dang.py old mode 100644 new mode 100755 diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index b3848a9eb..e34b5baa8 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -162,6 +162,7 @@ subroutine CPFEM_init write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + flush(6) endif mainProcess ! initialize stress and jacobian to zero @@ -242,8 +243,8 @@ subroutine CPFEM_init write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE) write(6,'(a32,1x,6(i8,1x),/)') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood) write(6,'(a32,l1)') 'symmetricSolver: ', symmetricSolver + flush(6) endif - flush(6) end subroutine CPFEM_init diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 0ac916046..a16aee54f 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -9,7 +9,7 @@ module CPFEM2 private public :: & - CPFEM_general, & + CPFEM_age, & CPFEM_initAll contains @@ -127,6 +127,7 @@ subroutine CPFEM_init write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + flush(6) endif mainProcess ! *** restore the last converged values of each essential variable from the binary file @@ -194,7 +195,6 @@ subroutine CPFEM_init restartRead = .false. endif - flush(6) end subroutine CPFEM_init @@ -202,7 +202,7 @@ end subroutine CPFEM_init !-------------------------------------------------------------------------------------------------- !> @brief perform initialization at first call, update variables and call the actual material model !-------------------------------------------------------------------------------------------------- -subroutine CPFEM_general(age, dt) +subroutine CPFEM_age() use prec, only: & pReal, & pInt @@ -215,7 +215,6 @@ subroutine CPFEM_general(age, dt) debug_levelExtensive, & debug_levelSelective use FEsolving, only: & - terminallyIll, & restartWrite use math, only: & math_identity2nd, & @@ -254,114 +253,99 @@ subroutine CPFEM_general(age, dt) crystallite_dPdF, & crystallite_Tstar0_v, & crystallite_Tstar_v - use homogenization, only: & - materialpoint_stressAndItsTangent, & - materialpoint_postResults use IO, only: & IO_write_jobRealFile, & IO_warning use DAMASK_interface implicit none - real(pReal), intent(in) :: dt !< time increment - logical, intent(in) :: age !< age results integer(pInt) :: i, k, l, m, ph, homog, mySource - character(len=1024) :: rankStr + character(len=32) :: rankStr - !*** age results and write restart data if requested - if (age) then - crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...) - crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation - crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity - crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation - crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity - crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness - crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress +if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + write(6,'(a)') '<< CPFEM >> aging states' - forall ( i = 1:size(plasticState )) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array - do i = 1, size(sourceState) - do mySource = 1,phase_Nsources(i) - sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array - enddo; enddo - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & - write(6,'(a)') '<< CPFEM >> aging states' +crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...) +crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation +crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity +crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation +crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity +crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness +crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress - do homog = 1_pInt, material_Nhomogenization - homogState (homog)%state0 = homogState (homog)%state - thermalState (homog)%state0 = thermalState (homog)%state - damageState (homog)%state0 = damageState (homog)%state - vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state - hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state - enddo +forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array +do i = 1, size(sourceState) + do mySource = 1,phase_Nsources(i) + sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array +enddo; enddo - if (restartWrite) then - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & - write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files' - - write(rankStr,'(a1,i0)')'_',worldrank +do homog = 1_pInt, material_Nhomogenization + homogState (homog)%state0 = homogState (homog)%state + thermalState (homog)%state0 = thermalState (homog)%state + damageState (homog)%state0 = damageState (homog)%state + vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state + hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state +enddo - call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase)) - write (777,rec=1) material_phase - close (777) +if (restartWrite) then + if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files' - call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0)) - write (777,rec=1) crystallite_F0 - close (777) + write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0)) - write (777,rec=1) crystallite_Fp0 - close (777) + call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase)) + write (777,rec=1) material_phase; close (777) - call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0)) - write (777,rec=1) crystallite_Fi0 - close (777) + call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0)) + write (777,rec=1) crystallite_F0; close (777) - call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0)) - write (777,rec=1) crystallite_Lp0 - close (777) + call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0)) + write (777,rec=1) crystallite_Fp0; close (777) - call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0)) - write (777,rec=1) crystallite_Li0 - close (777) + call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0)) + write (777,rec=1) crystallite_Fi0; close (777) - call IO_write_jobRealFile(777,'convergeddPdF'//trim(rankStr),size(crystallite_dPdF0)) - write (777,rec=1) crystallite_dPdF0 - close (777) + call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0)) + write (777,rec=1) crystallite_Lp0; close (777) - call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v)) - write (777,rec=1) crystallite_Tstar0_v - close (777) + call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0)) + write (777,rec=1) crystallite_Li0; close (777) - call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr)) - m = 0_pInt - writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity) - do k = 1_pInt, plasticState(ph)%sizeState - do l = 1, size(plasticState(ph)%state0(1,:)) - m = m+1_pInt - write(777,rec=m) plasticState(ph)%state0(k,l) - enddo; enddo - enddo writePlasticityInstances - close (777) + call IO_write_jobRealFile(777,'convergeddPdF'//trim(rankStr),size(crystallite_dPdF0)) + write (777,rec=1) crystallite_dPdF0; close (777) - call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr)) - m = 0_pInt - writeHomogInstances: do homog = 1_pInt, material_Nhomogenization - do k = 1_pInt, homogState(homog)%sizeState - do l = 1, size(homogState(homog)%state0(1,:)) - m = m+1_pInt - write(777,rec=m) homogState(homog)%state0(k,l) - enddo; enddo - enddo writeHomogInstances - close (777) + call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v)) + write (777,rec=1) crystallite_Tstar0_v; close (777) - endif - endif + call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr)) + m = 0_pInt + writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity) + do k = 1_pInt, plasticState(ph)%sizeState + do l = 1, size(plasticState(ph)%state0(1,:)) + m = m+1_pInt + write(777,rec=m) plasticState(ph)%state0(k,l) + enddo; enddo + enddo writePlasticityInstances + close (777) - if (.not. terminallyIll) & - call materialpoint_stressAndItsTangent(.True., dt) + call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr)) + m = 0_pInt + writeHomogInstances: do homog = 1_pInt, material_Nhomogenization + do k = 1_pInt, homogState(homog)%sizeState + do l = 1, size(homogState(homog)%state0(1,:)) + m = m+1_pInt + write(777,rec=m) homogState(homog)%state0(k,l) + enddo; enddo + enddo writeHomogInstances + close (777) -end subroutine CPFEM_general +endif + +if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + write(6,'(a)') '<< CPFEM >> done aging states' + +end subroutine CPFEM_age end module CPFEM2 diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 39eb77bc7..63b9ad211 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -456,21 +456,21 @@ program DAMASK_spectral fileOffset = fileOffset + sum(outputSize) ! forward to current file position endif !-------------------------------------------------------------------------------------------------- -! loopping over loadcases +! looping over loadcases loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) time0 = time ! currentLoadCase start time guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc !-------------------------------------------------------------------------------------------------- -! loop oper incs defined in input file for current currentLoadCase +! loop over incs defined in input file for current currentLoadCase incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs totalIncsCounter = totalIncsCounter + 1_pInt !-------------------------------------------------------------------------------------------------- ! forwarding time - timeIncOld = timeinc + timeIncOld = timeinc ! last timeinc that brought former inc to an end if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale - timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) ! only valid for given linear time scale. will be overwritten later in case loglinear scale is used + timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) else if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale @@ -486,8 +486,13 @@ program DAMASK_spectral real(loadCases(currentLoadCase)%incs ,pReal))) endif endif +<<<<<<< HEAD timeinc = timeinc / 2.0_pReal**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step ! QUESTION: what happens to inc-counter when cutbacklevel is not zero? not clear where half an inc gets incremented..? +======= + timeinc = timeinc / real(subStepFactor,pReal)**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step + +>>>>>>> spectralSolver-cutbackfix skipping: if (totalIncsCounter < restartInc) then ! not yet at restart inc? time = time + timeinc ! just advance time, skip already performed calculation guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference @@ -512,11 +517,11 @@ program DAMASK_spectral 's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,& '-', stepFraction, '/', subStepFactor**cutBackLevel,& ' of load case ', currentLoadCase,'/',size(loadCases) - flush(6) write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases%incs))//& ',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') & 'Increment ',totalIncsCounter,'/',sum(loadCases%incs),& '-',stepFraction, '/', subStepFactor**cutBackLevel + flush(6) !-------------------------------------------------------------------------------------------------- ! forward fields @@ -545,7 +550,7 @@ program DAMASK_spectral end select case(FIELD_THERMAL_ID); call spectral_thermal_forward() - case(FIELD_DAMAGE_ID); call spectral_damage_forward() + case(FIELD_DAMAGE_ID); call spectral_damage_forward() end select enddo @@ -592,6 +597,7 @@ program DAMASK_spectral stagIter = stagIter + 1_pInt stagIterate = stagIter < stagItMax & .and. all(solres(:)%converged) & +<<<<<<< HEAD .and. .not. all(solres(:)%stagConverged) enddo @@ -622,12 +628,41 @@ program DAMASK_spectral endif if (.not. cutBack) then +======= + .and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration + enddo + +!-------------------------------------------------------------------------------------------------- +! check solution for either advance or retry + + if ( (continueCalculation .or. all(solres(:)%converged .and. solres(:)%stagConverged)) & ! don't care or did converge + .and. .not. solres(1)%termIll) then ! and acceptable solution found + timeIncOld = timeinc + cutBack = .false. + guess = .true. ! start guessing after first converged (sub)inc +>>>>>>> spectralSolver-cutbackfix if (worldrank == 0) then write(statUnit,*) totalIncsCounter, time, cutBackLevel, & - solres%converged, solres%iterationsNeeded ! write statistics about accepted solution + solres%converged, solres%iterationsNeeded flush(statUnit) endif + elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated? + cutBack = .true. + stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator + cutBackLevel = cutBackLevel + 1_pInt + time = time - timeinc ! rewind time + timeinc = timeinc/real(subStepFactor,pReal) ! cut timestep + write(6,'(/,a)') ' cutting back ' + else ! no more options to continue + call IO_warning(850_pInt) + call MPI_file_close(resUnit,ierr) + close(statUnit) + call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written endif +<<<<<<< HEAD +======= + +>>>>>>> spectralSolver-cutbackfix enddo subStepLooping cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc @@ -645,9 +680,14 @@ program DAMASK_spectral if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency if (worldrank == 0) & write(6,'(1/,a)') ' ... writing results to file ......................................' + flush(6) call materialpoint_postResults() call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) +<<<<<<< HEAD if (ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') +======= + if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') +>>>>>>> spectralSolver-cutbackfix do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) @@ -677,6 +717,7 @@ program DAMASK_spectral real(convergedCounter, pReal)/& real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & ' %) increments converged!' + flush(6) call MPI_file_close(resUnit,ierr) close(statUnit) diff --git a/src/IO.f90 b/src/IO.f90 index 224fad8c4..a6c3a7da8 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -9,7 +9,7 @@ module IO use prec, only: & pInt, & pReal - + implicit none private character(len=5), parameter, public :: & @@ -50,6 +50,7 @@ module IO IO_skipChunks, & IO_extractValue, & IO_countDataLines, & + IO_countNumericalDataLines, & IO_countContinuousIntValues, & IO_continuousIntValues, & IO_error, & @@ -61,7 +62,7 @@ module IO IO_open_inputFile, & IO_open_logFile #endif -#ifdef Abaqus +#ifdef Abaqus public :: & IO_abaqus_hasNoPart #endif @@ -69,7 +70,7 @@ module IO IO_fixedFloatValue, & IO_verifyFloatValue, & IO_verifyIntValue -#ifdef Abaqus +#ifdef Abaqus private :: & abaqus_assembleInputFile #endif @@ -86,7 +87,7 @@ subroutine IO_init compiler_version, & compiler_options #endif - + implicit none write(6,'(/,a)') ' <<<+- IO init -+>>>' @@ -101,7 +102,7 @@ end subroutine IO_init !! Recursion is triggered by "{path/to/inputfile}" in a line !-------------------------------------------------------------------------------------------------- recursive function IO_read(fileUnit,reset) result(line) - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit logical, intent(in), optional :: reset @@ -131,7 +132,7 @@ recursive function IO_read(fileUnit,reset) result(line) unitOn(1) = fileUnit read(unitOn(stack),'(a65536)',END=100) line - + input = IO_getTag(line,'{','}') !-------------------------------------------------------------------------------------------------- @@ -139,7 +140,7 @@ recursive function IO_read(fileUnit,reset) result(line) if (input == '') return ! regular line !-------------------------------------------------------------------------------------------------- -! recursion case +! recursion case if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached inquire(UNIT=unitOn(stack),NAME=path) ! path of current file @@ -154,9 +155,9 @@ recursive function IO_read(fileUnit,reset) result(line) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack)) line = IO_read(fileUnit) - + return - + !-------------------------------------------------------------------------------------------------- ! end of file case 100 if (stack > 1_pInt) then ! can go back to former file @@ -175,13 +176,13 @@ end function IO_read !! error message !-------------------------------------------------------------------------------------------------- subroutine IO_checkAndRewind(fileUnit) - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit logical :: fileOpened character(len=15) :: fileRead - inquire(unit=fileUnit, opened=fileOpened, read=fileRead) + inquire(unit=fileUnit, opened=fileOpened, read=fileRead) if (.not. fileOpened .or. trim(fileRead)/='YES') call IO_error(102_pInt) rewind(fileUnit) @@ -189,7 +190,7 @@ end subroutine IO_checkAndRewind !-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. Path to file is relative to working +!> @brief opens existing file for reading to given unit. Path to file is relative to working !! directory !> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return !! value @@ -197,47 +198,47 @@ end subroutine IO_checkAndRewind subroutine IO_open_file(fileUnit,relPath) use DAMASK_interface, only: & getSolverWorkingDirectoryName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: relPath !< relative path from working directory integer(pInt) :: myStat character(len=1024) :: path - + path = trim(getSolverWorkingDirectoryName())//relPath open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + end subroutine IO_open_file !-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. Path to file is relative to working +!> @brief opens existing file for reading to given unit. Path to file is relative to working !! directory !> @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,relPath) use DAMASK_interface, only: & getSolverWorkingDirectoryName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: relPath !< relative path from working directory integer(pInt) :: myStat character(len=1024) :: path - + path = trim(getSolverWorkingDirectoryName())//relPath open(fileUnit,status='old',iostat=myStat,file=path) IO_open_file_stat = (myStat == 0_pInt) - + 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 +!> @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 !-------------------------------------------------------------------------------------------------- @@ -256,14 +257,14 @@ subroutine IO_open_jobFile(fileUnit,ext) path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext open(fileUnit,status='old',iostat=myStat,file=path) 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 -!> @details Like IO_open_jobFile, but error is handled via return value and not via call to +!> @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, but error is handled via return value and not via call to !! IO_error !-------------------------------------------------------------------------------------------------- logical function IO_open_jobFile_stat(fileUnit,ext) @@ -303,7 +304,7 @@ subroutine IO_open_inputFile(fileUnit,modelName) character(len=1024) :: path #ifdef Abaqus integer(pInt) :: fileType - + fileType = 1_pInt ! assume .pes path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used open(fileUnit+1,status='old',iostat=myStat,file=path) @@ -313,12 +314,12 @@ subroutine IO_open_inputFile(fileUnit,modelName) open(fileUnit+1,status='old',iostat=myStat,file=path) endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)//'_assembly' open(fileUnit,iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s - close(fileUnit+1_pInt) + close(fileUnit+1_pInt) #endif #ifdef Marc4DAMASK path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension @@ -330,8 +331,8 @@ end subroutine IO_open_inputFile !-------------------------------------------------------------------------------------------------- -!> @brief opens existing FEM log file for reading to given unit. File is named after solver job -!! name and located in current working directory +!> @brief opens existing FEM log file for reading to given unit. File is named after solver job +!! name and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(fileUnit) use DAMASK_interface, only: & @@ -354,14 +355,14 @@ end subroutine IO_open_logFile !-------------------------------------------------------------------------------------------------- -!> @brief opens ASCII file to given unit for writing. File is named after solver job name plus +!> @brief opens ASCII file to given unit for writing. File is named after solver job name plus !! given extension and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobFile(fileUnit,ext) use DAMASK_interface, only: & getSolverWorkingDirectoryName, & getSolverJobName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext !< extension of file @@ -372,19 +373,19 @@ subroutine IO_write_jobFile(fileUnit,ext) path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext open(fileUnit,status='replace',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + end subroutine IO_write_jobFile !-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pReal numbers to given unit for writing. File is +!> @brief opens binary file containing array of pReal 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_jobRealFile(fileUnit,ext,recMultiplier) - use DAMASK_interface, only: & + use DAMASK_interface, only: & getSolverWorkingDirectoryName, & getSolverJobName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext !< extension of file @@ -403,19 +404,19 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + end subroutine IO_write_jobRealFile !-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is +!> @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: & getSolverWorkingDirectoryName, & getSolverJobName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext !< extension of file @@ -434,21 +435,21 @@ subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) 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 +!> @brief opens binary file containing array of pReal numbers to given unit for reading. File is !! located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) use DAMASK_interface, only: & getSolverWorkingDirectoryName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext, & !< extension of file + character(len=*), intent(in) :: ext, & !< extension of file modelName !< model name, in case of restart not solver job name integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) @@ -457,28 +458,28 @@ subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext if (present(recMultiplier)) then - open(fileUnit,status='old',form='unformatted',access='direct', & + open(fileUnit,status='old',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) else open(fileUnit,status='old',form='unformatted',access='direct', & recl=pReal,iostat=myStat,file=path) endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + end subroutine IO_read_realFile !-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is +!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is !! located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) use DAMASK_interface, only: & getSolverWorkingDirectoryName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext, & !< extension of file + character(len=*), intent(in) :: ext, & !< extension of file modelName !< model name, in case of restart not solver job name integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) @@ -487,14 +488,14 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext if (present(recMultiplier)) then - open(fileUnit,status='old',form='unformatted',access='direct', & + open(fileUnit,status='old',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) else open(fileUnit,status='old',form='unformatted',access='direct', & recl=pInt,iostat=myStat,file=path) endif if (myStat /= 0) call IO_error(100_pInt,ext_msg=path) - + end subroutine IO_read_intFile @@ -509,9 +510,9 @@ logical function IO_abaqus_hasNoPart(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: line - + IO_abaqus_hasNoPart = .true. - + 610 FORMAT(A65536) rewind(fileUnit) do @@ -522,7 +523,7 @@ logical function IO_abaqus_hasNoPart(fileUnit) exit endif enddo - + 620 end function IO_abaqus_hasNoPart #endif @@ -537,7 +538,7 @@ function IO_hybridIA(Nast,ODFfileName) integer(pInt), intent(in) :: Nast !< number of samples? real(pReal), dimension(3,Nast) :: IO_hybridIA character(len=*), intent(in) :: ODFfileName !< name of ODF file including total path - + !-------------------------------------------------------------------------------------------------- ! math module is not available real(pReal), parameter :: PI = 3.141592653589793_pReal @@ -561,7 +562,7 @@ function IO_hybridIA(Nast,ODFfileName) write(6,'(/,a,/)',advance='no') ' Using linear ODF file: '//trim(ODFfileName) !-------------------------------------------------------------------------------------------------- -! parse header of ODF file +! parse header of ODF file call IO_open_file(FILEUNIT,ODFfileName) headerLength = 0_pInt line=IO_read(FILEUNIT) @@ -579,7 +580,7 @@ function IO_hybridIA(Nast,ODFfileName) line=IO_read(FILEUNIT) enddo columns = 0_pInt - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) do i = 1_pInt, chunkPos(1) select case ( IO_lc(IO_StringValue(line,chunkPos,i,.true.)) ) case ('phi1') @@ -603,7 +604,7 @@ function IO_hybridIA(Nast,ODFfileName) line=IO_read(FILEUNIT) do while (trim(line) /= IO_EOF) - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) eulers=[IO_floatValue(line,chunkPos,columns(1)),& IO_floatValue(line,chunkPos,columns(2)),& IO_floatValue(line,chunkPos,columns(3))] @@ -646,7 +647,7 @@ function IO_hybridIA(Nast,ODFfileName) do phi1=1_pInt,steps(1); do Phi=1_pInt,steps(2); do phi2=1_pInt,steps(3) line=IO_read(FILEUNIT) - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) eulers=[IO_floatValue(line,chunkPos,columns(1)),& ! read in again for consistency check only IO_floatValue(line,chunkPos,columns(2)),& IO_floatValue(line,chunkPos,columns(3))]*INRAD @@ -661,16 +662,16 @@ function IO_hybridIA(Nast,ODFfileName) prob = 0.0_pReal endif dV_V(phi2,Phi,phi1) = prob*dg_0*sin((real(Phi-1_pInt,pReal)+center)*deltas(2)) - enddo; enddo; enddo + enddo; enddo; enddo close(FILEUNIT) dV_V = dV_V/sum_dV_V ! normalize to 1 - + !-------------------------------------------------------------------------------------------------- ! now fix bounds Nset = max(Nast,NnonZero) ! if less than non-zero voxel count requested, sample at least that much lowerC = 0.0_pReal upperC = real(Nset, pReal) - + do while (hybridIA_reps(dV_V,steps,upperC) < Nset) lowerC = upperC upperC = upperC*2.0_pReal @@ -717,25 +718,25 @@ function IO_hybridIA(Nast,ODFfileName) IO_hybridIA(3,i) = deltas(3)*(real(mod(bin ,steps(3)),pReal)+center) ! phi2 binSet(j) = binSet(i) enddo - + contains !-------------------------------------------------------------------------------------------------- !> @brief counts hybrid IA repetitions !-------------------------------------------------------------------------------------------------- integer(pInt) pure function hybridIA_reps(dV_V,steps,C) - + implicit none integer(pInt), intent(in), dimension(3) :: steps !< number of bins in Euler space real(pReal), intent(in), dimension(steps(3),steps(2),steps(1)) :: dV_V !< needs description real(pReal), intent(in) :: C !< needs description - + integer(pInt) :: phi1,Phi,phi2 - + hybridIA_reps = 0_pInt do phi1=1_pInt,steps(1); do Phi =1_pInt,steps(2); do phi2=1_pInt,steps(3) hybridIA_reps = hybridIA_reps+nint(C*dV_V(phi2,Phi,phi1), pInt) enddo; enddo; enddo - + end function hybridIA_reps end function IO_hybridIA @@ -753,11 +754,11 @@ logical pure function IO_isBlank(string) character(len=*), parameter :: comment = achar(35) ! comment id '#' integer :: posNonBlank, posComment ! no pInt - + posNonBlank = verify(string,blankChar) posComment = scan(string,comment) IO_isBlank = posNonBlank == 0 .or. posNonBlank == posComment - + end function IO_isBlank @@ -769,8 +770,8 @@ pure function IO_getTag(string,openChar,closeChar) implicit none character(len=*), intent(in) :: string !< string to check for tag character(len=len_trim(string)) :: IO_getTag - - character(len=*), intent(in) :: openChar, & !< indicates beginning of tag + + character(len=*), intent(in) :: openChar, & !< indicates beginning of tag closeChar !< indicates end of tag character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces @@ -780,7 +781,7 @@ pure function IO_getTag(string,openChar,closeChar) IO_getTag = '' left = scan(string,openChar) right = scan(string,closeChar) - + if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs IO_getTag = string(left+1:right-1) @@ -793,7 +794,7 @@ end function IO_getTag integer(pInt) function IO_countSections(fileUnit,part) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle + integer(pInt), intent(in) :: fileUnit !< file handle character(len=*), intent(in) :: part !< part name in which sections are counted character(len=65536) :: line @@ -811,14 +812,14 @@ integer(pInt) function IO_countSections(fileUnit,part) 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 + exit endif if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier IO_countSections = IO_countSections + 1_pInt enddo end function IO_countSections - + !-------------------------------------------------------------------------------------------------- !> @brief returns array of tag counts within for at most N [sections] @@ -828,7 +829,7 @@ function IO_countTagInPart(fileUnit,part,tag,Nsections) implicit none integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for integer(pInt), dimension(Nsections) :: IO_countTagInPart - integer(pInt), intent(in) :: fileUnit !< file handle + integer(pInt), intent(in) :: fileUnit !< file handle character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for @@ -837,12 +838,12 @@ function IO_countTagInPart(fileUnit,part,tag,Nsections) integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: section character(len=65536) :: line - + line = '' counter = 0_pInt section = 0_pInt - rewind(fileUnit) + rewind(fileUnit) do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part line = IO_read(fileUnit) enddo @@ -852,14 +853,14 @@ function IO_countTagInPart(fileUnit,part,tag,Nsections) 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 + exit endif if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section > 0) then chunkPos = IO_stringPos(line) if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match counter(section) = counter(section) + 1_pInt - endif + endif enddo IO_countTagInPart = counter @@ -875,7 +876,7 @@ function IO_spotTagInPart(fileUnit,part,tag,Nsections) implicit none integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for logical, dimension(Nsections) :: IO_spotTagInPart - integer(pInt), intent(in) :: fileUnit !< file handle + integer(pInt), intent(in) :: fileUnit !< file handle character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for @@ -898,11 +899,11 @@ function IO_spotTagInPart(fileUnit,part,tag,Nsections) 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 + exit endif if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section > 0_pInt) then - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match IO_spotTagInPart(section) = .true. endif @@ -917,7 +918,7 @@ function IO_spotTagInPart(fileUnit,part,tag,Nsections) logical function IO_globalTagInPart(fileUnit,part,tag) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle + integer(pInt), intent(in) :: fileUnit !< file handle character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for @@ -940,21 +941,21 @@ logical function IO_globalTagInPart(fileUnit,part,tag) 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 + exit endif if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section == 0_pInt) then chunkPos = IO_stringPos(line) if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match IO_globalTagInPart = .true. - endif + endif enddo end function IO_globalTagInPart !-------------------------------------------------------------------------------------------------- -!> @brief locates all space-separated chunks in given string and returns array containing number +!> @brief locates all space-separated chunks in given string and returns array containing number !! them and the left/right position to be used by IO_xxxVal !! Array size is dynamically adjusted to number of chunks found in string !! IMPORTANT: first element contains number of chunks! @@ -964,13 +965,13 @@ pure function IO_stringPos(string) implicit none integer(pInt), dimension(:), allocatable :: IO_stringPos character(len=*), intent(in) :: string !< string in which chunk positions are searched for - + character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces integer :: left, right ! no pInt (verify and scan return default integer) allocate(IO_stringPos(1), source=0_pInt) right = 0 - + do while (verify(string(right+1:),SEP)>0) left = right + verify(string(right+1:),SEP) right = left + scan(string(left:),SEP) - 2 @@ -986,7 +987,7 @@ end function IO_stringPos !> @brief reads string value at myChunk from string !-------------------------------------------------------------------------------------------------- function IO_stringValue(string,chunkPos,myChunk,silent) - + implicit none integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer(pInt), intent(in) :: myChunk !< position number of desired chunk @@ -997,13 +998,13 @@ function IO_stringValue(string,chunkPos,myChunk,silent) character(len=16), parameter :: MYNAME = 'IO_stringValue: ' logical :: warn - + if (.not. present(silent)) then warn = .false. else warn = silent endif - + IO_stringValue = '' valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then if (warn) call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) @@ -1018,11 +1019,11 @@ 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=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)) @@ -1059,7 +1060,7 @@ 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 @@ -1086,11 +1087,11 @@ real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' character(len=13), parameter :: VALIDBASE = '0123456789.+-' character(len=12), parameter :: VALIDEXP = '0123456789+-' - + real(pReal) :: base integer(pInt) :: expon integer :: pos_exp - + pos_exp = scan(string(ends(myChunk)+1:ends(myChunk+1)),'+-',back=.true.) hasExponent: if (pos_exp > 1) then base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk)+pos_exp-1_pInt))),& @@ -1135,7 +1136,7 @@ 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 @@ -1159,8 +1160,8 @@ pure function IO_lc(string) character(len=len(string)) :: IO_lc character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - + character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + integer :: i,n ! no pInt (len returns default integer) IO_lc = string @@ -1178,8 +1179,8 @@ end function IO_lc subroutine IO_skipChunks(fileUnit,N) implicit none - integer(pInt), intent(in) :: fileUnit, & !< file handle - N !< minimum number of chunks to skip + integer(pInt), intent(in) :: fileUnit, & !< file handle + N !< minimum number of chunks to skip integer(pInt) :: remainingChunks character(len=65536) :: line @@ -1198,7 +1199,7 @@ end subroutine IO_skipChunks !> @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 @@ -1221,8 +1222,8 @@ end function IO_extractValue integer(pInt) function IO_countDataLines(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - + integer(pInt), intent(in) :: fileUnit !< file handle + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: line, & @@ -1236,7 +1237,7 @@ integer(pInt) function IO_countDataLines(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 + line = IO_read(fileUnit, .true.) ! reset IO_read exit else if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt @@ -1246,7 +1247,38 @@ integer(pInt) function IO_countDataLines(fileUnit) end function IO_countDataLines - + +!-------------------------------------------------------------------------------------------------- +!> @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 (scan(tmp,"abcdefghijklmnopqrstuvwxyz")/=0) then ! found keyword + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + else + IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt + endif + enddo + backspace(fileUnit) + +end function IO_countNumericalDataLines + !-------------------------------------------------------------------------------------------------- !> @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 @@ -1257,8 +1289,8 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - -#ifdef Abaqus + +#ifdef Abaqus integer(pInt) :: l,c #endif integer(pInt), allocatable, dimension(:) :: chunkPos @@ -1272,22 +1304,22 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) if (chunkPos(1) < 1_pInt) then ! empty line - line = IO_read(fileUnit, .true.) ! reset IO_read + 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 + 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 + line = IO_read(fileUnit, .true.) ! reset IO_read exit ! only one single multiplier 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 + line = IO_read(fileUnit, .true.) ! reset IO_read exit ! data ended endif endif @@ -1297,7 +1329,7 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) do l = 1_pInt,c backspace(fileUnit) ! ToDo: substitute by rewind? enddo - + l = 1_pInt do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct l = l + 1_pInt @@ -1313,7 +1345,7 @@ end function IO_countContinuousIntValues !-------------------------------------------------------------------------------------------------- -!> @brief return integer list corrsponding to items in consecutive lines. +!> @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 @@ -1324,7 +1356,7 @@ 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 @@ -1358,7 +1390,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) 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) + 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 @@ -1384,7 +1416,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) do l = 1_pInt,c backspace(fileUnit) enddo - + !-------------------------------------------------------------------------------------------------- ! check if the element values in the elset are auto generated backspace(fileUnit) @@ -1393,7 +1425,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) 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) @@ -1436,7 +1468,7 @@ pure function IO_intOut(intToPrint) character(len=19) :: N_Digits ! maximum digits for 64 bit integer character(len=40) :: IO_intOut integer(pInt), intent(in) :: intToPrint - + write(N_Digits, '(I19.19)') 1_pInt + int(log10(real(intToPrint)),pInt) IO_intOut = 'I'//trim(N_Digits)//'.'//trim(N_Digits) @@ -1451,7 +1483,7 @@ function IO_timeStamp() implicit none character(len=10) :: IO_timeStamp integer(pInt), dimension(8) :: values - + call DATE_AND_TIME(VALUES=values) write(IO_timeStamp,'(i2.2,a1,i2.2,a1,i2.2)') values(5),':',values(6),':',values(7) @@ -1468,11 +1500,11 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) integer(pInt), intent(in) :: error_ID integer(pInt), optional, intent(in) :: el,ip,g,instance character(len=*), optional, intent(in) :: ext_msg - + external :: quit character(len=1024) :: msg character(len=1024) :: formatString - + select case (error_ID) !-------------------------------------------------------------------------------------------------- @@ -1494,7 +1526,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = '{input} recursion limit reached' case (105_pInt) msg = 'unknown output:' - + !-------------------------------------------------------------------------------------------------- ! lattice error messages case (130_pInt) @@ -1540,7 +1572,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) !-------------------------------------------------------------------------------------------------- ! plasticity error messages case (200_pInt) - msg = 'unknown elasticity specified:' + msg = 'unknown elasticity specified:' case (201_pInt) msg = 'unknown plasticity specified:' @@ -1550,12 +1582,12 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'material parameter out of bounds:' !-------------------------------------------------------------------------------------------------- -! numerics error messages +! numerics error messages case (300_pInt) msg = 'unknown numerics parameter:' case (301_pInt) msg = 'numerics parameter out of bounds:' - + !-------------------------------------------------------------------------------------------------- ! math errors case (400_pInt) @@ -1577,7 +1609,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) ! homogenization errors case (500_pInt) msg = 'unknown homogenization specified' - + !-------------------------------------------------------------------------------------------------- ! user errors case (600_pInt) @@ -1638,7 +1670,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'PETSc: SNES_DIVERGED_FNORM_NAN' case (894_pInt) msg = 'MPI error' - + !------------------------------------------------------------------------------------------------- ! error messages related to parsing of Abaqus input file case (900_pInt) @@ -1660,9 +1692,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (908_pInt) msg = 'size of mesh_mapFEtoCPnode in mesh_abaqus_map_nodes' case (909_pInt) - msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes' - - + msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes' + + !------------------------------------------------------------------------------------------------- ! general error messages case (666_pInt) @@ -1671,7 +1703,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'unknown error number...' end select - + !$OMP CRITICAL (write2out) write(0,'(/,a)') ' ┌'//IO_DIVIDER//'┐' write(0,'(a,24x,a,40x,a)') ' │','error', '│' @@ -1711,7 +1743,7 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) integer(pInt), intent(in) :: warning_ID integer(pInt), optional, intent(in) :: el,ip,g character(len=*), optional, intent(in) :: ext_msg - + character(len=1024) :: msg character(len=1024) :: formatString @@ -1759,7 +1791,7 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) case default msg = 'unknown warning number' end select - + !$OMP CRITICAL (write2out) write(6,'(/,a)') ' ┌'//IO_DIVIDER//'┐' write(6,'(a,24x,a,38x,a)') ' │','warning', '│' @@ -1788,20 +1820,20 @@ end subroutine IO_warning !-------------------------------------------------------------------------------------------------- -! internal helper functions +! internal helper functions !-------------------------------------------------------------------------------------------------- !> @brief returns verified integer value in given string !-------------------------------------------------------------------------------------------------- integer(pInt) function IO_verifyIntValue (string,validChars,myName) - + implicit none - character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! + character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! validChars, & !< valid characters in string myName !< name of caller function (for debugging) integer(pInt) :: readStatus, invalidWhere !character(len=len(trim(string))) :: trimmed does not work with ifort 14.0.1 - + IO_verifyIntValue = 0_pInt invalidWhere = verify(string,validChars) @@ -1815,7 +1847,7 @@ integer(pInt) function IO_verifyIntValue (string,validChars,myName) if (readStatus /= 0_pInt) & ! error during string to float conversion call IO_warning(203_pInt,ext_msg=myName//'"'//string(1_pInt:invalidWhere-1_pInt)//'"') endif - + end function IO_verifyIntValue @@ -1823,15 +1855,15 @@ end function IO_verifyIntValue !> @brief returns verified float value in given string !-------------------------------------------------------------------------------------------------- real(pReal) function IO_verifyFloatValue (string,validChars,myName) - + implicit none - character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! + character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! validChars, & !< valid characters in string myName !< name of caller function (for debugging) integer(pInt) :: readStatus, invalidWhere !character(len=len(trim(string))) :: trimmed does not work with ifort 14.0.1 - + IO_verifyFloatValue = 0.0_pReal invalidWhere = verify(string,validChars) @@ -1845,12 +1877,12 @@ real(pReal) function IO_verifyFloatValue (string,validChars,myName) if (readStatus /= 0_pInt) & ! error during string to float conversion call IO_warning(203_pInt,ext_msg=myName//'"'//string(1_pInt:invalidWhere-1_pInt)//'"') endif - + end function IO_verifyFloatValue - -#ifdef Abaqus + +#ifdef Abaqus !-------------------------------------------------------------------------------------------------- -!> @brief create a new input file for abaqus simulations by removing all comment lines and +!> @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) @@ -1860,7 +1892,7 @@ 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 @@ -1894,10 +1926,10 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) write(unit1,'(A)') trim(line) endif enddo - + 220 createSuccess = .true. return - + 200 createSuccess =.false. end function abaqus_assembleInputFile diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 564e990a3..877f0e8fa 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -190,11 +190,11 @@ subroutine constitutive_init() if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) close(FILEUNIT) - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- constitutive init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- constitutive init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + mainProcess: if (worldrank == 0) then !-------------------------------------------------------------------------------------------------- ! write description file for constitutive output call IO_write_jobFile(FILEUNIT,'outputConstitutive') diff --git a/src/damage_local.f90 b/src/damage_local.f90 index a24f0b1a5..2f3014937 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -72,8 +72,6 @@ subroutine damage_local_init(fileUnit) damage, & damage_initialPhi, & material_partHomogenization - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -86,11 +84,9 @@ subroutine damage_local_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/damage_none.f90 b/src/damage_none.f90 index 746de340c..4750f5949 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -26,19 +26,15 @@ subroutine damage_none_init() use IO, only: & IO_timeStamp use material - use numerics, only: & - worldrank implicit none integer(pInt) :: & homog, & NofMyHomog - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess initializeInstances: do homog = 1_pInt, material_Nhomogenization diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index fb960ed7f..cd6ba8a5b 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -77,8 +77,6 @@ subroutine damage_nonlocal_init(fileUnit) damage, & damage_initialPhi, & material_partHomogenization - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -91,11 +89,9 @@ subroutine damage_nonlocal_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 5a30a72c8..2f4124c2b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -16,7 +16,7 @@ module homogenization ! General variables for the homogenization at a material point implicit none private - real(pReal), dimension(:,:,:,:), allocatable, public :: & + real(pReal), dimension(:,:,:,:), allocatable, public :: & materialpoint_F0, & !< def grad of IP at start of FE increment materialpoint_F, & !< def grad of IP to be reached at end of FE increment materialpoint_P !< first P--K stress of IP @@ -128,7 +128,7 @@ subroutine homogenization_init integer(pInt), dimension(:) , pointer :: thisNoutput character(len=64), dimension(:,:), pointer :: thisOutput character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready - logical :: knownHomogenization, knownThermal, knownDamage, knownVacancyflux, knownPorosity, knownHydrogenflux + logical :: valid !-------------------------------------------------------------------------------------------------- @@ -199,7 +199,7 @@ subroutine homogenization_init do p = 1,material_Nhomogenization if (any(material_homog == p)) then i = homogenization_typeInstance(p) ! which instance of this homogenization type - knownHomogenization = .true. ! assume valid + valid = .true. ! assume valid select case(homogenization_type(p)) ! split per homogenization type case (HOMOGENIZATION_NONE_ID) outputName = HOMOGENIZATION_NONE_label @@ -217,10 +217,10 @@ subroutine homogenization_init thisOutput => homogenization_RGC_output thisSize => homogenization_RGC_sizePostResult case default - knownHomogenization = .false. + valid = .false. end select write(FILEUNIT,'(/,a,/)') '['//trim(homogenization_name(p))//']' - if (knownHomogenization) then + if (valid) then write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName) write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID) then @@ -230,7 +230,7 @@ subroutine homogenization_init endif endif i = thermal_typeInstance(p) ! which instance of this thermal type - knownThermal = .true. ! assume valid + valid = .true. ! assume valid select case(thermal_type(p)) ! split per thermal type case (THERMAL_isothermal_ID) outputName = THERMAL_isothermal_label @@ -248,9 +248,9 @@ subroutine homogenization_init thisOutput => thermal_conduction_output thisSize => thermal_conduction_sizePostResult case default - knownThermal = .false. + valid = .false. end select - if (knownThermal) then + if (valid) then write(FILEUNIT,'(a)') '(thermal)'//char(9)//trim(outputName) if (thermal_type(p) /= THERMAL_isothermal_ID) then do e = 1,thisNoutput(i) @@ -259,7 +259,7 @@ subroutine homogenization_init endif endif i = damage_typeInstance(p) ! which instance of this damage type - knownDamage = .true. ! assume valid + valid = .true. ! assume valid select case(damage_type(p)) ! split per damage type case (DAMAGE_none_ID) outputName = DAMAGE_none_label @@ -277,9 +277,9 @@ subroutine homogenization_init thisOutput => damage_nonlocal_output thisSize => damage_nonlocal_sizePostResult case default - knownDamage = .false. + valid = .false. end select - if (knownDamage) then + if (valid) then write(FILEUNIT,'(a)') '(damage)'//char(9)//trim(outputName) if (damage_type(p) /= DAMAGE_none_ID) then do e = 1,thisNoutput(i) @@ -288,7 +288,7 @@ subroutine homogenization_init endif endif i = vacancyflux_typeInstance(p) ! which instance of this vacancy flux type - knownVacancyflux = .true. ! assume valid + valid = .true. ! assume valid select case(vacancyflux_type(p)) ! split per vacancy flux type case (VACANCYFLUX_isoconc_ID) outputName = VACANCYFLUX_isoconc_label @@ -306,9 +306,9 @@ subroutine homogenization_init thisOutput => vacancyflux_cahnhilliard_output thisSize => vacancyflux_cahnhilliard_sizePostResult case default - knownVacancyflux = .false. + valid = .false. end select - if (knownVacancyflux) then + if (valid) then write(FILEUNIT,'(a)') '(vacancyflux)'//char(9)//trim(outputName) if (vacancyflux_type(p) /= VACANCYFLUX_isoconc_ID) then do e = 1,thisNoutput(i) @@ -317,7 +317,7 @@ subroutine homogenization_init endif endif i = porosity_typeInstance(p) ! which instance of this porosity type - knownPorosity = .true. ! assume valid + valid = .true. ! assume valid select case(porosity_type(p)) ! split per porosity type case (POROSITY_none_ID) outputName = POROSITY_none_label @@ -330,9 +330,9 @@ subroutine homogenization_init thisOutput => porosity_phasefield_output thisSize => porosity_phasefield_sizePostResult case default - knownPorosity = .false. + valid = .false. end select - if (knownPorosity) then + if (valid) then write(FILEUNIT,'(a)') '(porosity)'//char(9)//trim(outputName) if (porosity_type(p) /= POROSITY_none_ID) then do e = 1,thisNoutput(i) @@ -341,7 +341,7 @@ subroutine homogenization_init endif endif i = hydrogenflux_typeInstance(p) ! which instance of this hydrogen flux type - knownHydrogenflux = .true. ! assume valid + valid = .true. ! assume valid select case(hydrogenflux_type(p)) ! split per hydrogen flux type case (HYDROGENFLUX_isoconc_ID) outputName = HYDROGENFLUX_isoconc_label @@ -354,9 +354,9 @@ subroutine homogenization_init thisOutput => hydrogenflux_cahnhilliard_output thisSize => hydrogenflux_cahnhilliard_sizePostResult case default - knownHydrogenflux = .false. + valid = .false. end select - if (knownHydrogenflux) then + if (valid) then write(FILEUNIT,'(a)') '(hydrogenflux)'//char(9)//trim(outputName) if (hydrogenflux_type(p) /= HYDROGENFLUX_isoconc_ID) then do e = 1,thisNoutput(i) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 43c16a39d..84cb594db 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -100,8 +100,6 @@ subroutine homogenization_RGC_init(fileUnit) FE_geomtype use IO use material - use numerics, only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration @@ -117,11 +115,9 @@ subroutine homogenization_RGC_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index aeb77c275..055bfbb46 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -62,8 +62,6 @@ subroutine homogenization_isostrain_init(fileUnit) debug_levelBasic use IO use material - use numerics, only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -80,11 +78,9 @@ subroutine homogenization_isostrain_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) if (maxNinstance == 0) return diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index 11bed7813..75d8bcd3a 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -29,21 +29,17 @@ subroutine homogenization_none_init() use IO, only: & IO_timeStamp use material - use numerics, only: & - worldrank implicit none integer(pInt) :: & homog, & NofMyHomog - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess - initializeInstances: do homog = 1_pInt, material_Nhomogenization + initializeInstances: do homog = 1_pInt, material_Nhomogenization myhomog: if (homogenization_type(homog) == HOMOGENIZATION_none_ID) then NofMyHomog = count(material_homog == homog) diff --git a/src/hydrogenflux_cahnhilliard.f90 b/src/hydrogenflux_cahnhilliard.f90 index db08bf5d8..89479a9c9 100644 --- a/src/hydrogenflux_cahnhilliard.f90 +++ b/src/hydrogenflux_cahnhilliard.f90 @@ -84,8 +84,6 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) hydrogenflux_initialCh, & material_partHomogenization, & material_partPhase - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -98,11 +96,9 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/hydrogenflux_isoconc.f90 b/src/hydrogenflux_isoconc.f90 index df5c01e68..bef2a8437 100644 --- a/src/hydrogenflux_isoconc.f90 +++ b/src/hydrogenflux_isoconc.f90 @@ -27,21 +27,17 @@ subroutine hydrogenflux_isoconc_init() use IO, only: & IO_timeStamp use material - use numerics, only: & - worldrank implicit none integer(pInt) :: & homog, & NofMyHomog - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess - initializeInstances: do homog = 1_pInt, material_Nhomogenization + initializeInstances: do homog = 1_pInt, material_Nhomogenization myhomog: if (hydrogenflux_type(homog) == HYDROGENFLUX_isoconc_ID) then NofMyHomog = count(material_homog == homog) diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 146918f5c..fffa26165 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -81,8 +81,6 @@ subroutine kinematics_cleavage_opening_init(fileUnit) KINEMATICS_cleavage_opening_ID, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - worldrank use lattice, only: & lattice_maxNcleavageFamily, & lattice_NcleavageSystem @@ -97,11 +95,9 @@ subroutine kinematics_cleavage_opening_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index f32efa929..07b98aa23 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -81,8 +81,6 @@ subroutine kinematics_slipplane_opening_init(fileUnit) KINEMATICS_slipplane_opening_ID, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - worldrank use lattice, only: & lattice_maxNslipFamily, & lattice_NslipSystem @@ -97,11 +95,9 @@ subroutine kinematics_slipplane_opening_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(phase_kinematics == KINEMATICS_slipplane_opening_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 30c267d34..e7cbca673 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -71,8 +71,6 @@ subroutine kinematics_thermal_expansion_init(fileUnit) KINEMATICS_thermal_expansion_ID, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -83,11 +81,9 @@ subroutine kinematics_thermal_expansion_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/kinematics_vacancy_strain.f90 b/src/kinematics_vacancy_strain.f90 index 791c0e3c1..9558f506d 100644 --- a/src/kinematics_vacancy_strain.f90 +++ b/src/kinematics_vacancy_strain.f90 @@ -71,8 +71,6 @@ subroutine kinematics_vacancy_strain_init(fileUnit) KINEMATICS_vacancy_strain_ID, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -83,11 +81,9 @@ subroutine kinematics_vacancy_strain_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(phase_kinematics == KINEMATICS_vacancy_strain_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/lattice.f90 b/src/lattice.f90 index 328d65380..9635643e8 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -96,19 +96,19 @@ module lattice real(pReal), dimension(3+3,LATTICE_fcc_Nslip), parameter, private :: & LATTICE_fcc_systemSlip = reshape(real([& - ! Slip direction Plane normal - 0, 1,-1, 1, 1, 1, & - -1, 0, 1, 1, 1, 1, & - 1,-1, 0, 1, 1, 1, & - 0,-1,-1, -1,-1, 1, & - 1, 0, 1, -1,-1, 1, & - -1, 1, 0, -1,-1, 1, & - 0,-1, 1, 1,-1,-1, & - -1, 0,-1, 1,-1,-1, & - 1, 1, 0, 1,-1,-1, & - 0, 1, 1, -1, 1,-1, & - 1, 0,-1, -1, 1,-1, & - -1,-1, 0, -1, 1,-1 & + ! Slip direction Plane normal ! SCHMID-BOAS notation + 0, 1,-1, 1, 1, 1, & ! B2 + -1, 0, 1, 1, 1, 1, & ! B4 + 1,-1, 0, 1, 1, 1, & ! B5 + 0,-1,-1, -1,-1, 1, & ! C1 + 1, 0, 1, -1,-1, 1, & ! C3 + -1, 1, 0, -1,-1, 1, & ! C5 + 0,-1, 1, 1,-1,-1, & ! A2 + -1, 0,-1, 1,-1,-1, & ! A3 + 1, 1, 0, 1,-1,-1, & ! A6 + 0, 1, 1, -1, 1,-1, & ! D1 + 1, 0,-1, -1, 1,-1, & ! D4 + -1,-1, 0, -1, 1,-1 & ! D6 ],pReal),[ 3_pInt + 3_pInt,LATTICE_fcc_Nslip]) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli real(pReal), dimension(3+3,LATTICE_fcc_Ntwin), parameter, private :: & diff --git a/src/math.f90 b/src/math.f90 index 48e09e674..0a5490f89 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -178,7 +178,7 @@ subroutine math_init compiler_version, & compiler_options #endif - use numerics, only: fixedSeed + use numerics, only: randomSeed use IO, only: IO_timeStamp implicit none @@ -195,8 +195,8 @@ subroutine math_init call random_seed(size=randSize) if (allocated(randInit)) deallocate(randInit) allocate(randInit(randSize)) - if (fixedSeed > 0_pInt) then - randInit(1:randSize) = int(fixedSeed) ! fixedSeed is of type pInt, randInit not + if (randomSeed > 0_pInt) then + randInit(1:randSize) = int(randomSeed) ! randomSeed is of type pInt, randInit not call random_seed(put=randInit) else call random_seed() diff --git a/src/mesh.f90 b/src/mesh.f90 index 666fe1e33..827875d2f 100644 --- a/src/mesh.f90 +++ b/src/mesh.f90 @@ -4,7 +4,7 @@ !> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Krishna Komerla, 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 solvers MSC.Marc, Abaqus and the spectral solver !-------------------------------------------------------------------------------------------------- module mesh use, intrinsic :: iso_c_binding @@ -45,7 +45,7 @@ module mesh mesh_element, & !< FEid, type(internal representation), material, texture, node indices as CP IDs 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] @@ -55,31 +55,34 @@ module 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 :: & + 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) #ifdef Marc4DAMASK - integer(pInt), private :: & + 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) #endif - + integer(pInt), dimension(2), private :: & mesh_maxValStateVar = 0_pInt - + #ifndef Spectral character(len=64), dimension(:), allocatable, private :: & mesh_nameElemSet, & !< names of elementSet @@ -104,13 +107,13 @@ module mesh 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 - + #ifdef Abaqus logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information #endif @@ -137,7 +140,7 @@ module mesh 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) @@ -241,7 +244,7 @@ module mesh 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]) + ],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 @@ -375,7 +378,7 @@ module mesh 4 & ! element 21 (3D 20node 27ip) ],pInt) - + integer(pInt), dimension(FE_Nelemtypes), parameter, private :: MESH_VTKELEMTYPE = & int([ & 5, & ! element 6 (2D 3node 1ip) @@ -428,13 +431,15 @@ module mesh mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & #elif 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_map_nodes, & mesh_marc_build_nodes, & mesh_marc_count_cpSizes, & mesh_marc_build_elements, & @@ -450,7 +455,7 @@ module mesh mesh_abaqus_build_nodes, & mesh_abaqus_count_cpSizes, & mesh_abaqus_build_elements, & -#endif +#endif #ifndef Spectral mesh_build_nodeTwins, & mesh_build_sharedElems, & @@ -508,7 +513,7 @@ subroutine mesh_init(ip,el) #endif FEsolving_execIP, & calcMode - + implicit none #ifdef Spectral integer(C_INTPTR_T) :: devNull, local_K, local_K_offset @@ -518,7 +523,7 @@ subroutine mesh_init(ip,el) integer(pInt), intent(in) :: el, ip integer(pInt) :: j logical :: myDebug - + external :: MPI_comm_size write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -546,7 +551,7 @@ subroutine mesh_init(ip,el) if (allocated(FE_subNodeOnIPFace)) deallocate(FE_subNodeOnIPFace) 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 @@ -579,8 +584,14 @@ subroutine mesh_init(ip,el) #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) @@ -662,12 +673,12 @@ subroutine mesh_init(ip,el) 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 if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP) allocate(FEsolving_execIP(2_pInt,mesh_NcpElems)); FEsolving_execIP = 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 (allocated(calcMode)) deallocate(calcMode) allocate(calcMode(mesh_maxNips,mesh_NcpElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) @@ -688,10 +699,10 @@ integer(pInt) function mesh_FEasCP(what,myID) 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') @@ -701,10 +712,10 @@ integer(pInt) function mesh_FEasCP(what,myID) 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 @@ -723,19 +734,19 @@ integer(pInt) function mesh_FEasCP(what,myID) 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, +!> @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 @@ -744,14 +755,14 @@ subroutine mesh_build_cellconnectivity integer(pInt), dimension(mesh_maxNcellnodes) :: & localCellnode2globalCellnode integer(pInt) :: & - e,t,g,c,n,i, & + 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 @@ -796,28 +807,28 @@ subroutine mesh_build_cellconnectivity deallocate(matchingNode2cellnode) deallocate(cellnodeParent) - + end subroutine mesh_build_cellconnectivity !-------------------------------------------------------------------------------------------------- !> @brief Calculate position of cellnodes from the given position of nodes -!> Build list of cellnodes' coordinates. +!> 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, & + 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 @@ -842,23 +853,23 @@ end function mesh_build_cellnodes !> 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 +!> 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 + 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 @@ -871,7 +882,7 @@ subroutine mesh_build_ipVolumes 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 @@ -916,19 +927,19 @@ end subroutine mesh_build_ipVolumes ! 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. +! 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 @@ -951,13 +962,13 @@ 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 @@ -972,7 +983,7 @@ pure function mesh_cellCenterCoordinates(ip,el) #ifdef Spectral !-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, +!> @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) @@ -987,7 +998,7 @@ function mesh_spectral_getGrid(fileUnit) IO_error use DAMASK_interface, only: & geometryFile - + implicit none integer(pInt), dimension(3) :: mesh_spectral_getGrid integer(pInt), intent(in), optional :: fileUnit @@ -998,7 +1009,7 @@ function mesh_spectral_getGrid(fileUnit) keyword integer(pInt) :: i, j, myFileUnit logical :: gotGrid = .false. - + mesh_spectral_getGrid = -1_pInt if(.not. present(fileUnit)) then myFileUnit = 289_pInt @@ -1006,7 +1017,7 @@ function mesh_spectral_getGrid(fileUnit) else myFileUnit = fileUnit endif - + call IO_checkAndRewind(myFileUnit) read(myFileUnit,'(a1024)') line @@ -1020,7 +1031,7 @@ function mesh_spectral_getGrid(fileUnit) rewind(myFileUnit) do i = 1_pInt, headerLength read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) case ('grid') gotGrid = .true. @@ -1036,9 +1047,9 @@ function mesh_spectral_getGrid(fileUnit) 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)) & @@ -1048,7 +1059,7 @@ end function mesh_spectral_getGrid !-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, +!> @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) @@ -1063,7 +1074,7 @@ function mesh_spectral_getSize(fileUnit) IO_error use DAMASK_interface, only: & geometryFile - + implicit none real(pReal), dimension(3) :: mesh_spectral_getSize integer(pInt), intent(in), optional :: fileUnit @@ -1071,9 +1082,9 @@ function mesh_spectral_getSize(fileUnit) integer(pInt) :: headerLength = 0_pInt character(len=1024) :: line, & keyword - integer(pInt) :: i, j, myFileUnit + integer(pInt) :: i, j, myFileUnit logical :: gotSize = .false. - + mesh_spectral_getSize = -1.0_pReal if(.not. present(fileUnit)) then myFileUnit = 289_pInt @@ -1081,7 +1092,7 @@ function mesh_spectral_getSize(fileUnit) else myFileUnit = fileUnit endif - + call IO_checkAndRewind(myFileUnit) read(myFileUnit,'(a1024)') line @@ -1095,7 +1106,7 @@ function mesh_spectral_getSize(fileUnit) rewind(myFileUnit) do i = 1_pInt, headerLength read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) case ('size') gotSize = .true. @@ -1111,7 +1122,7 @@ function mesh_spectral_getSize(fileUnit) enddo end select enddo - + if(.not. present(fileUnit)) close(myFileUnit) if (.not. gotSize) & @@ -1123,7 +1134,7 @@ end function mesh_spectral_getSize !-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. If fileUnit is given, +!> @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) @@ -1137,7 +1148,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) IO_error use DAMASK_interface, only: & geometryFile - + implicit none integer(pInt), intent(in), optional :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos @@ -1146,7 +1157,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) keyword integer(pInt) :: i, myFileUnit logical :: gotHomogenization = .false. - + mesh_spectral_getHomogenization = -1_pInt if(.not. present(fileUnit)) then myFileUnit = 289_pInt @@ -1154,7 +1165,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) else myFileUnit = fileUnit endif - + call IO_checkAndRewind(myFileUnit) read(myFileUnit,'(a1024)') line @@ -1168,21 +1179,21 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) rewind(myFileUnit) do i = 1_pInt, headerLength read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(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 @@ -1197,7 +1208,7 @@ subroutine mesh_spectral_count() mesh_Nelems = product(grid(1:2))*grid3 mesh_NcpElems= mesh_Nelems mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) - + mesh_NcpElemsGlobal = product(grid) end subroutine mesh_spectral_count @@ -1223,14 +1234,14 @@ end subroutine mesh_spectral_mapNodesAndElems !-------------------------------------------------------------------------------------------------- !> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! Sets global values 'mesh_maxNnodes', '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) @@ -1254,7 +1265,7 @@ subroutine mesh_spectral_build_nodes() 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) & @@ -1265,8 +1276,8 @@ subroutine mesh_spectral_build_nodes() 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 + size3offset + end forall mesh_node = mesh_node0 @@ -1324,7 +1335,7 @@ subroutine mesh_spectral_build_elements(fileUnit) else call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') endif - + !-------------------------------------------------------------------------------------------------- ! get maximum microstructure index call IO_checkAndRewind(fileUnit) @@ -1349,7 +1360,7 @@ subroutine mesh_spectral_build_elements(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,maxIntCount,dummyName,dummySet,0_pInt) ! get affected elements @@ -1359,7 +1370,7 @@ subroutine mesh_spectral_build_elements(fileUnit) enddo enddo - elemType = FE_mapElemtype('C3D8R') + 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!) @@ -1378,7 +1389,7 @@ subroutine mesh_spectral_build_elements(fileUnit) 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)) + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) enddo deallocate(microstructures) @@ -1399,7 +1410,7 @@ subroutine mesh_spectral_build_ipNeighborhood 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 @@ -1453,7 +1464,7 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) debug_levelBasic use math, only: & math_mul33x3 - + implicit none real(pReal), intent(in), dimension(:,:,:,:) :: & centres @@ -1491,7 +1502,7 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) 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 @@ -1517,7 +1528,7 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) - 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) @@ -1532,10 +1543,41 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) end function mesh_nodesAroundCentres #endif - + #ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and +!> @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) @@ -1544,20 +1586,20 @@ subroutine mesh_marc_get_tableStyles(fileUnit) 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 + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) @@ -1570,6 +1612,51 @@ subroutine mesh_marc_get_tableStyles(fileUnit) 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 + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Marc_matNumber = (/Marc_matNumber, 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 @@ -1581,10 +1668,10 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) IO_stringValue, & IO_stringPos, & IO_IntValue - + implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line @@ -1594,7 +1681,7 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) 610 FORMAT(A300) rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) @@ -1621,7 +1708,7 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) IO_stringValue, & IO_stringPos, & IO_countContinuousIntValues - + implicit none integer(pInt), intent(in) :: fileUnit @@ -1634,7 +1721,7 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) 610 FORMAT(A300) rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) @@ -1663,7 +1750,7 @@ subroutine mesh_marc_map_elementSets(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: elemSet = 0_pInt @@ -1685,7 +1772,7 @@ subroutine mesh_marc_map_elementSets(fileUnit) IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) endif enddo - + 640 end subroutine mesh_marc_map_elementSets @@ -1699,13 +1786,14 @@ subroutine mesh_marc_count_cpElements(fileUnit) IO_stringPos, & IO_countContinuousIntValues, & IO_error, & - IO_intValue - + IO_intValue, & + IO_countNumericalDataLines + implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, version + integer(pInt) :: i character(len=300):: line mesh_NcpElems = 0_pInt @@ -1713,29 +1801,32 @@ subroutine mesh_marc_count_cpElements(fileUnit) 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 - version = IO_intValue(line,chunkPos,2_pInt) - if (version < 13) then ! Marc 2016 or earlier - rewind(fileUnit) - do + 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 - 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)? keyword hypoelastic might appear several times - exit - endif enddo - else ! Marc2017 and later - call IO_error(error_ID=701_pInt) - end if - end if - enddo + mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? keyword hypoelastic might appear several times so the next line probably should not be there + exit + endif + enddo + else ! Marc2017 and later + call IO_error(error_ID=701_pInt) + 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 @@ -1799,7 +1890,7 @@ subroutine mesh_marc_map_nodes(fileUnit) IO_stringValue, & IO_stringPos, & IO_fixedIntValue - + implicit none integer(pInt), intent(in) :: fileUnit @@ -1831,7 +1922,7 @@ subroutine mesh_marc_map_nodes(fileUnit) enddo 650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - + end subroutine mesh_marc_map_nodes @@ -1885,11 +1976,11 @@ 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', +!! 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, & @@ -1898,7 +1989,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: i,t,g,e,c @@ -1907,7 +1998,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) mesh_maxNips = 0_pInt mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt - + 610 FORMAT(A300) rewind(fileUnit) do @@ -1917,7 +2008,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) 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 + 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)) @@ -1927,13 +2018,13 @@ subroutine mesh_marc_count_cpSizes(fileUnit) 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 endif enddo exit endif enddo - + 630 end subroutine mesh_marc_count_cpSizes @@ -1981,7 +2072,7 @@ subroutine mesh_marc_build_elements(fileUnit) 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 + 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 @@ -1997,7 +2088,7 @@ subroutine mesh_marc_build_elements(fileUnit) exit endif enddo - + 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" read (fileUnit,610,END=620) line do @@ -2029,13 +2120,13 @@ subroutine mesh_marc_build_elements(fileUnit) chunkPos = IO_stringPos(line) enddo endif - else + else read (fileUnit,610,END=630) line endif enddo 630 end subroutine mesh_marc_build_elements -#endif +#endif #ifdef Abaqus !-------------------------------------------------------------------------------------------------- @@ -2049,28 +2140,28 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) 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 + 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') @@ -2092,10 +2183,10 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) 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 @@ -2116,21 +2207,21 @@ subroutine mesh_abaqus_count_elementSets(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 + 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 @@ -2155,18 +2246,18 @@ subroutine mesh_abaqus_count_materials(fileUnit) 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 + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. @@ -2180,12 +2271,12 @@ subroutine mesh_abaqus_count_materials(fileUnit) enddo 620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) - + end subroutine mesh_abaqus_count_materials !-------------------------------------------------------------------------------------------------- -! Build element set mapping +! Build element set mapping ! ! allocate globals: mesh_nameElemSet, mesh_mapElemSet !-------------------------------------------------------------------------------------------------- @@ -2219,7 +2310,7 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) 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')) @@ -2257,14 +2348,14 @@ subroutine mesh_abaqus_map_materials(fileUnit) 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 + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. @@ -2289,7 +2380,7 @@ subroutine mesh_abaqus_map_materials(fileUnit) 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 endif enddo @@ -2299,7 +2390,7 @@ subroutine mesh_abaqus_map_materials(fileUnit) enddo end subroutine mesh_abaqus_map_materials - + !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' @@ -2311,22 +2402,22 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) 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 + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) @@ -2348,7 +2439,7 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) endif endselect enddo - + 620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) end subroutine mesh_abaqus_count_cpElements @@ -2366,7 +2457,7 @@ subroutine mesh_abaqus_map_elements(fileUnit) IO_stringPos, & IO_extractValue, & IO_error - + implicit none integer(pInt), intent(in) :: fileUnit @@ -2381,7 +2472,7 @@ subroutine mesh_abaqus_map_elements(fileUnit) 610 FORMAT(A300) rewind(fileUnit) - do + do read (fileUnit,610,END=660) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) @@ -2500,7 +2591,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) character(len=300) :: line integer(pInt) :: i,j,m,c logical :: inPart - + allocate ( mesh_node0 (3,mesh_Nnodes) ); mesh_node0 = 0.0_pReal allocate ( mesh_node (3,mesh_Nnodes) ); mesh_node = 0.0_pReal @@ -2532,7 +2623,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) 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 enddo endif enddo @@ -2545,7 +2636,7 @@ 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', +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', !! and 'mesh_maxNcellnodes' !-------------------------------------------------------------------------------------------------- subroutine mesh_abaqus_count_cpSizes(fileUnit) @@ -2597,7 +2688,7 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) endif enddo - + 620 end subroutine mesh_abaqus_count_cpSizes @@ -2677,11 +2768,11 @@ subroutine mesh_abaqus_build_elements(fileUnit) endif enddo - + 620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" materialFound = .false. - do + do read (fileUnit,610,END=630) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) @@ -2737,14 +2828,14 @@ use IO, only: & integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) chunk, Nchunks character(len=300) :: line, damaskOption, v - character(len=300) :: keyword + character(len=300) :: keyword #endif #ifdef Spectral mesh_periodicSurface = .true. #else mesh_periodicSurface = .false. -#ifdef Marc4DAMASK +#ifdef Marc4DAMASK keyword = '$damask' #endif #ifdef Abaqus @@ -2752,7 +2843,7 @@ use IO, only: & #endif rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) @@ -2782,7 +2873,7 @@ use IO, only: & 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 @@ -2824,10 +2915,10 @@ subroutine mesh_build_ipAreas enddo case (4_pInt) ! 3D 8node - ! for this cell type we get the normal of the quadrilateral face as an average of + ! 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 + ! 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 @@ -2846,10 +2937,10 @@ subroutine mesh_build_ipAreas end select enddo !$OMP END PARALLEL DO - + end subroutine mesh_build_ipAreas - -#ifndef Spectral + +#ifndef Spectral !-------------------------------------------------------------------------------------------------- !> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' !-------------------------------------------------------------------------------------------------- @@ -2867,19 +2958,19 @@ subroutine mesh_build_nodeTwins 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 + + + !*** 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,:)) @@ -2893,10 +2984,10 @@ subroutine mesh_build_nodeTwins 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) @@ -2913,15 +3004,15 @@ subroutine mesh_build_nodeTwins 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 +!> @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 @@ -2930,17 +3021,16 @@ subroutine mesh_build_sharedElems integer(pint) e, & ! element index g, & ! element type node, & ! CP node index - n, & ! node index per element - myDim, & ! dimension 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 @@ -2957,12 +3047,12 @@ subroutine mesh_build_sharedElems 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)) mesh_sharedElem = 0_pInt - + do e = 1_pInt,mesh_NcpElems g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType node_seen = 0_pInt @@ -2982,9 +3072,9 @@ subroutine mesh_build_sharedElems node_seen(n) = node enddo enddo - + deallocate(node_seen) - + end subroutine mesh_build_sharedElems @@ -2994,14 +3084,14 @@ end subroutine mesh_build_sharedElems 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) + 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 @@ -3011,52 +3101,52 @@ subroutine mesh_build_ipNeighborhood matchingElem, & ! CP elem number of matching element matchingFace, & ! face ID of matching element a, anchor, & - neighboringIP, & + 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 + + 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 @@ -3072,11 +3162,11 @@ subroutine mesh_build_ipNeighborhood 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 @@ -3093,12 +3183,12 @@ subroutine mesh_build_ipNeighborhood 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 @@ -3106,9 +3196,9 @@ subroutine mesh_build_ipNeighborhood 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 @@ -3119,12 +3209,12 @@ subroutine mesh_build_ipNeighborhood endif enddo endif - + !*** we found a match !!! - + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = candidateIP - exit checkCandidateIP + exit checkCandidateIP enddo checkCandidateIP endif ! end of valid external matching endif ! end of internal/external matching @@ -3153,7 +3243,7 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - + end subroutine mesh_build_ipNeighborhood #endif @@ -3179,12 +3269,12 @@ subroutine mesh_tell_statistics 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))); mesh_HomogMicro = 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 @@ -3268,7 +3358,7 @@ enddo 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 + enddo #ifndef Spectral write(6,'(/,a,/)') 'Input Parser: NODE TWINS' write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' @@ -3295,7 +3385,7 @@ enddo !$OMP END CRITICAL (write2out) deallocate(mesh_HomogMicro) - + end subroutine mesh_tell_statistics @@ -3307,7 +3397,7 @@ integer(pInt) function FE_mapElemtype(what) implicit none character(len=*), intent(in) :: what - + select case (IO_lc(what)) case ( '6') FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle @@ -3354,7 +3444,7 @@ integer(pInt) function FE_mapElemtype(what) 'c3d20', & 'c3d20t') FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral - case default + case default call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) end select @@ -3368,7 +3458,7 @@ subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) implicit none integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID - matchingFace ! matching face 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)))) :: & @@ -3583,7 +3673,7 @@ subroutine mesh_build_FEdata 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. @@ -3596,7 +3686,7 @@ subroutine mesh_build_FEdata 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([& @@ -3604,7 +3694,7 @@ subroutine mesh_build_FEdata -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([& @@ -3833,32 +3923,32 @@ subroutine mesh_build_FEdata 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) + 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, & + 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, & + 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, & + 1, 0, 0, 0, & + 0, 1, 0, 0, & 0, 0, 1, 0, & - 0, 0, 0, 1, & + 0, 0, 0, 1, & 1, 1, 0, 0, & 0, 1, 1, 0, & 0, 0, 1, 1, & @@ -3902,16 +3992,16 @@ subroutine mesh_build_FEdata ],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) + 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, & + 1, 0, 0, 0, & + 0, 1, 0, 0, & 0, 0, 1, 0, & - 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 157 (3D 5node 4ip) + 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, & @@ -3977,7 +4067,7 @@ subroutine mesh_build_FEdata ],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) + 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, & @@ -3992,134 +4082,134 @@ subroutine mesh_build_FEdata 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, & ! + 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, 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, 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, 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, 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 & ! + 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 & ! + 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 & ! + 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))]) @@ -4174,7 +4264,7 @@ end subroutine mesh_build_FEdata integer(pInt) function mesh_get_Ncellnodes() implicit none - + mesh_get_Ncellnodes = mesh_Ncellnodes end function mesh_get_Ncellnodes @@ -4186,7 +4276,7 @@ end function mesh_get_Ncellnodes real(pReal) function mesh_get_unitlength() implicit none - + mesh_get_unitlength = mesh_unitlength end function mesh_get_unitlength diff --git a/src/numerics.f90 b/src/numerics.f90 index 2085e221e..8392ac61c 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -25,7 +25,7 @@ module numerics nState = 10_pInt, & !< state loop limit nStress = 40_pInt, & !< stress loop limit pert_method = 1_pInt, & !< method used in perturbation technique for tangent - fixedSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed + randomSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed worldrank = 0_pInt, & !< MPI worldrank (/=0 for MPI simulations only) worldsize = 0_pInt !< MPI worldsize (/=0 for MPI simulations only) integer(4), protected, public :: & @@ -120,9 +120,9 @@ module numerics petsc_options = '' integer(pInt), protected, public :: & fftw_planner_flag = 32_pInt, & !< conversion of fftw_plan_mode to integer, basically what is usually done in the include file of fftw - continueCalculation = 0_pInt, & !< 0: exit if BVP solver does not converge, 1: continue calculation if BVP solver does not converge divergence_correction = 2_pInt !< correct divergence calculation in fourier space 0: no correction, 1: size scaled to 1, 2: size scaled to Npoints logical, protected, public :: & + continueCalculation = .false., & !< false:exit if BVP solver does not converge, true: continue calculation despite BVP solver not converging memory_efficient = .true., & !< for fast execution (pre calculation of gamma_hat), Default .true.: do not precalculate update_gamma = .false. !< update gamma operator with current stiffness, Default .false.: use initial stiffness #endif @@ -359,8 +359,8 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! random seeding parameter - case ('fixed_seed') - fixedSeed = IO_intValue(line,chunkPos,2_pInt) + case ('random_seed','fixed_seed') + randomSeed = IO_intValue(line,chunkPos,2_pInt) !-------------------------------------------------------------------------------------------------- ! gradient parameter @@ -424,9 +424,9 @@ subroutine numerics_init case ('err_stress_tolabs') err_stress_tolabs = IO_floatValue(line,chunkPos,2_pInt) case ('continuecalculation') - continueCalculation = IO_intValue(line,chunkPos,2_pInt) + continueCalculation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('memory_efficient') - memory_efficient = IO_intValue(line,chunkPos,2_pInt) > 0_pInt + memory_efficient = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('fftw_timelimit') fftw_timelimit = IO_floatValue(line,chunkPos,2_pInt) case ('fftw_plan_mode') @@ -436,7 +436,7 @@ subroutine numerics_init case ('divergence_correction') divergence_correction = IO_intValue(line,chunkPos,2_pInt) case ('update_gamma') - update_gamma = IO_intValue(line,chunkPos,2_pInt) > 0_pInt + update_gamma = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('petsc_options') petsc_options = trim(line(chunkPos(4):)) case ('spectralsolver','myspectralsolver') @@ -560,9 +560,9 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! Random seeding parameter - write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed - if (fixedSeed <= 0_pInt) & - write(6,'(a,/)') ' No fixed Seed: Random is random!' + write(6,'(a24,1x,i16,/)') ' random_seed: ',randomSeed + if (randomSeed <= 0_pInt) & + write(6,'(a,/)') ' random seed will be generated!' !-------------------------------------------------------------------------------------------------- ! gradient parameter @@ -599,7 +599,7 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! spectral parameters #ifdef Spectral - write(6,'(a24,1x,i8)') ' continueCalculation: ',continueCalculation + write(6,'(a24,1x,L8)') ' continueCalculation: ',continueCalculation write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient write(6,'(a24,1x,i8)') ' divergence_correction: ',divergence_correction write(6,'(a24,1x,a)') ' spectral_derivative: ',trim(spectral_derivative) @@ -698,8 +698,6 @@ subroutine numerics_init if (err_hydrogenflux_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_hydrogenflux_tolabs') if (err_hydrogenflux_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_hydrogenflux_tolrel') #ifdef Spectral - if (continueCalculation /= 0_pInt .and. & - continueCalculation /= 1_pInt) call IO_error(301_pInt,ext_msg='continueCalculation') if (divergence_correction < 0_pInt .or. & divergence_correction > 2_pInt) call IO_error(301_pInt,ext_msg='divergence_correction') if (update_gamma .and. & @@ -713,7 +711,7 @@ subroutine numerics_init if (polarAlpha <= 0.0_pReal .or. & polarAlpha > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarAlpha') if (polarBeta < 0.0_pReal .or. & - polarBeta > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarBeta') + polarBeta > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarBeta') #endif end subroutine numerics_init diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 75e087770..c02a7c4d4 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -1178,7 +1178,7 @@ end subroutine plastic_disloUCLA_dotState function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) use prec, only: & tol_math_check, & - dEq + dEq, dNeq0 use math, only: & pi use material, only: & @@ -1445,9 +1445,13 @@ function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems2: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j + 1_pInt + if (dNeq0(abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph))))) then plastic_disloUCLA_postResults(c+j) = & (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)))) + else + plastic_disloUCLA_postResults(c+j) = huge(1.0_pReal) + endif plastic_disloUCLA_postResults(c+j)=min(plastic_disloUCLA_postResults(c+j),& state(instance)%mfp_slip(j,of)) enddo slipSystems2; enddo slipFamilies2 diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 50b14bdf9..d6c73e8f3 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -1029,7 +1029,7 @@ subroutine plastic_dislotwin_init(fileUnit) do p = 1_pInt,3_pInt; do q = 1_pInt,3_pInt; do r = 1_pInt,3_pInt; do s = 1_pInt,3_pInt plastic_dislotwin_Ctwin3333(l,m,n,o,index_myFamily+j,instance) = & plastic_dislotwin_Ctwin3333(l,m,n,o,index_myFamily+j,instance) + & - lattice_C3333(p,q,r,s,instance) * & + lattice_C3333(p,q,r,s,phase) * & lattice_Qtwin(l,p,index_otherFamily+j,phase) * & lattice_Qtwin(m,q,index_otherFamily+j,phase) * & lattice_Qtwin(n,r,index_otherFamily+j,phase) * & @@ -1087,7 +1087,7 @@ subroutine plastic_dislotwin_init(fileUnit) do p = 1_pInt,3_pInt; do q = 1_pInt,3_pInt; do r = 1_pInt,3_pInt; do s = 1_pInt,3_pInt plastic_dislotwin_Ctrans3333(l,m,n,o,index_myFamily+j,instance) = & plastic_dislotwin_Ctrans3333(l,m,n,o,index_myFamily+j,instance) + & - lattice_trans_C3333(p,q,r,s,instance) * & + lattice_trans_C3333(p,q,r,s,phase) * & lattice_Qtrans(l,p,index_otherFamily+j,phase) * & lattice_Qtrans(m,q,index_otherFamily+j,phase) * & lattice_Qtrans(n,r,index_otherFamily+j,phase) * & diff --git a/src/prec.f90 b/src/prec.f90 index 0e3b276db..912a02533 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -137,6 +137,7 @@ end subroutine prec_init !> @brief equality comparison for float with double precision ! replaces "==" but for certain (relative) tolerance. Counterpart to dNeq ! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ +! AlmostEqualRelative !-------------------------------------------------------------------------------------------------- logical elemental pure function dEq(a,b,tol) @@ -153,6 +154,7 @@ end function dEq !> @brief inequality comparison for float with double precision ! replaces "!=" but for certain (relative) tolerance. Counterpart to dEq ! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ +! AlmostEqualRelative NOT !-------------------------------------------------------------------------------------------------- logical elemental pure function dNeq(a,b,tol) @@ -167,33 +169,35 @@ end function dNeq !-------------------------------------------------------------------------------------------------- !> @brief equality to 0 comparison for float with double precision -! replaces "==0" but for certain (absolute) tolerance. Counterpart to dNeq0 -! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ +! replaces "==0" but everything not representable as a normal number is treated as 0. Counterpart to dNeq0 +! https://de.mathworks.com/help/matlab/ref/realmin.html +! https://docs.oracle.com/cd/E19957-01/806-3568/ncg_math.html !-------------------------------------------------------------------------------------------------- logical elemental pure function dEq0(a,tol) implicit none real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol - real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C + real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dEq0 = merge(.True., .False.,abs(a) <= merge(tol,eps,present(tol))*10.0_pReal) + dEq0 = merge(.True., .False.,abs(a) <= merge(tol,eps,present(tol))) end function dEq0 !-------------------------------------------------------------------------------------------------- !> @brief inequality to 0 comparison for float with double precision -! replaces "!=0" but for certain (absolute) tolerance. Counterpart to dEq0 -! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ +! replaces "!=0" but everything not representable as a normal number is treated as 0. Counterpart to dEq0 +! https://de.mathworks.com/help/matlab/ref/realmin.html +! https://docs.oracle.com/cd/E19957-01/806-3568/ncg_math.html !-------------------------------------------------------------------------------------------------- logical elemental pure function dNeq0(a,tol) implicit none real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol - real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C + real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dNeq0 = merge(.False., .True.,abs(a) <= merge(tol,eps,present(tol))*10.0_pReal) + dNeq0 = merge(.False., .True.,abs(a) <= merge(tol,eps,present(tol))) end function dNeq0 diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 index 6d0fff286..4695d4faa 100644 --- a/src/spectral_mech_AL.f90 +++ b/src/spectral_mech_AL.f90 @@ -213,8 +213,9 @@ subroutine AL_init endif restart call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) - call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & - 0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3) + call Utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, & + reshape(F,shape(F_lastInc)), 0.0_pReal, math_I3) + nullify(F) nullify(F_lambda) call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc @@ -364,12 +365,10 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) DMDALocalInfo, dimension(& DMDA_LOCAL_INFO_SIZE) :: & in - PetscScalar, target, dimension(3,3,2, & - XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: & - x_scal - PetscScalar, target, dimension(3,3,2, & - X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: & - f_scal + PetscScalar, & + target, dimension(3,3,2, XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: x_scal + PetscScalar, & + target, dimension(3,3,2, X_RANGE, Y_RANGE, Z_RANGE), intent(out) :: f_scal PetscScalar, pointer, dimension(:,:,:,:,:) :: & F, & F_lambda, & @@ -441,8 +440,9 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) !-------------------------------------------------------------------------------------------------- ! evaluate constitutive response P_avLastEval = P_av - call Utilities_constitutiveResponse(F_lastInc,F - residual_F_lambda/polarBeta,params%timeinc, & - residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC) + + call Utilities_constitutiveResponse(residual_F,P_av,C_volAvg,C_minMaxAvg, & + F - residual_F_lambda/polarBeta,params%timeinc, params%rotation_BC) call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) ForwardData = .False. @@ -655,10 +655,12 @@ subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stre !-------------------------------------------------------------------------------------------------- ! update coordinates and rate and forward last inc call utilities_updateIPcoords(F) - Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3])) - F_lambdaDot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lambda_lastInc,reshape(F_lambda,[3,3,grid(1),grid(2),grid3])) + Fdot = Utilities_calculateRate(guess, & + F_lastInc, reshape(F, [3,3,grid(1),grid(2),grid3]), timeinc_old, & + math_rotate_backward33(f_aimDot,rotation_BC)) + F_lambdaDot = Utilities_calculateRate(guess, & + F_lambda_lastInc,reshape(F_lambda,[3,3,grid(1),grid(2),grid3]), timeinc_old, & + math_rotate_backward33(f_aimDot,rotation_BC)) F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) F_lambda_lastInc = reshape(F_lambda,[3,3,grid(1),grid(2),grid3]) endif diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index ea6526091..262167872 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -39,16 +39,16 @@ module spectral_mech_basic ! stress, stiffness and compliance average etc. real(pReal), private, dimension(3,3) :: & F_aim = math_I3, & - F_aim_lastIter = math_I3, & F_aim_lastInc = math_I3, & P_av = 0.0_pReal, & - F_aimDot=0.0_pReal + F_aimDot = 0.0_pReal character(len=1024), private :: incInfo real(pReal), private, dimension(3,3,3,3) :: & C_volAvg = 0.0_pReal, & !< current volume average stiffness C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness - S = 0.0_pReal !< current compliance (filled up with zeros) + C_minMaxAvgLastInc = 0.0_pReal, & !< previous (min+max)/2 stiffness + S = 0.0_pReal !< current compliance (filled up with zeros) real(pReal), private :: err_stress, err_div logical, private :: ForwardData integer(pInt), private :: & @@ -69,7 +69,7 @@ module spectral_mech_basic contains !-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields and fills them with data, potentially from restart info +!> @brief allocates all necessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine basicPETSc_init #ifdef __GFORTRAN__ @@ -90,6 +90,8 @@ subroutine basicPETSc_init use numerics, only: & worldrank, & worldsize + use homogenization, only: & + materialpoint_F0 use DAMASK_interface, only: & getSolverJobName use spectral_utilities, only: & @@ -172,14 +174,11 @@ subroutine basicPETSc_init flush(6) write(rankStr,'(a1,i0)')'_',worldrank call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F)) - read (777,rec=1) F - close (777) + read (777,rec=1) F; close (777) call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc)) - read (777,rec=1) F_lastInc - close (777) + read (777,rec=1) F_lastInc; close (777) call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) - read (777,rec=1) f_aimDot - close (777) + read (777,rec=1) f_aimDot; close (777) F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc elseif (restartInc == 1_pInt) then restart @@ -187,34 +186,29 @@ subroutine basicPETSc_init F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) endif restart + materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) - call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & - 0.0_pReal, & - P, & - C_volAvg,C_minMaxAvg, & ! global average of stiffness and (min+max)/2 - temp33_Real, & - .false., & - math_I3) + call Utilities_constitutiveResponse(P, temp33_Real, C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2 + reshape(F,shape(F_lastInc)), & ! target F + 0.0_pReal, & ! time increment + math_I3) ! no rotation of boundary condition call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back to PETSc ! QUESTION: why not writing back right after reading (l.189)? restartRead: if (restartInc > 1_pInt) then ! QUESTION: are those values not calc'ed by constitutiveResponse? why reading from file? if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & - 'reading more values of increment', restartInc - 1_pInt, 'from file' + 'reading more values of increment', restartInc-1_pInt, 'from file' flush(6) call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) - read (777,rec=1) C_volAvg - close (777) + read (777,rec=1) C_volAvg; close (777) call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) - read (777,rec=1) C_volAvgLastInc - close (777) + read (777,rec=1) C_volAvgLastInc; close (777) call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) - read (777,rec=1) C_minMaxAvg - close (777) + read (777,rec=1) C_minMaxAvg; close (777) endif restartRead - call Utilities_updateGamma(C_minmaxAvg,.True.) + call Utilities_updateGamma(C_minmaxAvg,.true.) end subroutine basicPETSc_init @@ -238,13 +232,13 @@ type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old, !-------------------------------------------------------------------------------------------------- ! input data for solution - real(pReal), intent(in) :: & - timeinc, & !< increment in time for current solution - timeinc_old !< increment in time of last increment - type(tBoundaryCondition), intent(in) :: & - stress_BC character(len=*), intent(in) :: & incInfoIn + real(pReal), intent(in) :: & + timeinc, & !< increment time for current solution + timeinc_old !< increment time of last successful increment + type(tBoundaryCondition), intent(in) :: & + stress_BC real(pReal), dimension(3,3), intent(in) :: rotation_BC !-------------------------------------------------------------------------------------------------- @@ -279,13 +273,19 @@ type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old, !-------------------------------------------------------------------------------------------------- ! check convergence - call SNESGetConvergedReason(snes,reason,ierr) - CHKERRQ(ierr) + call SNESGetConvergedReason(snes,reason,ierr); CHKERRQ(ierr) + + BasicPETSc_solution%converged = reason > 0 + basicPETSC_solution%iterationsNeeded = totalIter basicPETSc_solution%termIll = terminallyIll terminallyIll = .false. +<<<<<<< HEAD if (reason == -4) call IO_error(893_pInt) BasicPETSc_solution%converged = reason > 0 basicPETSC_solution%iterationsNeeded = totalIter +======= + if (reason == -4) call IO_error(893_pInt) ! MPI error +>>>>>>> spectralSolver-cutbackfix end function BasicPETSc_solution @@ -321,19 +321,18 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) terminallyIll implicit none - DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & - in - PetscScalar, dimension(3,3, & - XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: & - x_scal - PetscScalar, dimension(3,3, & - X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: & - f_scal + DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: in + PetscScalar, & + dimension(3,3, XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: x_scal !< what is this? + PetscScalar, & + dimension(3,3, X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: f_scal !< what is this? PetscInt :: & PETScIter, & nfuncs PetscObject :: dummy PetscErrorCode :: ierr + real(pReal), dimension(3,3) :: & + deltaF_aim external :: & SNESGetNumberFunctionEvals, & @@ -343,45 +342,48 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment +<<<<<<< HEAD newIteration: if (totalIter <= PETScIter) then +======= +>>>>>>> spectralSolver-cutbackfix !-------------------------------------------------------------------------------------------------- -! report begin of new iteration +! begin of new iteration + newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1_pInt - write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & - ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax + write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') & + trim(incInfo), ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & - math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & - math_transpose33(F_aim) + write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & + ' deformation gradient aim (lab) =', math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) + write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & + ' deformation gradient aim =', math_transpose33(F_aim) flush(6) endif newIteration !-------------------------------------------------------------------------------------------------- ! evaluate constitutive response - call Utilities_constitutiveResponse(F_lastInc,x_scal,params%timeinc, & - f_scal,C_volAvg,C_minmaxAvg,P_av,ForwardData,params%rotation_BC) + call Utilities_constitutiveResponse(f_scal,P_av,C_volAvg,C_minmaxAvg, & + x_scal,params%timeinc, params%rotation_BC) call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) - ForwardData = .false. !-------------------------------------------------------------------------------------------------- ! stress BC handling - F_aim_lastIter = F_aim - F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%stress_BC))) ! S = 0.0 for no bc - err_stress = maxval(abs(mask_stress * (P_av - params%stress_BC))) ! mask = 0.0 for no bc + deltaF_aim = math_mul3333xx33(S, P_av - params%stress_BC) + F_aim = F_aim - deltaF_aim + err_stress = maxval(abs(mask_stress * (P_av - params%stress_BC))) ! mask = 0.0 when no stress bc !-------------------------------------------------------------------------------------------------- ! updated deformation gradient using fix point algorithm of basic scheme tensorField_real = 0.0_pReal tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = f_scal - call utilities_FFTtensorForward() - err_div = Utilities_divergenceRMS() - call utilities_fourierGammaConvolution(math_rotate_backward33(F_aim_lastIter-F_aim,params%rotation_BC)) - call utilities_FFTtensorBackward() + call utilities_FFTtensorForward() ! FFT forward of global "tensorField_real" + err_div = Utilities_divergenceRMS() ! divRMS of tensorField_fourier + call utilities_fourierGammaConvolution(math_rotate_backward33(deltaF_aim,params%rotation_BC)) ! convolution of Gamma and tensorField_fourier, with arg + call utilities_FFTtensorBackward() ! FFT backward of global tensorField_fourier !-------------------------------------------------------------------------------------------------- ! constructing residual - f_scal = tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) + f_scal = tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) ! Gamma*P gives correction towards div(P) = 0, so needs to be zero, too end subroutine BasicPETSc_formResidual @@ -442,8 +444,11 @@ end subroutine BasicPETSc_converged !-------------------------------------------------------------------------------------------------- !> @brief forwarding routine +!> @details find new boundary conditions and best F estimate for end of current timestep +!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates !-------------------------------------------------------------------------------------------------- subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC) +<<<<<<< HEAD use math, only: & math_mul33x33 ,& math_rotate_backward33 @@ -542,6 +547,118 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3]) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) +======= + use math, only: & + math_mul33x33 ,& + math_rotate_backward33 + use numerics, only: & + worldrank + use homogenization, only: & + materialpoint_F0 + use mesh, only: & + grid, & + grid3 + use CPFEM2, only: & + CPFEM_age + use spectral_utilities, only: & + Utilities_calculateRate, & + Utilities_forwardField, & + Utilities_updateIPcoords, & + tBoundaryCondition, & + cutBack + use IO, only: & + IO_write_JobRealFile + use FEsolving, only: & + restartWrite + + implicit none + logical, intent(in) :: & + guess + real(pReal), intent(in) :: & + timeinc_old, & + timeinc, & + loadCaseTime !< remaining time of current load case + type(tBoundaryCondition), intent(in) :: & + stress_BC, & + deformation_BC + real(pReal), dimension(3,3), intent(in) ::& + rotation_BC + PetscErrorCode :: ierr + PetscScalar, pointer :: F(:,:,:,:) + + character(len=32) :: rankStr + + call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) + + if (cutBack) then + C_volAvg = C_volAvgLastInc ! QUESTION: where is this required? + C_minMaxAvg = C_minMaxAvgLastInc ! QUESTION: where is this required? + else + !-------------------------------------------------------------------------------------------------- + ! restart information for spectral solver + if (restartWrite) then ! QUESTION: where is this logical properly set? + write(6,'(/,a)') ' writing converged results for restart' + flush(6) + + if (worldrank == 0_pInt) then + call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) + write (777,rec=1) C_volAvg; close(777) + call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) + write (777,rec=1) C_volAvgLastInc; close(777) + call IO_write_jobRealFile(777,'C_minMaxAvg',size(C_volAvg)) + write (777,rec=1) C_minMaxAvg; close(777) + call IO_write_jobRealFile(777,'C_minMaxAvgLastInc',size(C_volAvgLastInc)) + write (777,rec=1) C_minMaxAvgLastInc; close(777) + endif + + write(rankStr,'(a1,i0)')'_',worldrank + call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file + write (777,rec=1) F; close (777) + call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file + write (777,rec=1) F_lastInc; close (777) + endif + + call CPFEM_age() ! age state and kinematics + call utilities_updateIPcoords(F) + + C_volAvgLastInc = C_volAvg + C_minMaxAvgLastInc = C_minMaxAvg + + if (guess) then ! QUESTION: better with a = L ? x:y + F_aimDot = stress_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old ! initialize with correction based on last inc + else + F_aimDot = 0.0_pReal + endif + F_aim_lastInc = F_aim + !-------------------------------------------------------------------------------------------------- + ! calculate rate for aim + if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F + F_aimDot = & + F_aimDot + deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim_lastInc) + elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed + F_aimDot = & + F_aimDot + deformation_BC%maskFloat * deformation_BC%values + elseif (deformation_BC%myType=='f') then ! aim at end of load case is prescribed + F_aimDot = & + F_aimDot + deformation_BC%maskFloat * (deformation_BC%values - F_aim_lastInc)/loadCaseTime + endif + + + Fdot = Utilities_calculateRate(guess, & + F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, & + math_rotate_backward33(f_aimDot,rotation_BC)) + F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) ! winding F forward + materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent + endif + +!-------------------------------------------------------------------------------------------------- +! update average and local deformation gradients + F_aim = F_aim_lastInc + f_aimDot * timeinc + F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average + math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3]) + call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) + +>>>>>>> spectralSolver-cutbackfix end subroutine BasicPETSc_forward !-------------------------------------------------------------------------------------------------- diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index ecf707d46..fc65f14cf 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -213,8 +213,8 @@ subroutine Polarisation_init endif restart call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) - call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & - 0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3) + call Utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, & + reshape(F,shape(F_lastInc)),0.0_pReal,math_I3) nullify(F) nullify(F_tau) call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc @@ -364,12 +364,10 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr) DMDALocalInfo, dimension(& DMDA_LOCAL_INFO_SIZE) :: & in - PetscScalar, target, dimension(3,3,2, & - XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: & - x_scal - PetscScalar, target, dimension(3,3,2, & - X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: & - f_scal + PetscScalar, & + target, dimension(3,3,2, XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: x_scal + PetscScalar, & + target, dimension(3,3,2, X_RANGE, Y_RANGE, Z_RANGE), intent(out) :: f_scal PetscScalar, pointer, dimension(:,:,:,:,:) :: & F, & F_tau, & @@ -440,8 +438,8 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr) !-------------------------------------------------------------------------------------------------- ! evaluate constitutive response P_avLastEval = P_av - call Utilities_constitutiveResponse(F_lastInc,F - residual_F_tau/polarBeta,params%timeinc, & - residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC) + call Utilities_constitutiveResponse(residual_F,P_av,C_volAvg,C_minMaxAvg, & + F - residual_F_tau/polarBeta,params%timeinc,params%rotation_BC) call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) ForwardData = .False. @@ -654,13 +652,13 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati !-------------------------------------------------------------------------------------------------- ! update coordinates and rate and forward last inc call utilities_updateIPcoords(F) - Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc, & - reshape(F,[3,3,grid(1),grid(2),grid3])) - F_tauDot = Utilities_calculateRate(math_rotate_backward33(2.0_pReal*f_aimDot,rotation_BC), & - timeinc_old,guess,F_tau_lastInc, & - reshape(F_tau,[3,3,grid(1),grid(2),grid3])) - F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) + Fdot = Utilities_calculateRate(guess, & + F_lastInc, reshape(F, [3,3,grid(1),grid(2),grid3]), timeinc_old, & + math_rotate_backward33( f_aimDot,rotation_BC)) + F_tauDot = Utilities_calculateRate(guess, & + F_tau_lastInc, reshape(F_tau,[3,3,grid(1),grid(2),grid3]), timeinc_old, & + math_rotate_backward33(2.0_pReal*f_aimDot,rotation_BC)) + F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) F_tau_lastInc = reshape(F_tau,[3,3,grid(1),grid(2),grid3]) endif diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 2c56d4de7..aa2cfad8a 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -16,7 +16,7 @@ module spectral_utilities #include include 'fftw3-mpi.f03' - logical, public :: cutBack =.false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill + logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill integer(pInt), public, parameter :: maxPhaseFields = 2_pInt integer(pInt), public :: nActiveFields = 0_pInt @@ -799,7 +799,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) call math_invert(size_reduced, c_reduced, s_reduced, errmatinv) ! invert reduced stiffness if (any(IEEE_is_NaN(s_reduced))) errmatinv = .true. - if(errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') + if (errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') temp99_Real = 0.0_pReal ! fill up compliance with zeros k = 0_pInt do n = 1_pInt,9_pInt @@ -817,28 +817,41 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) sTimesC = matmul(c_reduced,s_reduced) do m=1_pInt, size_reduced do n=1_pInt, size_reduced - if(m==n .and. abs(sTimesC(m,n)) > (1.0_pReal + 10.0e-12_pReal)) errmatinv = .true. ! diagonal elements of S*C should be 1 - if(m/=n .and. abs(sTimesC(m,n)) > (0.0_pReal + 10.0e-12_pReal)) errmatinv = .true. ! off diagonal elements of S*C should be 0 + errmatinv = errmatinv & + .or. (m==n .and. abs(sTimesC(m,n)-1.0_pReal) > 1.0e-12_pReal) & ! diagonal elements of S*C should be 1 + .or. (m/=n .and. abs(sTimesC(m,n)) > 1.0e-12_pReal) ! off-diagonal elements of S*C should be 0 enddo enddo +<<<<<<< HEAD if(debugGeneral .or. errmatinv) then +======= + if (debugGeneral .or. errmatinv) then +>>>>>>> spectralSolver-cutbackfix write(formatString, '(i2)') size_reduced formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))' write(6,trim(formatString),advance='no') ' C * S (load) ', & transpose(matmul(c_reduced,s_reduced)) write(6,trim(formatString),advance='no') ' S (load) ', transpose(s_reduced) + if(errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') endif - if(errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') deallocate(c_reduced) deallocate(s_reduced) deallocate(sTimesC) else temp99_real = 0.0_pReal endif +<<<<<<< HEAD if(debugGeneral) & write(6,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') ' Masked Compliance (load) / GPa =', & transpose(temp99_Real*1.e9_pReal) flush(6) +======= + if(debugGeneral) then + write(6,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') & + ' Masked Compliance (load) / GPa =', transpose(temp99_Real*1.e-9_pReal) + flush(6) + endif +>>>>>>> spectralSolver-cutbackfix utilities_maskedCompliance = math_Plain99to3333(temp99_Real) end function utilities_maskedCompliance @@ -924,10 +937,10 @@ end subroutine utilities_fourierTensorDivergence !-------------------------------------------------------------------------------------------------- -!> @brief calculates constitutive response +!> @brief calculate constitutive response from materialpoint_F0 to F during timeinc !-------------------------------------------------------------------------------------------------- -subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & - P,C_volAvg,C_minmaxAvg,P_av,forwardData,rotation_BC) +subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& + F,timeinc,rotation_BC) use IO, only: & IO_error use debug, only: & @@ -940,31 +953,22 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & use mesh, only: & grid,& grid3 - use FEsolving, only: & - restartWrite - use CPFEM2, only: & - CPFEM_general use homogenization, only: & - materialpoint_F0, & materialpoint_F, & materialpoint_P, & - materialpoint_dPdF + materialpoint_dPdF, & + materialpoint_stressAndItsTangent implicit none - real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid3) :: & - F_lastInc, & !< target deformation gradient - F !< previous deformation gradient - real(pReal), intent(in) :: timeinc !< loading time - logical, intent(in) :: forwardData !< age results - real(pReal), intent(in), dimension(3,3) :: rotation_BC !< rotation of load frame - real(pReal),intent(out), dimension(3,3,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress real(pReal),intent(out), dimension(3,3,grid(1),grid(2),grid3) :: P !< PK stress - logical :: & - age + real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid3) :: F !< deformation gradient target !< previous deformation gradient + real(pReal), intent(in) :: timeinc !< loading time + real(pReal), intent(in), dimension(3,3) :: rotation_BC !< rotation of load frame + integer(pInt) :: & j,k,ierr real(pReal), dimension(3,3,3,3) :: max_dPdF, min_dPdF @@ -975,17 +979,9 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & write(6,'(/,a)') ' ... evaluating constitutive response ......................................' flush(6) - age = .False. - - if (forwardData) then ! aging results - age = .True. - materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) - endif - if (cutBack) age = .False. ! restore saved variables - - materialpoint_F = reshape(F,[3,3,1,product(grid(1:2))*grid3]) - call debug_reset() ! this has no effect on rank >0 - + + materialpoint_F = reshape(F,[3,3,1,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field + !-------------------------------------------------------------------------------------------------- ! calculate bounds of det(F) and report if(debugGeneral) then @@ -1002,7 +998,19 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & flush(6) endif - call CPFEM_general(age,timeinc) + call debug_reset() ! this has no effect on rank >0 + call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field + + P = reshape(materialpoint_P, [3,3,grid(1),grid(2),grid3]) + P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P + call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + if (debugRotation) & + write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress (lab) / MPa =',& + math_transpose33(P_av)*1.e-6_pReal + P_av = math_rotate_forward33(P_av,rotation_BC) + write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& + math_transpose33(P_av)*1.e-6_pReal + flush(6) max_dPdF = 0.0_pReal max_dPdF_norm = 0.0_pReal @@ -1020,38 +1028,24 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & end do call MPI_Allreduce(MPI_IN_PLACE,max_dPdF,81,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce max') + if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce max') call MPI_Allreduce(MPI_IN_PLACE,min_dPdF,81,MPI_DOUBLE,MPI_MIN,PETSC_COMM_WORLD,ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce min') + if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce min') C_minmaxAvg = 0.5_pReal*(max_dPdF + min_dPdF) - C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt + C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) call debug_info() ! this has no effect on rank >0 - restartWrite = .false. ! reset restartWrite status - cutBack = .false. ! reset cutBack status - - P = reshape(materialpoint_P, [3,3,grid(1),grid(2),grid3]) - P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P - call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - if (debugRotation) & - write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress (lab) / MPa =',& - math_transpose33(P_av)*1.e-6_pReal - P_av = math_rotate_forward33(P_av,rotation_BC) - write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& - math_transpose33(P_av)*1.e-6_pReal - flush(6) - end subroutine utilities_constitutiveResponse !-------------------------------------------------------------------------------------------------- !> @brief calculates forward rate, either guessing or just add delta/timeinc !-------------------------------------------------------------------------------------------------- -pure function utilities_calculateRate(avRate,timeinc_old,guess,field_lastInc,field) +pure function utilities_calculateRate(heterogeneous,field0,field,dt,avRate) use mesh, only: & grid3, & grid @@ -1059,17 +1053,17 @@ pure function utilities_calculateRate(avRate,timeinc_old,guess,field_lastInc,fie implicit none real(pReal), intent(in), dimension(3,3) :: avRate !< homogeneous addon real(pReal), intent(in) :: & - timeinc_old !< timeinc of last step + dt !< timeinc between field0 and field logical, intent(in) :: & - guess !< guess along former trajectory + heterogeneous !< calculate field of rates real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid3) :: & - field_lastInc, & !< data of previous step + field0, & !< data of previous step field !< data of current step real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: & utilities_calculateRate - if (guess) then - utilities_calculateRate = (field-field_lastInc) / timeinc_old + if (heterogeneous) then + utilities_calculateRate = (field-field0) / dt else utilities_calculateRate = spread(spread(spread(avRate,3,grid(1)),4,grid(2)),5,grid3) endif