223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Merge branch '30_parsePhasePartOnce' into 19-NewStylePhenopowerlaw

This commit is contained in:
Martin Diehl 2018-06-02 19:33:06 +02:00
parent c7da8c7f75 142ce51c9c
commit 4ee62538d7
5 changed files with 265 additions and 275 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PRIVATE

@ -1 +1 @@
Subproject commit a11897e49af7c0e71ccc74d222a6d502990f730b Subproject commit 55a1fd701720fdd8caa53c058f651e009ab9e4aa

204
src/crystallite.f90
View File

@ -155,7 +155,6 @@ subroutine crystallite_init
math_I3, & math_I3, &
math_EulerToR, & math_EulerToR, &
math_inv33, & math_inv33, &
math_transpose33, &
math_mul33xx33, & math_mul33xx33, &
math_mul33x33 math_mul33x33
use FEsolving, only: & use FEsolving, only: &
@ -167,28 +166,18 @@ subroutine crystallite_init
mesh_maxNips, & mesh_maxNips, &
mesh_maxNipNeighbors mesh_maxNipNeighbors
use IO, only: & use IO, only: &
IO_read, &
IO_timeStamp, & IO_timeStamp, &
IO_open_jobFile_stat, &
IO_open_file, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, & IO_stringValue, &
IO_write_jobFile, & IO_write_jobFile, &
IO_error, & IO_error
IO_EOF
use material use material
use constitutive, only: & use constitutive, only: &
constitutive_initialFi, & constitutive_initialFi, &
constitutive_microstructure ! derived (shortcut) quantities of given state constitutive_microstructure ! derived (shortcut) quantities of given state
implicit none implicit none
integer(pInt), parameter :: &
FILEUNIT = 200_pInt
integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), parameter :: FILEUNIT=434_pInt
integer(pInt) :: & integer(pInt) :: &
c, & !< counter in integration point component loop c, & !< counter in integration point component loop
i, & !< counter in integration point loop i, & !< counter in integration point loop
@ -200,12 +189,11 @@ subroutine crystallite_init
eMax, & !< maximum number of elements eMax, & !< maximum number of elements
nMax, & !< maximum number of ip neighbors nMax, & !< maximum number of ip neighbors
myNcomponents, & !< number of components at current IP myNcomponents, & !< number of components at current IP
section = 0_pInt, &
mySize mySize
character(len=64), dimension(:), allocatable :: str
character(len=65536) :: & character(len=65536) :: &
tag = '', & tag = ''
line= ''
write(6,'(/,a)') ' <<<+- crystallite init -+>>>' write(6,'(/,a)') ' <<<+- crystallite init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -277,85 +265,61 @@ subroutine crystallite_init
allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), &
material_Ncrystallite), source=0_pInt) material_Ncrystallite), source=0_pInt)
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partCrystallite) ! wind forward to <crystallite> do c = 1_pInt, material_Ncrystallite
line = IO_read(FILEUNIT) str = crystalliteConfig(c)%getStrings('(output)')!,defaultVal=[])
enddo do o = 1_pInt, size(str)
outputName: select case(str(o))
do while (trim(line) /= IO_EOF) ! read through sections of crystallite part
line = IO_read(FILEUNIT)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(FILEUNIT, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt
o = 0_pInt ! reset output counter
cycle ! skip to next line
endif
if (section > 0_pInt) then
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
o = o + 1_pInt
crystallite_output(o,section) = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
outputName: select case(crystallite_output(o,section))
case ('phase') outputName case ('phase') outputName
crystallite_outputID(o,section) = phase_ID crystallite_outputID(o,c) = phase_ID
case ('texture') outputName case ('texture') outputName
crystallite_outputID(o,section) = texture_ID crystallite_outputID(o,c) = texture_ID
case ('volume') outputName case ('volume') outputName
crystallite_outputID(o,section) = volume_ID crystallite_outputID(o,c) = volume_ID
case ('grainrotationx') outputName case ('grainrotationx') outputName
crystallite_outputID(o,section) = grainrotationx_ID crystallite_outputID(o,c) = grainrotationx_ID
case ('grainrotationy') outputName case ('grainrotationy') outputName
crystallite_outputID(o,section) = grainrotationy_ID crystallite_outputID(o,c) = grainrotationy_ID
case ('grainrotationz') outputName case ('grainrotationz') outputName
crystallite_outputID(o,section) = grainrotationx_ID crystallite_outputID(o,c) = grainrotationx_ID
case ('orientation') outputName case ('orientation') outputName
crystallite_outputID(o,section) = orientation_ID crystallite_outputID(o,c) = orientation_ID
case ('grainrotation') outputName case ('grainrotation') outputName
crystallite_outputID(o,section) = grainrotation_ID crystallite_outputID(o,c) = grainrotation_ID
case ('eulerangles') outputName case ('eulerangles') outputName
crystallite_outputID(o,section) = eulerangles_ID crystallite_outputID(o,c) = eulerangles_ID
case ('defgrad','f') outputName case ('defgrad','f') outputName
crystallite_outputID(o,section) = defgrad_ID crystallite_outputID(o,c) = defgrad_ID
case ('fe') outputName case ('fe') outputName
crystallite_outputID(o,section) = fe_ID crystallite_outputID(o,c) = fe_ID
case ('fp') outputName case ('fp') outputName
crystallite_outputID(o,section) = fp_ID crystallite_outputID(o,c) = fp_ID
case ('fi') outputName case ('fi') outputName
crystallite_outputID(o,section) = fi_ID crystallite_outputID(o,c) = fi_ID
case ('lp') outputName case ('lp') outputName
crystallite_outputID(o,section) = lp_ID crystallite_outputID(o,c) = lp_ID
case ('li') outputName case ('li') outputName
crystallite_outputID(o,section) = li_ID crystallite_outputID(o,c) = li_ID
case ('e') outputName case ('e') outputName
crystallite_outputID(o,section) = e_ID crystallite_outputID(o,c) = e_ID
case ('ee') outputName case ('ee') outputName
crystallite_outputID(o,section) = ee_ID crystallite_outputID(o,c) = ee_ID
case ('p','firstpiola','1stpiola') outputName case ('p','firstpiola','1stpiola') outputName
crystallite_outputID(o,section) = p_ID crystallite_outputID(o,c) = p_ID
case ('s','tstar','secondpiola','2ndpiola') outputName case ('s','tstar','secondpiola','2ndpiola') outputName
crystallite_outputID(o,section) = s_ID crystallite_outputID(o,c) = s_ID
case ('elasmatrix') outputName case ('elasmatrix') outputName
crystallite_outputID(o,section) = elasmatrix_ID crystallite_outputID(o,c) = elasmatrix_ID
case ('neighboringip') outputName case ('neighboringip') outputName
crystallite_outputID(o,section) = neighboringip_ID crystallite_outputID(o,c) = neighboringip_ID
case ('neighboringelement') outputName case ('neighboringelement') outputName
crystallite_outputID(o,section) = neighboringelement_ID crystallite_outputID(o,c) = neighboringelement_ID
case default outputName case default outputName
call IO_error(105_pInt,ext_msg=IO_stringValue(line,chunkPos,2_pInt)//' (Crystallite)') call IO_error(105_pInt,ext_msg=tag//' (Crystallite)')
end select outputName end select outputName
end select enddo
endif
enddo enddo
close(FILEUNIT)
do r = 1_pInt,material_Ncrystallite do r = 1_pInt,material_Ncrystallite
do o = 1_pInt,crystallite_Noutput(r) do o = 1_pInt,crystallite_Noutput(r)
@ -537,7 +501,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
use math, only: & use math, only: &
math_inv33, & math_inv33, &
math_identity2nd, & math_identity2nd, &
math_transpose33, &
math_mul33x33, & math_mul33x33, &
math_mul66x6, & math_mul66x6, &
math_Mandel6to33, & math_Mandel6to33, &
@ -616,17 +579,17 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
write(6,'(/,a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> boundary values at el ip ipc ', & write(6,'(/,a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> boundary values at el ip ipc ', &
debug_e,'(',mesh_element(1,debug_e), ')',debug_i, debug_g debug_e,'(',mesh_element(1,debug_e), ')',debug_i, debug_g
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F ', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F ', &
math_transpose33(crystallite_partionedF(1:3,1:3,debug_g,debug_i,debug_e)) transpose(crystallite_partionedF(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F0 ', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F0 ', &
math_transpose33(crystallite_partionedF0(1:3,1:3,debug_g,debug_i,debug_e)) transpose(crystallite_partionedF0(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp0', &
math_transpose33(crystallite_partionedFp0(1:3,1:3,debug_g,debug_i,debug_e)) transpose(crystallite_partionedFp0(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fi0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fi0', &
math_transpose33(crystallite_partionedFi0(1:3,1:3,debug_g,debug_i,debug_e)) transpose(crystallite_partionedFi0(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp0', &
math_transpose33(crystallite_partionedLp0(1:3,1:3,debug_g,debug_i,debug_e)) transpose(crystallite_partionedLp0(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Li0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Li0', &
math_transpose33(crystallite_partionedLi0(1:3,1:3,debug_g,debug_i,debug_e)) transpose(crystallite_partionedLi0(1:3,1:3,debug_g,debug_i,debug_e))
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1107,15 +1070,15 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
.or. .not. iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip ipc ',e,i,c write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip ipc ',e,i,c
write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CRYST >> P / MPa', & write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CRYST >> P / MPa', &
math_transpose33(crystallite_P(1:3,1:3,c,i,e))*1.0e-6_pReal transpose(crystallite_P(1:3,1:3,c,i,e))*1.0e-6_pReal
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp', &
math_transpose33(crystallite_Fp(1:3,1:3,c,i,e)) transpose(crystallite_Fp(1:3,1:3,c,i,e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fi', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fi', &
math_transpose33(crystallite_Fi(1:3,1:3,c,i,e)) transpose(crystallite_Fi(1:3,1:3,c,i,e))
write(6,'(a,/,3(12x,3(f14.9,1x)/),/)') '<< CRYST >> Lp', & write(6,'(a,/,3(12x,3(f14.9,1x)/),/)') '<< CRYST >> Lp', &
math_transpose33(crystallite_Lp(1:3,1:3,c,i,e)) transpose(crystallite_Lp(1:3,1:3,c,i,e))
write(6,'(a,/,3(12x,3(f14.9,1x)/),/)') '<< CRYST >> Li', & write(6,'(a,/,3(12x,3(f14.9,1x)/),/)') '<< CRYST >> Li', &
math_transpose33(crystallite_Li(1:3,1:3,c,i,e)) transpose(crystallite_Li(1:3,1:3,c,i,e))
flush(6) flush(6)
endif endif
enddo enddo
@ -1166,7 +1129,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration
dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS
temp_33 = math_transpose33(math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), & temp_33 = transpose(math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
crystallite_invFi(1:3,1:3,c,i,e))) crystallite_invFi(1:3,1:3,c,i,e)))
rhs_3333 = 0.0_pReal rhs_3333 = 0.0_pReal
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) & forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
@ -1208,12 +1171,12 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal
temp_33 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), & temp_33 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), & math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), &
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e)))) transpose(crystallite_invFp(1:3,1:3,c,i,e))))
forall(p=1_pInt:3_pInt) & forall(p=1_pInt:3_pInt) &
crystallite_dPdF(p,1:3,p,1:3,c,i,e) = math_transpose33(temp_33) crystallite_dPdF(p,1:3,p,1:3,c,i,e) = transpose(temp_33)
temp_33 = math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), & temp_33 = math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), &
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e))) transpose(crystallite_invFp(1:3,1:3,c,i,e)))
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) & forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + & crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e),dFpinvdF(1:3,1:3,p,o)),temp_33) math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e),dFpinvdF(1:3,1:3,p,o)),temp_33)
@ -1223,14 +1186,14 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) & forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + & crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
math_mul33x33(math_mul33x33(temp_33,dSdF(1:3,1:3,p,o)), & math_mul33x33(math_mul33x33(temp_33,dSdF(1:3,1:3,p,o)), &
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e))) transpose(crystallite_invFp(1:3,1:3,c,i,e)))
temp_33 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), & temp_33 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
crystallite_invFp(1:3,1:3,c,i,e)), & crystallite_invFp(1:3,1:3,c,i,e)), &
math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e))) math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)))
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) & forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + & crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
math_mul33x33(temp_33,math_transpose33(dFpinvdF(1:3,1:3,p,o))) math_mul33x33(temp_33,transpose(dFpinvdF(1:3,1:3,p,o)))
enddo; enddo enddo; enddo
enddo elementLooping6 enddo elementLooping6
@ -3195,7 +3158,6 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33)
use math, only: & use math, only: &
math_mul33x33, & math_mul33x33, &
math_inv33, & math_inv33, &
math_transpose33, &
math_EulerToR math_EulerToR
use material, only: & use material, only: &
material_EulerAngles material_EulerAngles
@ -3210,8 +3172,8 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33)
ipc ! grain index ipc ! grain index
T = math_mul33x33(math_EulerToR(material_EulerAngles(1:3,ipc,ip,el)), & T = math_mul33x33(math_EulerToR(material_EulerAngles(1:3,ipc,ip,el)), &
math_transpose33(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el)))) transpose(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el))))
crystallite_push33ToRef = math_mul33x33(math_transpose33(T),math_mul33x33(tensor33,T)) crystallite_push33ToRef = math_mul33x33(transpose(T),math_mul33x33(tensor33,T))
end function crystallite_push33ToRef end function crystallite_push33ToRef
@ -3260,7 +3222,6 @@ logical function crystallite_integrateStress(&
math_mul3333xx3333, & math_mul3333xx3333, &
math_mul66x6, & math_mul66x6, &
math_mul99x99, & math_mul99x99, &
math_transpose33, &
math_inv33, & math_inv33, &
math_invert, & math_invert, &
math_det33, & math_det33, &
@ -3386,7 +3347,7 @@ logical function crystallite_integrateStress(&
write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fp_current at el (elFE) ip ipc ',& write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fp_current at el (elFE) ip ipc ',&
el,'(',mesh_element(1,el),')',ip,ipc el,'(',mesh_element(1,el),')',ip,ipc
if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) & if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) &
write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',math_transpose33(Fp_current(1:3,1:3)) write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',transpose(Fp_current(1:3,1:3))
endif endif
#endif #endif
return return
@ -3402,7 +3363,7 @@ logical function crystallite_integrateStress(&
write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fi_current at el (elFE) ip ipc ',& write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fi_current at el (elFE) ip ipc ',&
el,'(',mesh_element(1,el),')',ip,ipc el,'(',mesh_element(1,el),')',ip,ipc
if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) & if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) &
write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',math_transpose33(Fi_current(1:3,1:3)) write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',transpose(Fi_current(1:3,1:3))
endif endif
#endif #endif
return return
@ -3465,9 +3426,9 @@ logical function crystallite_integrateStress(&
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i3,/)') '<< CRYST >> stress iteration ', NiterationStressLp write(6,'(a,i3,/)') '<< CRYST >> stress iteration ', NiterationStressLp
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lpguess', math_transpose33(Lpguess) write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lpguess', transpose(Lpguess)
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fi', math_transpose33(Fi_new) write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fi', transpose(Fi_new)
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fe', math_transpose33(Fe) write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fe', transpose(Fe)
write(6,'(a,/,6(e20.10,1x))') '<< CRYST >> Tstar', Tstar_v write(6,'(a,/,6(e20.10,1x))') '<< CRYST >> Tstar', Tstar_v
endif endif
#endif #endif
@ -3488,7 +3449,7 @@ logical function crystallite_integrateStress(&
if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lp_constitutive', math_transpose33(Lp_constitutive) write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lp_constitutive', transpose(Lp_constitutive)
endif endif
#endif #endif
@ -3534,7 +3495,7 @@ logical function crystallite_integrateStress(&
if (mod(jacoCounterLp, iJacoLpresiduum) == 0_pInt) then if (mod(jacoCounterLp, iJacoLpresiduum) == 0_pInt) then
dFe_dLp3333 = 0.0_pReal dFe_dLp3333 = 0.0_pReal
forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) & forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) &
dFe_dLp3333(o,1:3,p,1:3) = A(o,p)*math_transpose33(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) dFe_dLp3333(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j)
dFe_dLp3333 = - dt * dFe_dLp3333 dFe_dLp3333 = - dt * dFe_dLp3333
dRLp_dLp = math_identity2nd(9_pInt) & dRLp_dLp = math_identity2nd(9_pInt) &
- math_Plain3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dT3333,dT_dFe3333),dFe_dLp3333)) - math_Plain3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dT3333,dT_dFe3333),dFe_dLp3333))
@ -3564,10 +3525,10 @@ logical function crystallite_integrateStress(&
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLp',transpose(math_Plain3333to99(dFe_dLp3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLp',transpose(math_Plain3333to99(dFe_dLp3333))
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dT_dFe_constitutive',transpose(math_Plain3333to99(dT_dFe3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dT_dFe_constitutive',transpose(math_Plain3333to99(dT_dFe3333))
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLp_dT_constitutive',transpose(math_Plain3333to99(dLp_dT3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLp_dT_constitutive',transpose(math_Plain3333to99(dLp_dT3333))
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> A',math_transpose33(A) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> A',transpose(A)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> B',math_transpose33(B) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> B',transpose(B)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive',math_transpose33(Lp_constitutive) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive',transpose(Lp_constitutive)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lpguess',math_transpose33(Lpguess) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lpguess',transpose(Lpguess)
endif endif
endif endif
#endif #endif
@ -3597,8 +3558,8 @@ logical function crystallite_integrateStress(&
if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive', math_transpose33(Li_constitutive) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive', transpose(Li_constitutive)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess', math_transpose33(Liguess) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess', transpose(Liguess)
endif endif
#endif #endif
!* update current residuum and check for convergence of loop !* update current residuum and check for convergence of loop
@ -3653,8 +3614,8 @@ logical function crystallite_integrateStress(&
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLi',transpose(math_Plain3333to99(dFe_dLi3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLi',transpose(math_Plain3333to99(dFe_dLi3333))
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dT_dFi_constitutive',transpose(math_Plain3333to99(dT_dFi3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dT_dFi_constitutive',transpose(math_Plain3333to99(dT_dFi3333))
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLi_dT_constitutive',transpose(math_Plain3333to99(dLi_dT3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLi_dT_constitutive',transpose(math_Plain3333to99(dLi_dT3333))
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive',math_transpose33(Li_constitutive) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive',transpose(Li_constitutive)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess',math_transpose33(Liguess) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess',transpose(Liguess)
endif endif
endif endif
#endif #endif
@ -3688,7 +3649,7 @@ logical function crystallite_integrateStress(&
if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) &
write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new) write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',transpose(invFp_new)
endif endif
#endif #endif
return return
@ -3699,7 +3660,7 @@ logical function crystallite_integrateStress(&
crystallite_P(1:3,1:3,ipc,ip,el) = math_mul33x33(math_mul33x33(Fg_new,invFp_new), & crystallite_P(1:3,1:3,ipc,ip,el) = math_mul33x33(math_mul33x33(Fg_new,invFp_new), &
math_mul33x33(math_Mandel6to33(Tstar_v), & math_mul33x33(math_Mandel6to33(Tstar_v), &
math_transpose33(invFp_new))) transpose(invFp_new)))
!* store local values in global variables !* store local values in global variables
@ -3719,13 +3680,13 @@ logical function crystallite_integrateStress(&
if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> P / MPa',math_transpose33(crystallite_P(1:3,1:3,ipc,ip,el))*1.0e-6_pReal write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> P / MPa',transpose(crystallite_P(1:3,1:3,ipc,ip,el))*1.0e-6_pReal
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Cauchy / MPa', & write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Cauchy / MPa', &
math_mul33x33(crystallite_P(1:3,1:3,ipc,ip,el), math_transpose33(Fg_new)) * 1.0e-6_pReal / math_det33(Fg_new) math_mul33x33(crystallite_P(1:3,1:3,ipc,ip,el), transpose(Fg_new)) * 1.0e-6_pReal / math_det33(Fg_new)
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fe Lp Fe^-1', & write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fe Lp Fe^-1', &
math_transpose33(math_mul33x33(Fe_new, math_mul33x33(crystallite_Lp(1:3,1:3,ipc,ip,el), math_inv33(Fe_new)))) ! transpose to get correct print out order transpose(math_mul33x33(Fe_new, math_mul33x33(crystallite_Lp(1:3,1:3,ipc,ip,el), math_inv33(Fe_new)))) ! transpose to get correct print out order
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp',math_transpose33(crystallite_Fp(1:3,1:3,ipc,ip,el)) write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp',transpose(crystallite_Fp(1:3,1:3,ipc,ip,el))
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fi',math_transpose33(crystallite_Fi(1:3,1:3,ipc,ip,el)) write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fi',transpose(crystallite_Fi(1:3,1:3,ipc,ip,el))
endif endif
#endif #endif
@ -3842,7 +3803,6 @@ function crystallite_postResults(ipc, ip, el)
math_qToEuler, & math_qToEuler, &
math_qToEulerAxisAngle, & math_qToEulerAxisAngle, &
math_mul33x33, & math_mul33x33, &
math_transpose33, &
math_det33, & math_det33, &
math_I3, & math_I3, &
inDeg, & inDeg, &
@ -3945,41 +3905,41 @@ function crystallite_postResults(ipc, ip, el)
case (defgrad_ID) case (defgrad_ID)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = & crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize]) reshape(transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize])
case (e_ID) case (e_ID)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = 0.5_pReal * reshape((math_mul33x33( & crystallite_postResults(c+1:c+mySize) = 0.5_pReal * reshape((math_mul33x33( &
math_transpose33(crystallite_partionedF(1:3,1:3,ipc,ip,el)), & transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)), &
crystallite_partionedF(1:3,1:3,ipc,ip,el)) - math_I3),[mySize]) crystallite_partionedF(1:3,1:3,ipc,ip,el)) - math_I3),[mySize])
case (fe_ID) case (fe_ID)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = & crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Fe(1:3,1:3,ipc,ip,el)),[mySize]) reshape(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)),[mySize])
case (ee_ID) case (ee_ID)
Ee = 0.5_pReal *(math_mul33x33(math_transpose33(crystallite_Fe(1:3,1:3,ipc,ip,el)), & Ee = 0.5_pReal *(math_mul33x33(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)), &
crystallite_Fe(1:3,1:3,ipc,ip,el)) - math_I3) crystallite_Fe(1:3,1:3,ipc,ip,el)) - math_I3)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = reshape(Ee,[mySize]) crystallite_postResults(c+1:c+mySize) = reshape(Ee,[mySize])
case (fp_ID) case (fp_ID)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = & crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Fp(1:3,1:3,ipc,ip,el)),[mySize]) reshape(transpose(crystallite_Fp(1:3,1:3,ipc,ip,el)),[mySize])
case (fi_ID) case (fi_ID)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = & crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Fi(1:3,1:3,ipc,ip,el)),[mySize]) reshape(transpose(crystallite_Fi(1:3,1:3,ipc,ip,el)),[mySize])
case (lp_ID) case (lp_ID)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = & crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Lp(1:3,1:3,ipc,ip,el)),[mySize]) reshape(transpose(crystallite_Lp(1:3,1:3,ipc,ip,el)),[mySize])
case (li_ID) case (li_ID)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = & crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Li(1:3,1:3,ipc,ip,el)),[mySize]) reshape(transpose(crystallite_Li(1:3,1:3,ipc,ip,el)),[mySize])
case (p_ID) case (p_ID)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = & crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize]) reshape(transpose(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize])
case (s_ID) case (s_ID)
mySize = 9_pInt mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = & crystallite_postResults(c+1:c+mySize) = &

8
src/homogenization.f90
View File

@ -443,11 +443,9 @@ subroutine homogenization_init
allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems)) allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems))
#endif #endif
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
write(6,'(/,a)') ' <<<+- homogenization init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then
#ifdef TODO #ifdef TODO
@ -475,7 +473,7 @@ subroutine homogenization_init
flush(6) flush(6)
if (debug_g < 1 .or. debug_g > homogenization_Ngrains(mesh_element(3,debug_e))) & if (debug_g < 1 .or. debug_g > homogenization_Ngrains(mesh_element(3,debug_e))) &
call IO_error(602_pInt,ext_msg='component (grain)', el=debug_e, g=debug_g) call IO_error(602_pInt,ext_msg='constituent', el=debug_e, g=debug_g)
end subroutine homogenization_init end subroutine homogenization_init

8
src/list.f90
View File

@ -405,7 +405,6 @@ end function getFloatArray
type(tPartitionedStringList), pointer :: tmp type(tPartitionedStringList), pointer :: tmp
integer(pInt) :: i integer(pInt) :: i
allocate(getStrings(0))
tmp => this%next tmp => this%next
do do
@ -413,7 +412,12 @@ end function getFloatArray
if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
if (tmp%string%pos(1) < 2) print*, "NOT WORKKING" if (tmp%string%pos(1) < 2) print*, "NOT WORKKING"
str = IO_StringValue(tmp%string%val,tmp%string%pos,2) str = IO_StringValue(tmp%string%val,tmp%string%pos,2)
getStrings = [getStrings,str]
GfortranBug86033: if (.not. allocated(getStrings)) then
allocate(getStrings(1),source=str)
else GfortranBug86033
getStrings = [getStrings,str]
endif GfortranBug86033
endif endif
tmp => tmp%next tmp => tmp%next
end do end do

318
src/material.f90
View File

@ -173,6 +173,7 @@ module material
integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: &
homogenization_type !< type of each homogenization homogenization_type !< type of each homogenization
!ToDo: should be private
character(len=64), dimension(:), allocatable, public, protected :: & character(len=64), dimension(:), allocatable, public, protected :: &
phase_name, & !< name of each phase phase_name, & !< name of each phase
@ -308,6 +309,7 @@ module material
type(tPartitionedStringList), public,protected, allocatable, dimension(:) :: & type(tPartitionedStringList), public,protected, allocatable, dimension(:) :: &
phaseConfig, & phaseConfig, &
microstructureConfig, & microstructureConfig, &
homogenizationConfig, &
crystalliteConfig crystalliteConfig
public :: & public :: &
@ -439,14 +441,17 @@ subroutine material_init()
line = material_parseCrystallite(FILEUNIT) line = material_parseCrystallite(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim(material_partHomogenization))
line = material_parseHomogenization(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
case default case default
line = IO_read(fileUnit) line = IO_read(fileUnit)
end select end select
enddo enddo
call material_parseHomogenization(FILEUNIT,material_partHomogenization)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
call material_parseTexture(FILEUNIT,material_partTexture) call material_parseTexture(FILEUNIT,material_partTexture)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
close(FILEUNIT) close(FILEUNIT)
@ -559,14 +564,14 @@ subroutine material_init()
allocate(vacancyConcRate (myHomog)%p(1), source=0.0_pReal) allocate(vacancyConcRate (myHomog)%p(1), source=0.0_pReal)
allocate(hydrogenConcRate(myHomog)%p(1), source=0.0_pReal) allocate(hydrogenConcRate(myHomog)%p(1), source=0.0_pReal)
enddo enddo
end subroutine material_init end subroutine material_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief parses the homogenization part in the material configuration file !> @brief parses the homogenization part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_parseHomogenization(fileUnit,myPart) character(len=65536) function material_parseHomogenization(fileUnit)
use IO, only: & use IO, only: &
IO_read, & IO_read, &
IO_globalTagInPart, & IO_globalTagInPart, &
@ -585,174 +590,183 @@ subroutine material_parseHomogenization(fileUnit,myPart)
mesh_element mesh_element
implicit none implicit none
character(len=*), intent(in) :: myPart
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: Nsections, section, s, p integer(pInt) :: Nsections, h
character(len=65536) :: & character(len=65536) :: line, tag,devNull
tag, line character(len=64) :: tag2
logical :: echo logical :: echo
allocate(homogenizationConfig(0))
echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') h = 0_pInt
Nsections = IO_countSections(fileUnit,myPart)
material_Nhomogenization = Nsections
if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart)
allocate(homogenization_name(Nsections)); homogenization_name = ''
allocate(homogenization_type(Nsections), source=HOMOGENIZATION_undefined_ID)
allocate(thermal_type(Nsections), source=THERMAL_isothermal_ID)
allocate(damage_type (Nsections), source=DAMAGE_none_ID)
allocate(vacancyflux_type(Nsections), source=VACANCYFLUX_isoconc_ID)
allocate(porosity_type (Nsections), source=POROSITY_none_ID)
allocate(hydrogenflux_type(Nsections), source=HYDROGENFLUX_isoconc_ID)
allocate(homogenization_typeInstance(Nsections), source=0_pInt)
allocate(thermal_typeInstance(Nsections), source=0_pInt)
allocate(damage_typeInstance(Nsections), source=0_pInt)
allocate(vacancyflux_typeInstance(Nsections), source=0_pInt)
allocate(porosity_typeInstance(Nsections), source=0_pInt)
allocate(hydrogenflux_typeInstance(Nsections), source=0_pInt)
allocate(homogenization_Ngrains(Nsections), source=0_pInt)
allocate(homogenization_Noutput(Nsections), source=0_pInt)
allocate(homogenization_active(Nsections), source=.false.) !!!!!!!!!!!!!!!
allocate(thermal_initialT(Nsections), source=300.0_pReal)
allocate(damage_initialPhi(Nsections), source=1.0_pReal)
allocate(vacancyflux_initialCv(Nsections), source=0.0_pReal)
allocate(porosity_initialPhi(Nsections), source=1.0_pReal)
allocate(hydrogenflux_initialCh(Nsections), source=0.0_pReal)
forall (s = 1_pInt:Nsections) homogenization_active(s) = any(mesh_element(3,:) == s) ! current homogenization used in model? Homogenization view, maximum operations depend on maximum number of homog schemes
homogenization_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections)
rewind(fileUnit)
line = '' ! to have it initialized
section = 0_pInt ! - " -
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to <homogenization>
line = IO_read(fileUnit)
enddo
if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header
do while (trim(line) /= IO_EOF) ! read through sections of material part do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit) line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part foundNextPart: if (IO_getTag(line,'<','>') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read devNull = IO_read(fileUnit, .true.) ! reset IO_read
exit exit
endif endif foundNextPart
if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines nextSection: if (IO_getTag(line,'[',']') /= '') then
if (IO_getTag(line,'[',']') /= '') then ! next section h = h + 1_pInt
section = section + 1_pInt homogenizationConfig = [homogenizationConfig, emptyList]
homogenization_name(section) = IO_getTag(line,'[',']') tag2 = IO_getTag(line,'[',']')
endif GfortranBug86033: if (.not. allocated(homogenization_name)) then
if (section > 0_pInt) then allocate(homogenization_name(1),source=tag2)
else GfortranBug86033
homogenization_name = [homogenization_name,tag2]
endif GfortranBug86033
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (h > 0_pInt) then
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key call homogenizationConfig(h)%add(IO_lc(trim(line)),chunkPos)
select case(tag) else inSection
case ('type','mech','mechanical') echo = (trim(tag) == '/echo/')
select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) endif inSection
enddo
material_Nhomogenization = size(homogenizationConfig)
if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization)
allocate(homogenization_type(material_Nhomogenization), source=HOMOGENIZATION_undefined_ID)
allocate(thermal_type(material_Nhomogenization), source=THERMAL_isothermal_ID)
allocate(damage_type (material_Nhomogenization), source=DAMAGE_none_ID)
allocate(vacancyflux_type(material_Nhomogenization), source=VACANCYFLUX_isoconc_ID)
allocate(porosity_type (material_Nhomogenization), source=POROSITY_none_ID)
allocate(hydrogenflux_type(material_Nhomogenization), source=HYDROGENFLUX_isoconc_ID)
allocate(homogenization_typeInstance(material_Nhomogenization), source=0_pInt)
allocate(thermal_typeInstance(material_Nhomogenization), source=0_pInt)
allocate(damage_typeInstance(material_Nhomogenization), source=0_pInt)
allocate(vacancyflux_typeInstance(material_Nhomogenization), source=0_pInt)
allocate(porosity_typeInstance(material_Nhomogenization), source=0_pInt)
allocate(hydrogenflux_typeInstance(material_Nhomogenization), source=0_pInt)
allocate(homogenization_Ngrains(material_Nhomogenization), source=0_pInt)
allocate(homogenization_Noutput(material_Nhomogenization), source=0_pInt)
allocate(homogenization_active(material_Nhomogenization), source=.false.) !!!!!!!!!!!!!!!
allocate(thermal_initialT(material_Nhomogenization), source=300.0_pReal)
allocate(damage_initialPhi(material_Nhomogenization), source=1.0_pReal)
allocate(vacancyflux_initialCv(material_Nhomogenization), source=0.0_pReal)
allocate(porosity_initialPhi(material_Nhomogenization), source=1.0_pReal)
allocate(hydrogenflux_initialCh(material_Nhomogenization), source=0.0_pReal)
forall (h = 1_pInt:material_Nhomogenization) homogenization_active(h) = any(mesh_element(3,:) == h)
! homogenization_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections)
do h=1_pInt, material_Nhomogenization
tag = homogenizationConfig(h)%getString('mech')
select case (trim(tag))
case(HOMOGENIZATION_NONE_label) case(HOMOGENIZATION_NONE_label)
homogenization_type(section) = HOMOGENIZATION_NONE_ID homogenization_type(h) = HOMOGENIZATION_NONE_ID
homogenization_Ngrains(section) = 1_pInt homogenization_Ngrains(h) = 1_pInt
case(HOMOGENIZATION_ISOSTRAIN_label) case(HOMOGENIZATION_ISOSTRAIN_label)
homogenization_type(section) = HOMOGENIZATION_ISOSTRAIN_ID homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID
homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents')
case(HOMOGENIZATION_RGC_label) case(HOMOGENIZATION_RGC_label)
homogenization_type(section) = HOMOGENIZATION_RGC_ID homogenization_type(h) = HOMOGENIZATION_RGC_ID
homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents')
case default case default
call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
homogenization_typeInstance(section) = & homogenization_typeInstance(h) = &
count(homogenization_type==homogenization_type(section)) ! count instances count(homogenization_type==homogenization_type(h)) ! count instances
case ('thermal') if (homogenizationConfig(h)%keyExists('thermal')) then
select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) tag = homogenizationConfig(h)%getString('thermal')
select case (trim(tag))
case(THERMAL_isothermal_label) case(THERMAL_isothermal_label)
thermal_type(section) = THERMAL_isothermal_ID thermal_type(h) = THERMAL_isothermal_ID
case(THERMAL_adiabatic_label) case(THERMAL_adiabatic_label)
thermal_type(section) = THERMAL_adiabatic_ID thermal_type(h) = THERMAL_adiabatic_ID
case(THERMAL_conduction_label) case(THERMAL_conduction_label)
thermal_type(section) = THERMAL_conduction_ID thermal_type(h) = THERMAL_conduction_ID
case default case default
call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
case ('damage') tag = homogenizationConfig(h)%getString('damage')
select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) select case (trim(tag))
case(DAMAGE_NONE_label) ! case(DAMAGE_NONE_label)
damage_type(section) = DAMAGE_none_ID ! damage_type(section) = DAMAGE_none_ID
case(DAMAGE_LOCAL_label) ! case(DAMAGE_LOCAL_label)
damage_type(section) = DAMAGE_local_ID ! damage_type(section) = DAMAGE_local_ID
case(DAMAGE_NONLOCAL_label) ! case(DAMAGE_NONLOCAL_label)
damage_type(section) = DAMAGE_nonlocal_ID ! damage_type(section) = DAMAGE_nonlocal_ID
case default case default
call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
!
case ('vacancyflux') tag = homogenizationConfig(h)%getString('vacancyflux')
select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) select case (trim(tag))
case(VACANCYFLUX_isoconc_label) ! case(VACANCYFLUX_isoconc_label)
vacancyflux_type(section) = VACANCYFLUX_isoconc_ID ! vacancyflux_type(section) = VACANCYFLUX_isoconc_ID
case(VACANCYFLUX_isochempot_label) ! case(VACANCYFLUX_isochempot_label)
vacancyflux_type(section) = VACANCYFLUX_isochempot_ID ! vacancyflux_type(section) = VACANCYFLUX_isochempot_ID
case(VACANCYFLUX_cahnhilliard_label) ! case(VACANCYFLUX_cahnhilliard_label)
vacancyflux_type(section) = VACANCYFLUX_cahnhilliard_ID ! vacancyflux_type(section) = VACANCYFLUX_cahnhilliard_ID
case default case default
call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
!
case ('porosity') tag = homogenizationConfig(h)%getString('porosity')
select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) select case (trim(tag))
case(POROSITY_NONE_label) ! case(POROSITY_NONE_label)
porosity_type(section) = POROSITY_none_ID ! porosity_type(section) = POROSITY_none_ID
case(POROSITY_phasefield_label) ! case(POROSITY_phasefield_label)
porosity_type(section) = POROSITY_phasefield_ID ! porosity_type(section) = POROSITY_phasefield_ID
case default case default
call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
!
case ('hydrogenflux') tag = homogenizationConfig(h)%getString('hydrogenflux')
select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) select case (trim(tag))
case(HYDROGENFLUX_isoconc_label) ! case(HYDROGENFLUX_isoconc_label)
hydrogenflux_type(section) = HYDROGENFLUX_isoconc_ID ! hydrogenflux_type(section) = HYDROGENFLUX_isoconc_ID
case(HYDROGENFLUX_cahnhilliard_label) ! case(HYDROGENFLUX_cahnhilliard_label)
hydrogenflux_type(section) = HYDROGENFLUX_cahnhilliard_ID ! hydrogenflux_type(section) = HYDROGENFLUX_cahnhilliard_ID
case default case default
call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
case ('nconstituents')
homogenization_Ngrains(section) = IO_intValue(line,chunkPos,2_pInt)
case ('t0')
thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('initialdamage')
damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('cv0')
vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('initialporosity')
porosity_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('ch0')
hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt)
end select
endif endif
enddo enddo
do p=1_pInt, Nsections !
homogenization_typeInstance(p) = count(homogenization_type(1:p) == homogenization_type(p)) ! case ('t0')
thermal_typeInstance(p) = count(thermal_type (1:p) == thermal_type (p)) ! thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt)
damage_typeInstance(p) = count(damage_type (1:p) == damage_type (p)) !
vacancyflux_typeInstance(p) = count(vacancyflux_type (1:p) == vacancyflux_type (p)) ! case ('initialdamage')
porosity_typeInstance(p) = count(porosity_type (1:p) == porosity_type (p)) ! damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt)
hydrogenflux_typeInstance(p) = count(hydrogenflux_type (1:p) == hydrogenflux_type (p)) !
! case ('cv0')
! vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt)
!
!
! case ('ch0')
! hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt)
!
! end select
! endif
! enddo
do h=1_pInt, material_Nhomogenization
homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h))
thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h))
damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h))
vacancyflux_typeInstance(h) = count(vacancyflux_type (1:h) == vacancyflux_type (h))
porosity_typeInstance(h) = count(porosity_type (1:h) == porosity_type (h))
hydrogenflux_typeInstance(h) = count(hydrogenflux_type (1:h) == hydrogenflux_type (h))
enddo enddo
homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active)
material_parseHomogenization=line
end subroutine material_parseHomogenization end function material_parseHomogenization
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -769,8 +783,9 @@ character(len=65536) function material_parseMicrostructure(fileUnit)
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
character(len=64), dimension(:), allocatable :: & character(len=256), dimension(:), allocatable :: &
str str
character(len=64) :: tag2
integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt), allocatable, dimension(:,:) :: chunkPoss integer(pInt), allocatable, dimension(:,:) :: chunkPoss
integer(pInt) :: e, m, constituent, i integer(pInt) :: e, m, constituent, i
@ -778,7 +793,6 @@ character(len=65536) function material_parseMicrostructure(fileUnit)
tag,line,devNull tag,line,devNull
logical :: echo logical :: echo
allocate(microstructure_name(0))
allocate(MicrostructureConfig(0)) allocate(MicrostructureConfig(0))
line = '' ! to have it initialized line = '' ! to have it initialized
m = 0_pInt m = 0_pInt
@ -794,7 +808,12 @@ character(len=65536) function material_parseMicrostructure(fileUnit)
nextSection: if (IO_getTag(line,'[',']') /= '') then nextSection: if (IO_getTag(line,'[',']') /= '') then
m = m + 1_pInt m = m + 1_pInt
microstructureConfig = [microstructureConfig, emptyList] microstructureConfig = [microstructureConfig, emptyList]
microstructure_name = [microstructure_Name,IO_getTag(line,'[',']')] tag2 = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(microstructure_name)) then
allocate(microstructure_name(1),source=tag2)
else GfortranBug86033
microstructure_name = [microstructure_name,tag2]
endif GfortranBug86033
endif nextSection endif nextSection
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
@ -833,7 +852,6 @@ character(len=65536) function material_parseMicrostructure(fileUnit)
do m=1_pInt, material_Nmicrostructure do m=1_pInt, material_Nmicrostructure
call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss) call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss)
do constituent = 1_pInt, size(str) do constituent = 1_pInt, size(str)
print*, trim(str(constituent))
do i = 2_pInt,6_pInt,2_pInt do i = 2_pInt,6_pInt,2_pInt
tag = IO_lc(IO_stringValue(str(constituent),chunkPoss(:,constituent),i)) tag = IO_lc(IO_stringValue(str(constituent),chunkPoss(:,constituent),i))
@ -879,11 +897,11 @@ character(len=65536) function material_parseCrystallite(fileUnit)
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=64) :: tag2
integer(pInt) :: c integer(pInt) :: c
character(len=65536) :: line, tag,devNull character(len=65536) :: line, tag,devNull
logical :: echo logical :: echo
allocate(crystallite_name(0))
allocate(crystalliteConfig(0)) allocate(crystalliteConfig(0))
c = 0_pInt c = 0_pInt
do while (trim(line) /= IO_EOF) ! read through sections of material part do while (trim(line) /= IO_EOF) ! read through sections of material part
@ -896,7 +914,12 @@ character(len=65536) function material_parseCrystallite(fileUnit)
nextSection: if (IO_getTag(line,'[',']') /= '') then nextSection: if (IO_getTag(line,'[',']') /= '') then
c = c + 1_pInt c = c + 1_pInt
crystalliteConfig = [crystalliteConfig, emptyList] crystalliteConfig = [crystalliteConfig, emptyList]
crystallite_name = [crystallite_name,IO_getTag(line,'[',']')] tag2 = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(crystallite_name)) then
allocate(crystallite_name(1),source=tag2)
else GfortranBug86033
crystallite_name = [crystallite_name,tag2]
endif GfortranBug86033
endif nextSection endif nextSection
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
@ -948,11 +971,11 @@ character(len=65536) function material_parsePhase(fileUnit)
integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
character(len=65536) :: & character(len=65536) :: &
tag,line,devNull tag,line,devNull
character(len=64) :: tag2
character(len=64), dimension(:), allocatable :: & character(len=64), dimension(:), allocatable :: &
str str
logical :: echo logical :: echo
allocate(phase_name(0))
allocate(phaseConfig(0)) allocate(phaseConfig(0))
line = '' ! to have it initialized line = '' ! to have it initialized
p = 0_pInt ! - " - p = 0_pInt ! - " -
@ -968,7 +991,12 @@ character(len=65536) function material_parsePhase(fileUnit)
nextSection: if (IO_getTag(line,'[',']') /= '') then nextSection: if (IO_getTag(line,'[',']') /= '') then
p = p + 1_pInt p = p + 1_pInt
phaseConfig = [phaseConfig, emptyList] phaseConfig = [phaseConfig, emptyList]
phase_name = [phase_Name,IO_getTag(line,'[',']')] tag2 = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(phase_name)) then
allocate(phase_name(1),source=tag2)
else GfortranBug86033
phase_name = [phase_name,tag2]
endif GfortranBug86033
endif nextSection endif nextSection
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key