From 71e17ba91715654b02e5140557b0075d15a143d3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 24 Jul 2021 22:51:57 +0200 Subject: [PATCH 01/13] WIP: report active slip systems to DADF5 needs further work, currently an array of fixed length strings is written while all single strings are of variable length type --- src/HDF5_utilities.f90 | 4 +- ...phase_mechanical_plastic_phenopowerlaw.f90 | 24 ++++---- src/results.f90 | 58 ++++++++++++++++--- 3 files changed, 65 insertions(+), 21 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index c981fad53..22a6e00e5 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -453,7 +453,6 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) integer :: hdferr logical :: attrExists character(len=:), allocatable :: p - type(C_PTR) :: f_ptr character(len=:), allocatable, dimension(:), target :: attrValue_ @@ -483,8 +482,7 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) endif call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),filetype_id,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - f_ptr = c_loc(attrValue_) - call h5awrite_f(attr_id, memtype_id, f_ptr, hdferr) + call h5awrite_f(attr_id, memtype_id, c_loc(attrValue_), hdferr) if(hdferr < 0) error stop 'HDF5 error' call h5tclose_f(memtype_id,hdferr) diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index 3bfb360b4..e4d84df0b 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -42,6 +42,9 @@ submodule(phase:plastic) phenopowerlaw nonSchmidActive = .false. character(len=pStringLen), allocatable, dimension(:) :: & output + character(len=:), allocatable, dimension(:) :: & + systems_sl, & + systems_tw end type tParameters type :: tPhenopowerlawState @@ -115,6 +118,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(N_sl)) slipActive: if (prm%sum_N_sl > 0) then + prm%systems_sl = lattice_labels_slip(N_sl,phase_lattice(ph)) prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph)) if (phase_lattice(ph) == 'cI') then @@ -126,8 +130,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) prm%P_nS_pos = prm%P_sl prm%P_nS_neg = prm%P_sl endif - prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dFloat('h_sl-sl'), & - phase_lattice(ph)) + prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dFloat('h_sl-sl'),phase_lattice(ph)) xi_0_sl = pl%get_as1dFloat('xi_0_sl', requiredSize=size(N_sl)) prm%xi_inf_sl = pl%get_as1dFloat('xi_inf_sl', requiredSize=size(N_sl)) @@ -162,11 +165,10 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) N_tw = pl%get_as1dInt('N_tw', defaultVal=emptyIntArray) prm%sum_N_tw = sum(abs(N_tw)) twinActive: if (prm%sum_N_tw > 0) then - prm%P_tw = lattice_SchmidMatrix_twin(N_tw,phase_lattice(ph),phase_cOverA(ph)) - prm%h_tw_tw = lattice_interaction_TwinByTwin(N_tw,pl%get_as1dFloat('h_tw-tw'), & - phase_lattice(ph)) - prm%gamma_char = lattice_characteristicShear_twin(N_tw,phase_lattice(ph),& - phase_cOverA(ph)) + prm%systems_tw = lattice_labels_twin(N_tw,phase_lattice(ph)) + prm%P_tw = lattice_SchmidMatrix_twin(N_tw,phase_lattice(ph),phase_cOverA(ph)) + prm%h_tw_tw = lattice_interaction_TwinByTwin(N_tw,pl%get_as1dFloat('h_tw-tw'),phase_lattice(ph)) + prm%gamma_char = lattice_characteristicShear_twin(N_tw,phase_lattice(ph),phase_cOverA(ph)) xi_0_tw = pl%get_as1dFloat('xi_0_tw',requiredSize=size(N_tw)) @@ -377,11 +379,11 @@ module subroutine plastic_phenopowerlaw_results(ph,group) select case(trim(prm%output(o))) case('xi_sl') - if(prm%sum_N_sl>0) call results_writeDataset(stt%xi_sl,group,trim(prm%output(o)), & - 'resistance against plastic slip','Pa') + call results_writeState_slip(stt%xi_sl,group,trim(prm%output(o)),prm%systems_sl, & + 'resistance against plastic slip','Pa') case('gamma_sl') - if(prm%sum_N_sl>0) call results_writeDataset(stt%gamma_sl,group,trim(prm%output(o)), & - 'plastic shear','1') + call results_writeState_slip(stt%gamma_sl,group,trim(prm%output(o)),prm%systems_sl, & + 'plastic shear','1') case('xi_tw') if(prm%sum_N_tw>0) call results_writeDataset(stt%xi_tw,group,trim(prm%output(o)), & diff --git a/src/results.f90 b/src/results.f90 index 94625a4b9..fdf50a437 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -34,10 +34,11 @@ module results end interface results_writeDataset interface results_addAttribute - module procedure results_addAttribute_real - module procedure results_addAttribute_int module procedure results_addAttribute_str + module procedure results_addAttribute_int + module procedure results_addAttribute_real + module procedure results_addAttribute_str_array module procedure results_addAttribute_int_array module procedure results_addAttribute_real_array end interface results_addAttribute @@ -52,6 +53,7 @@ module results results_openGroup, & results_closeGroup, & results_writeDataset, & + results_writeState_slip, & results_setLink, & results_addAttribute, & results_removeLink, & @@ -189,7 +191,7 @@ subroutine results_setLink(path,link) end subroutine results_setLink !-------------------------------------------------------------------------------------------------- -!> @brief adds a string attribute to an object in the results file +!> @brief Add a string attribute to an object in the results file. !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_str(attrLabel,attrValue,path) @@ -207,7 +209,7 @@ end subroutine results_addAttribute_str !-------------------------------------------------------------------------------------------------- -!> @brief adds an integer attribute an object in the results file +!> @brief Add an integer attribute an object in the results file. !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_int(attrLabel,attrValue,path) @@ -226,7 +228,7 @@ end subroutine results_addAttribute_int !-------------------------------------------------------------------------------------------------- -!> @brief adds a real attribute an object in the results file +!> @brief Add a real attribute an object in the results file. !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_real(attrLabel,attrValue,path) @@ -245,7 +247,26 @@ end subroutine results_addAttribute_real !-------------------------------------------------------------------------------------------------- -!> @brief adds an integer array attribute an object in the results file +!> @brief Add a string array attribute an object in the results file. +!-------------------------------------------------------------------------------------------------- +subroutine results_addAttribute_str_array(attrLabel,attrValue,path) + + character(len=*), intent(in) :: attrLabel + character(len=*), intent(in), dimension(:) :: attrValue + character(len=*), intent(in), optional :: path + + + if (present(path)) then + call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + else + call HDF5_addAttribute(resultsFile,attrLabel, attrValue) + endif + +end subroutine results_addAttribute_str_array + + +!-------------------------------------------------------------------------------------------------- +!> @brief Add an integer array attribute an object in the results file. !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_int_array(attrLabel,attrValue,path) @@ -264,7 +285,7 @@ end subroutine results_addAttribute_int_array !-------------------------------------------------------------------------------------------------- -!> @brief adds a real array attribute an object in the results file +!> @brief Add a real array attribute an object in the results file. !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_real_array(attrLabel,attrValue,path) @@ -337,6 +358,29 @@ subroutine results_writeVectorDataset_real(dataset,group,label,description,SIuni end subroutine results_writeVectorDataset_real +!-------------------------------------------------------------------------------------------------- +!> @brief Store real vector dataset with associated metadata for slip +!-------------------------------------------------------------------------------------------------- +subroutine results_writeState_slip(dataset,group,label,systems,description,SIunit) + + character(len=*), intent(in) :: label,group,description,SIunit + real(pReal), intent(in), dimension(:,:) :: dataset + character(len=*), intent(in), dimension(:) :: systems + + integer(HID_T) :: groupHandle + + + if (size(systems) == 0) return + + groupHandle = results_openGroup(group) + call HDF5_write(dataset,groupHandle,label) + call executionStamp(group//'/'//label,description,SIunit) + call HDF5_addAttribute(resultsFile,'slip_systems',systems,group//'/'//label) + call HDF5_closeGroup(groupHandle) + +end subroutine results_writeState_slip + + !-------------------------------------------------------------------------------------------------- !> @brief Store real tensor dataset with associated metadata. !> @details Data is transposed to compenstate transposed storage order. From 26e1e979f598bda3b0e53fbcde7b2b26d443abe4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 24 Jul 2021 23:08:05 +0200 Subject: [PATCH 02/13] length is known --- src/HDF5_utilities.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 22a6e00e5..7655788bb 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -312,7 +312,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) logical :: attrExists integer :: hdferr character(len=:), allocatable :: p - character(len=:,kind=C_CHAR), allocatable,target :: attrValue_ + character(len=len_trim(attrValue)+1,kind=C_CHAR), target :: attrValue_ type(c_ptr), target, dimension(1) :: ptr From d9ef1ef5e4d6ccd1cc7d27b5f146d80cca9f083e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 25 Jul 2021 09:36:56 +0200 Subject: [PATCH 03/13] write variable length string (as other, best compatibility with h5py) --- src/HDF5_utilities.f90 | 45 ++++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 7655788bb..37ca2563a 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -313,7 +313,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) integer :: hdferr character(len=:), allocatable :: p character(len=len_trim(attrValue)+1,kind=C_CHAR), target :: attrValue_ - type(c_ptr), target, dimension(1) :: ptr + type(C_PTR), target, dimension(1) :: ptr if (present(path)) then @@ -333,9 +333,10 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) if(hdferr < 0) error stop 'HDF5 error' if (attrExists) then - call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) - if(hdferr < 0) error stop 'HDF5 error' + call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) + if(hdferr < 0) error stop 'HDF5 error' endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, type_id, c_loc(ptr(1)), hdferr) @@ -382,6 +383,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path) call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) if(hdferr < 0) error stop 'HDF5 error' endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr) @@ -426,6 +428,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path) call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) if(hdferr < 0) error stop 'HDF5 error' endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr) @@ -449,11 +452,12 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) character(len=*), intent(in), dimension(:) :: attrValue character(len=*), intent(in), optional :: path - integer(HID_T) :: attr_id, space_id, filetype_id, memtype_id - integer :: hdferr + integer(HID_T) :: attr_id, space_id, filetype_id, type_id logical :: attrExists + integer :: hdferr,i character(len=:), allocatable :: p - character(len=:), allocatable, dimension(:), target :: attrValue_ + character(len=len(attrValue)+1,kind=C_CHAR), dimension(size(attrValue)), target :: attrValue_ + type(C_PTR), target, dimension(size(attrValue)) :: ptr if (present(path)) then @@ -462,35 +466,32 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) p = '.' endif - attrValue_ = attrValue + do i=1,size(attrValue) + attrValue_(i) = attrValue(i)//C_NULL_CHAR + ptr(i) = c_loc(attrValue_(i)) + enddo - call h5tcopy_f(H5T_C_S1,filetype_id,hdferr) + call h5screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id,hdferr,shape(attrValue_,kind=HSIZE_T)) if(hdferr < 0) error stop 'HDF5 error' - call h5tset_size_f(filetype_id, int(len(attrValue_)+1,C_SIZE_T),hdferr) - if(hdferr < 0) error stop 'HDF5 error' - call h5tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - call h5tset_size_f(memtype_id, int(len(attrValue_),C_SIZE_T), hdferr) - if(hdferr < 0) error stop 'HDF5 error' - call h5screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id, hdferr) + call h5tcopy_f(H5T_STRING, type_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) + if(hdferr < 0) error stop 'HDF5 error' if (attrExists) then call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) if(hdferr < 0) error stop 'HDF5 error' endif - call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),filetype_id,space_id,attr_id,hdferr) + + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5awrite_f(attr_id, memtype_id, c_loc(attrValue_), hdferr) + call h5awrite_f(attr_id, type_id, ptr, hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(memtype_id,hdferr) - if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(filetype_id,hdferr) - if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' + call h5tclose_f(type_id,hdferr) + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(space_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' @@ -531,6 +532,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path) call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) if(hdferr < 0) error stop 'HDF5 error' endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr) @@ -578,6 +580,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path) call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) if(hdferr < 0) error stop 'HDF5 error' endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr) From c388ab97c955e1fd9dffea2e03976d138d63e999 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 25 Jul 2021 09:43:52 +0200 Subject: [PATCH 04/13] trying to make sense of HDF5 pointer magic --- src/HDF5_utilities.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 37ca2563a..afc6738be 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -312,7 +312,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) logical :: attrExists integer :: hdferr character(len=:), allocatable :: p - character(len=len_trim(attrValue)+1,kind=C_CHAR), target :: attrValue_ + character(len=len_trim(attrValue)+1,kind=C_CHAR), dimension(1), target :: attrValue_ type(C_PTR), target, dimension(1) :: ptr @@ -322,8 +322,8 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) p = '.' endif - attrValue_ = trim(attrValue)//C_NULL_CHAR - ptr(1) = c_loc(attrValue_) + attrValue_(1) = trim(attrValue)//C_NULL_CHAR + ptr(1) = c_loc(attrValue_(1)) call h5screate_f(H5S_SCALAR_F,space_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' @@ -339,7 +339,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5awrite_f(attr_id, type_id, c_loc(ptr(1)), hdferr) + call h5awrite_f(attr_id, type_id, ptr, hdferr) if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) @@ -452,7 +452,7 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) character(len=*), intent(in), dimension(:) :: attrValue character(len=*), intent(in), optional :: path - integer(HID_T) :: attr_id, space_id, filetype_id, type_id + integer(HID_T) :: attr_id, space_id, type_id logical :: attrExists integer :: hdferr,i character(len=:), allocatable :: p From 18b342497555fec5b6d841fe866e093a698d390d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 25 Jul 2021 10:11:19 +0200 Subject: [PATCH 05/13] handle twin and slip systems --- src/lattice.f90 | 2 +- ...phase_mechanical_plastic_phenopowerlaw.f90 | 39 +++++++++++-------- src/results.f90 | 10 ++--- 3 files changed, 28 insertions(+), 23 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 725c36ba8..bf48fe019 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -2062,7 +2062,7 @@ function getlabels(active,potential,system) result(labels) enddo normal label(i:i) = ')' - labels(s) = label + labels(a) = label enddo activeSystems enddo activeFamilies diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index e4d84df0b..4f66e5f18 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -372,28 +372,33 @@ module subroutine plastic_phenopowerlaw_results(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - integer :: o + integer :: ou + associate(prm => param(ph), stt => state(ph)) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case('xi_sl') - call results_writeState_slip(stt%xi_sl,group,trim(prm%output(o)),prm%systems_sl, & - 'resistance against plastic slip','Pa') - case('gamma_sl') - call results_writeState_slip(stt%gamma_sl,group,trim(prm%output(o)),prm%systems_sl, & - 'plastic shear','1') + do ou = 1,size(prm%output) - case('xi_tw') - if(prm%sum_N_tw>0) call results_writeDataset(stt%xi_tw,group,trim(prm%output(o)), & - 'resistance against twinning','Pa') - case('gamma_tw') - if(prm%sum_N_tw>0) call results_writeDataset(stt%gamma_tw,group,trim(prm%output(o)), & - 'twinning shear','1') + select case(trim(prm%output(ou))) + + case('xi_sl') + call results_writePhaseState(stt%xi_sl,group,trim(prm%output(ou)),prm%systems_sl, & + 'resistance against plastic slip','Pa') + case('gamma_sl') + call results_writePhaseState(stt%gamma_sl,group,trim(prm%output(ou)),prm%systems_sl, & + 'plastic shear','1') + + case('xi_tw') + call results_writePhaseState(stt%xi_tw,group,trim(prm%output(ou)),prm%systems_tw, & + 'resistance against twinning','Pa') + case('gamma_tw') + call results_writePhaseState(stt%gamma_tw,group,trim(prm%output(ou)),prm%systems_tw, & + 'twinning shear','1') + + end select + + enddo - end select - enddo outputsLoop end associate end subroutine plastic_phenopowerlaw_results diff --git a/src/results.f90 b/src/results.f90 index fdf50a437..79745a2f3 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -53,7 +53,7 @@ module results results_openGroup, & results_closeGroup, & results_writeDataset, & - results_writeState_slip, & + results_writePhaseState, & results_setLink, & results_addAttribute, & results_removeLink, & @@ -361,7 +361,7 @@ end subroutine results_writeVectorDataset_real !-------------------------------------------------------------------------------------------------- !> @brief Store real vector dataset with associated metadata for slip !-------------------------------------------------------------------------------------------------- -subroutine results_writeState_slip(dataset,group,label,systems,description,SIunit) +subroutine results_writePhaseState(dataset,group,label,systems,description,SIunit) character(len=*), intent(in) :: label,group,description,SIunit real(pReal), intent(in), dimension(:,:) :: dataset @@ -370,15 +370,15 @@ subroutine results_writeState_slip(dataset,group,label,systems,description,SIuni integer(HID_T) :: groupHandle - if (size(systems) == 0) return + if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe use for other results_write (not sure about scalar) groupHandle = results_openGroup(group) call HDF5_write(dataset,groupHandle,label) call executionStamp(group//'/'//label,description,SIunit) - call HDF5_addAttribute(resultsFile,'slip_systems',systems,group//'/'//label) + call HDF5_addAttribute(resultsFile,'systems',systems,group//'/'//label) call HDF5_closeGroup(groupHandle) -end subroutine results_writeState_slip +end subroutine results_writePhaseState !-------------------------------------------------------------------------------------------------- From d2b5a4b33969c4383576feaa0964efae1fb4532f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 25 Jul 2021 10:18:35 +0200 Subject: [PATCH 06/13] pointer voodoo for ifort --- src/HDF5_utilities.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index afc6738be..82ec78811 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -339,7 +339,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5awrite_f(attr_id, type_id, ptr, hdferr) + call h5awrite_f(attr_id, type_id, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) @@ -485,7 +485,7 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5awrite_f(attr_id, type_id, ptr, hdferr) + call h5awrite_f(attr_id, type_id, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) From 61a3b33e71c457a467acda1341824f74dd11b749 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 25 Jul 2021 11:54:41 +0200 Subject: [PATCH 07/13] output info about used slip/twin systems --- src/lattice.f90 | 7 +- src/phase_mechanical_plastic_dislotwin.f90 | 76 ++++++++++++---------- 2 files changed, 47 insertions(+), 36 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index bf48fe019..65950774e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1930,7 +1930,8 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) -1,-2,-1, -1, 1,-1, & -1, 1, 2, -1, 1,-1 & ],pReal),shape(FCCTOHEX_SYSTEMTRANS)) - real(pReal), dimension(4,fcc_Ntrans), parameter :: & + + real(pReal), dimension(4,fcc_Ntrans), parameter :: & FCCTOBCC_SYSTEMTRANS = reshape([& 0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) 0.0,-1.0, 0.0, 10.26, & @@ -1978,7 +1979,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) 0.0, 0.0, 1.0, 45.0 & ],shape(FCCTOBCC_BAINROT)) - if (a_bcc > 0.0_pReal .and. a_fcc > 0.0_pReal .and. dEq0(cOverA)) then ! fcc -> bcc transformation + if (a_bcc > 0.0_pReal .and. a_fcc > 0.0_pReal .and. dEq0(cOverA)) then ! fcc -> bcc do i = 1,sum(Ntrans) call R%fromAxisAngle(FCCTOBCC_SYSTEMTRANS(:,i),degrees=.true.,P=1) call B%fromAxisAngle(FCCTOBCC_BAINROT(:,i), degrees=.true.,P=1) @@ -1992,7 +1993,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) Q(1:3,1:3,i) = matmul(R%asMatrix(),B%asMatrix()) S(1:3,1:3,i) = matmul(R%asMatrix(),U) - MATH_I3 enddo - elseif (cOverA > 0.0_pReal .and. dEq0(a_bcc)) then ! fcc -> hex transformation + elseif (cOverA > 0.0_pReal .and. dEq0(a_bcc)) then ! fcc -> hex ss = MATH_I3 sd = MATH_I3 ss(1,3) = sqrt(2.0_pReal)/4.0_pReal diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index 6ecf9ee7a..75f55fa7a 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -83,6 +83,9 @@ submodule(phase:plastic) dislotwin ExtendedDislocations, & !< consider split into partials for climb calculation fccTwinTransNucleation, & !< twinning and transformation models are for fcc omitDipoles !< flag controlling consideration of dipole formation + character(len=:), allocatable, dimension(:) :: & + systems_sl, & + systems_tw end type !< container type for internal constitutive parameters type :: tDislotwinState @@ -193,6 +196,7 @@ module function plastic_dislotwin_init() result(myPlasticity) N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(N_sl)) slipActive: if (prm%sum_N_sl > 0) then + prm%systems_sl = lattice_labels_slip(N_sl,phase_lattice(ph)) prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph)) prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dFloat('h_sl-sl'),phase_lattice(ph)) prm%forestProjection = lattice_forestProjection_edge(N_sl,phase_lattice(ph),phase_cOverA(ph)) @@ -261,6 +265,7 @@ module function plastic_dislotwin_init() result(myPlasticity) N_tw = pl%get_as1dInt('N_tw', defaultVal=emptyIntArray) prm%sum_N_tw = sum(abs(N_tw)) twinActive: if (prm%sum_N_tw > 0) then + prm%systems_tw = lattice_labels_twin(N_tw,phase_lattice(ph)) prm%P_tw = lattice_SchmidMatrix_twin(N_tw,phase_lattice(ph),phase_cOverA(ph)) prm%h_tw_tw = lattice_interaction_TwinByTwin(N_tw,pl%get_as1dFloat('h_tw-tw'), & phase_lattice(ph)) @@ -794,44 +799,49 @@ module subroutine plastic_dislotwin_results(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - integer :: o + integer :: ou - associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case('rho_mob') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_mob,group,trim(prm%output(o)), & - 'mobile dislocation density','1/m²') - case('rho_dip') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_dip,group,trim(prm%output(o)), & - 'dislocation dipole density','1/m²') - case('gamma_sl') - if(prm%sum_N_sl>0) call results_writeDataset(stt%gamma_sl,group,trim(prm%output(o)), & - 'plastic shear','1') - case('Lambda_sl') - if(prm%sum_N_sl>0) call results_writeDataset(dst%Lambda_sl,group,trim(prm%output(o)), & - 'mean free path for slip','m') - case('tau_pass') - if(prm%sum_N_sl>0) call results_writeDataset(dst%tau_pass,group,trim(prm%output(o)), & - 'passing stress for slip','Pa') + associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) - case('f_tw') - if(prm%sum_N_tw>0) call results_writeDataset(stt%f_tw,group,trim(prm%output(o)), & - 'twinned volume fraction','m³/m³') - case('Lambda_tw') - if(prm%sum_N_tw>0) call results_writeDataset(dst%Lambda_tw,group,trim(prm%output(o)), & - 'mean free path for twinning','m') - case('tau_hat_tw') - if(prm%sum_N_tw>0) call results_writeDataset(dst%tau_hat_tw,group,trim(prm%output(o)), & - 'threshold stress for twinning','Pa') + do ou = 1,size(prm%output) - case('f_tr') - if(prm%sum_N_tr>0) call results_writeDataset(stt%f_tr,group,trim(prm%output(o)), & - 'martensite volume fraction','m³/m³') + select case(trim(prm%output(ou))) + + case('rho_mob') + call results_writePhaseState(stt%rho_mob,group,trim(prm%output(ou)),prm%systems_sl, & + 'mobile dislocation density','1/m²') + case('rho_dip') + call results_writePhaseState(stt%rho_dip,group,trim(prm%output(ou)),prm%systems_sl, & + 'dislocation dipole density','1/m²') + case('gamma_sl') + call results_writePhaseState(stt%gamma_sl,group,trim(prm%output(ou)),prm%systems_sl, & + 'plastic shear','1') + case('Lambda_sl') + call results_writePhaseState(dst%Lambda_sl,group,trim(prm%output(ou)),prm%systems_sl, & + 'mean free path for slip','m') + case('tau_pass') + call results_writePhaseState(dst%tau_pass,group,trim(prm%output(ou)),prm%systems_sl, & + 'passing stress for slip','Pa') + + case('f_tw') + call results_writePhaseState(stt%f_tw,group,trim(prm%output(ou)),prm%systems_tw, & + 'twinned volume fraction','m³/m³') + case('Lambda_tw') + call results_writePhaseState(dst%Lambda_tw,group,trim(prm%output(ou)),prm%systems_tw, & + 'mean free path for twinning','m') + case('tau_hat_tw') + call results_writePhaseState(dst%tau_hat_tw,group,trim(prm%output(ou)),prm%systems_tw, & + 'threshold stress for twinning','Pa') + + case('f_tr') + if(prm%sum_N_tr>0) call results_writeDataset(stt%f_tr,group,trim(prm%output(ou)), & + 'martensite volume fraction','m³/m³') + + end select + + enddo - end select - enddo outputsLoop end associate end subroutine plastic_dislotwin_results From b5dade2f705492755cd7694948cf700ffae54d0d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 26 Jul 2021 20:38:43 +0200 Subject: [PATCH 08/13] Report slip system definition to result file --- ...phase_mechanical_plastic_dislotungsten.f90 | 59 +++++++------ src/phase_mechanical_plastic_nonlocal.f90 | 86 ++++++++++--------- 2 files changed, 81 insertions(+), 64 deletions(-) diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 index 4f86b23b1..fc2be33a3 100644 --- a/src/phase_mechanical_plastic_dislotungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -44,20 +44,22 @@ submodule(phase:plastic) dislotungsten output logical :: & dipoleFormation !< flag indicating consideration of dipole formation - end type !< container type for internal constitutive parameters + character(len=:), allocatable, dimension(:) :: & + systems_sl + end type tParameters !< container type for internal constitutive parameters - type :: tDisloTungstenState + type :: tDislotungstenState real(pReal), dimension(:,:), pointer :: & rho_mob, & rho_dip, & gamma_sl - end type tDisloTungstenState + end type tDislotungstenState - type :: tDisloTungstendependentState + type :: tDislotungstendependentState real(pReal), dimension(:,:), allocatable :: & Lambda_sl, & tau_pass - end type tDisloTungstendependentState + end type tDislotungstendependentState !-------------------------------------------------------------------------------------------------- ! containers for parameters and state @@ -136,6 +138,7 @@ module function plastic_dislotungsten_init() result(myPlasticity) N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(N_sl)) slipActive: if (prm%sum_N_sl > 0) then + prm%systems_sl = lattice_labels_slip(N_sl,phase_lattice(ph)) prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph)) if (phase_lattice(ph) == 'cI') then @@ -394,28 +397,34 @@ module subroutine plastic_dislotungsten_results(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - integer :: o + integer :: ou + associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case('rho_mob') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_mob,group,trim(prm%output(o)), & - 'mobile dislocation density','1/m²') - case('rho_dip') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_dip,group,trim(prm%output(o)), & - 'dislocation dipole density','1/m²') - case('gamma_sl') - if(prm%sum_N_sl>0) call results_writeDataset(stt%gamma_sl,group,trim(prm%output(o)), & - 'plastic shear','1') - case('Lambda_sl') - if(prm%sum_N_sl>0) call results_writeDataset(dst%Lambda_sl,group,trim(prm%output(o)), & - 'mean free path for slip','m') - case('tau_pass') - if(prm%sum_N_sl>0) call results_writeDataset(dst%tau_pass,group,trim(prm%output(o)), & - 'threshold stress for slip','Pa') - end select - enddo outputsLoop + + outputsLoop: do ou = 1,size(prm%output) + + select case(trim(prm%output(ou))) + + case('rho_mob') + call results_writePhaseState(stt%rho_mob,group,trim(prm%output(ou)),prm%systems_sl, & + 'mobile dislocation density','1/m²') + case('rho_dip') + call results_writePhaseState(stt%rho_dip,group,trim(prm%output(ou)),prm%systems_sl, & + 'dislocation dipole density','1/m²') + case('gamma_sl') + call results_writePhaseState(stt%gamma_sl,group,trim(prm%output(ou)),prm%systems_sl, & + 'plastic shear','1') + case('Lambda_sl') + call results_writePhaseState(dst%Lambda_sl,group,trim(prm%output(ou)),prm%systems_sl, & + 'mean free path for slip','m') + case('tau_pass') + call results_writePhaseState(dst%tau_pass,group,trim(prm%output(ou)),prm%systems_sl, & + 'threshold stress for slip','Pa') + end select + + enddo outputsLoop + end associate end subroutine plastic_dislotungsten_results diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index f7941c7e5..704aae616 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -120,6 +120,8 @@ submodule(phase:plastic) nonlocal logical :: & shortRangeStressCorrection, & !< use of short range stress correction by excess density gradient term nonSchmidActive = .false. + character(len=:), allocatable, dimension(:) :: & + systems_sl end type tParameters type :: tNonlocalMicrostructure @@ -246,6 +248,7 @@ module function plastic_nonlocal_init() result(myPlasticity) ini%N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(ini%N_sl)) slipActive: if (prm%sum_N_sl > 0) then + prm%systems_sl = lattice_labels_slip(ini%N_sl,phase_lattice(ph)) prm%P_sl = lattice_SchmidMatrix_slip(ini%N_sl,phase_lattice(ph), phase_cOverA(ph)) if (phase_lattice(ph) == 'cI') then @@ -1458,71 +1461,76 @@ end subroutine plastic_nonlocal_updateCompatibility !-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file +!> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- module subroutine plastic_nonlocal_results(ph,group) integer, intent(in) :: ph character(len=*),intent(in) :: group - integer :: o + integer :: ou associate(prm => param(ph),dst => microstructure(ph),stt=>state(ph)) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) + + do ou = 1,size(prm%output) + + select case(trim(prm%output(ou))) + case('rho_u_ed_pos') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_sgl_mob_edg_pos,group,trim(prm%output(o)), & - 'positive mobile edge density','1/m²') + call results_writePhaseState(stt%rho_sgl_mob_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive mobile edge density','1/m²') case('rho_b_ed_pos') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_sgl_imm_edg_pos,group,trim(prm%output(o)), & - 'positive immobile edge density','1/m²') + call results_writePhaseState(stt%rho_sgl_imm_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive immobile edge density','1/m²') case('rho_u_ed_neg') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_sgl_mob_edg_neg,group,trim(prm%output(o)), & - 'negative mobile edge density','1/m²') + call results_writePhaseState(stt%rho_sgl_mob_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative mobile edge density','1/m²') case('rho_b_ed_neg') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_sgl_imm_edg_neg,group,trim(prm%output(o)), & - 'negative immobile edge density','1/m²') + call results_writePhaseState(stt%rho_sgl_imm_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative immobile edge density','1/m²') case('rho_d_ed') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_dip_edg,group,trim(prm%output(o)), & - 'edge dipole density','1/m²') + call results_writePhaseState(stt%rho_dip_edg,group,trim(prm%output(ou)), prm%systems_sl, & + 'edge dipole density','1/m²') case('rho_u_sc_pos') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_sgl_mob_scr_pos,group,trim(prm%output(o)), & - 'positive mobile screw density','1/m²') + call results_writePhaseState(stt%rho_sgl_mob_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive mobile screw density','1/m²') case('rho_b_sc_pos') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_sgl_imm_scr_pos,group,trim(prm%output(o)), & - 'positive immobile screw density','1/m²') + call results_writePhaseState(stt%rho_sgl_imm_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive immobile screw density','1/m²') case('rho_u_sc_neg') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_sgl_mob_scr_neg,group,trim(prm%output(o)), & - 'negative mobile screw density','1/m²') + call results_writePhaseState(stt%rho_sgl_mob_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative mobile screw density','1/m²') case('rho_b_sc_neg') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_sgl_imm_scr_neg,group,trim(prm%output(o)), & - 'negative immobile screw density','1/m²') + call results_writePhaseState(stt%rho_sgl_imm_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative immobile screw density','1/m²') case('rho_d_sc') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_dip_scr,group,trim(prm%output(o)), & - 'screw dipole density','1/m²') + call results_writePhaseState(stt%rho_dip_scr,group,trim(prm%output(ou)), prm%systems_sl, & + 'screw dipole density','1/m²') case('rho_f') - if(prm%sum_N_sl>0) call results_writeDataset(stt%rho_forest,group,trim(prm%output(o)), & - 'forest density','1/m²') + call results_writePhaseState(stt%rho_forest,group,trim(prm%output(ou)), prm%systems_sl, & + 'forest density','1/m²') case('v_ed_pos') - if(prm%sum_N_sl>0) call results_writeDataset(stt%v_edg_pos,group,trim(prm%output(o)), & - 'positive edge velocity','m/s') + call results_writePhaseState(stt%v_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive edge velocity','m/s') case('v_ed_neg') - if(prm%sum_N_sl>0) call results_writeDataset(stt%v_edg_neg,group,trim(prm%output(o)), & - 'negative edge velocity','m/s') + call results_writePhaseState(stt%v_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative edge velocity','m/s') case('v_sc_pos') - if(prm%sum_N_sl>0) call results_writeDataset(stt%v_scr_pos,group,trim(prm%output(o)), & - 'positive srew velocity','m/s') + call results_writePhaseState(stt%v_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive srew velocity','m/s') case('v_sc_neg') - if(prm%sum_N_sl>0) call results_writeDataset(stt%v_scr_neg,group,trim(prm%output(o)), & - 'negative screw velocity','m/s') + call results_writePhaseState(stt%v_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative screw velocity','m/s') case('gamma') - if(prm%sum_N_sl>0) call results_writeDataset(stt%gamma,group,trim(prm%output(o)), & - 'plastic shear','1') + call results_writePhaseState(stt%gamma,group,trim(prm%output(ou)), prm%systems_sl, & + 'plastic shear','1') case('tau_pass') - if(prm%sum_N_sl>0) call results_writeDataset(dst%tau_pass,group,trim(prm%output(o)), & - 'passing stress for slip','Pa') + call results_writePhaseState(dst%tau_pass,group,trim(prm%output(ou)), prm%systems_sl, & + 'passing stress for slip','Pa') end select - enddo outputsLoop + + enddo + end associate end subroutine plastic_nonlocal_results From 558a6431205019832db9685aae8b776e40e61c77 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 26 Jul 2021 22:56:40 +0200 Subject: [PATCH 09/13] microstructure is now dependentState --- ...phase_mechanical_plastic_dislotungsten.f90 | 6 ++--- src/phase_mechanical_plastic_dislotwin.f90 | 6 ++--- src/phase_mechanical_plastic_nonlocal.f90 | 22 +++++++++---------- 3 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 index fc2be33a3..94d9c52e7 100644 --- a/src/phase_mechanical_plastic_dislotungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -55,11 +55,11 @@ submodule(phase:plastic) dislotungsten gamma_sl end type tDislotungstenState - type :: tDislotungstendependentState + type :: tDislotungstenDependentState real(pReal), dimension(:,:), allocatable :: & Lambda_sl, & tau_pass - end type tDislotungstendependentState + end type tDislotungstenDependentState !-------------------------------------------------------------------------------------------------- ! containers for parameters and state @@ -67,7 +67,7 @@ submodule(phase:plastic) dislotungsten type(tDisloTungstenState), allocatable, dimension(:) :: & dotState, & state - type(tDisloTungstendependentState), allocatable, dimension(:) :: dependentState + type(tDisloTungstenDependentState), allocatable, dimension(:) :: dependentState contains diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index e6de63cc7..8aae77144 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -96,7 +96,7 @@ submodule(phase:plastic) dislotwin f_tr end type tDislotwinState - type :: tDislotwinMicrostructure + type :: tDislotwinDependentState real(pReal), dimension(:,:), allocatable :: & Lambda_sl, & !< mean free path between 2 obstacles seen by a moving dislocation Lambda_tw, & !< mean free path between 2 obstacles seen by a growing twin @@ -108,7 +108,7 @@ submodule(phase:plastic) dislotwin V_tr, & !< volume of a new martensite disc tau_r_tw, & !< stress to bring partials close together (twin) tau_r_tr !< stress to bring partials close together (trans) - end type tDislotwinMicrostructure + end type tDislotwinDependentState !-------------------------------------------------------------------------------------------------- ! containers for parameters and state @@ -116,7 +116,7 @@ submodule(phase:plastic) dislotwin type(tDislotwinState), allocatable, dimension(:) :: & dotState, & state - type(tDislotwinMicrostructure), allocatable, dimension(:) :: dependentState + type(tDislotwinDependentState), allocatable, dimension(:) :: dependentState contains diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index 704aae616..863d115a4 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -124,11 +124,11 @@ submodule(phase:plastic) nonlocal systems_sl end type tParameters - type :: tNonlocalMicrostructure + type :: tNonlocalDependentState real(pReal), allocatable, dimension(:,:) :: & tau_pass, & tau_Back - end type tNonlocalMicrostructure + end type tNonlocalDependentState type :: tNonlocalState real(pReal), pointer, dimension(:,:) :: & @@ -164,7 +164,7 @@ submodule(phase:plastic) nonlocal type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters - type(tNonlocalMicrostructure), dimension(:), allocatable :: microstructure + type(tNonlocalDependentState), dimension(:), allocatable :: dependentState contains @@ -221,13 +221,13 @@ module function plastic_nonlocal_init() result(myPlasticity) allocate(state0(phases%length)) allocate(dotState(phases%length)) allocate(deltaState(phases%length)) - allocate(microstructure(phases%length)) + allocate(dependentState(phases%length)) do ph = 1, phases%length if(.not. myPlasticity(ph)) cycle associate(prm => param(ph), dot => dotState(ph), stt => state(ph), & - st0 => state0(ph), del => deltaState(ph), dst => microstructure(ph)) + st0 => state0(ph), del => deltaState(ph), dst => dependentState(ph)) phase => phases%get(ph) mech => phase%get('mechanical') @@ -607,7 +607,7 @@ module subroutine nonlocal_dependentState(ph, en, ip, el) real(pReal), dimension(3,param(ph)%sum_N_sl,2) :: & m ! direction of dislocation motion - associate(prm => param(ph),dst => microstructure(ph), stt => state(ph)) + associate(prm => param(ph),dst => dependentState(ph), stt => state(ph)) rho = getRho(ph,en) @@ -774,7 +774,7 @@ module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, & tau, & !< resolved shear stress including backstress terms dot_gamma !< shear rate - associate(prm => param(ph),dst=>microstructure(ph),stt=>state(ph)) + associate(prm => param(ph),dst=>dependentState(ph),stt=>state(ph)) !*** shortcut to state variables rho = getRho(ph,en) @@ -870,7 +870,7 @@ module subroutine plastic_nonlocal_deltaState(Mp,ph,en) dUpperOld, & ! old maximum stable dipole distance for edges and screws deltaDUpper ! change in maximum stable dipole distance for edges and screws - associate(prm => param(ph),dst => microstructure(ph),del => deltaState(ph)) + associate(prm => param(ph),dst => dependentState(ph),del => deltaState(ph)) !*** shortcut to state variables forall (s = 1:prm%sum_N_sl, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,ph),en) @@ -982,7 +982,7 @@ module subroutine nonlocal_dotState(Mp, Temperature,timestep, & return endif - associate(prm => param(ph), dst => microstructure(ph), dot => dotState(ph), stt => state(ph)) + associate(prm => param(ph), dst => dependentState(ph), dot => dotState(ph), stt => state(ph)) tau = 0.0_pReal dot_gamma = 0.0_pReal @@ -1179,7 +1179,7 @@ function rhoDotFlux(timestep,ph,en,ip,el) associate(prm => param(ph), & - dst => microstructure(ph), & + dst => dependentState(ph), & dot => dotState(ph), & stt => state(ph)) ns = prm%sum_N_sl @@ -1470,7 +1470,7 @@ module subroutine plastic_nonlocal_results(ph,group) integer :: ou - associate(prm => param(ph),dst => microstructure(ph),stt=>state(ph)) + associate(prm => param(ph),dst => dependentState(ph),stt=>state(ph)) do ou = 1,size(prm%output) From a891fe4281c6302b93c8ba6a09adafe721777470 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 26 Jul 2021 22:59:53 +0200 Subject: [PATCH 10/13] keep it simple --- src/HDF5_utilities.f90 | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 82ec78811..e13e67f73 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -308,7 +308,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel, attrValue character(len=*), intent(in), optional :: path - integer(HID_T) :: attr_id, space_id, type_id + integer(HID_T) :: attr_id, space_id logical :: attrExists integer :: hdferr character(len=:), allocatable :: p @@ -327,8 +327,6 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) call h5screate_f(H5S_SCALAR_F,space_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tcopy_f(H5T_STRING, type_id, hdferr) - if(hdferr < 0) error stop 'HDF5 error' call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) if(hdferr < 0) error stop 'HDF5 error' @@ -337,15 +335,13 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) if(hdferr < 0) error stop 'HDF5 error' endif - call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5awrite_f(attr_id, type_id, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort + call h5awrite_f(attr_id, H5T_STRING, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(type_id,hdferr) - if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(space_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' @@ -452,7 +448,7 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) character(len=*), intent(in), dimension(:) :: attrValue character(len=*), intent(in), optional :: path - integer(HID_T) :: attr_id, space_id, type_id + integer(HID_T) :: attr_id, space_id logical :: attrExists integer :: hdferr,i character(len=:), allocatable :: p @@ -473,8 +469,6 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) call h5screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id,hdferr,shape(attrValue_,kind=HSIZE_T)) if(hdferr < 0) error stop 'HDF5 error' - call h5tcopy_f(H5T_STRING, type_id, hdferr) - if(hdferr < 0) error stop 'HDF5 error' call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) if(hdferr < 0) error stop 'HDF5 error' @@ -483,15 +477,13 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path) if(hdferr < 0) error stop 'HDF5 error' endif - call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5awrite_f(attr_id, type_id, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort + call h5awrite_f(attr_id, H5T_STRING, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(type_id,hdferr) - if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(space_id,hdferr) if(hdferr < 0) error stop 'HDF5 error' From 07fb7f8fdfa8e5ea19ecb733ec814f63335a24cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 27 Jul 2021 15:05:27 +0200 Subject: [PATCH 11/13] save information on slip systems for reproducibility --- ...phase_mechanical_plastic_dislotungsten.f90 | 4 +- ...phase_mechanical_plastic_kinehardening.f90 | 56 +++++---- src/phase_mechanical_plastic_nonlocal.f90 | 108 +++++++++--------- src/results.f90 | 34 +++++- 4 files changed, 119 insertions(+), 83 deletions(-) diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 index 94d9c52e7..b58274a74 100644 --- a/src/phase_mechanical_plastic_dislotungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -402,7 +402,7 @@ module subroutine plastic_dislotungsten_results(ph,group) associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) - outputsLoop: do ou = 1,size(prm%output) + do ou = 1,size(prm%output) select case(trim(prm%output(ou))) @@ -423,7 +423,7 @@ module subroutine plastic_dislotungsten_results(ph,group) 'threshold stress for slip','Pa') end select - enddo outputsLoop + enddo end associate diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index f1c9b0332..7c77ca3a0 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -30,6 +30,8 @@ submodule(phase:plastic) kinehardening nonSchmidActive = .false. character(len=pStringLen), allocatable, dimension(:) :: & output + character(len=:), allocatable, dimension(:) :: & + systems_sl end type tParameters type :: tKinehardeningState @@ -40,7 +42,6 @@ submodule(phase:plastic) kinehardening gamma, & !< accumulated (absolute) shear gamma_0, & !< accumulated shear at last switch of stress sense sgn_gamma !< sense of acting shear stress (-1 or +1) - end type tKinehardeningState !-------------------------------------------------------------------------------------------------- @@ -113,6 +114,7 @@ module function plastic_kinehardening_init() result(myPlasticity) N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(N_sl)) slipActive: if (prm%sum_N_sl > 0) then + prm%systems_sl = lattice_labels_slip(N_sl,phase_lattice(ph)) prm%P = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph)) if (phase_lattice(ph) == 'cI') then @@ -351,31 +353,37 @@ module subroutine plastic_kinehardening_results(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - integer :: o + integer :: ou + associate(prm => param(ph), stt => state(ph)) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case ('xi') - if(prm%sum_N_sl>0) call results_writeDataset(stt%xi,group,trim(prm%output(o)), & - 'resistance against plastic slip','Pa') - case ('chi') - if(prm%sum_N_sl>0) call results_writeDataset(stt%chi,group,trim(prm%output(o)), & - 'back stress','Pa') - case ('sgn(gamma)') - if(prm%sum_N_sl>0) call results_writeDataset(int(stt%sgn_gamma),group,trim(prm%output(o)), & - 'sense of shear','1') - case ('chi_0') - if(prm%sum_N_sl>0) call results_writeDataset(stt%chi_0,group,trim(prm%output(o)), & - 'back stress at last switch of stress sense','Pa') - case ('gamma_0') - if(prm%sum_N_sl>0) call results_writeDataset(stt%gamma_0,group,trim(prm%output(o)), & - 'plastic shear at last switch of stress sense','1') - case ('gamma') - if(prm%sum_N_sl>0) call results_writeDataset(stt%gamma,group,trim(prm%output(o)), & - 'plastic shear','1') - end select - enddo outputsLoop + + do ou = 1,size(prm%output) + + select case(trim(prm%output(ou))) + + case ('xi') + call results_writePhaseState(stt%xi,group,trim(prm%output(ou)),prm%systems_sl, & + 'resistance against plastic slip','Pa') + case ('chi') + call results_writePhaseState(stt%chi,group,trim(prm%output(ou)),prm%systems_sl, & + 'back stress','Pa') + case ('sgn(gamma)') + call results_writePhaseState(int(stt%sgn_gamma),group,trim(prm%output(ou)),prm%systems_sl, & + 'sense of shear','1') + case ('chi_0') + call results_writePhaseState(stt%chi_0,group,trim(prm%output(ou)),prm%systems_sl, & + 'back stress at last switch of stress sense','Pa') + case ('gamma_0') + call results_writePhaseState(stt%gamma_0,group,trim(prm%output(ou)),prm%systems_sl, & + 'plastic shear at last switch of stress sense','1') + case ('gamma') + call results_writePhaseState(stt%gamma,group,trim(prm%output(ou)),prm%systems_sl, & + 'plastic shear','1') + end select + + enddo + end associate end subroutine plastic_kinehardening_results diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index 863d115a4..47cb1a0d8 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -1474,62 +1474,62 @@ module subroutine plastic_nonlocal_results(ph,group) do ou = 1,size(prm%output) - select case(trim(prm%output(ou))) + select case(trim(prm%output(ou))) - case('rho_u_ed_pos') - call results_writePhaseState(stt%rho_sgl_mob_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive mobile edge density','1/m²') - case('rho_b_ed_pos') - call results_writePhaseState(stt%rho_sgl_imm_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive immobile edge density','1/m²') - case('rho_u_ed_neg') - call results_writePhaseState(stt%rho_sgl_mob_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative mobile edge density','1/m²') - case('rho_b_ed_neg') - call results_writePhaseState(stt%rho_sgl_imm_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative immobile edge density','1/m²') - case('rho_d_ed') - call results_writePhaseState(stt%rho_dip_edg,group,trim(prm%output(ou)), prm%systems_sl, & - 'edge dipole density','1/m²') - case('rho_u_sc_pos') - call results_writePhaseState(stt%rho_sgl_mob_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive mobile screw density','1/m²') - case('rho_b_sc_pos') - call results_writePhaseState(stt%rho_sgl_imm_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive immobile screw density','1/m²') - case('rho_u_sc_neg') - call results_writePhaseState(stt%rho_sgl_mob_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative mobile screw density','1/m²') - case('rho_b_sc_neg') - call results_writePhaseState(stt%rho_sgl_imm_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative immobile screw density','1/m²') - case('rho_d_sc') - call results_writePhaseState(stt%rho_dip_scr,group,trim(prm%output(ou)), prm%systems_sl, & - 'screw dipole density','1/m²') - case('rho_f') - call results_writePhaseState(stt%rho_forest,group,trim(prm%output(ou)), prm%systems_sl, & - 'forest density','1/m²') - case('v_ed_pos') - call results_writePhaseState(stt%v_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive edge velocity','m/s') - case('v_ed_neg') - call results_writePhaseState(stt%v_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative edge velocity','m/s') - case('v_sc_pos') - call results_writePhaseState(stt%v_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive srew velocity','m/s') - case('v_sc_neg') - call results_writePhaseState(stt%v_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative screw velocity','m/s') - case('gamma') - call results_writePhaseState(stt%gamma,group,trim(prm%output(ou)), prm%systems_sl, & - 'plastic shear','1') - case('tau_pass') - call results_writePhaseState(dst%tau_pass,group,trim(prm%output(ou)), prm%systems_sl, & - 'passing stress for slip','Pa') - end select + case('rho_u_ed_pos') + call results_writePhaseState(stt%rho_sgl_mob_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive mobile edge density','1/m²') + case('rho_b_ed_pos') + call results_writePhaseState(stt%rho_sgl_imm_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive immobile edge density','1/m²') + case('rho_u_ed_neg') + call results_writePhaseState(stt%rho_sgl_mob_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative mobile edge density','1/m²') + case('rho_b_ed_neg') + call results_writePhaseState(stt%rho_sgl_imm_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative immobile edge density','1/m²') + case('rho_d_ed') + call results_writePhaseState(stt%rho_dip_edg,group,trim(prm%output(ou)), prm%systems_sl, & + 'edge dipole density','1/m²') + case('rho_u_sc_pos') + call results_writePhaseState(stt%rho_sgl_mob_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive mobile screw density','1/m²') + case('rho_b_sc_pos') + call results_writePhaseState(stt%rho_sgl_imm_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive immobile screw density','1/m²') + case('rho_u_sc_neg') + call results_writePhaseState(stt%rho_sgl_mob_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative mobile screw density','1/m²') + case('rho_b_sc_neg') + call results_writePhaseState(stt%rho_sgl_imm_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative immobile screw density','1/m²') + case('rho_d_sc') + call results_writePhaseState(stt%rho_dip_scr,group,trim(prm%output(ou)), prm%systems_sl, & + 'screw dipole density','1/m²') + case('rho_f') + call results_writePhaseState(stt%rho_forest,group,trim(prm%output(ou)), prm%systems_sl, & + 'forest density','1/m²') + case('v_ed_pos') + call results_writePhaseState(stt%v_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive edge velocity','m/s') + case('v_ed_neg') + call results_writePhaseState(stt%v_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative edge velocity','m/s') + case('v_sc_pos') + call results_writePhaseState(stt%v_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & + 'positive srew velocity','m/s') + case('v_sc_neg') + call results_writePhaseState(stt%v_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & + 'negative screw velocity','m/s') + case('gamma') + call results_writePhaseState(stt%gamma,group,trim(prm%output(ou)), prm%systems_sl, & + 'plastic shear','1') + case('tau_pass') + call results_writePhaseState(dst%tau_pass,group,trim(prm%output(ou)), prm%systems_sl, & + 'passing stress for slip','Pa') + end select - enddo + enddo end associate diff --git a/src/results.f90 b/src/results.f90 index 79745a2f3..970175712 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -33,6 +33,11 @@ module results module procedure results_writeVectorDataset_int end interface results_writeDataset + interface results_writePhaseState + module procedure results_writePhaseState_real + module procedure results_writePhaseState_int + end interface results_writePhaseState + interface results_addAttribute module procedure results_addAttribute_str module procedure results_addAttribute_int @@ -361,7 +366,7 @@ end subroutine results_writeVectorDataset_real !-------------------------------------------------------------------------------------------------- !> @brief Store real vector dataset with associated metadata for slip !-------------------------------------------------------------------------------------------------- -subroutine results_writePhaseState(dataset,group,label,systems,description,SIunit) +subroutine results_writePhaseState_real(dataset,group,label,systems,description,SIunit) character(len=*), intent(in) :: label,group,description,SIunit real(pReal), intent(in), dimension(:,:) :: dataset @@ -370,7 +375,7 @@ subroutine results_writePhaseState(dataset,group,label,systems,description,SIuni integer(HID_T) :: groupHandle - if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe use for other results_write (not sure about scalar) + if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe also implement for other results_write (not sure about scalar) groupHandle = results_openGroup(group) call HDF5_write(dataset,groupHandle,label) @@ -378,7 +383,30 @@ subroutine results_writePhaseState(dataset,group,label,systems,description,SIuni call HDF5_addAttribute(resultsFile,'systems',systems,group//'/'//label) call HDF5_closeGroup(groupHandle) -end subroutine results_writePhaseState +end subroutine results_writePhaseState_real + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store real vector dataset with associated metadata for slip +!-------------------------------------------------------------------------------------------------- +subroutine results_writePhaseState_int(dataset,group,label,systems,description,SIunit) + + character(len=*), intent(in) :: label,group,description,SIunit + integer, intent(in), dimension(:,:) :: dataset + character(len=*), intent(in), dimension(:) :: systems + + integer(HID_T) :: groupHandle + + + if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe also implement for other results_write (not sure about scalar) + + groupHandle = results_openGroup(group) + call HDF5_write(dataset,groupHandle,label) + call executionStamp(group//'/'//label,description,SIunit) + call HDF5_addAttribute(resultsFile,'systems',systems,group//'/'//label) + call HDF5_closeGroup(groupHandle) + +end subroutine results_writePhaseState_int !-------------------------------------------------------------------------------------------------- From 83183408eabb64ac584079d8813bf78230899d57 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 30 Jul 2021 20:09:47 +0200 Subject: [PATCH 12/13] can only decode strings, not arrays of strings --- python/damask/_result.py | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/python/damask/_result.py b/python/damask/_result.py index 1fa376f63..88e555b27 100644 --- a/python/damask/_result.py +++ b/python/damask/_result.py @@ -1311,7 +1311,8 @@ class Result: loc = f[group+'/'+label] datasets_in[arg]={'data' :loc[()], 'label':label, - 'meta': {k:(v if h5py3 else v.decode()) for k,v in loc.attrs.items()}} + 'meta': {k:(v.decode() if not h5py3 and type(v) is bytes else v) \ + for k,v in loc.attrs.items()}} lock.release() r = func(**datasets_in,**args) return [group,r] @@ -1379,7 +1380,7 @@ class Result: now.strftime('%Y-%m-%d %H:%M:%S%z').encode() for l,v in result['meta'].items(): - dataset.attrs[l.lower()]=v if h5py3 else v.encode() + dataset.attrs[l.lower()]=v.encode() if not h5py3 and type(v) is str else v creator = dataset.attrs['creator'] if h5py3 else \ dataset.attrs['creator'].decode() dataset.attrs['creator'] = f'damask.Result.{creator} v{damask.version}' if h5py3 else \ From cf66b81e3acdddb52c197d5d737cb93c7d265e88 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 7 Aug 2021 22:02:44 +0200 Subject: [PATCH 13/13] avoid code duplication --- ...phase_mechanical_plastic_dislotungsten.f90 | 20 +++--- src/phase_mechanical_plastic_dislotwin.f90 | 32 ++++----- ...phase_mechanical_plastic_kinehardening.f90 | 24 +++---- src/phase_mechanical_plastic_nonlocal.f90 | 68 +++++++++---------- ...phase_mechanical_plastic_phenopowerlaw.f90 | 16 ++--- src/results.f90 | 68 ++++--------------- 6 files changed, 94 insertions(+), 134 deletions(-) diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 index b58274a74..76dc4adeb 100644 --- a/src/phase_mechanical_plastic_dislotungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -407,20 +407,20 @@ module subroutine plastic_dislotungsten_results(ph,group) select case(trim(prm%output(ou))) case('rho_mob') - call results_writePhaseState(stt%rho_mob,group,trim(prm%output(ou)),prm%systems_sl, & - 'mobile dislocation density','1/m²') + call results_writeDataset(stt%rho_mob,group,trim(prm%output(ou)), & + 'mobile dislocation density','1/m²',prm%systems_sl) case('rho_dip') - call results_writePhaseState(stt%rho_dip,group,trim(prm%output(ou)),prm%systems_sl, & - 'dislocation dipole density','1/m²') + call results_writeDataset(stt%rho_dip,group,trim(prm%output(ou)), & + 'dislocation dipole density','1/m²',prm%systems_sl) case('gamma_sl') - call results_writePhaseState(stt%gamma_sl,group,trim(prm%output(ou)),prm%systems_sl, & - 'plastic shear','1') + call results_writeDataset(stt%gamma_sl,group,trim(prm%output(ou)), & + 'plastic shear','1',prm%systems_sl) case('Lambda_sl') - call results_writePhaseState(dst%Lambda_sl,group,trim(prm%output(ou)),prm%systems_sl, & - 'mean free path for slip','m') + call results_writeDataset(dst%Lambda_sl,group,trim(prm%output(ou)), & + 'mean free path for slip','m',prm%systems_sl) case('tau_pass') - call results_writePhaseState(dst%tau_pass,group,trim(prm%output(ou)),prm%systems_sl, & - 'threshold stress for slip','Pa') + call results_writeDataset(dst%tau_pass,group,trim(prm%output(ou)), & + 'threshold stress for slip','Pa',prm%systems_sl) end select enddo diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index 8aae77144..ac179d775 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -802,30 +802,30 @@ module subroutine plastic_dislotwin_results(ph,group) select case(trim(prm%output(ou))) case('rho_mob') - call results_writePhaseState(stt%rho_mob,group,trim(prm%output(ou)),prm%systems_sl, & - 'mobile dislocation density','1/m²') + call results_writeDataset(stt%rho_mob,group,trim(prm%output(ou)), & + 'mobile dislocation density','1/m²',prm%systems_sl) case('rho_dip') - call results_writePhaseState(stt%rho_dip,group,trim(prm%output(ou)),prm%systems_sl, & - 'dislocation dipole density','1/m²') + call results_writeDataset(stt%rho_dip,group,trim(prm%output(ou)), & + 'dislocation dipole density','1/m²',prm%systems_sl) case('gamma_sl') - call results_writePhaseState(stt%gamma_sl,group,trim(prm%output(ou)),prm%systems_sl, & - 'plastic shear','1') + call results_writeDataset(stt%gamma_sl,group,trim(prm%output(ou)), & + 'plastic shear','1',prm%systems_sl) case('Lambda_sl') - call results_writePhaseState(dst%Lambda_sl,group,trim(prm%output(ou)),prm%systems_sl, & - 'mean free path for slip','m') + call results_writeDataset(dst%Lambda_sl,group,trim(prm%output(ou)), & + 'mean free path for slip','m',prm%systems_sl) case('tau_pass') - call results_writePhaseState(dst%tau_pass,group,trim(prm%output(ou)),prm%systems_sl, & - 'passing stress for slip','Pa') + call results_writeDataset(dst%tau_pass,group,trim(prm%output(ou)), & + 'passing stress for slip','Pa',prm%systems_sl) case('f_tw') - call results_writePhaseState(stt%f_tw,group,trim(prm%output(ou)),prm%systems_tw, & - 'twinned volume fraction','m³/m³') + call results_writeDataset(stt%f_tw,group,trim(prm%output(ou)), & + 'twinned volume fraction','m³/m³',prm%systems_tw) case('Lambda_tw') - call results_writePhaseState(dst%Lambda_tw,group,trim(prm%output(ou)),prm%systems_tw, & - 'mean free path for twinning','m') + call results_writeDataset(dst%Lambda_tw,group,trim(prm%output(ou)), & + 'mean free path for twinning','m',prm%systems_tw) case('tau_hat_tw') - call results_writePhaseState(dst%tau_hat_tw,group,trim(prm%output(ou)),prm%systems_tw, & - 'threshold stress for twinning','Pa') + call results_writeDataset(dst%tau_hat_tw,group,trim(prm%output(ou)), & + 'threshold stress for twinning','Pa',prm%systems_tw) case('f_tr') if(prm%sum_N_tr>0) call results_writeDataset(stt%f_tr,group,trim(prm%output(ou)), & diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index 7c77ca3a0..276212576 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -363,23 +363,23 @@ module subroutine plastic_kinehardening_results(ph,group) select case(trim(prm%output(ou))) case ('xi') - call results_writePhaseState(stt%xi,group,trim(prm%output(ou)),prm%systems_sl, & - 'resistance against plastic slip','Pa') + call results_writeDataset(stt%xi,group,trim(prm%output(ou)), & + 'resistance against plastic slip','Pa',prm%systems_sl) case ('chi') - call results_writePhaseState(stt%chi,group,trim(prm%output(ou)),prm%systems_sl, & - 'back stress','Pa') + call results_writeDataset(stt%chi,group,trim(prm%output(ou)), & + 'back stress','Pa',prm%systems_sl) case ('sgn(gamma)') - call results_writePhaseState(int(stt%sgn_gamma),group,trim(prm%output(ou)),prm%systems_sl, & - 'sense of shear','1') + call results_writeDataset(int(stt%sgn_gamma),group,trim(prm%output(ou)), & + 'sense of shear','1',prm%systems_sl) case ('chi_0') - call results_writePhaseState(stt%chi_0,group,trim(prm%output(ou)),prm%systems_sl, & - 'back stress at last switch of stress sense','Pa') + call results_writeDataset(stt%chi_0,group,trim(prm%output(ou)), & + 'back stress at last switch of stress sense','Pa',prm%systems_sl) case ('gamma_0') - call results_writePhaseState(stt%gamma_0,group,trim(prm%output(ou)),prm%systems_sl, & - 'plastic shear at last switch of stress sense','1') + call results_writeDataset(stt%gamma_0,group,trim(prm%output(ou)), & + 'plastic shear at last switch of stress sense','1',prm%systems_sl) case ('gamma') - call results_writePhaseState(stt%gamma,group,trim(prm%output(ou)),prm%systems_sl, & - 'plastic shear','1') + call results_writeDataset(stt%gamma,group,trim(prm%output(ou)), & + 'plastic shear','1',prm%systems_sl) end select enddo diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index 47cb1a0d8..1d22d35c2 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -1477,56 +1477,56 @@ module subroutine plastic_nonlocal_results(ph,group) select case(trim(prm%output(ou))) case('rho_u_ed_pos') - call results_writePhaseState(stt%rho_sgl_mob_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive mobile edge density','1/m²') + call results_writeDataset(stt%rho_sgl_mob_edg_pos,group,trim(prm%output(ou)), & + 'positive mobile edge density','1/m²', prm%systems_sl) case('rho_b_ed_pos') - call results_writePhaseState(stt%rho_sgl_imm_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive immobile edge density','1/m²') + call results_writeDataset(stt%rho_sgl_imm_edg_pos,group,trim(prm%output(ou)), & + 'positive immobile edge density','1/m²', prm%systems_sl) case('rho_u_ed_neg') - call results_writePhaseState(stt%rho_sgl_mob_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative mobile edge density','1/m²') + call results_writeDataset(stt%rho_sgl_mob_edg_neg,group,trim(prm%output(ou)), & + 'negative mobile edge density','1/m²', prm%systems_sl) case('rho_b_ed_neg') - call results_writePhaseState(stt%rho_sgl_imm_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative immobile edge density','1/m²') + call results_writeDataset(stt%rho_sgl_imm_edg_neg,group,trim(prm%output(ou)), & + 'negative immobile edge density','1/m²', prm%systems_sl) case('rho_d_ed') - call results_writePhaseState(stt%rho_dip_edg,group,trim(prm%output(ou)), prm%systems_sl, & - 'edge dipole density','1/m²') + call results_writeDataset(stt%rho_dip_edg,group,trim(prm%output(ou)), & + 'edge dipole density','1/m²', prm%systems_sl) case('rho_u_sc_pos') - call results_writePhaseState(stt%rho_sgl_mob_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive mobile screw density','1/m²') + call results_writeDataset(stt%rho_sgl_mob_scr_pos,group,trim(prm%output(ou)), & + 'positive mobile screw density','1/m²', prm%systems_sl) case('rho_b_sc_pos') - call results_writePhaseState(stt%rho_sgl_imm_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive immobile screw density','1/m²') + call results_writeDataset(stt%rho_sgl_imm_scr_pos,group,trim(prm%output(ou)), & + 'positive immobile screw density','1/m²', prm%systems_sl) case('rho_u_sc_neg') - call results_writePhaseState(stt%rho_sgl_mob_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative mobile screw density','1/m²') + call results_writeDataset(stt%rho_sgl_mob_scr_neg,group,trim(prm%output(ou)), & + 'negative mobile screw density','1/m²', prm%systems_sl) case('rho_b_sc_neg') - call results_writePhaseState(stt%rho_sgl_imm_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative immobile screw density','1/m²') + call results_writeDataset(stt%rho_sgl_imm_scr_neg,group,trim(prm%output(ou)), & + 'negative immobile screw density','1/m²', prm%systems_sl) case('rho_d_sc') - call results_writePhaseState(stt%rho_dip_scr,group,trim(prm%output(ou)), prm%systems_sl, & - 'screw dipole density','1/m²') + call results_writeDataset(stt%rho_dip_scr,group,trim(prm%output(ou)), & + 'screw dipole density','1/m²', prm%systems_sl) case('rho_f') - call results_writePhaseState(stt%rho_forest,group,trim(prm%output(ou)), prm%systems_sl, & - 'forest density','1/m²') + call results_writeDataset(stt%rho_forest,group,trim(prm%output(ou)), & + 'forest density','1/m²', prm%systems_sl) case('v_ed_pos') - call results_writePhaseState(stt%v_edg_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive edge velocity','m/s') + call results_writeDataset(stt%v_edg_pos,group,trim(prm%output(ou)), & + 'positive edge velocity','m/s', prm%systems_sl) case('v_ed_neg') - call results_writePhaseState(stt%v_edg_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative edge velocity','m/s') + call results_writeDataset(stt%v_edg_neg,group,trim(prm%output(ou)), & + 'negative edge velocity','m/s', prm%systems_sl) case('v_sc_pos') - call results_writePhaseState(stt%v_scr_pos,group,trim(prm%output(ou)), prm%systems_sl, & - 'positive srew velocity','m/s') + call results_writeDataset(stt%v_scr_pos,group,trim(prm%output(ou)), & + 'positive srew velocity','m/s', prm%systems_sl) case('v_sc_neg') - call results_writePhaseState(stt%v_scr_neg,group,trim(prm%output(ou)), prm%systems_sl, & - 'negative screw velocity','m/s') + call results_writeDataset(stt%v_scr_neg,group,trim(prm%output(ou)), & + 'negative screw velocity','m/s', prm%systems_sl) case('gamma') - call results_writePhaseState(stt%gamma,group,trim(prm%output(ou)), prm%systems_sl, & - 'plastic shear','1') + call results_writeDataset(stt%gamma,group,trim(prm%output(ou)), & + 'plastic shear','1', prm%systems_sl) case('tau_pass') - call results_writePhaseState(dst%tau_pass,group,trim(prm%output(ou)), prm%systems_sl, & - 'passing stress for slip','Pa') + call results_writeDataset(dst%tau_pass,group,trim(prm%output(ou)), & + 'passing stress for slip','Pa', prm%systems_sl) end select enddo diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index 4f66e5f18..51e347eb5 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -382,18 +382,18 @@ module subroutine plastic_phenopowerlaw_results(ph,group) select case(trim(prm%output(ou))) case('xi_sl') - call results_writePhaseState(stt%xi_sl,group,trim(prm%output(ou)),prm%systems_sl, & - 'resistance against plastic slip','Pa') + call results_writeDataset(stt%xi_sl,group,trim(prm%output(ou)), & + 'resistance against plastic slip','Pa',prm%systems_sl) case('gamma_sl') - call results_writePhaseState(stt%gamma_sl,group,trim(prm%output(ou)),prm%systems_sl, & - 'plastic shear','1') + call results_writeDataset(stt%gamma_sl,group,trim(prm%output(ou)), & + 'plastic shear','1',prm%systems_sl) case('xi_tw') - call results_writePhaseState(stt%xi_tw,group,trim(prm%output(ou)),prm%systems_tw, & - 'resistance against twinning','Pa') + call results_writeDataset(stt%xi_tw,group,trim(prm%output(ou)), & + 'resistance against twinning','Pa',prm%systems_tw) case('gamma_tw') - call results_writePhaseState(stt%gamma_tw,group,trim(prm%output(ou)),prm%systems_tw, & - 'twinning shear','1') + call results_writeDataset(stt%gamma_tw,group,trim(prm%output(ou)), & + 'twinning shear','1',prm%systems_tw) end select diff --git a/src/results.f90 b/src/results.f90 index ff300f37c..a5dccdaac 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -33,11 +33,6 @@ module results module procedure results_writeVectorDataset_int end interface results_writeDataset - interface results_writePhaseState - module procedure results_writePhaseState_real - module procedure results_writePhaseState_int - end interface results_writePhaseState - interface results_addAttribute module procedure results_addAttribute_str module procedure results_addAttribute_int @@ -59,7 +54,6 @@ module results results_closeGroup, & results_writeDataset, & results_writeDataset_str, & - results_writePhaseState, & results_setLink, & results_addAttribute, & results_removeLink, & @@ -385,69 +379,29 @@ end subroutine results_writeScalarDataset_real !-------------------------------------------------------------------------------------------------- !> @brief Store real vector dataset with associated metadata. !-------------------------------------------------------------------------------------------------- -subroutine results_writeVectorDataset_real(dataset,group,label,description,SIunit) +subroutine results_writeVectorDataset_real(dataset,group,label,description,SIunit,systems) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit + character(len=*), intent(in), dimension(:), optional :: systems real(pReal), intent(in), dimension(:,:) :: dataset integer(HID_T) :: groupHandle + if (present(systems)) then + if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe also implement for other results_write (not sure about scalar) + endif + groupHandle = results_openGroup(group) call HDF5_write(dataset,groupHandle,label) call executionStamp(group//'/'//label,description,SIunit) + if (present(systems)) call HDF5_addAttribute(resultsFile,'systems',systems,group//'/'//label) call HDF5_closeGroup(groupHandle) end subroutine results_writeVectorDataset_real -!-------------------------------------------------------------------------------------------------- -!> @brief Store real vector dataset with associated metadata for slip -!-------------------------------------------------------------------------------------------------- -subroutine results_writePhaseState_real(dataset,group,label,systems,description,SIunit) - - character(len=*), intent(in) :: label,group,description,SIunit - real(pReal), intent(in), dimension(:,:) :: dataset - character(len=*), intent(in), dimension(:) :: systems - - integer(HID_T) :: groupHandle - - - if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe also implement for other results_write (not sure about scalar) - - groupHandle = results_openGroup(group) - call HDF5_write(dataset,groupHandle,label) - call executionStamp(group//'/'//label,description,SIunit) - call HDF5_addAttribute(resultsFile,'systems',systems,group//'/'//label) - call HDF5_closeGroup(groupHandle) - -end subroutine results_writePhaseState_real - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store real vector dataset with associated metadata for slip -!-------------------------------------------------------------------------------------------------- -subroutine results_writePhaseState_int(dataset,group,label,systems,description,SIunit) - - character(len=*), intent(in) :: label,group,description,SIunit - integer, intent(in), dimension(:,:) :: dataset - character(len=*), intent(in), dimension(:) :: systems - - integer(HID_T) :: groupHandle - - - if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe also implement for other results_write (not sure about scalar) - - groupHandle = results_openGroup(group) - call HDF5_write(dataset,groupHandle,label) - call executionStamp(group//'/'//label,description,SIunit) - call HDF5_addAttribute(resultsFile,'systems',systems,group//'/'//label) - call HDF5_closeGroup(groupHandle) - -end subroutine results_writePhaseState_int - - !-------------------------------------------------------------------------------------------------- !> @brief Store real tensor dataset with associated metadata. !> @details Data is transposed to compenstate transposed storage order. @@ -491,18 +445,24 @@ end subroutine results_writeTensorDataset_real !-------------------------------------------------------------------------------------------------- !> @brief Store integer vector dataset with associated metadata. !-------------------------------------------------------------------------------------------------- -subroutine results_writeVectorDataset_int(dataset,group,label,description,SIunit) +subroutine results_writeVectorDataset_int(dataset,group,label,description,SIunit,systems) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit + character(len=*), intent(in), dimension(:), optional :: systems integer, intent(in), dimension(:,:) :: dataset integer(HID_T) :: groupHandle + if (present(systems)) then + if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe also implement for other results_write (not sure about scalar) + endif + groupHandle = results_openGroup(group) call HDF5_write(dataset,groupHandle,label) call executionStamp(group//'/'//label,description,SIunit) + if (present(systems)) call HDF5_addAttribute(resultsFile,'systems',systems,group//'/'//label) call HDF5_closeGroup(groupHandle) end subroutine results_writeVectorDataset_int