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

same as for rev327

This commit is contained in:
Christoph Kords 2009-05-26 17:24:42 +00:00
parent a350e076f2
commit b0bf444a51
1 changed files with 14 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
trunk/material.f90
View File

@ -51,8 +51,8 @@ integer(pInt), dimension(:), allocatable :: homogenization_Ngrains, &
integer(pInt), dimension(:,:), allocatable :: microstructure_phase, & ! phase IDs of each microstructure integer(pInt), dimension(:,:), allocatable :: microstructure_phase, & ! phase IDs of each microstructure
microstructure_texture ! texture IDs of each microstructure microstructure_texture ! texture IDs of each microstructure
real(pReal), dimension(:,:), allocatable :: microstructure_fraction ! vol fraction of each constituent in microstructure real(pReal), dimension(:,:), allocatable :: microstructure_fraction ! vol fraction of each constituent in microstructure
integer(pInt), dimension(:,:,:), allocatable :: material_volFrac, & ! vol fraction of grain within phase (?) real(pReal), dimension(:,:,:), allocatable :: material_volume ! volume of each grain,IP,element
material_phase ! phase of each grain,IP,element integer(pInt), dimension(:,:,:), allocatable :: material_phase ! phase of each grain,IP,element
real(pReal), dimension(:,:,:,:), allocatable :: material_EulerAngles ! initial orientation of each grain,IP,element real(pReal), dimension(:,:,:,:), allocatable :: material_EulerAngles ! initial orientation of each grain,IP,element
real(pReal), dimension(:,:,:), allocatable :: texture_Gauss, & ! data of each Gauss component real(pReal), dimension(:,:,:), allocatable :: texture_Gauss, & ! data of each Gauss component
texture_Fiber ! data of each Fiber component texture_Fiber ! data of each Fiber component
@ -433,8 +433,7 @@ subroutine material_populateGrains()
integer(pInt), dimension (:,:), allocatable :: Ngrains integer(pInt), dimension (:,:), allocatable :: Ngrains
integer(pInt), dimension (microstructure_maxNconstituents) :: NgrainsOfConstituent integer(pInt), dimension (microstructure_maxNconstituents) :: NgrainsOfConstituent
real(pReal), dimension (:,:), allocatable :: volume real(pReal), dimension (:), allocatable :: volumeOfGrain, phaseOfGrain
real(pReal), dimension (:), allocatable :: volFracOfGrain, phaseOfGrain
real(pReal), dimension (:,:), allocatable :: orientationOfGrain real(pReal), dimension (:,:), allocatable :: orientationOfGrain
real(pReal), dimension (3) :: orientation real(pReal), dimension (3) :: orientation
real(pReal), dimension (3,3) :: symOrientation real(pReal), dimension (3,3) :: symOrientation
@ -443,14 +442,13 @@ subroutine material_populateGrains()
grain,constituentGrain,symExtension grain,constituentGrain,symExtension
real(pReal) extreme,rnd real(pReal) extreme,rnd
allocate(material_volFrac(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_volFrac = 0.0_pReal allocate(material_volume(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_volume = 0.0_pReal
allocate(material_phase(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_phase = 0_pInt allocate(material_phase(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_phase = 0_pInt
allocate(material_EulerAngles(3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_EulerAngles = 0.0_pReal allocate(material_EulerAngles(3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_EulerAngles = 0.0_pReal
allocate(Ngrains(material_Nhomogenization,material_Nmicrostructure)); Ngrains = 0_pInt allocate(Ngrains(material_Nhomogenization,material_Nmicrostructure)); Ngrains = 0_pInt
allocate(volume(material_Nhomogenization,material_Nmicrostructure)); volume = 0.0_pReal
! count grains and total volume per homog/micro pair ! count grains per homog/micro pair
do e = 1,mesh_NcpElems do e = 1,mesh_NcpElems
homog = mesh_element(3,e) homog = mesh_element(3,e)
micro = mesh_element(4,e) micro = mesh_element(4,e)
@ -459,10 +457,9 @@ subroutine material_populateGrains()
if (micro < 1 .or. micro > material_Nmicrostructure) & ! out of bounds if (micro < 1 .or. micro > material_Nmicrostructure) & ! out of bounds
call IO_error(140,e,0,0) call IO_error(140,e,0,0)
Ngrains(homog,micro) = Ngrains(homog,micro) + homogenization_Ngrains(homog) * FE_Nips(mesh_element(2,e)) Ngrains(homog,micro) = Ngrains(homog,micro) + homogenization_Ngrains(homog) * FE_Nips(mesh_element(2,e))
volume(homog,micro) = volume(homog,micro) + sum(mesh_ipVolume(:,e))
enddo enddo
allocate(volFracOfGrain(maxval(Ngrains))) ! reserve memory for maximum case allocate(volumeOfGrain(maxval(Ngrains))) ! reserve memory for maximum case
allocate(phaseOfGrain(maxval(Ngrains))) ! reserve memory for maximum case allocate(phaseOfGrain(maxval(Ngrains))) ! reserve memory for maximum case
allocate(orientationOfGrain(3,maxval(Ngrains))) ! reserve memory for maximum case allocate(orientationOfGrain(3,maxval(Ngrains))) ! reserve memory for maximum case
@ -477,13 +474,13 @@ subroutine material_populateGrains()
write (6,'(a32,x,a32,x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains write (6,'(a32,x,a32,x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains
! ---------------------------------------------------------------------------- ! ----------------------------------------------------------------------------
volFracOfGrain = 0.0_pReal volumeOfGrain = 0.0_pReal
grain = 0_pInt ! microstructure grain index grain = 0_pInt ! microstructure grain index
do e = 1,mesh_NcpElems ! check each element do e = 1,mesh_NcpElems ! check each element
if (mesh_element(3,e) == homog .and. mesh_element(4,e) == micro) then ! my combination of homog and micro if (mesh_element(3,e) == homog .and. mesh_element(4,e) == micro) then ! my combination of homog and micro
forall (i = 1:FE_Nips(mesh_element(2,e))) & ! loop over IPs forall (i = 1:FE_Nips(mesh_element(2,e))) & ! loop over IPs
volFracOfGrain(grain+(i-1)*dGrains+1:grain+i*dGrains) = & volumeOfGrain(grain+(i-1)*dGrains+1:grain+i*dGrains) = &
mesh_ipVolume(i,e)/volume(homog,micro)/dGrains ! assign IPvolfrac/Ngrains to grains mesh_ipVolume(i,e)/dGrains ! assign IPvolume/Ngrains to grains
grain = grain + FE_Nips(mesh_element(2,e)) * dGrains ! wind forward by Nips*NgrainsPerIP grain = grain + FE_Nips(mesh_element(2,e)) * dGrains ! wind forward by Nips*NgrainsPerIP
endif endif
enddo enddo
@ -587,13 +584,13 @@ subroutine material_populateGrains()
do e = 1,mesh_NcpElems ! check each element do e = 1,mesh_NcpElems ! check each element
if (mesh_element(3,e) == homog .and. mesh_element(4,e) == micro) then ! my combination of homog and micro if (mesh_element(3,e) == homog .and. mesh_element(4,e) == micro) then ! my combination of homog and micro
forall (i = 1:FE_Nips(mesh_element(2,e)), g = 1:dGrains) ! loop over IPs and grains forall (i = 1:FE_Nips(mesh_element(2,e)), g = 1:dGrains) ! loop over IPs and grains
material_volFrac(g,i,e) = volFracOfGrain(grain+(i-1)*dGrains+g) material_volume(g,i,e) = volumeOfGrain(grain+(i-1)*dGrains+g)
material_phase(g,i,e) = phaseOfGrain(grain+(i-1)*dGrains+g) material_phase(g,i,e) = phaseOfGrain(grain+(i-1)*dGrains+g)
material_EulerAngles(:,g,i,e) = orientationOfGrain(:,grain+(i-1)*dGrains+g) material_EulerAngles(:,g,i,e) = orientationOfGrain(:,grain+(i-1)*dGrains+g)
end forall end forall
write (6,*) e ! write (6,*) e
write (6,*) material_phase(:,:,e) ! write (6,*) material_phase(:,:,e)
write (6,*) material_EulerAngles(:,:,:,e) ! write (6,*) material_EulerAngles(:,:,:,e)
grain = grain + FE_Nips(mesh_element(2,e)) * dGrains ! wind forward by Nips*NgrainsPerIP grain = grain + FE_Nips(mesh_element(2,e)) * dGrains ! wind forward by Nips*NgrainsPerIP
endif endif
enddo enddo
@ -603,7 +600,7 @@ subroutine material_populateGrains()
enddo enddo
deallocate(volFracOfGrain) deallocate(volumeOfGrain)
deallocate(phaseOfGrain) deallocate(phaseOfGrain)
deallocate(orientationOfGrain) deallocate(orientationOfGrain)