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

added doxygen documentation to material.f90 and marked read-only quantities as protected where possible, removed substituted "call flush" by "flush"

This commit is contained in:
Martin Diehl 2013-01-18 11:30:52 +00:00
parent b018934b45
commit 9ee8108b6b
8 changed files with 275 additions and 268 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
code/CPFEM.f90
View File

@ -207,21 +207,18 @@ subroutine CPFEM_init
endif endif
! *** end of restoring ! *** end of restoring
!$OMP CRITICAL (write2out) write(6,'(/,a)') '<<<+- CPFEM init -+>>>'
write(6,*) write(6,'(a)') '$Id$'
write(6,*) '<<<+- CPFEM init -+>>>'
write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs)
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE)
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood)
write(6,*) write(6,*)
write(6,*) 'parallelExecution: ', parallelExecution write(6,*) 'parallelExecution: ', parallelExecution
write(6,*) 'symmetricSolver: ', symmetricSolver write(6,*) 'symmetricSolver: ', symmetricSolver
endif endif
flush(6) flush(6)
!$OMP END CRITICAL (write2out)
end subroutine CPFEM_init end subroutine CPFEM_init
@ -354,16 +351,14 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt .and. cp_en == 1 .and. IP == 1) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt .and. cp_en == 1 .and. IP == 1) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,'(/,a)') '#############################################'
write(6,'(a)') '#############################################'
write(6,'(a1,a22,1x,f15.7,a6)') '#','theTime', theTime, '#' write(6,'(a1,a22,1x,f15.7,a6)') '#','theTime', theTime, '#'
write(6,'(a1,a22,1x,f15.7,a6)') '#','theDelta', theDelta, '#' write(6,'(a1,a22,1x,f15.7,a6)') '#','theDelta', theDelta, '#'
write(6,'(a1,a22,1x,i8,a13)') '#','theInc', theInc, '#' write(6,'(a1,a22,1x,i8,a13)') '#','theInc', theInc, '#'
write(6,'(a1,a22,1x,i8,a13)') '#','cycleCounter', cycleCounter, '#' write(6,'(a1,a22,1x,i8,a13)') '#','cycleCounter', cycleCounter, '#'
write(6,'(a1,a22,1x,i8,a13)') '#','computationMode',mode, '#' write(6,'(a1,a22,1x,i8,a13)') '#','computationMode',mode, '#'
write(6,'(a)') '#############################################' write(6,'(a,/)') '#############################################'
write(6,*) flush (6)
call flush (6)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif endif
@ -617,7 +612,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') '<< CPFEM >> stress/MPa at el ip ', cp_en, IP, cauchyStress/1.0e6_pReal write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') '<< CPFEM >> stress/MPa at el ip ', cp_en, IP, cauchyStress/1.0e6_pReal
write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') '<< CPFEM >> Jacobian/GPa at el ip ', cp_en, IP, transpose(jacobian)/1.0e9_pReal write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') '<< CPFEM >> Jacobian/GPa at el ip ', cp_en, IP, transpose(jacobian)/1.0e9_pReal
call flush(6) flush(6)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif endif

2
code/DAMASK_spectral_driver.f90
View File

@ -431,7 +431,7 @@ program DAMASK_spectral_Driver
cutBack = .False. cutBack = .False.
if(solres%termIll .or. .not. solres%converged) then ! no solution found if(solres%termIll .or. .not. solres%converged) then ! no solution found
if (cutBackLevel < maxCutBack) then ! do cut back if (cutBackLevel < maxCutBack) then ! do cut back
write(6,'(/,a)') 'cut back detected' write(6,'(/,a)') ' cut back detected'
cutBack = .True. cutBack = .True.
stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1_pInt cutBackLevel = cutBackLevel + 1_pInt

6
code/DAMASK_spectral_solverAL.f90
View File

@ -282,15 +282,15 @@ type(tSolutionState) function &
call IO_write_jobBinaryFile(777,'F_lambda_lastInc',size(F_lambda_lastInc)) ! writing F_lastInc field to file call IO_write_jobBinaryFile(777,'F_lambda_lastInc',size(F_lambda_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lambda_lastInc write (777,rec=1) F_lambda_lastInc
close (777) close (777)
call IO_write_jobBinaryFile(777,'F_aimDot',size(F_aimDot))
write (777,rec=1) F_aimDot
close(777)
call IO_write_jobBinaryFile(777,'C',size(C)) call IO_write_jobBinaryFile(777,'C',size(C))
write (777,rec=1) C write (777,rec=1) C
close(777) close(777)
call IO_write_jobBinaryFile(777,'C_lastInc',size(C_lastInc)) call IO_write_jobBinaryFile(777,'C_lastInc',size(C_lastInc))
write (777,rec=1) C_lastInc write (777,rec=1) C_lastInc
close(777) close(777)
call IO_write_jobBinaryFile(777,'F_aimDot',size(F_aimDot))
write (777,rec=1) F_aimDot
close(777)
endif endif
AL_solution%converged =.false. AL_solution%converged =.false.

6
code/DAMASK_spectral_solverBasic.f90
View File

@ -226,15 +226,15 @@ type(tSolutionState) function &
call IO_write_jobBinaryFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file call IO_write_jobBinaryFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc write (777,rec=1) F_lastInc
close (777) close (777)
call IO_write_jobBinaryFile(777,'F_aimDot',size(f_aimDot))
write (777,rec=1) f_aimDot
close(777)
call IO_write_jobBinaryFile(777,'C',size(C)) call IO_write_jobBinaryFile(777,'C',size(C))
write (777,rec=1) C write (777,rec=1) C
close(777) close(777)
call IO_write_jobBinaryFile(777,'C_lastInc',size(C_lastInc)) call IO_write_jobBinaryFile(777,'C_lastInc',size(C_lastInc))
write (777,rec=1) C_lastInc write (777,rec=1) C_lastInc
close(777) close(777)
call IO_write_jobBinaryFile(777,'F_aimDot',size(f_aimDot))
write (777,rec=1) f_aimDot
close(777)
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

6
code/DAMASK_spectral_solverBasicPETSc.f90
View File

@ -254,15 +254,15 @@ type(tSolutionState) function &
call IO_write_jobBinaryFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file call IO_write_jobBinaryFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc write (777,rec=1) F_lastInc
close (777) close (777)
call IO_write_jobBinaryFile(777,'F_aimDot',size(F_aimDot))
write (777,rec=1) F_aimDot
close(777)
call IO_write_jobBinaryFile(777,'C',size(C)) call IO_write_jobBinaryFile(777,'C',size(C))
write (777,rec=1) C write (777,rec=1) C
close(777) close(777)
call IO_write_jobBinaryFile(777,'C_lastInc',size(C_lastInc)) call IO_write_jobBinaryFile(777,'C_lastInc',size(C_lastInc))
write (777,rec=1) C_lastInc write (777,rec=1) C_lastInc
close(777) close(777)
call IO_write_jobBinaryFile(777,'F_aimDot',size(F_aimDot))
write (777,rec=1) F_aimDot
close(777)
endif endif
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomdim,reshape(F,[3,3,res(1),res(2),res(3)])),& mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomdim,reshape(F,[3,3,res(1),res(2),res(3)])),&
[3,1,mesh_NcpElems]) [3,1,mesh_NcpElems])

2
code/DAMASK_spectral_utilities.f90
View File

@ -141,7 +141,7 @@ subroutine utilities_init()
write(6,'(a)') ' $Id$' write(6,'(a)') ' $Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
write(6,'(a)') '' write(6,'(a)') ''
call flush(6) flush(6)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set debugging parameters ! set debugging parameters

482
code/material.f90
View File

@ -21,25 +21,28 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!! Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !! Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Parses material.config !> @brief Parses material config file, either solverJobName.materialConfig or material.config
!> @details reads the material configuration file, where solverJobName.materialConfig takes
!! precedence over material.config and parses the sections 'homogenization', 'crystallite',
!! 'phase', 'texture', and 'microstucture'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module material module material
use prec, only: &
use prec, only: pReal, & pReal, &
pInt pInt
implicit none implicit none
private private
character(len=64), parameter, public :: & character(len=64), parameter, public :: &
material_configFile = 'material.config', & material_configFile = 'material.config', & !> generic name for material configuration file
material_localFileExt = 'materialConfig' material_localFileExt = 'materialConfig' !> extension of solver job name depending material configuration file
character(len=32), parameter, public :: & character(len=32), parameter, public :: &
material_partHomogenization = 'homogenization', & material_partHomogenization = 'homogenization', & !> keyword for homogenization part
material_partCrystallite = 'crystallite', & material_partCrystallite = 'crystallite', & !> keyword for crystallite part
material_partPhase = 'phase' material_partPhase = 'phase' !> keyword for phase part
character(len=64), dimension(:), allocatable, public :: & character(len=64), dimension(:), allocatable, public, protected :: &
phase_elasticity, & !> elasticity of each phase phase_elasticity, & !> elasticity of each phase
phase_plasticity, & !> plasticity of each phase phase_plasticity, & !> plasticity of each phase
phase_name, & !> name of each phase phase_name, & !> name of each phase
@ -47,14 +50,14 @@ module material
homogenization_type, & !> type of each homogenization homogenization_type, & !> type of each homogenization
crystallite_name !> name of each crystallite setting crystallite_name !> name of each crystallite setting
integer(pInt), public :: & integer(pInt), public, protected :: &
homogenization_maxNgrains, & !> max number of grains in any USED homogenization homogenization_maxNgrains, & !> max number of grains in any USED homogenization
material_Nphase, & !> number of phases material_Nphase, & !> number of phases
material_Nhomogenization, & !> number of homogenizations material_Nhomogenization, & !> number of homogenizations
material_Nmicrostructure, & !> number of microstructures material_Nmicrostructure, & !> number of microstructures
material_Ncrystallite !> number of crystallite settings material_Ncrystallite !> number of crystallite settings
integer(pInt), dimension(:), allocatable, public :: & integer(pInt), dimension(:), allocatable, public, protected :: &
homogenization_Ngrains, & !> number of grains in each homogenization homogenization_Ngrains, & !> number of grains in each homogenization
homogenization_Noutput, & !> number of '(output)' items per homogenization homogenization_Noutput, & !> number of '(output)' items per homogenization
phase_Noutput, & !> number of '(output)' items per phase phase_Noutput, & !> number of '(output)' items per phase
@ -64,22 +67,23 @@ module material
homogenization_typeInstance, & !> instance of particular type of each homogenization homogenization_typeInstance, & !> instance of particular type of each homogenization
microstructure_crystallite !> crystallite setting ID of each microstructure microstructure_crystallite !> crystallite setting ID of each microstructure
integer(pInt), dimension(:,:,:), allocatable, public :: & integer(pInt), dimension(:,:,:), allocatable, public:: &
material_phase, & !> phase (index) of each grain,IP,element material_phase !> phase (index) of each grain,IP,element
integer(pInt), dimension(:,:,:), allocatable, public, protected :: &
material_texture !> texture (index) of each grain,IP,element material_texture !> texture (index) of each grain,IP,element
real(pReal), dimension(:,:,:,:), allocatable, public :: & real(pReal), dimension(:,:,:,:), allocatable, public, protected :: &
material_EulerAngles !> initial orientation of each grain,IP,element material_EulerAngles !> initial orientation of each grain,IP,element
logical, dimension(:), allocatable, public :: & logical, dimension(:), allocatable, public, protected :: &
microstructure_active, & microstructure_active, &
microstructure_elemhomo, & !> flag to indicate homogeneous microstructure distribution over element's IPs microstructure_elemhomo, & !> flag to indicate homogeneous microstructure distribution over element's IPs
phase_localPlasticity !> flags phases with local constitutive law phase_localPlasticity !> flags phases with local constitutive law
character(len=32), parameter, private :: & character(len=32), parameter, private :: &
material_partMicrostructure = 'microstructure', & material_partMicrostructure = 'microstructure', & !> keyword for microstructure part
material_partTexture = 'texture' material_partTexture = 'texture' !> keyword for texture part
character(len=64), dimension(:), allocatable, private :: & character(len=64), dimension(:), allocatable, private :: &
microstructure_name, & !> name of each microstructure microstructure_name, & !> name of each microstructure
@ -107,7 +111,7 @@ module material
real(pReal), dimension(:,:), allocatable, private :: & real(pReal), dimension(:,:), allocatable, private :: &
microstructure_fraction !> vol fraction of each constituent in microstructure microstructure_fraction !> vol fraction of each constituent in microstructure
real(pReal), dimension(:,:,:), allocatable :: & real(pReal), dimension(:,:,:), allocatable, private :: &
material_volume, & !> volume of each grain,IP,element material_volume, & !> volume of each grain,IP,element
texture_Gauss, & !> data of each Gauss component texture_Gauss, & !> data of each Gauss component
texture_Fiber !> data of each Fiber component texture_Fiber !> data of each Fiber component
@ -118,69 +122,65 @@ module material
public :: material_init public :: material_init
private :: material_parseHomogenization, &
material_parseMicrostructure, &
material_parseCrystallite, &
material_parsePhase, &
material_parseTexture, &
material_populateGrains
contains contains
!*********************************************************************
subroutine material_init
!*********************************************************************
!* Module initialization *
!**************************************
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) !--------------------------------------------------------------------------------------------------
use IO, only: IO_error, & !> @brief parses material configuration file
IO_open_file, & !> @details figures out if solverJobName.materialConfig is present, if not looks for
IO_open_jobFile_stat !> material.config
use debug, only: debug_level, & !--------------------------------------------------------------------------------------------------
debug_material, & subroutine material_init
debug_levelBasic, & use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
debug_levelExtensive use IO, only: &
IO_error, &
IO_open_file, &
IO_open_jobFile_stat
use debug, only: &
debug_level, &
debug_material, &
debug_levelBasic, &
debug_levelExtensive
implicit none implicit none
integer(pInt), parameter :: fileunit = 200_pInt integer(pInt), parameter :: fileunit = 200_pInt
integer(pInt) :: i,j, myDebug integer(pInt) :: i,j, myDebug
myDebug = debug_level(debug_material) myDebug = debug_level(debug_material)
!$OMP CRITICAL (write2out) write(6,'(/,a)') ' <<<+- material init -+>>>'
write(6,*) write(6,'(a)') ' $Id$'
write(6,*) '<<<+- material init -+>>>'
write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
!$OMP END CRITICAL (write2out)
if (.not. IO_open_jobFile_stat(fileunit,material_localFileExt)) then ! no local material configuration present... if (.not. IO_open_jobFile_stat(fileunit,material_localFileExt)) then ! no local material configuration present...
call IO_open_file(fileunit,material_configFile) ! ...open material.config file call IO_open_file(fileunit,material_configFile) ! ...open material.config file
endif endif
call material_parseHomogenization(fileunit,material_partHomogenization) call material_parseHomogenization(fileunit,material_partHomogenization)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out)
write(6,*) 'Homogenization parsed' write(6,*) 'Homogenization parsed'
!$OMP END CRITICAL (write2out)
endif endif
call material_parseMicrostructure(fileunit,material_partMicrostructure) call material_parseMicrostructure(fileunit,material_partMicrostructure)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out)
write(6,*) 'Microstructure parsed' write(6,*) 'Microstructure parsed'
!$OMP END CRITICAL (write2out)
endif endif
call material_parseCrystallite(fileunit,material_partCrystallite) call material_parseCrystallite(fileunit,material_partCrystallite)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out)
write(6,*) 'Crystallite parsed' write(6,*) 'Crystallite parsed'
!$OMP END CRITICAL (write2out)
endif endif
call material_parseTexture(fileunit,material_partTexture) call material_parseTexture(fileunit,material_partTexture)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out)
write(6,*) 'Texture parsed' write(6,*) 'Texture parsed'
!$OMP END CRITICAL (write2out)
endif endif
call material_parsePhase(fileunit,material_partPhase) call material_parsePhase(fileunit,material_partPhase)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out)
write(6,*) 'Phase parsed' write(6,*) 'Phase parsed'
!$OMP END CRITICAL (write2out)
endif endif
close(fileunit) close(fileunit)
@ -193,39 +193,33 @@ subroutine material_init
maxval(microstructure_texture(1:microstructure_Nconstituents(i),i)) > material_Ntexture) call IO_error(152_pInt,i) maxval(microstructure_texture(1:microstructure_Nconstituents(i),i)) > material_Ntexture) call IO_error(152_pInt,i)
if (abs(sum(microstructure_fraction(:,i)) - 1.0_pReal) >= 1.0e-10_pReal) then if (abs(sum(microstructure_fraction(:,i)) - 1.0_pReal) >= 1.0e-10_pReal) then
if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out)
write(6,*)'sum of microstructure fraction = ',sum(microstructure_fraction(:,i)) write(6,*)'sum of microstructure fraction = ',sum(microstructure_fraction(:,i))
!$OMP END CRITICAL (write2out)
endif endif
call IO_error(153_pInt,i) call IO_error(153_pInt,i)
endif endif
enddo enddo
if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) write(6,'(/,a,/)') ' MATERIAL configuration'
write(6,*) write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains'
write(6,*) 'MATERIAL configuration' do i = 1_pInt,material_Nhomogenization
write(6,*) write(6,'(1x,a32,1x,a16,1x,i4)') homogenization_name(i),homogenization_type(i),homogenization_Ngrains(i)
write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' enddo
do i = 1_pInt,material_Nhomogenization write(6,*)
write(6,'(1x,a32,1x,a16,1x,i4)') homogenization_name(i),homogenization_type(i),homogenization_Ngrains(i) write(6,'(a32,1x,a11,1x,a12,1x,a13)') 'microstructure ','crystallite','constituents','homogeneous'
enddo do i = 1_pInt,material_Nmicrostructure
write(6,*) write(6,'(a32,4x,i4,8x,i4,8x,l1)') microstructure_name(i), &
write(6,'(a32,1x,a11,1x,a12,1x,a13)') 'microstructure ','crystallite','constituents','homogeneous' microstructure_crystallite(i), &
do i = 1_pInt,material_Nmicrostructure microstructure_Nconstituents(i), &
write(6,'(a32,4x,i4,8x,i4,8x,l1)') microstructure_name(i), & microstructure_elemhomo(i)
microstructure_crystallite(i), & if (microstructure_Nconstituents(i) > 0_pInt) then
microstructure_Nconstituents(i), & do j = 1_pInt,microstructure_Nconstituents(i)
microstructure_elemhomo(i) write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(j,i)),&
if (microstructure_Nconstituents(i) > 0_pInt) then texture_name(microstructure_texture(j,i)),&
do j = 1_pInt,microstructure_Nconstituents(i) microstructure_fraction(j,i)
write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(j,i)),& enddo
texture_name(microstructure_texture(j,i)),& write(6,*)
microstructure_fraction(j,i) endif
enddo enddo
write(6,*)
endif
enddo
!$OMP END CRITICAL (write2out)
endif endif
call material_populateGrains call material_populateGrains
@ -233,12 +227,13 @@ subroutine material_init
end subroutine material_init end subroutine material_init
!********************************************************************* !--------------------------------------------------------------------------------------------------
!> @brief parses the homogenization part in the material configuration file
!--------------------------------------------------------------------------------------------------
subroutine material_parseHomogenization(myFile,myPart) subroutine material_parseHomogenization(myFile,myPart)
!*********************************************************************
use IO use IO
use mesh, only: mesh_element use mesh, only: &
mesh_element
implicit none implicit none
character(len=*), intent(in) :: myPart character(len=*), intent(in) :: myPart
@ -265,36 +260,36 @@ subroutine material_parseHomogenization(myFile,myPart)
allocate(homogenization_Noutput(Nsections)); homogenization_Noutput = 0_pInt allocate(homogenization_Noutput(Nsections)); homogenization_Noutput = 0_pInt
allocate(homogenization_active(Nsections)); homogenization_active = .false. allocate(homogenization_active(Nsections)); homogenization_active = .false.
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 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(myFile,myPart,'(output)',Nsections) homogenization_Noutput = IO_countTagInPart(myFile,myPart,'(output)',Nsections)
rewind(myFile) rewind(myFile)
line = '' line = ''
section = 0_pInt section = 0_pInt
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
enddo enddo
if (echo) write(6,*) trim(line) ! echo part header if (echo) write(6,*) trim(line) ! echo part header
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (echo) write(6,*) trim(line) ! echo back read lines if (echo) write(6,*) trim(line) ! echo back read lines
if (IO_getTag(line,'[',']') /= '') then ! next section if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt section = section + 1_pInt
homogenization_name(section) = IO_getTag(line,'[',']') homogenization_name(section) = IO_getTag(line,'[',']')
endif endif
if (section > 0_pInt) then if (section > 0_pInt) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('type') case ('type')
homogenization_type(section) = IO_lc(IO_stringValue(line,positions,2_pInt)) ! adding: IO_lc function homogenization_type(section) = IO_lc(IO_stringValue(line,positions,2_pInt)) ! adding: IO_lc function
do s = 1_pInt,section do s = 1_pInt,section
if (homogenization_type(s) == homogenization_type(section)) & if (homogenization_type(s) == homogenization_type(section)) &
homogenization_typeInstance(section) = homogenization_typeInstance(section) + 1_pInt ! count instances homogenization_typeInstance(section) = homogenization_typeInstance(section) + 1_pInt ! count instances
enddo enddo
case ('ngrains') case ('ngrains')
homogenization_Ngrains(section) = IO_intValue(line,positions,2_pInt) homogenization_Ngrains(section) = IO_intValue(line,positions,2_pInt)
@ -307,12 +302,14 @@ subroutine material_parseHomogenization(myFile,myPart)
end subroutine material_parseHomogenization end subroutine material_parseHomogenization
!********************************************************************* !--------------------------------------------------------------------------------------------------
!> @brief parses the microstructure part in the material configuration file
!--------------------------------------------------------------------------------------------------
subroutine material_parseMicrostructure(myFile,myPart) subroutine material_parseMicrostructure(myFile,myPart)
!*********************************************************************
use IO use IO
use mesh, only: mesh_element, mesh_NcpElems use mesh, only: &
mesh_element, &
mesh_NcpElems
implicit none implicit none
character(len=*), intent(in) :: myPart character(len=*), intent(in) :: myPart
@ -338,38 +335,41 @@ subroutine material_parseMicrostructure(myFile,myPart)
allocate(microstructure_active(Nsections)) allocate(microstructure_active(Nsections))
allocate(microstructure_elemhomo(Nsections)) allocate(microstructure_elemhomo(Nsections))
forall (e = 1_pInt:mesh_NcpElems) microstructure_active(mesh_element(4,e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements forall (e = 1_pInt:mesh_NcpElems) microstructure_active(mesh_element(4,e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
microstructure_Nconstituents = IO_countTagInPart(myFile,myPart,'(constituent)',Nsections) microstructure_Nconstituents = IO_countTagInPart(myFile,myPart,'(constituent)',Nsections)
microstructure_maxNconstituents = maxval(microstructure_Nconstituents) microstructure_maxNconstituents = maxval(microstructure_Nconstituents)
microstructure_elemhomo = IO_spotTagInPart(myFile,myPart,'/elementhomogeneous/',Nsections) microstructure_elemhomo = IO_spotTagInPart(myFile,myPart,'/elementhomogeneous/',Nsections)
allocate(microstructure_phase (microstructure_maxNconstituents,Nsections)); microstructure_phase = 0_pInt allocate(microstructure_phase (microstructure_maxNconstituents,Nsections))
allocate(microstructure_texture (microstructure_maxNconstituents,Nsections)); microstructure_texture = 0_pInt microstructure_phase = 0_pInt
allocate(microstructure_fraction(microstructure_maxNconstituents,Nsections)); microstructure_fraction = 0.0_pReal allocate(microstructure_texture (microstructure_maxNconstituents,Nsections))
microstructure_texture = 0_pInt
allocate(microstructure_fraction(microstructure_maxNconstituents,Nsections))
microstructure_fraction = 0.0_pReal
rewind(myFile) rewind(myFile)
line = '' line = ''
section = 0_pInt section = 0_pInt
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
enddo enddo
if (echo) write(6,*) trim(line) ! echo part header if (echo) write(6,*) trim(line) ! echo part header
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (echo) write(6,*) trim(line) ! echo back read lines if (echo) write(6,*) trim(line) ! echo back read lines
if (IO_getTag(line,'[',']') /= '') then ! next section if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt section = section + 1_pInt
constituent = 0_pInt constituent = 0_pInt
microstructure_name(section) = IO_getTag(line,'[',']') microstructure_name(section) = IO_getTag(line,'[',']')
endif endif
if (section > 0_pInt) then if (section > 0_pInt) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('crystallite') case ('crystallite')
microstructure_crystallite(section) = IO_intValue(line,positions,2_pInt) microstructure_crystallite(section) = IO_intValue(line,positions,2_pInt)
@ -393,17 +393,18 @@ subroutine material_parseMicrostructure(myFile,myPart)
100 end subroutine material_parseMicrostructure 100 end subroutine material_parseMicrostructure
!********************************************************************* !--------------------------------------------------------------------------------------------------
!> @brief parses the crystallite part in the material configuration file
!--------------------------------------------------------------------------------------------------
subroutine material_parseCrystallite(myFile,myPart) subroutine material_parseCrystallite(myFile,myPart)
!********************************************************************* use IO, only: &
IO_countSections, &
use IO, only: IO_countSections, & IO_error, &
IO_error, & IO_countTagInPart, &
IO_countTagInPart, & IO_globalTagInPart, &
IO_globalTagInPart, & IO_getTag, &
IO_getTag, & IO_lc, &
IO_lc, & IO_isBlank
IO_isBlank
implicit none implicit none
character(len=*), intent(in) :: myPart character(len=*), intent(in) :: myPart
@ -429,17 +430,17 @@ subroutine material_parseCrystallite(myFile,myPart)
line = '' line = ''
section = 0_pInt section = 0_pInt
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
enddo enddo
if (echo) write(6,*) trim(line) ! echo part header if (echo) write(6,*) trim(line) ! echo part header
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (echo) write(6,*) trim(line) ! echo back read lines if (echo) write(6,*) trim(line) ! echo back read lines
if (IO_getTag(line,'[',']') /= '') then ! next section if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt section = section + 1_pInt
crystallite_name(section) = IO_getTag(line,'[',']') crystallite_name(section) = IO_getTag(line,'[',']')
endif endif
@ -448,10 +449,10 @@ subroutine material_parseCrystallite(myFile,myPart)
100 end subroutine material_parseCrystallite 100 end subroutine material_parseCrystallite
!********************************************************************* !--------------------------------------------------------------------------------------------------
!> @brief parses the phase part in the material configuration file
!--------------------------------------------------------------------------------------------------
subroutine material_parsePhase(myFile,myPart) subroutine material_parsePhase(myFile,myPart)
!*********************************************************************
use IO use IO
implicit none implicit none
@ -487,35 +488,35 @@ subroutine material_parsePhase(myFile,myPart)
line = '' line = ''
section = 0_pInt section = 0_pInt
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
enddo enddo
if (echo) write(6,*) trim(line) ! echo part header if (echo) write(6,*) trim(line) ! echo part header
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (echo) write(6,*) trim(line) ! echo back read lines if (echo) write(6,*) trim(line) ! echo back read lines
if (IO_getTag(line,'[',']') /= '') then ! next section if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt section = section + 1_pInt
phase_name(section) = IO_getTag(line,'[',']') phase_name(section) = IO_getTag(line,'[',']')
endif endif
if (section > 0_pInt) then if (section > 0_pInt) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('elasticity') case ('elasticity')
phase_elasticity(section) = IO_lc(IO_stringValue(line,positions,2_pInt)) phase_elasticity(section) = IO_lc(IO_stringValue(line,positions,2_pInt))
do s = 1_pInt,section do s = 1_pInt,section
if (phase_elasticity(s) == phase_elasticity(section)) & if (phase_elasticity(s) == phase_elasticity(section)) &
phase_elasticityInstance(section) = phase_elasticityInstance(section) + 1_pInt ! count instances phase_elasticityInstance(section) = phase_elasticityInstance(section) + 1_pInt ! count instances
enddo enddo
case ('plasticity') case ('plasticity')
phase_plasticity(section) = IO_lc(IO_stringValue(line,positions,2_pInt)) phase_plasticity(section) = IO_lc(IO_stringValue(line,positions,2_pInt))
do s = 1_pInt,section do s = 1_pInt,section
if (phase_plasticity(s) == phase_plasticity(section)) & if (phase_plasticity(s) == phase_plasticity(section)) &
phase_plasticityInstance(section) = phase_plasticityInstance(section) + 1_pInt ! count instances phase_plasticityInstance(section) = phase_plasticityInstance(section) + 1_pInt ! count instances
enddo enddo
end select end select
endif endif
@ -524,12 +525,14 @@ subroutine material_parsePhase(myFile,myPart)
100 end subroutine material_parsePhase 100 end subroutine material_parsePhase
!********************************************************************* !--------------------------------------------------------------------------------------------------
!> @brief parses the texture part in the material configuration file
!--------------------------------------------------------------------------------------------------
subroutine material_parseTexture(myFile,myPart) subroutine material_parseTexture(myFile,myPart)
!*********************************************************************
use IO use IO
use math, only: inRad, math_sampleRandomOri use math, only: &
inRad, &
math_sampleRandomOri
implicit none implicit none
character(len=*), intent(in) :: myPart character(len=*), intent(in) :: myPart
@ -567,17 +570,17 @@ subroutine material_parseTexture(myFile,myPart)
line = '' line = ''
section = 0_pInt section = 0_pInt
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
enddo enddo
if (echo) write(6,*) trim(line) ! echo part header if (echo) write(6,*) trim(line) ! echo part header
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (echo) write(6,*) trim(line) ! echo back read lines if (echo) write(6,*) trim(line) ! echo back read lines
if (IO_getTag(line,'[',']') /= '') then ! next section if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt section = section + 1_pInt
gauss = 0_pInt gauss = 0_pInt
fiber = 0_pInt fiber = 0_pInt
@ -585,7 +588,7 @@ subroutine material_parseTexture(myFile,myPart)
endif endif
if (section > 0_pInt) then if (section > 0_pInt) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('hybridia') case ('hybridia')
@ -660,26 +663,33 @@ subroutine material_parseTexture(myFile,myPart)
100 end subroutine material_parseTexture 100 end subroutine material_parseTexture
!********************************************************************* !--------------------------------------------------------------------------------------------------
!> @brief populates the grains
!> @details populates the grains by identifying active microstructure/homogenization pairs,
!! calculates the volume of the grains and deals with texture components and hybridIA
!--------------------------------------------------------------------------------------------------
subroutine material_populateGrains subroutine material_populateGrains
!********************************************************************* use math, only: &
math_sampleRandomOri, &
use math, only: math_sampleRandomOri, & math_sampleGaussOri, &
math_sampleGaussOri, & math_sampleFiberOri, &
math_sampleFiberOri, & math_symmetricEulers
math_symmetricEulers use mesh, only: &
use mesh, only: mesh_element, & mesh_element, &
mesh_maxNips, & mesh_maxNips, &
mesh_NcpElems, & mesh_NcpElems, &
mesh_ipVolume, & mesh_ipVolume, &
FE_Nips, & FE_Nips, &
FE_geomtype FE_geomtype
use IO, only: IO_error, & use IO, only: &
IO_hybridIA IO_error, &
use FEsolving, only: FEsolving_execIP IO_hybridIA
use debug, only: debug_level, & use FEsolving, only: &
debug_material, & FEsolving_execIP
debug_levelBasic use debug, only: &
debug_level, &
debug_material, &
debug_levelBasic
implicit none implicit none
integer(pInt), dimension (:,:), allocatable :: Ngrains integer(pInt), dimension (:,:), allocatable :: Ngrains
@ -694,8 +704,8 @@ subroutine material_populateGrains
integer(pInt) :: phaseID,textureID,dGrains,myNgrains,myNorientations, & integer(pInt) :: phaseID,textureID,dGrains,myNgrains,myNorientations, &
grain,constituentGrain,symExtension grain,constituentGrain,symExtension
real(pReal) :: extreme,rnd real(pReal) :: extreme,rnd
integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array
integer(pInt), dimension (:,:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array integer(pInt), dimension (:,:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array
myDebug = debug_level(debug_material) myDebug = debug_level(debug_material)
@ -707,6 +717,7 @@ subroutine material_populateGrains
allocate(Ngrains(material_Nhomogenization,material_Nmicrostructure)); Ngrains = 0_pInt allocate(Ngrains(material_Nhomogenization,material_Nmicrostructure)); Ngrains = 0_pInt
allocate(Nelems(material_Nhomogenization,material_Nmicrostructure)); Nelems = 0_pInt allocate(Nelems(material_Nhomogenization,material_Nmicrostructure)); Nelems = 0_pInt
!--------------------------------------------------------------------------------------------------
! precounting of elements for each homog/micro pair ! precounting of elements for each homog/micro pair
do e = 1_pInt, mesh_NcpElems do e = 1_pInt, mesh_NcpElems
homog = mesh_element(3,e) homog = mesh_element(3,e)
@ -717,16 +728,16 @@ subroutine material_populateGrains
allocate(elemsOfHomogMicro(maxval(Nelems),material_Nhomogenization,material_Nmicrostructure)) allocate(elemsOfHomogMicro(maxval(Nelems),material_Nhomogenization,material_Nmicrostructure))
elemsOfHomogMicro = 0_pInt elemsOfHomogMicro = 0_pInt
Nelems = 0_pInt ! reuse as counter !--------------------------------------------------------------------------------------------------
! identify maximum grain count per IP (from element) and find grains per homog/micro pair ! identify maximum grain count per IP (from element) and find grains per homog/micro pair
Nelems = 0_pInt ! reuse as counter
do e = 1_pInt,mesh_NcpElems do e = 1_pInt,mesh_NcpElems
t = FE_geomtype(mesh_element(2,e)) t = FE_geomtype(mesh_element(2,e))
homog = mesh_element(3,e) homog = mesh_element(3,e)
micro = mesh_element(4,e) micro = mesh_element(4,e)
if (homog < 1_pInt .or. homog > material_Nhomogenization) & ! out of bounds if (homog < 1_pInt .or. homog > material_Nhomogenization) & ! out of bounds
call IO_error(154_pInt,e,0_pInt,0_pInt) call IO_error(154_pInt,e,0_pInt,0_pInt)
if (micro < 1_pInt .or. micro > material_Nmicrostructure) & ! out of bounds if (micro < 1_pInt .or. micro > material_Nmicrostructure) & ! out of bounds
call IO_error(155_pInt,e,0_pInt,0_pInt) call IO_error(155_pInt,e,0_pInt,0_pInt)
if (microstructure_elemhomo(micro)) then if (microstructure_elemhomo(micro)) then
dGrains = homogenization_Ngrains(homog) dGrains = homogenization_Ngrains(homog)
@ -735,14 +746,14 @@ subroutine material_populateGrains
endif endif
Ngrains(homog,micro) = Ngrains(homog,micro) + dGrains Ngrains(homog,micro) = Ngrains(homog,micro) + dGrains
Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt
elemsOfHomogMicro(Nelems(homog,micro),homog,micro) = e ! remember elements active in this homog/micro pair elemsOfHomogMicro(Nelems(homog,micro),homog,micro) = e ! remember elements active in this homog/micro pair
enddo enddo
allocate(volumeOfGrain(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(textureOfGrain(maxval(Ngrains))) ! reserve memory for maximum case allocate(textureOfGrain(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
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
@ -752,11 +763,11 @@ subroutine material_populateGrains
write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#'
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif endif
do homog = 1_pInt,material_Nhomogenization ! loop over homogenizations do homog = 1_pInt,material_Nhomogenization ! loop over homogenizations
dGrains = homogenization_Ngrains(homog) ! grain number per material point dGrains = homogenization_Ngrains(homog) ! grain number per material point
do micro = 1_pInt,material_Nmicrostructure ! all pairs of homog and micro do micro = 1_pInt,material_Nmicrostructure ! all pairs of homog and micro
if (Ngrains(homog,micro) > 0_pInt) then ! an active pair of homog and micro if (Ngrains(homog,micro) > 0_pInt) then ! an active pair of homog and micro
myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,*)
@ -764,61 +775,63 @@ subroutine material_populateGrains
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif endif
! ---------------------------------------------------------------------------- calculate volume of each grain !--------------------------------------------------------------------------------------------------
! calculate volume of each grain
volumeOfGrain = 0.0_pReal volumeOfGrain = 0.0_pReal
grain = 0_pInt grain = 0_pInt
do hme = 1_pInt, Nelems(homog,micro) do hme = 1_pInt, Nelems(homog,micro)
e = elemsOfHomogMicro(hme,homog,micro) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex e = elemsOfHomogMicro(hme,homog,micro) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
t = FE_geomtype(mesh_element(2,e)) t = FE_geomtype(mesh_element(2,e))
if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs
volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:FE_Nips(t),e))/& volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:FE_Nips(t),e))/&
real(dGrains,pReal) real(dGrains,pReal)
grain = grain + dGrains ! wind forward by NgrainsPerIP grain = grain + dGrains ! wind forward by NgrainsPerIP
else else
forall (i = 1_pInt:FE_Nips(t)) & ! loop over IPs forall (i = 1_pInt:FE_Nips(t)) & ! loop over IPs
volumeOfGrain(grain+(i-1)*dGrains+1_pInt:grain+i*dGrains) = & volumeOfGrain(grain+(i-1)*dGrains+1_pInt:grain+i*dGrains) = &
mesh_ipVolume(i,e)/dGrains ! assign IPvolume/Ngrains to all grains of IP mesh_ipVolume(i,e)/dGrains ! assign IPvolume/Ngrains to all grains of IP
grain = grain + FE_Nips(t) * dGrains ! wind forward by Nips*NgrainsPerIP grain = grain + FE_Nips(t) * dGrains ! wind forward by Nips*NgrainsPerIP
endif endif
enddo enddo
! ---------------------------------------------------------------------------- divide myNgrains as best over constituents !--------------------------------------------------------------------------------------------------
! divide myNgrains as best over constituents
NgrainsOfConstituent = 0_pInt NgrainsOfConstituent = 0_pInt
forall (i = 1_pInt:microstructure_Nconstituents(micro)) & forall (i = 1_pInt:microstructure_Nconstituents(micro)) &
NgrainsOfConstituent(i) = nint(microstructure_fraction(i,micro) * myNgrains, pInt) ! do rounding integer conversion NgrainsOfConstituent(i) = nint(microstructure_fraction(i,micro) * myNgrains, pInt) ! do rounding integer conversion
do while (sum(NgrainsOfConstituent) /= myNgrains) ! total grain count over constituents wrong? do while (sum(NgrainsOfConstituent) /= myNgrains) ! total grain count over constituents wrong?
sgn = sign(1_pInt, myNgrains - sum(NgrainsOfConstituent)) ! direction of required change sgn = sign(1_pInt, myNgrains - sum(NgrainsOfConstituent)) ! direction of required change
extreme = 0.0_pReal extreme = 0.0_pReal
t = 0_pInt t = 0_pInt
do i = 1_pInt,microstructure_Nconstituents(micro) ! find largest deviator do i = 1_pInt,microstructure_Nconstituents(micro) ! find largest deviator
if (real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) > extreme) then if (real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) > extreme) then
extreme = real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) extreme = real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro))
t = i t = i
endif endif
enddo enddo
NgrainsOfConstituent(t) = NgrainsOfConstituent(t) + sgn ! change that by one NgrainsOfConstituent(t) = NgrainsOfConstituent(t) + sgn ! change that by one
enddo enddo
! ----------------------------------------------------------------------------
phaseOfGrain = 0_pInt phaseOfGrain = 0_pInt
textureOfGrain = 0_pInt textureOfGrain = 0_pInt
orientationOfGrain = 0.0_pReal orientationOfGrain = 0.0_pReal
grain = 0_pInt ! reset microstructure grain index grain = 0_pInt ! reset microstructure grain index
do i = 1_pInt,microstructure_Nconstituents(micro) ! loop over constituents constituents: do i = 1_pInt,microstructure_Nconstituents(micro) ! loop over constituents
phaseID = microstructure_phase(i,micro) phaseID = microstructure_phase(i,micro)
textureID = microstructure_texture(i,micro) textureID = microstructure_texture(i,micro)
phaseOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = phaseID ! assign resp. phase phaseOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = phaseID ! assign resp. phase
textureOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = textureID ! assign resp. texture textureOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = textureID ! assign resp. texture
myNorientations = ceiling(real(NgrainsOfConstituent(i),pReal)/& myNorientations = ceiling(real(NgrainsOfConstituent(i),pReal)/&
real(texture_symmetry(textureID),pReal),pInt) ! max number of unique orientations (excl. symmetry) real(texture_symmetry(textureID),pReal),pInt) ! max number of unique orientations (excl. symmetry)
constituentGrain = 0_pInt ! constituent grain index constituentGrain = 0_pInt ! constituent grain index
! --------- !--------------------------------------------------------------------------------------------------
if (texture_ODFfile(textureID) == '') then ! dealing with texture components ! dealing with texture components
! --------- if (texture_ODFfile(textureID) == '') then
do t = 1_pInt,texture_Ngauss(textureID) ! loop over Gauss components do t = 1_pInt,texture_Ngauss(textureID) ! loop over Gauss components
do g = 1_pInt,int(myNorientations*texture_Gauss(5,t,textureID),pInt) ! loop over required grain count do g = 1_pInt,int(myNorientations*texture_Gauss(5,t,textureID),pInt) ! loop over required grain count
orientationOfGrain(:,grain+constituentGrain+g) = & orientationOfGrain(:,grain+constituentGrain+g) = &
math_sampleGaussOri(texture_Gauss(1:3,t,textureID),& math_sampleGaussOri(texture_Gauss(1:3,t,textureID),&
texture_Gauss( 4,t,textureID)) texture_Gauss( 4,t,textureID))
@ -826,8 +839,8 @@ subroutine material_populateGrains
constituentGrain = constituentGrain + int(myNorientations*texture_Gauss(5,t,textureID)) constituentGrain = constituentGrain + int(myNorientations*texture_Gauss(5,t,textureID))
enddo enddo
do t = 1_pInt,texture_Nfiber(textureID) ! loop over fiber components do t = 1_pInt,texture_Nfiber(textureID) ! loop over fiber components
do g = 1_pInt,int(myNorientations*texture_Fiber(6,t,textureID),pInt) ! loop over required grain count do g = 1_pInt,int(myNorientations*texture_Fiber(6,t,textureID),pInt) ! loop over required grain count
orientationOfGrain(:,grain+constituentGrain+g) = & orientationOfGrain(:,grain+constituentGrain+g) = &
math_sampleFiberOri(texture_Fiber(1:2,t,textureID),& math_sampleFiberOri(texture_Fiber(1:2,t,textureID),&
texture_Fiber(3:4,t,textureID),& texture_Fiber(3:4,t,textureID),&
@ -836,45 +849,45 @@ subroutine material_populateGrains
constituentGrain = constituentGrain + int(myNorientations*texture_fiber(6,t,textureID),pInt) constituentGrain = constituentGrain + int(myNorientations*texture_fiber(6,t,textureID),pInt)
enddo enddo
do j = constituentGrain+1_pInt,myNorientations ! fill remainder with random do j = constituentGrain+1_pInt,myNorientations ! fill remainder with random
orientationOfGrain(:,grain+j) = math_sampleRandomOri() orientationOfGrain(:,grain+j) = math_sampleRandomOri()
enddo enddo
! --------- else
else ! hybrid IA !--------------------------------------------------------------------------------------------------
! --------- ! hybrid IA
orientationOfGrain(:,grain+1:grain+myNorientations) = IO_hybridIA(myNorientations,texture_ODFfile(textureID)) orientationOfGrain(:,grain+1:grain+myNorientations) = IO_hybridIA(myNorientations,texture_ODFfile(textureID))
if (all(orientationOfGrain(:,grain+1) == -1.0_pReal)) call IO_error(156_pInt) if (all(orientationOfGrain(:,grain+1) == -1.0_pReal)) call IO_error(156_pInt)
constituentGrain = constituentGrain + myNorientations constituentGrain = constituentGrain + myNorientations
endif endif
! ----------------------------------------------------------------------------
symExtension = texture_symmetry(textureID) - 1_pInt symExtension = texture_symmetry(textureID) - 1_pInt
if (symExtension > 0_pInt) then ! sample symmetry if (symExtension > 0_pInt) then ! sample symmetry
constituentGrain = NgrainsOfConstituent(i)-myNorientations ! calc remainder of array constituentGrain = NgrainsOfConstituent(i)-myNorientations ! calc remainder of array
do j = 1_pInt,myNorientations ! loop over each "real" orientation do j = 1_pInt,myNorientations ! loop over each "real" orientation
symOrientation = math_symmetricEulers(texture_symmetry(textureID),orientationOfGrain(:,j)) ! get symmetric equivalents symOrientation = math_symmetricEulers(texture_symmetry(textureID),orientationOfGrain(:,j)) ! get symmetric equivalents
e = min(symExtension,constituentGrain) ! are we at end of constituent grain array? e = min(symExtension,constituentGrain) ! are we at end of constituent grain array?
if (e > 0_pInt) then if (e > 0_pInt) then
orientationOfGrain(:,grain+myNorientations+1+(j-1_pInt)*symExtension:& orientationOfGrain(:,grain+myNorientations+1+(j-1_pInt)*symExtension:&
grain+myNorientations+e+(j-1_pInt)*symExtension) = & grain+myNorientations+e+(j-1_pInt)*symExtension) = &
symOrientation(:,1:e) symOrientation(:,1:e)
constituentGrain = constituentGrain - e ! remainder shrinks by e constituentGrain = constituentGrain - e ! remainder shrinks by e
endif endif
enddo enddo
endif endif
grain = grain + NgrainsOfConstituent(i) ! advance microstructure grain index grain = grain + NgrainsOfConstituent(i) ! advance microstructure grain index
enddo ! constituent enddo constituents
! ----------------------------------------------------------------------------
if (.not. microstructure_elemhomo(micro)) then ! unless element homogeneous, reshuffle grains ! unless element homogeneous, reshuffle grains
do i=1_pInt,myNgrains-1_pInt ! walk thru grains if (.not. microstructure_elemhomo(micro)) then
do i=1_pInt,myNgrains-1_pInt ! walk thru grains
call random_number(rnd) call random_number(rnd)
t = nint(rnd*(myNgrains-i)+i+0.5_pReal,pInt) ! select a grain in remaining list t = nint(rnd*(myNgrains-i)+i+0.5_pReal,pInt) ! select a grain in remaining list
m = phaseOfGrain(t) ! exchange current with random m = phaseOfGrain(t) ! exchange current with random
phaseOfGrain(t) = phaseOfGrain(i) phaseOfGrain(t) = phaseOfGrain(i)
phaseOfGrain(i) = m phaseOfGrain(i) = m
m = textureOfGrain(t) ! exchange current with random m = textureOfGrain(t) ! exchange current with random
textureOfGrain(t) = textureOfGrain(i) textureOfGrain(t) = textureOfGrain(i)
textureOfGrain(i) = m textureOfGrain(i) = m
orientation = orientationOfGrain(:,t) orientation = orientationOfGrain(:,t)
@ -882,34 +895,33 @@ subroutine material_populateGrains
orientationOfGrain(:,i) = orientation orientationOfGrain(:,i) = orientation
enddo enddo
endif endif
!calc fraction after weighing with volumePerGrain
!exchange in MC steps to improve result...
! ---------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calc fraction after weighing with volumePerGrain, exchange in MC steps to improve result...
grain = 0_pInt grain = 0_pInt
do hme = 1_pInt, Nelems(homog,micro) do hme = 1_pInt, Nelems(homog,micro)
e = elemsOfHomogMicro(hme,homog,micro) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex e = elemsOfHomogMicro(hme,homog,micro) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
t = FE_geomtype(mesh_element(2,e)) t = FE_geomtype(mesh_element(2,e))
if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs
forall (i = 1_pInt:FE_Nips(t), g = 1_pInt:dGrains) ! loop over IPs and grains forall (i = 1_pInt:FE_Nips(t), g = 1_pInt:dGrains) ! loop over IPs and grains
material_volume(g,i,e) = volumeOfGrain(grain+g) material_volume(g,i,e) = volumeOfGrain(grain+g)
material_phase(g,i,e) = phaseOfGrain(grain+g) material_phase(g,i,e) = phaseOfGrain(grain+g)
material_texture(g,i,e) = textureOfGrain(grain+g) material_texture(g,i,e) = textureOfGrain(grain+g)
material_EulerAngles(:,g,i,e) = orientationOfGrain(:,grain+g) material_EulerAngles(:,g,i,e) = orientationOfGrain(:,grain+g)
end forall end forall
FEsolving_execIP(2,e) = 1_pInt ! restrict calculation to first IP only, since all other results are to be copied from this FEsolving_execIP(2,e) = 1_pInt ! restrict calculation to first IP only, since all other results are to be copied from this
grain = grain + dGrains ! wind forward by NgrainsPerIP grain = grain + dGrains ! wind forward by NgrainsPerIP
else else
forall (i = 1_pInt:FE_Nips(t), g = 1_pInt:dGrains) ! loop over IPs and grains forall (i = 1_pInt:FE_Nips(t), g = 1_pInt:dGrains) ! loop over IPs and grains
material_volume(g,i,e) = volumeOfGrain(grain+(i-1_pInt)*dGrains+g) material_volume(g,i,e) = volumeOfGrain(grain+(i-1_pInt)*dGrains+g)
material_phase(g,i,e) = phaseOfGrain(grain+(i-1_pInt)*dGrains+g) material_phase(g,i,e) = phaseOfGrain(grain+(i-1_pInt)*dGrains+g)
material_texture(g,i,e) = textureOfGrain(grain+(i-1_pInt)*dGrains+g) material_texture(g,i,e) = textureOfGrain(grain+(i-1_pInt)*dGrains+g)
material_EulerAngles(:,g,i,e) = orientationOfGrain(:,grain+(i-1_pInt)*dGrains+g) material_EulerAngles(:,g,i,e) = orientationOfGrain(:,grain+(i-1_pInt)*dGrains+g)
end forall end forall
grain = grain + FE_Nips(t) * dGrains ! wind forward by Nips*NgrainsPerIP grain = grain + FE_Nips(t) * dGrains ! wind forward by Nips*NgrainsPerIP
endif endif
enddo enddo
endif ! active homog,micro pair endif ! active homog,micro pair
enddo enddo
enddo enddo

4
code/prec.f90
View File

@ -82,8 +82,8 @@ subroutine prec_init
implicit none implicit none
write(6,'(/,a)') '<<<+- prec init -+>>>' write(6,'(/,a)') ' <<<+- prec init -+>>>'
write(6,'(a)') '$Id$' write(6,'(a)') ' $Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
write(6,'(a,i3)') ' Bytes for pReal: ',pReal write(6,'(a,i3)') ' Bytes for pReal: ',pReal
write(6,'(a,i3)') ' Bytes for pInt: ',pInt write(6,'(a,i3)') ' Bytes for pInt: ',pInt