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

Corrected some compilation errors

This commit is contained in:
Luc Hantcherli 2007-03-26 20:16:37 +00:00
parent 68d89a9d4e
commit 99c8765729
1 changed files with 98 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

193
trunk/constitutive.f90
View File

@ -170,38 +170,38 @@ real(pReal), parameter :: constitutive_latent_hardening=1.4
!* Definition of material properties * !* Definition of material properties *
!************************************* !*************************************
!* Number of materials !* Number of materials
integer(pInt) materials_maxN integer(pInt) material_maxN
!* Crystal structure and number of selected slip systems per material !* Crystal structure and number of selected slip systems per material
integer(pInt), dimension(:) , allocatable :: materials_CrystalStructure integer(pInt), dimension(:) , allocatable :: material_CrystalStructure
integer(pInt), dimension(:) , allocatable :: materials_Nslip integer(pInt), dimension(:) , allocatable :: material_Nslip
!* Maximum number of selected slip systems over materials !* Maximum number of selected slip systems over materials
integer(pInt) materials_MaxNslip integer(pInt) material_MaxNslip
!* Elastic constants and matrices !* Elastic constants and matrices
real(pReal), dimension(:) , allocatable :: materials_C11 real(pReal), dimension(:) , allocatable :: material_C11
real(pReal), dimension(:) , allocatable :: materials_C12 real(pReal), dimension(:) , allocatable :: material_C12
real(pReal), dimension(:) , allocatable :: materials_C13 real(pReal), dimension(:) , allocatable :: material_C13
real(pReal), dimension(:) , allocatable :: materials_C33 real(pReal), dimension(:) , allocatable :: material_C33
real(pReal), dimension(:) , allocatable :: materials_C44 real(pReal), dimension(:) , allocatable :: material_C44
real(pReal), dimension(:,:,:), allocatable :: materials_Cslip_66 real(pReal), dimension(:,:,:), allocatable :: material_Cslip_66
! NB: Cslip_66(1:6,1:6,number of materials) ! NB: Cslip_66(1:6,1:6,number of materials)
!* Visco-plastic material parameters !* Visco-plastic material parameters
real(pReal), dimension(:) , allocatable :: materials_s0_slip real(pReal), dimension(:) , allocatable :: material_s0_slip
real(pReal), dimension(:) , allocatable :: materials_gdot0_slip real(pReal), dimension(:) , allocatable :: material_gdot0_slip
real(pReal), dimension(:) , allocatable :: materials_n_slip real(pReal), dimension(:) , allocatable :: material_n_slip
real(pReal), dimension(:) , allocatable :: materials_h0 real(pReal), dimension(:) , allocatable :: material_h0
real(pReal), dimension(:) , allocatable :: materials_s_sat real(pReal), dimension(:) , allocatable :: material_s_sat
real(pReal), dimension(:) , allocatable :: materials_w0 real(pReal), dimension(:) , allocatable :: material_w0
! NB: Parameters(number of materials) ! NB: Parameters(number of materials)
!************************************ !************************************
!* Definition of texture properties * !* Definition of texture properties *
!************************************ !************************************
!* Number of textures !* Number of textures
integer(pInt) textures_maxN integer(pInt) texture_maxN
!* Textures definition !* Textures definition
character(len=80), dimension(:), allocatable :: textures_ODFfile character(len=80), dimension(:), allocatable :: texture_ODFfile
character(len=80), dimension(:), allocatable :: textures_symmetry character(len=80), dimension(:), allocatable :: texture_symmetry
integer(pInt), dimension(:) , allocatable :: textures_Ngrains integer(pInt), dimension(:) , allocatable :: texture_Ngrains
! NB: symmetry(number of texture) ! NB: symmetry(number of texture)
!************************************ !************************************
@ -222,8 +222,11 @@ real(pReal), dimension(:,:,:,:), allocatable :: constitutive_results
!************************************ !************************************
!* Other * !* Other *
!************************************ !************************************
integer(pInt), dimension(:,:) , allocatable :: constitutive_Ngrains
integer(pInt), dimension(:,:,:) , allocatable :: constitutive_matID integer(pInt), dimension(:,:,:) , allocatable :: constitutive_matID
real(pReal), dimension(:,:,:) , allocatable :: constitutive_matvolfrac real(pReal), dimension(:,:,:) , allocatable :: constitutive_matVolFrac
integer(pInt), dimension(:,:,:) , allocatable :: constitutive_texID
real(pReal), dimension(:,:,:) , allocatable :: constitutive_texVolFrac
real(pReal), dimension(:,:,:,:,:), allocatable :: consitutive_initFp real(pReal), dimension(:,:,:,:,:), allocatable :: consitutive_initFp
@ -360,8 +363,8 @@ do while(.true.)
read(file,'(a80)',END=100) line read(file,'(a80)',END=100) line
positions=IO_stringPos(line,1) positions=IO_stringPos(line,1)
tag=IO_lc(IO_stringValue(line,positions,1)) tag=IO_lc(IO_stringValue(line,positions,1))
if (tag(1:1)=='<') then if (tag(1:1)=='<'.AND.tag(len_trim(tag):len_trim(tag))=='>') then
part=tag part=tag(2:len_trim(tag)-1)
exit exit
elseif (tag(1:1)=='[') then elseif (tag(1:1)=='[') then
count=count+1 count=count+1
@ -374,7 +377,7 @@ end subroutine
character(len=80) function constitutive_Parse_UnknownPart(file) character(len=80) function constitutive_Parse_UnknownPart(file)
!********************************************************************* !*********************************************************************
!* This function reads a unknown "part" from the input file until * !* read an unknown "part" from the input file until *
!* the next part is reached * !* the next part is reached *
!* INPUT: * !* INPUT: *
!* - file : file ID * !* - file : file ID *
@ -395,8 +398,8 @@ do while(.true.)
read(file,'(a80)',END=100) line read(file,'(a80)',END=100) line
positions=IO_stringPos(line,maxNchunks) positions=IO_stringPos(line,maxNchunks)
tag=IO_lc(IO_stringValue(line,positions,1)) tag=IO_lc(IO_stringValue(line,positions,1))
if (tag(1:1)=='<') then if (tag(1:1)=='<'.AND.tag(len_trim(tag):len_trim(tag))=='>') then
constitutive_Parse_UnknownPart=tag constitutive_Parse_UnknownPart=tag(2:len_trim(tag)-1)
exit exit
endif endif
enddo enddo
@ -432,8 +435,8 @@ do while(.true.)
tag=IO_lc(IO_stringValue(line,positions,1)) tag=IO_lc(IO_stringValue(line,positions,1))
if (tag(1:1)=='#') then ! skip comment line if (tag(1:1)=='#') then ! skip comment line
cycle cycle
elseif (tag(1:1)=='<') then elseif (tag(1:1)=='<'.AND.tag(len_trim(tag):len_trim(tag))=='>') then
constitutive_parse_materialPart=tag constitutive_parse_materialPart=tag(2:len_trim(tag)-1)
exit exit
elseif (tag(1:1)=='[') then elseif (tag(1:1)=='[') then
section=section+1 section=section+1
@ -441,31 +444,31 @@ do while(.true.)
if (section>0) then if (section>0) then
select case(tag) select case(tag)
case ('crystal_structure') case ('crystal_structure')
materials_CrystalStructure(section)=IO_intValue(line,positions,2) material_CrystalStructure(section)=IO_intValue(line,positions,2)
case ('nslip') case ('nslip')
materials_Nslip(section)=IO_intValue(line,positions,2) material_Nslip(section)=IO_intValue(line,positions,2)
case ('c11') case ('c11')
materials_C11(section)=IO_floatValue(line,positions,2) material_C11(section)=IO_floatValue(line,positions,2)
case ('c12') case ('c12')
materials_C12(section)=IO_floatValue(line,positions,2) material_C12(section)=IO_floatValue(line,positions,2)
case ('c13') case ('c13')
materials_C13(section)=IO_floatValue(line,positions,2) material_C13(section)=IO_floatValue(line,positions,2)
case ('c33') case ('c33')
materials_C33(section)=IO_floatValue(line,positions,2) material_C33(section)=IO_floatValue(line,positions,2)
case ('c44') case ('c44')
materials_C44(section)=IO_floatValue(line,positions,2) material_C44(section)=IO_floatValue(line,positions,2)
case ('s0_slip') case ('s0_slip')
materials_s0_slip(section)=IO_floatValue(line,positions,2) material_s0_slip(section)=IO_floatValue(line,positions,2)
case ('gdot0_slip') case ('gdot0_slip')
materials_gdot0_slip(section)=IO_floatValue(line,positions,2) material_gdot0_slip(section)=IO_floatValue(line,positions,2)
case ('n_slip') case ('n_slip')
materials_n_slip(section)=IO_floatValue(line,positions,2) material_n_slip(section)=IO_floatValue(line,positions,2)
case ('h0') case ('h0')
materials_h0(section)=IO_floatValue(line,positions,2) material_h0(section)=IO_floatValue(line,positions,2)
case ('s_sat') case ('s_sat')
materials_s_sat(section)=IO_floatValue(line,positions,2) material_s_sat(section)=IO_floatValue(line,positions,2)
case ('w0') case ('w0')
materials_w0(section)=IO_floatValue(line,positions,2) material_w0(section)=IO_floatValue(line,positions,2)
case default case default
write(6,*) 'Unknown material parameter ',line write(6,*) 'Unknown material parameter ',line
end select end select
@ -503,8 +506,8 @@ do while(.true.)
tag=IO_lc(IO_stringValue(line,positions,1)) tag=IO_lc(IO_stringValue(line,positions,1))
if (tag(1:1)=='#') then ! skip comment line if (tag(1:1)=='#') then ! skip comment line
cycle cycle
elseif (tag(1:1)=='<') then elseif (tag(1:1)=='<'.AND.tag(len_trim(tag):len_trim(tag))=='>') then
constitutive_parse_texturePart=tag constitutive_parse_texturePart=tag(2:len_trim(tag)-1)
exit exit
elseif (tag(1:1)=='[') then elseif (tag(1:1)=='[') then
section=section+1 section=section+1
@ -512,15 +515,15 @@ do while(.true.)
if (section>0) then if (section>0) then
select case(tag) select case(tag)
case ('hybridIA') case ('hybridIA')
textures_ODFfile(section)=IO_stringValue(line,positions,2) texture_ODFfile(section)=IO_stringValue(line,positions,2)
case ('gauss') case ('gauss')
!* euler angles, scatter, volfrac of component !* euler angles, scatter, volfrac of component
case ('fiber') case ('fiber')
!* 4 angles, scatte, volfrac of component !* 4 angles, scatte, volfrac of component
case ('ngrains') case ('ngrains')
textures_Ngrains(section)=IO_intValue(line,positions,2) texture_Ngrains(section)=IO_intValue(line,positions,2)
case ('symmetry') case ('symmetry')
textures_symmetry(section)=IO_stringValue(line,positions,2) texture_symmetry(section)=IO_stringValue(line,positions,2)
case default case default
write(6,*) 'Unknown texture parameter ',line write(6,*) 'Unknown texture parameter ',line
end select end select
@ -555,29 +558,29 @@ do while (part/='')
formerPart = part formerPart = part
call constitutive_CountSections(1,sectionCount,part) call constitutive_CountSections(1,sectionCount,part)
select case (formerPart) select case (formerPart)
case ('<materials>') case ('materials')
materials_maxN = sectionCount material_maxN = sectionCount
case ('<textures>') case ('textures')
textures_maxN = sectionCount texture_maxN = sectionCount
end select end select
enddo enddo
close(1) close(1)
allocate(textures_ODFfile(textures_maxN)) ; textures_ODFfile='' allocate(texture_ODFfile(texture_maxN)) ; texture_ODFfile=''
allocate(textures_Ngrains(textures_maxN)) ; textures_Ngrains=0_pInt allocate(texture_Ngrains(texture_maxN)) ; texture_Ngrains=0_pInt
allocate(textures_symmetry(textures_maxN)) ; textures_symmetry='' allocate(texture_symmetry(texture_maxN)) ; texture_symmetry=''
allocate(materials_CrystalStructure(materials_maxN)) ; materials_CrystalStructure=0_pInt allocate(material_CrystalStructure(material_maxN)) ; material_CrystalStructure=0_pInt
allocate(materials_Nslip(materials_maxN)) ; materials_Nslip=0_pInt allocate(material_Nslip(material_maxN)) ; material_Nslip=0_pInt
allocate(materials_C11(materials_maxN)) ; materials_C11=0.0_pReal allocate(material_C11(material_maxN)) ; material_C11=0.0_pReal
allocate(materials_C12(materials_maxN)) ; materials_C12=0.0_pReal allocate(material_C12(material_maxN)) ; material_C12=0.0_pReal
allocate(materials_C13(materials_maxN)) ; materials_C13=0.0_pReal allocate(material_C13(material_maxN)) ; material_C13=0.0_pReal
allocate(materials_C33(materials_maxN)) ; materials_C33=0.0_pReal allocate(material_C33(material_maxN)) ; material_C33=0.0_pReal
allocate(materials_C44(materials_maxN)) ; materials_C44=0.0_pReal allocate(material_C44(material_maxN)) ; material_C44=0.0_pReal
allocate(materials_s0_slip(materials_maxN)) ; materials_s0_slip=0.0_pReal allocate(material_s0_slip(material_maxN)) ; material_s0_slip=0.0_pReal
allocate(materials_gdot0_slip(materials_maxN)) ; materials_gdot0_slip=0.0_pReal allocate(material_gdot0_slip(material_maxN)) ; material_gdot0_slip=0.0_pReal
allocate(materials_n_slip(materials_maxN)) ; materials_n_slip=0.0_pReal allocate(material_n_slip(material_maxN)) ; material_n_slip=0.0_pReal
allocate(materials_h0(materials_maxN)) ; materials_h0=0.0_pReal allocate(material_h0(material_maxN)) ; material_h0=0.0_pReal
allocate(materials_s_sat(materials_maxN)) ; materials_s_sat=0.0_pReal allocate(material_s_sat(material_maxN)) ; material_s_sat=0.0_pReal
allocate(materials_w0(materials_maxN)) ; materials_w0=0.0_pReal allocate(material_w0(material_maxN)) ; material_w0=0.0_pReal
write(*,*) 'Allocation is done' write(*,*) 'Allocation is done'
!* Second reading: materials and textures are stored !* Second reading: materials and textures are stored
@ -585,9 +588,9 @@ open(1,FILE=filename,ACTION='READ',STATUS='OLD',ERR=100)
part='_dummy_' part='_dummy_'
do while (part/='') do while (part/='')
select case (part) select case (part)
case ('<materials>') case ('materials')
part=constitutive_Parse_MaterialPart(1) part=constitutive_Parse_MaterialPart(1)
case ('<textures>') case ('textures')
part=constitutive_Parse_TexturePart(1) part=constitutive_Parse_TexturePart(1)
case default case default
part=constitutive_Parse_UnknownPart(1) part=constitutive_Parse_UnknownPart(1)
@ -596,27 +599,27 @@ enddo
close(1) close(1)
!do m=1,materials_maxN !do m=1,material_maxN
! materials_Cslip_66(:,:,m) = 0.0_pReal ! material_Cslip_66(:,:,m) = 0.0_pReal
! select case (material_crystal_structure) ! select case (material_crystal_structure)
! case (1:2) ! cubic structure ! case (1:2) ! cubic structure
! do i=1,3 ! do i=1,3
! do j=1,3 ! do j=1,3
! materials_Cslip_66(i,j,m) = C12 ! material_Cslip_66(i,j,m) = C12
! enddo ! enddo
! materials_Cslip_66(i,i,m) = C11 ! material_Cslip_66(i,i,m) = C11
! materials_Cslip_66(i+3,i+3,m) = C44 ! material_Cslip_66(i+3,i+3,m) = C44
! enddo ! enddo
! case (3) ! hcp structure MISSING correct ! case (3) ! hcp structure MISSING correct
! do i=1,3 ! do i=1,3
! do j=1,3 ! do j=1,3
! materials_Cslip_66(i,j,m) = C12 ! material_Cslip_66(i,j,m) = C12
! enddo ! enddo
! materials_Cslip_66(i,i,m) = C11 ! material_Cslip_66(i,i,m) = C11
! materials_Cslip_66(i+3,i+3,m) = C44 ! material_Cslip_66(i+3,i+3,m) = C44
! enddo ! enddo
! end select ! end select
! materials_Cslip_3333(:,:,:,:,m) = math_66to3333(Cslip_66(:,:,m)) ! material_Cslip_3333(:,:,:,:,m) = math_66to3333(Cslip_66(:,:,m))
!end do !end do
@ -627,22 +630,22 @@ return
end subroutine end subroutine
subroutine constitutive_InitFp(CPFEM_Fp_old) !subroutine constitutive_InitFp(CPFEM_Fp_old)
!********************************************************************* !*********************************************************************
!* This function reads the material and texture input file * !* This function reads the material and texture input file *
!* INPUT: * !* INPUT: *
!* - CPFEM_Fp_old : old plastic deformation gradient * !* - CPFEM_Fp_old : old plastic deformation gradient *
!********************************************************************* !*********************************************************************
use prec, only: pReal,pInt !use prec, only: pReal,pInt
use CPFEM, only: CPFEM_Fp_old !use CPFEM, only: CPFEM_Fp_old
implicit none !implicit none
!* Definition of variables !* Definition of variables
!* Initialization of Fp_old with starting orientation !* Initialization of Fp_old with starting orientation
end subroutine !end subroutine
subroutine constitutive_LpAndItsTangent(Tstar_v,ipc,ip,el,Lp,dLp_dTstar) subroutine constitutive_LpAndItsTangent(Tstar_v,ipc,ip,el,Lp,dLp_dTstar)
@ -677,18 +680,18 @@ matID=constitutive_matID(ipc,ip,el)
!* Calculation of Lp !* Calculation of Lp
Lp=0.0_pReal Lp=0.0_pReal
do i=1,materials_Nslip(matID) do i=1,material_Nslip(matID)
tau_slip(i)=dot_product(Tstar_v,constitutive_Sslip_v(:,i,materials_CrystalStructure(matID))) tau_slip(i)=dot_product(Tstar_v,constitutive_Sslip_v(:,i,material_CrystalStructure(matID)))
gdot_slip(i)=materials_gdot0_slip(matID)*(abs(tau_slip(i))/constitutive_state_new(i,ipc,ip,el))**materials_n_slip(matID)*sign(1.0_pReal,tau_slip(i)) gdot_slip(i)=material_gdot0_slip(matID)*(abs(tau_slip(i))/constitutive_state_new(i,ipc,ip,el))**material_n_slip(matID)*sign(1.0_pReal,tau_slip(i))
Lp=Lp+gdot_slip(i)*constitutive_Sslip(:,:,i,materials_CrystalStructure(matID)) Lp=Lp+gdot_slip(i)*constitutive_Sslip(:,:,i,material_CrystalStructure(matID))
enddo enddo
!* Calculation of the tangent of Lp !* Calculation of the tangent of Lp
dLp_dTstar=0.0_pReal dLp_dTstar=0.0_pReal
do i=1,materials_Nslip(matID) do i=1,material_Nslip(matID)
dgdot_dtauslip(i)=materials_gdot0_slip(matID)*(abs(tau_slip(i))/constitutive_state_new(i,ipc,ip,el))**(materials_n_slip(matID)-1.0_pReal)*materials_n_slip(matID)/constitutive_state_new(i,ipc,ip,el) dgdot_dtauslip(i)=material_gdot0_slip(matID)*(abs(tau_slip(i))/constitutive_state_new(i,ipc,ip,el))**(material_n_slip(matID)-1.0_pReal)*material_n_slip(matID)/constitutive_state_new(i,ipc,ip,el)
forall (j=1:6,k=1:6) forall (j=1:6,k=1:6)
dLp_dTstar(j,k)=dLp_dTstar(j,k)+constitutive_Sslip_v(j,i,materials_CrystalStructure(matID))*constitutive_Sslip_v(k,i,materials_CrystalStructure(matID))*dgdot_dtauslip(i) dLp_dTstar(j,k)=dLp_dTstar(j,k)+constitutive_Sslip_v(j,i,material_CrystalStructure(matID))*constitutive_Sslip_v(k,i,material_CrystalStructure(matID))*dgdot_dtauslip(i)
endforall endforall
enddo enddo
@ -721,17 +724,17 @@ real(pReal), dimension(constitutive_matID(ipc,ip,el)) :: tau_slip
real(pReal), dimension(constitutive_matID(ipc,ip,el)) :: self_hardening real(pReal), dimension(constitutive_matID(ipc,ip,el)) :: self_hardening
!* Get the material-ID from the triplet(ipc,ip,el) !* Get the material-ID from the triplet(ipc,ip,el)
matID=constitutive_mat(ipc,ip,el) matID=constitutive_matID(ipc,ip,el)
!* Self-Hardening of each system !* Self-Hardening of each system
do i=1,materials_Nslip(matID) do i=1,material_Nslip(matID)
tau_slip(i)=dot_product(Tstar_v,constitutive_Sslip_v(:,i,materials_CrystalStructure(matID))) tau_slip(i)=dot_product(Tstar_v,constitutive_Sslip_v(:,i,material_CrystalStructure(matID)))
gdot_slip(i)=materials_gdot0_slip(matID)*(abs(tau_slip(i))/constitutive_state_new(i,ipc,ip,el))**materials_n_slip(matID)*sign(1.0_pReal,tau_slip(i)) gdot_slip(i)=material_gdot0_slip(matID)*(abs(tau_slip(i))/constitutive_state_new(i,ipc,ip,el))**material_n_slip(matID)*sign(1.0_pReal,tau_slip(i))
self_hardening(i)=materials_h0(matID)*(1.0_pReal-constitutive_state_new(i,ipc,ip,el)/materials_s_sat(matID))**materials_w0(matID)*abs(gdot_slip(i)) self_hardening(i)=material_h0(matID)*(1.0_pReal-constitutive_state_new(i,ipc,ip,el)/material_s_sat(matID))**material_w0(matID)*abs(gdot_slip(i))
enddo enddo
!* Hardening for all systems !* Hardening for all systems
constitutive_DotState=matmul(constitutive_hardening_matrix(1:materials_Nslip(matID),1:materials_Nslip(matID),materials_CrystalStructure(matID)),self_hardening) constitutive_DotState=matmul(constitutive_hardening_matrix(1:material_Nslip(matID),1:material_Nslip(matID),material_CrystalStructure(matID)),self_hardening)
return return
end function end function