2011-04-07 12:50:28 +05:30
! Copyright 2011 Max-Planck-Institut für Eisenforschung GmbH
2011-04-04 19:39:54 +05:30
!
! This file is part of DAMASK,
2011-04-07 12:50:28 +05:30
! the Düsseldorf Advanced MAterial Simulation Kit.
2011-04-04 19:39:54 +05:30
!
! DAMASK is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! DAMASK is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with DAMASK. If not, see <http://www.gnu.org/licenses/>.
!
!##############################################################
2009-08-31 20:39:15 +05:30
!* $Id$
2009-03-04 17:18:54 +05:30
!************************************
!* Module: MATERIAL *
!************************************
!* contains: *
!* - parsing of material.config *
!************************************
MODULE material
!*** Include other modules ***
use prec , only : pReal , pInt
implicit none
2011-08-02 15:44:16 +05:30
character ( len = 64 ) , parameter :: material_configFile = 'material.config'
character ( len = 64 ) , parameter :: material_localFileExt = 'materialConfig'
2009-03-20 20:04:24 +05:30
character ( len = 32 ) , parameter :: material_partHomogenization = 'homogenization'
character ( len = 32 ) , parameter :: material_partMicrostructure = 'microstructure'
2011-08-02 15:44:16 +05:30
character ( len = 32 ) , parameter :: material_partCrystallite = 'crystallite'
character ( len = 32 ) , parameter :: material_partPhase = 'phase'
character ( len = 32 ) , parameter :: material_partTexture = 'texture'
2012-01-12 16:06:17 +05:30
2009-03-04 17:18:54 +05:30
!*************************************
!* Definition of material properties *
!*************************************
!* Number of materials
2010-03-19 18:26:00 +05:30
integer ( pInt ) &
material_Nhomogenization , & ! number of homogenizations
material_Nmicrostructure , & ! number of microstructures
material_Ncrystallite , & ! number of crystallite settings
material_Nphase , & ! number of phases
material_Ntexture , & ! number of textures
microstructure_maxNconstituents , & ! max number of constituents in any phase
homogenization_maxNgrains , & ! max number of grains in any USED homogenization
texture_maxNgauss , & ! max number of Gauss components in any texture
texture_maxNfiber ! max number of Fiber components in any texture
character ( len = 64 ) , dimension ( : ) , allocatable :: &
homogenization_name , & ! name of each homogenization
homogenization_type , & ! type of each homogenization
microstructure_name , & ! name of each microstructure
crystallite_name , & ! name of each crystallite setting
phase_name , & ! name of each phase
phase_constitution , & ! constitution of each phase
texture_name ! name of each texture
character ( len = 256 ) , dimension ( : ) , allocatable :: &
texture_ODFfile ! name of each ODF file
integer ( pInt ) , dimension ( : ) , allocatable :: &
homogenization_Ngrains , & ! number of grains in each homogenization
homogenization_typeInstance , & ! instance of particular type of each homogenization
homogenization_Noutput , & ! number of '(output)' items per homogenization
microstructure_Nconstituents , & ! number of constituents in each microstructure
crystallite_Noutput , & ! number of '(output)' items per crystallite setting
phase_constitutionInstance , & ! instance of particular constitution of each phase
phase_Noutput , & ! number of '(output)' items per phase
texture_symmetry , & ! number of symmetric orientations per texture
texture_Ngauss , & ! number of Gauss components per texture
texture_Nfiber ! number of Fiber components per texture
logical , dimension ( : ) , allocatable :: &
homogenization_active , & !
microstructure_active , & !
microstructure_elemhomo , & ! flag to indicate homogeneous microstructure distribution over element's IPs
phase_localConstitution ! flags phases with local constitutive law
integer ( pInt ) , dimension ( : ) , allocatable :: &
microstructure_crystallite ! crystallite setting ID of each microstructure
integer ( pInt ) , dimension ( : , : ) , allocatable :: &
microstructure_phase , & ! phase 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 :: &
material_volume ! volume of each grain,IP,element
integer ( pInt ) , dimension ( : , : , : ) , allocatable :: &
2011-03-22 19:10:27 +05:30
material_phase , & ! phase (index) of each grain,IP,element
material_texture ! texture (index) of each grain,IP,element
2010-03-19 18:26:00 +05:30
real ( pReal ) , dimension ( : , : , : , : ) , allocatable :: &
material_EulerAngles ! initial orientation of each grain,IP,element
real ( pReal ) , dimension ( : , : , : ) , allocatable :: &
texture_Gauss , & ! data of each Gauss component
texture_Fiber ! data of each Fiber component
2009-03-04 17:18:54 +05:30
CONTAINS
!*********************************************************************
subroutine material_init ( )
!*********************************************************************
!* Module initialization *
!**************************************
use prec , only : pReal , pInt
2011-08-02 15:44:16 +05:30
use IO , only : IO_error , IO_open_file , IO_open_jobFile
2011-03-21 16:01:17 +05:30
use debug , only : debug_verbosity
2009-03-04 17:18:54 +05:30
implicit none
!* Definition of variables
integer ( pInt ) , parameter :: fileunit = 200
2009-07-22 21:37:19 +05:30
integer ( pInt ) i , j
2009-06-18 19:58:02 +05:30
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
!$OMP CRITICAL (write2out)
2011-03-21 16:01:17 +05:30
write ( 6 , * )
write ( 6 , * ) '<<<+- material init -+>>>'
write ( 6 , * ) '$Id$'
write ( 6 , * )
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
!$OMP END CRITICAL (write2out)
2011-08-02 15:44:16 +05:30
if ( . not . IO_open_jobFile ( fileunit , material_localFileExt ) ) then ! no local material configuration present...
if ( . not . IO_open_file ( fileunit , material_configFile ) ) call IO_error ( 100 ) ! ...and cannot open material.config file
endif
2009-03-20 20:04:24 +05:30
call material_parseHomogenization ( fileunit , material_partHomogenization )
2011-10-18 14:48:05 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * ) 'Homogenization parsed'
!$OMP END CRITICAL (write2out)
endif
2009-03-20 20:04:24 +05:30
call material_parseMicrostructure ( fileunit , material_partMicrostructure )
2011-10-18 14:48:05 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * ) 'Microstructure parsed'
!$OMP END CRITICAL (write2out)
endif
2010-02-25 23:09:11 +05:30
call material_parseCrystallite ( fileunit , material_partCrystallite )
2011-10-18 14:48:05 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * ) 'Crystallite parsed'
!$OMP END CRITICAL (write2out)
endif
2009-03-20 20:04:24 +05:30
call material_parseTexture ( fileunit , material_partTexture )
2011-10-18 14:48:05 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * ) 'Texture parsed'
!$OMP END CRITICAL (write2out)
endif
2009-03-20 20:04:24 +05:30
call material_parsePhase ( fileunit , material_partPhase )
2011-10-18 14:48:05 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * ) 'Phase parsed'
!$OMP END CRITICAL (write2out)
endif
2009-03-04 17:18:54 +05:30
close ( fileunit )
do i = 1 , material_Nmicrostructure
2010-02-25 23:09:11 +05:30
if ( microstructure_crystallite ( i ) < 1 . or . &
microstructure_crystallite ( i ) > material_Ncrystallite ) call IO_error ( 150 , i )
2009-03-09 19:28:59 +05:30
if ( minval ( microstructure_phase ( 1 : microstructure_Nconstituents ( i ) , i ) ) < 1 . or . &
2010-02-25 23:09:11 +05:30
maxval ( microstructure_phase ( 1 : microstructure_Nconstituents ( i ) , i ) ) > material_Nphase ) call IO_error ( 155 , i )
2009-03-09 19:28:59 +05:30
if ( minval ( microstructure_texture ( 1 : microstructure_Nconstituents ( i ) , i ) ) < 1 . or . &
2009-03-31 14:39:24 +05:30
maxval ( microstructure_texture ( 1 : microstructure_Nconstituents ( i ) , i ) ) > material_Ntexture ) call IO_error ( 160 , i )
2009-12-02 18:38:14 +05:30
if ( abs ( sum ( microstructure_fraction ( : , i ) ) - 1.0_pReal ) > = 1.0e-10_pReal ) then
2011-03-21 16:01:17 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * ) 'sum of microstructure fraction = ' , sum ( microstructure_fraction ( : , i ) )
!$OMP END CRITICAL (write2out)
endif
2009-12-02 18:38:14 +05:30
call IO_error ( 170 , i )
endif
2009-03-04 17:18:54 +05:30
enddo
2011-03-21 16:01:17 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * )
write ( 6 , * ) 'MATERIAL configuration'
write ( 6 , * )
write ( 6 , '(a32,x,a16,x,a6)' ) 'homogenization ' , 'type ' , 'grains'
do i = 1 , material_Nhomogenization
write ( 6 , '(x,a32,x,a16,x,i4)' ) homogenization_name ( i ) , homogenization_type ( i ) , homogenization_Ngrains ( i )
2009-07-22 21:37:19 +05:30
enddo
write ( 6 , * )
2011-03-21 16:01:17 +05:30
write ( 6 , '(a32,x,a11,x,a12,x,a13)' ) 'microstructure ' , 'crystallite' , 'constituents' , 'homogeneous'
do i = 1 , material_Nmicrostructure
write ( 6 , '(a32,4x,i4,8x,i4,8x,l)' ) microstructure_name ( i ) , &
microstructure_crystallite ( i ) , &
microstructure_Nconstituents ( i ) , &
microstructure_elemhomo ( i )
if ( microstructure_Nconstituents ( i ) > 0_pInt ) then
do j = 1 , microstructure_Nconstituents ( i )
write ( 6 , '(a1,x,a32,x,a32,x,f6.4)' ) '>' , phase_name ( microstructure_phase ( j , i ) ) , &
texture_name ( microstructure_texture ( j , i ) ) , &
microstructure_fraction ( j , i )
enddo
write ( 6 , * )
endif
enddo
!$OMP END CRITICAL (write2out)
endif
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
2009-03-04 17:18:54 +05:30
call material_populateGrains ( )
2009-06-15 18:41:21 +05:30
endsubroutine
2009-03-04 17:18:54 +05:30
!*********************************************************************
2009-03-20 20:04:24 +05:30
subroutine material_parseHomogenization ( file , myPart )
2009-03-04 17:18:54 +05:30
!*********************************************************************
use prec , only : pInt
use IO
2009-07-22 21:37:19 +05:30
use mesh , only : mesh_element
2009-03-04 17:18:54 +05:30
implicit none
2009-03-20 20:04:24 +05:30
character ( len = * ) , intent ( in ) :: myPart
2009-03-04 17:18:54 +05:30
integer ( pInt ) , intent ( in ) :: file
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: positions
2009-03-31 14:54:12 +05:30
integer ( pInt ) Nsections , section , s
2009-03-04 17:18:54 +05:30
character ( len = 64 ) tag
character ( len = 1024 ) line
2009-05-07 21:57:36 +05:30
Nsections = IO_countSections ( file , myPart )
2009-03-04 17:18:54 +05:30
material_Nhomogenization = Nsections
2010-02-25 23:09:11 +05:30
if ( Nsections < 1_pInt ) call IO_error ( 125 , ext_msg = myPart )
2009-05-07 21:57:36 +05:30
2009-03-04 17:18:54 +05:30
allocate ( homogenization_name ( Nsections ) ) ; homogenization_name = ''
allocate ( homogenization_type ( Nsections ) ) ; homogenization_type = ''
2009-03-31 14:54:12 +05:30
allocate ( homogenization_typeInstance ( Nsections ) ) ; homogenization_typeInstance = 0_pInt
2009-03-04 17:18:54 +05:30
allocate ( homogenization_Ngrains ( Nsections ) ) ; homogenization_Ngrains = 0_pInt
2009-05-07 21:57:36 +05:30
allocate ( homogenization_Noutput ( Nsections ) ) ; homogenization_Noutput = 0_pInt
2009-07-22 21:37:19 +05:30
allocate ( homogenization_active ( Nsections ) ) ; homogenization_active = . false .
forall ( s = 1 : Nsections ) homogenization_active ( s ) = any ( mesh_element ( 3 , : ) == s ) ! current homogenization used in model?
2009-03-31 14:54:12 +05:30
homogenization_Noutput = IO_countTagInPart ( file , myPart , '(output)' , Nsections )
2009-03-04 17:18:54 +05:30
rewind ( file )
line = ''
section = 0
do while ( IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = myPart ) ! wind forward to myPart
read ( file , '(a1024)' , END = 100 ) line
enddo
do
read ( file , '(a1024)' , END = 100 ) line
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
if ( IO_getTag ( line , '<' , '>' ) / = '' ) exit ! stop at next part
if ( IO_getTag ( line , '[' , ']' ) / = '' ) then ! next section
section = section + 1
homogenization_name ( section ) = IO_getTag ( line , '[' , ']' )
endif
if ( section > 0 ) then
positions = IO_stringPos ( line , maxNchunks )
tag = IO_lc ( IO_stringValue ( line , positions , 1 ) ) ! extract key
select case ( tag )
case ( 'type' )
2009-07-31 17:32:20 +05:30
homogenization_type ( section ) = IO_lc ( IO_stringValue ( line , positions , 2 ) ) ! adding: IO_lc function <<<updated 31.07.2009>>>
2009-03-31 14:54:12 +05:30
do s = 1 , section
if ( homogenization_type ( s ) == homogenization_type ( section ) ) &
homogenization_typeInstance ( section ) = homogenization_typeInstance ( section ) + 1 ! count instances
enddo
2009-03-04 17:18:54 +05:30
case ( 'ngrains' )
homogenization_Ngrains ( section ) = IO_intValue ( line , positions , 2 )
end select
endif
enddo
2009-07-22 21:37:19 +05:30
100 homogenization_maxNgrains = maxval ( homogenization_Ngrains , homogenization_active )
2009-03-04 17:18:54 +05:30
2009-06-15 18:41:21 +05:30
endsubroutine
2009-03-04 17:18:54 +05:30
!*********************************************************************
2009-03-20 20:04:24 +05:30
subroutine material_parseMicrostructure ( file , myPart )
2009-03-04 17:18:54 +05:30
!*********************************************************************
use prec , only : pInt
use IO
2012-01-12 16:06:17 +05:30
use mesh , only : mesh_element
2009-03-04 17:18:54 +05:30
implicit none
2009-03-20 20:04:24 +05:30
character ( len = * ) , intent ( in ) :: myPart
2009-03-04 17:18:54 +05:30
integer ( pInt ) , intent ( in ) :: file
integer ( pInt ) , parameter :: maxNchunks = 7
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: positions
integer ( pInt ) Nsections , section , constituent , i
character ( len = 64 ) tag
character ( len = 1024 ) line
2011-09-13 21:24:06 +05:30
2009-03-04 17:18:54 +05:30
Nsections = IO_countSections ( file , myPart )
material_Nmicrostructure = Nsections
2010-02-25 23:09:11 +05:30
if ( Nsections < 1_pInt ) call IO_error ( 125 , ext_msg = myPart )
allocate ( microstructure_name ( Nsections ) ) ; microstructure_name = ''
allocate ( microstructure_crystallite ( Nsections ) ) ; microstructure_crystallite = 0_pInt
2009-03-04 17:18:54 +05:30
allocate ( microstructure_Nconstituents ( Nsections ) )
2009-07-22 21:37:19 +05:30
allocate ( microstructure_active ( Nsections ) )
2009-11-24 20:30:25 +05:30
allocate ( microstructure_elemhomo ( Nsections ) )
2009-07-22 21:37:19 +05:30
2012-01-12 16:06:17 +05:30
forall ( i = 1 : Nsections ) microstructure_active ( i ) = any ( mesh_element ( 4 , : ) == i ) ! current microstructure used in model?
2011-10-18 14:48:05 +05:30
2009-03-04 17:18:54 +05:30
microstructure_Nconstituents = IO_countTagInPart ( file , myPart , '(constituent)' , Nsections )
microstructure_maxNconstituents = maxval ( microstructure_Nconstituents )
2009-11-24 20:30:25 +05:30
microstructure_elemhomo = IO_spotTagInPart ( file , myPart , '/elementhomogeneous/' , Nsections )
2009-03-04 17:18:54 +05:30
allocate ( microstructure_phase ( microstructure_maxNconstituents , Nsections ) ) ; microstructure_phase = 0_pInt
allocate ( microstructure_texture ( microstructure_maxNconstituents , Nsections ) ) ; microstructure_texture = 0_pInt
allocate ( microstructure_fraction ( microstructure_maxNconstituents , Nsections ) ) ; microstructure_fraction = 0.0_pReal
rewind ( file )
line = ''
section = 0
do while ( IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = myPart ) ! wind forward to myPart
read ( file , '(a1024)' , END = 100 ) line
enddo
do
read ( file , '(a1024)' , END = 100 ) line
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
if ( IO_getTag ( line , '<' , '>' ) / = '' ) exit ! stop at next part
if ( IO_getTag ( line , '[' , ']' ) / = '' ) then ! next section
section = section + 1
constituent = 0
microstructure_name ( section ) = IO_getTag ( line , '[' , ']' )
endif
if ( section > 0 ) then
positions = IO_stringPos ( line , maxNchunks )
tag = IO_lc ( IO_stringValue ( line , positions , 1 ) ) ! extract key
select case ( tag )
2010-02-25 23:09:11 +05:30
case ( 'crystallite' )
microstructure_crystallite ( section ) = IO_intValue ( line , positions , 2 )
2009-03-04 17:18:54 +05:30
case ( '(constituent)' )
constituent = constituent + 1
do i = 2 , 6 , 2
tag = IO_lc ( IO_stringValue ( line , positions , i ) )
select case ( tag )
case ( 'phase' )
microstructure_phase ( constituent , section ) = IO_intValue ( line , positions , i + 1 )
case ( 'texture' )
microstructure_texture ( constituent , section ) = IO_intValue ( line , positions , i + 1 )
case ( 'fraction' )
microstructure_fraction ( constituent , section ) = IO_floatValue ( line , positions , i + 1 )
end select
enddo
end select
endif
enddo
2011-10-18 14:48:05 +05:30
100 endsubroutine
2009-03-04 17:18:54 +05:30
2010-02-25 23:09:11 +05:30
!*********************************************************************
subroutine material_parseCrystallite ( file , myPart )
!*********************************************************************
use prec , only : pInt
use IO
use mesh , only : mesh_element
implicit none
character ( len = * ) , intent ( in ) :: myPart
integer ( pInt ) , intent ( in ) :: file
integer ( pInt ) Nsections , section
character ( len = 1024 ) line
Nsections = IO_countSections ( file , myPart )
material_Ncrystallite = Nsections
if ( Nsections < 1_pInt ) call IO_error ( 125 , ext_msg = myPart )
allocate ( crystallite_name ( Nsections ) ) ; crystallite_name = ''
allocate ( crystallite_Noutput ( Nsections ) ) ; crystallite_Noutput = 0_pInt
crystallite_Noutput = IO_countTagInPart ( file , myPart , '(output)' , Nsections )
rewind ( file )
line = ''
section = 0
do while ( IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = myPart ) ! wind forward to myPart
read ( file , '(a1024)' , END = 100 ) line
enddo
do
read ( file , '(a1024)' , END = 100 ) line
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
if ( IO_getTag ( line , '<' , '>' ) / = '' ) exit ! stop at next part
if ( IO_getTag ( line , '[' , ']' ) / = '' ) then ! next section
section = section + 1
crystallite_name ( section ) = IO_getTag ( line , '[' , ']' )
endif
enddo
2011-10-18 14:48:05 +05:30
100 endsubroutine
2010-02-25 23:09:11 +05:30
2009-03-04 17:18:54 +05:30
!*********************************************************************
2009-03-20 20:04:24 +05:30
subroutine material_parsePhase ( file , myPart )
2009-03-04 17:18:54 +05:30
!*********************************************************************
use prec , only : pInt
use IO
implicit none
2009-03-20 20:04:24 +05:30
character ( len = * ) , intent ( in ) :: myPart
2009-03-04 17:18:54 +05:30
integer ( pInt ) , intent ( in ) :: file
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: positions
integer ( pInt ) Nsections , section , s
character ( len = 64 ) tag
character ( len = 1024 ) line
2009-03-20 20:04:24 +05:30
Nsections = IO_countSections ( file , myPart )
2009-03-04 17:18:54 +05:30
material_Nphase = Nsections
2010-02-25 23:09:11 +05:30
if ( Nsections < 1_pInt ) call IO_error ( 125 , ext_msg = myPart )
2009-03-04 17:18:54 +05:30
allocate ( phase_name ( Nsections ) ) ; phase_name = ''
allocate ( phase_constitution ( Nsections ) ) ; phase_constitution = ''
allocate ( phase_constitutionInstance ( Nsections ) ) ; phase_constitutionInstance = 0_pInt
allocate ( phase_Noutput ( Nsections ) )
2009-04-03 16:04:17 +05:30
allocate ( phase_localConstitution ( Nsections ) )
2009-03-04 17:18:54 +05:30
phase_Noutput = IO_countTagInPart ( file , myPart , '(output)' , Nsections )
2009-04-03 16:04:17 +05:30
phase_localConstitution = . not . IO_spotTagInPart ( file , myPart , '/nonlocal/' , Nsections )
2009-03-04 17:18:54 +05:30
rewind ( file )
line = ''
section = 0
do while ( IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = myPart ) ! wind forward to myPart
read ( file , '(a1024)' , END = 100 ) line
enddo
do
read ( file , '(a1024)' , END = 100 ) line
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
if ( IO_getTag ( line , '<' , '>' ) / = '' ) exit ! stop at next part
if ( IO_getTag ( line , '[' , ']' ) / = '' ) then ! next section
section = section + 1
phase_name ( section ) = IO_getTag ( line , '[' , ']' )
endif
if ( section > 0 ) then
positions = IO_stringPos ( line , maxNchunks )
tag = IO_lc ( IO_stringValue ( line , positions , 1 ) ) ! extract key
select case ( tag )
case ( 'constitution' )
phase_constitution ( section ) = IO_lc ( IO_stringValue ( line , positions , 2 ) )
do s = 1 , section
if ( phase_constitution ( s ) == phase_constitution ( section ) ) &
phase_constitutionInstance ( section ) = phase_constitutionInstance ( section ) + 1 ! count instances
enddo
end select
endif
enddo
2011-10-18 14:48:05 +05:30
100 endsubroutine
2009-03-04 17:18:54 +05:30
!*********************************************************************
2009-03-20 20:04:24 +05:30
subroutine material_parseTexture ( file , myPart )
2009-03-04 17:18:54 +05:30
!*********************************************************************
use prec , only : pInt , pReal
use IO
2011-05-28 15:14:43 +05:30
use math , only : inRad , math_sampleRandomOri
2009-03-04 17:18:54 +05:30
implicit none
2009-03-20 20:04:24 +05:30
character ( len = * ) , intent ( in ) :: myPart
2009-03-04 17:18:54 +05:30
integer ( pInt ) , intent ( in ) :: file
integer ( pInt ) , parameter :: maxNchunks = 13
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: positions
integer ( pInt ) Nsections , section , gauss , fiber , i
character ( len = 64 ) tag
character ( len = 1024 ) line
Nsections = IO_countSections ( file , myPart )
material_Ntexture = Nsections
2010-02-25 23:09:11 +05:30
if ( Nsections < 1_pInt ) call IO_error ( 125 , ext_msg = myPart )
2009-03-04 17:18:54 +05:30
allocate ( texture_name ( Nsections ) ) ; texture_name = ''
allocate ( texture_ODFfile ( Nsections ) ) ; texture_ODFfile = ''
allocate ( texture_symmetry ( Nsections ) ) ; texture_symmetry = 1_pInt
allocate ( texture_Ngauss ( Nsections ) ) ; texture_Ngauss = 0_pInt
allocate ( texture_Nfiber ( Nsections ) ) ; texture_Nfiber = 0_pInt
2011-05-28 15:14:43 +05:30
texture_Ngauss = IO_countTagInPart ( file , myPart , '(gauss)' , Nsections ) + &
IO_countTagInPart ( file , myPart , '(random)' , Nsections )
texture_Nfiber = IO_countTagInPart ( file , myPart , '(fiber)' , Nsections )
2009-03-04 17:18:54 +05:30
texture_maxNgauss = maxval ( texture_Ngauss )
texture_maxNfiber = maxval ( texture_Nfiber )
allocate ( texture_Gauss ( 5 , texture_maxNgauss , Nsections ) ) ; texture_Gauss = 0.0_pReal
allocate ( texture_Fiber ( 6 , texture_maxNfiber , Nsections ) ) ; texture_Fiber = 0.0_pReal
rewind ( file )
line = ''
section = 0
do while ( IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = myPart ) ! wind forward to myPart
read ( file , '(a1024)' , END = 100 ) line
enddo
do
read ( file , '(a1024)' , END = 100 ) line
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
if ( IO_getTag ( line , '<' , '>' ) / = '' ) exit ! stop at next part
if ( IO_getTag ( line , '[' , ']' ) / = '' ) then ! next section
section = section + 1
gauss = 0
fiber = 0
texture_name ( section ) = IO_getTag ( line , '[' , ']' )
endif
if ( section > 0 ) then
positions = IO_stringPos ( line , maxNchunks )
tag = IO_lc ( IO_stringValue ( line , positions , 1 ) ) ! extract key
select case ( tag )
case ( 'hybridia' )
texture_ODFfile ( section ) = IO_stringValue ( line , positions , 2 )
case ( 'symmetry' )
tag = IO_lc ( IO_stringValue ( line , positions , 2 ) )
select case ( tag )
case ( 'orthotropic' )
texture_symmetry ( section ) = 4
case ( 'monoclinic' )
texture_symmetry ( section ) = 2
case default
texture_symmetry ( section ) = 1
end select
2011-05-28 15:14:43 +05:30
case ( '(random)' )
gauss = gauss + 1
texture_Gauss ( 1 : 3 , gauss , section ) = math_sampleRandomOri ( )
do i = 2 , 4 , 2
tag = IO_lc ( IO_stringValue ( line , positions , i ) )
select case ( tag )
case ( 'scatter' )
texture_Gauss ( 4 , gauss , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'fraction' )
texture_Gauss ( 5 , gauss , section ) = IO_floatValue ( line , positions , i + 1 )
end select
enddo
2009-03-04 17:18:54 +05:30
case ( '(gauss)' )
gauss = gauss + 1
do i = 2 , 10 , 2
tag = IO_lc ( IO_stringValue ( line , positions , i ) )
select case ( tag )
case ( 'phi1' )
texture_Gauss ( 1 , gauss , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'phi' )
texture_Gauss ( 2 , gauss , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'phi2' )
texture_Gauss ( 3 , gauss , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'scatter' )
texture_Gauss ( 4 , gauss , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'fraction' )
texture_Gauss ( 5 , gauss , section ) = IO_floatValue ( line , positions , i + 1 )
end select
enddo
2011-05-28 15:14:43 +05:30
2009-03-04 17:18:54 +05:30
case ( '(fiber)' )
fiber = fiber + 1
do i = 2 , 12 , 2
tag = IO_lc ( IO_stringValue ( line , positions , i ) )
select case ( tag )
2009-04-28 15:15:52 +05:30
case ( 'alpha1' )
2009-03-04 17:18:54 +05:30
texture_Fiber ( 1 , fiber , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'alpha2' )
texture_Fiber ( 2 , fiber , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'beta1' )
texture_Fiber ( 3 , fiber , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'beta2' )
texture_Fiber ( 4 , fiber , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'scatter' )
texture_Fiber ( 5 , fiber , section ) = IO_floatValue ( line , positions , i + 1 ) * inRad
case ( 'fraction' )
texture_Fiber ( 6 , fiber , section ) = IO_floatValue ( line , positions , i + 1 )
end select
enddo
end select
endif
enddo
2011-10-18 14:48:05 +05:30
100 endsubroutine
2009-03-04 17:18:54 +05:30
!*********************************************************************
subroutine material_populateGrains ( )
!*********************************************************************
use prec , only : pInt , pReal
2010-02-18 21:24:10 +05:30
use math , only : math_sampleRandomOri , math_sampleGaussOri , math_sampleFiberOri , math_symmetricEulers , inDeg
2012-01-12 16:06:17 +05:30
use mesh , only : mesh_element , mesh_maxNips , mesh_NcpElems , mesh_ipVolume , FE_Nips
2009-03-04 17:18:54 +05:30
use IO , only : IO_error , IO_hybridIA
2010-03-24 18:50:12 +05:30
use FEsolving , only : FEsolving_execIP
2011-03-21 16:01:17 +05:30
use debug , only : debug_verbosity
2009-03-04 17:18:54 +05:30
implicit none
integer ( pInt ) , dimension ( : , : ) , allocatable :: Ngrains
integer ( pInt ) , dimension ( microstructure_maxNconstituents ) :: NgrainsOfConstituent
2010-02-18 21:24:10 +05:30
real ( pReal ) , dimension ( : ) , allocatable :: volumeOfGrain
2009-03-04 17:18:54 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable :: orientationOfGrain
real ( pReal ) , dimension ( 3 ) :: orientation
real ( pReal ) , dimension ( 3 , 3 ) :: symOrientation
2011-03-22 19:10:27 +05:30
integer ( pInt ) , dimension ( : ) , allocatable :: phaseOfGrain , textureOfGrain
2011-10-18 14:48:05 +05:30
integer ( pInt ) t , e , i , g , j , m , homog , micro , sgn , loopStart , loopEnd
2009-03-05 19:48:50 +05:30
integer ( pInt ) phaseID , textureID , dGrains , myNgrains , myNorientations , &
2012-01-12 16:06:17 +05:30
grain , constituentGrain , symExtension , counter_cpElemsindex
2009-03-04 17:18:54 +05:30
real ( pReal ) extreme , rnd
2012-01-12 16:06:17 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable :: NcpElemscounter ! counts number of elements in homog, micro array
integer ( pInt ) , dimension ( : , : , : ) , allocatable :: cpElemsindex ! lists element number in homog, micro array
2009-03-04 17:18:54 +05:30
2010-02-18 21:24:10 +05:30
2011-03-22 19:10:27 +05:30
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_texture ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) ) ; material_texture = 0_pInt
2009-03-04 17:18:54 +05:30
allocate ( material_EulerAngles ( 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) ) ; material_EulerAngles = 0.0_pReal
allocate ( Ngrains ( material_Nhomogenization , material_Nmicrostructure ) ) ; Ngrains = 0_pInt
2012-01-12 16:06:17 +05:30
allocate ( NcpElemscounter ( material_Nhomogenization , material_Nmicrostructure ) ) ; NcpElemscounter = &
0_pInt
2009-03-04 17:18:54 +05:30
2009-07-22 21:37:19 +05:30
! identify maximum grain count per IP (from element) and find grains per homog/micro pair
2012-01-12 16:06:17 +05:30
do e = 1 , mesh_NcpElems
NcpElemscounter ( homog , micro ) = NcpElemscounter ( homog , micro ) + 1_pInt
enddo
allocate ( cpElemsindex ( material_Nhomogenization , material_Nmicrostructure , maxval ( NcpElemscounter ) ) )
cpElemsindex = 0_pInt
counter_cpElemsindex = 0_pInt
2009-03-04 17:18:54 +05:30
do e = 1 , mesh_NcpElems
homog = mesh_element ( 3 , e )
micro = mesh_element ( 4 , e )
if ( homog < 1 . or . homog > material_Nhomogenization ) & ! out of bounds
call IO_error ( 130 , e , 0 , 0 )
if ( micro < 1 . or . micro > material_Nmicrostructure ) & ! out of bounds
call IO_error ( 140 , e , 0 , 0 )
2009-11-24 20:30:25 +05:30
if ( microstructure_elemhomo ( micro ) ) then
dGrains = homogenization_Ngrains ( homog )
else
dGrains = homogenization_Ngrains ( homog ) * FE_Nips ( mesh_element ( 2 , e ) )
endif
Ngrains ( homog , micro ) = Ngrains ( homog , micro ) + dGrains
2012-01-12 16:06:17 +05:30
counter_cpElemsindex = counter_cpElemsindex + 1_pInt
cpElemsindex ( homog , micro , counter_cpElemsindex ) = e ! populate arrays
2009-03-04 17:18:54 +05:30
enddo
2009-07-22 21:37:19 +05:30
allocate ( volumeOfGrain ( maxval ( Ngrains ) ) ) ! reserve memory for maximum case
2009-03-04 17:18:54 +05:30
allocate ( phaseOfGrain ( maxval ( Ngrains ) ) ) ! reserve memory for maximum case
2011-03-22 19:10:27 +05:30
allocate ( textureOfGrain ( maxval ( Ngrains ) ) ) ! reserve memory for maximum case
2009-03-04 17:18:54 +05:30
allocate ( orientationOfGrain ( 3 , maxval ( Ngrains ) ) ) ! reserve memory for maximum case
2011-03-21 16:01:17 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * )
write ( 6 , * ) 'MATERIAL grain population'
write ( 6 , * )
write ( 6 , '(a32,x,a32,x,a6)' ) 'homogenization_name' , 'microstructure_name' , 'grain#'
!$OMP END CRITICAL (write2out)
endif
2009-03-04 17:18:54 +05:30
do homog = 1 , material_Nhomogenization ! loop over homogenizations
dGrains = homogenization_Ngrains ( homog ) ! grain number per material point
do micro = 1 , material_Nmicrostructure ! all pairs of homog and micro
if ( Ngrains ( homog , micro ) > 0 ) then ! an active pair of homog and micro
2009-11-02 13:33:14 +05:30
myNgrains = Ngrains ( homog , micro ) ! assign short name for total number of grains to populate
2011-03-21 16:01:17 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * )
write ( 6 , '(a32,x,a32,x,i6)' ) homogenization_name ( homog ) , microstructure_name ( micro ) , myNgrains
!$OMP END CRITICAL (write2out)
endif
2009-03-04 17:18:54 +05:30
2009-11-02 13:33:14 +05:30
! ---------------------------------------------------------------------------- calculate volume of each grain
2009-05-26 22:54:42 +05:30
volumeOfGrain = 0.0_pReal
2012-01-12 16:06:17 +05:30
grain = 0_pInt
do counter_cpElemsindex = 1 , NcpElemscounter ( homog , micro )
e = cpElemsindex ( homog , micro , counter_cpElemsindex ) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
if ( microstructure_elemhomo ( micro ) ) then ! homogeneous distribution of grains over each element's IPs
volumeOfGrain ( grain + 1 : grain + dGrains ) = sum ( mesh_ipVolume ( 1 : FE_Nips ( mesh_element ( 2 , e ) ) , e ) ) / dGrains
grain = grain + dGrains ! wind forward by NgrainsPerIP
else
forall ( i = 1 : FE_Nips ( mesh_element ( 2 , e ) ) ) & ! loop over IPs
volumeOfGrain ( grain + ( i - 1 ) * dGrains + 1 : grain + i * dGrains ) = &
mesh_ipVolume ( i , e ) / dGrains ! assign IPvolume/Ngrains to all grains of IP
grain = grain + FE_Nips ( mesh_element ( 2 , e ) ) * dGrains ! wind forward by Nips*NgrainsPerIP
2009-03-04 17:18:54 +05:30
endif
enddo
2012-01-12 16:06:17 +05:30
2009-11-02 13:33:14 +05:30
! ---------------------------------------------------------------------------- divide myNgrains as best over constituents
2009-03-04 17:18:54 +05:30
NgrainsOfConstituent = 0_pInt
forall ( i = 1 : microstructure_Nconstituents ( micro ) ) &
2009-11-02 13:33:14 +05:30
NgrainsOfConstituent ( i ) = nint ( microstructure_fraction ( i , micro ) * myNgrains , pInt ) ! do rounding integer conversion
2009-03-04 17:18:54 +05:30
do while ( sum ( NgrainsOfConstituent ) / = myNgrains ) ! total grain count over constituents wrong?
sgn = sign ( 1_pInt , myNgrains - sum ( NgrainsOfConstituent ) ) ! direction of required change
extreme = 0.0_pReal
t = 0_pInt
do i = 1 , microstructure_Nconstituents ( micro ) ! find largest deviator
if ( sgn * log ( NgrainsOfConstituent ( i ) / myNgrains / microstructure_fraction ( i , micro ) ) > extreme ) then
extreme = sgn * log ( NgrainsOfConstituent ( i ) / myNgrains / microstructure_fraction ( i , micro ) )
t = i
endif
enddo
NgrainsOfConstituent ( t ) = NgrainsOfConstituent ( t ) + sgn ! change that by one
2009-06-15 18:41:21 +05:30
enddo
2009-03-04 17:18:54 +05:30
! ----------------------------------------------------------------------------
phaseOfGrain = 0_pInt
2011-03-22 19:10:27 +05:30
textureOfGrain = 0_pInt
2009-03-04 17:18:54 +05:30
orientationOfGrain = 0.0_pReal
grain = 0_pInt ! reset microstructure grain index
2009-11-02 13:33:14 +05:30
do i = 1 , microstructure_Nconstituents ( micro ) ! loop over constituents
2009-03-04 17:18:54 +05:30
phaseID = microstructure_phase ( i , micro )
textureID = microstructure_texture ( i , micro )
phaseOfGrain ( grain + 1 : grain + NgrainsOfConstituent ( i ) ) = phaseID ! assign resp. phase
2011-03-22 19:10:27 +05:30
textureOfGrain ( grain + 1 : grain + NgrainsOfConstituent ( i ) ) = textureID ! assign resp. texture
2009-03-04 17:18:54 +05:30
myNorientations = ceiling ( float ( NgrainsOfConstituent ( i ) ) / texture_symmetry ( textureID ) ) ! max number of unique orientations (excl. symmetry)
constituentGrain = 0_pInt ! constituent grain index
! ---------
if ( texture_ODFfile ( textureID ) == '' ) then ! dealing with texture components
! ---------
do t = 1 , texture_Ngauss ( textureID ) ! loop over Gauss components
do g = 1 , int ( myNorientations * texture_Gauss ( 5 , t , textureID ) ) ! loop over required grain count
orientationOfGrain ( : , grain + constituentGrain + g ) = &
math_sampleGaussOri ( texture_Gauss ( 1 : 3 , t , textureID ) , &
texture_Gauss ( 4 , t , textureID ) )
enddo
constituentGrain = constituentGrain + int ( myNorientations * texture_Gauss ( 5 , t , textureID ) )
enddo
2009-11-02 13:33:14 +05:30
do t = 1 , texture_Nfiber ( textureID ) ! loop over fiber components
2009-03-04 17:18:54 +05:30
do g = 1 , int ( myNorientations * texture_Fiber ( 6 , t , textureID ) ) ! loop over required grain count
orientationOfGrain ( : , grain + constituentGrain + g ) = &
math_sampleFiberOri ( texture_Fiber ( 1 : 2 , t , textureID ) , &
texture_Fiber ( 3 : 4 , t , textureID ) , &
texture_Fiber ( 5 , t , textureID ) )
enddo
constituentGrain = constituentGrain + int ( myNorientations * texture_fiber ( 6 , t , textureID ) )
enddo
do j = constituentGrain + 1 , myNorientations ! fill remainder with random
orientationOfGrain ( : , grain + j ) = math_sampleRandomOri ( )
enddo
! ---------
else ! hybrid IA
! ---------
orientationOfGrain ( : , grain + 1 : grain + myNorientations ) = IO_hybridIA ( myNorientations , texture_ODFfile ( textureID ) )
if ( all ( orientationOfGrain ( : , grain + 1 ) == - 1.0_pReal ) ) call IO_error ( 105 )
constituentGrain = constituentGrain + myNorientations
endif
! ----------------------------------------------------------------------------
symExtension = texture_symmetry ( textureID ) - 1_pInt
if ( symExtension > 0_pInt ) then ! sample symmetry
constituentGrain = NgrainsOfConstituent ( i ) - myNorientations ! calc remainder of array
do j = 1 , myNorientations ! loop over each "real" orientation
symOrientation = math_symmetricEulers ( texture_symmetry ( textureID ) , orientationOfGrain ( : , j ) ) ! get symmetric equivalents
e = min ( symExtension , constituentGrain ) ! are we at end of constituent grain array?
if ( e > 0_pInt ) then
orientationOfGrain ( : , grain + myNorientations + 1 + ( j - 1 ) * symExtension : &
grain + myNorientations + e + ( j - 1 ) * symExtension ) = &
symOrientation ( : , 1 : e )
constituentGrain = constituentGrain - e ! remainder shrinks by e
endif
enddo
endif
grain = grain + NgrainsOfConstituent ( i ) ! advance microstructure grain index
2009-06-15 18:41:21 +05:30
enddo ! constituent
2009-03-04 17:18:54 +05:30
! ----------------------------------------------------------------------------
2011-03-22 19:10:27 +05:30
if ( . not . microstructure_elemhomo ( micro ) ) then ! unless element homogeneous, reshuffle grains
do i = 1 , myNgrains - 1 ! walk thru grains
call random_number ( rnd )
t = nint ( rnd * ( myNgrains - i ) + i + 0.5_pReal , pInt ) ! select a grain in remaining list
m = phaseOfGrain ( t ) ! exchange current with random
phaseOfGrain ( t ) = phaseOfGrain ( i )
phaseOfGrain ( i ) = m
m = textureOfGrain ( t ) ! exchange current with random
textureOfGrain ( t ) = textureOfGrain ( i )
textureOfGrain ( i ) = m
orientation = orientationOfGrain ( : , t )
orientationOfGrain ( : , t ) = orientationOfGrain ( : , i )
orientationOfGrain ( : , i ) = orientation
enddo
endif
2009-03-04 17:18:54 +05:30
!calc fraction after weighing with volumePerGrain
!exchange in MC steps to improve result...
! ----------------------------------------------------------------------------
2012-01-12 16:06:17 +05:30
grain = 0_pInt
do counter_cpElemsindex = 1 , NcpElemscounter ( homog , micro )
e = cpElemsindex ( homog , micro , counter_cpElemsindex ) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
if ( microstructure_elemhomo ( micro ) ) then ! homogeneous distribution of grains over each element's IPs
forall ( i = 1 : FE_Nips ( mesh_element ( 2 , e ) ) , g = 1 : dGrains ) ! loop over IPs and grains
material_volume ( g , i , e ) = volumeOfGrain ( grain + g )
material_phase ( g , i , e ) = phaseOfGrain ( grain + g )
material_texture ( g , i , e ) = textureOfGrain ( grain + g )
material_EulerAngles ( : , g , i , e ) = orientationOfGrain ( : , grain + g )
end forall
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
else
forall ( i = 1 : FE_Nips ( mesh_element ( 2 , e ) ) , g = 1 : dGrains ) ! loop over IPs and grains
material_volume ( g , i , e ) = volumeOfGrain ( grain + ( i - 1 ) * dGrains + g )
material_phase ( g , i , e ) = phaseOfGrain ( grain + ( i - 1 ) * dGrains + g )
material_texture ( g , i , e ) = textureOfGrain ( grain + ( i - 1 ) * dGrains + g )
material_EulerAngles ( : , g , i , e ) = orientationOfGrain ( : , grain + ( i - 1 ) * dGrains + g )
end forall
grain = grain + FE_Nips ( mesh_element ( 2 , e ) ) * dGrains ! wind forward by Nips*NgrainsPerIP
2009-03-04 17:18:54 +05:30
endif
enddo
endif ! active homog,micro pair
enddo
enddo
2009-05-26 22:54:42 +05:30
deallocate ( volumeOfGrain )
2009-03-04 17:18:54 +05:30
deallocate ( phaseOfGrain )
2011-03-22 19:10:27 +05:30
deallocate ( textureOfGrain )
2009-03-04 17:18:54 +05:30
deallocate ( orientationOfGrain )
2012-01-12 16:06:17 +05:30
deallocate ( cpElemsindex )
deallocate ( NcpElemscounter )
2009-03-04 17:18:54 +05:30
2009-06-15 18:41:21 +05:30
endsubroutine
2009-03-04 17:18:54 +05:30
END MODULE