From 71e17ba91715654b02e5140557b0075d15a143d3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 24 Jul 2021 22:51:57 +0200 Subject: [PATCH] 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.