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

removed (in IO.f90) a dangerous initialization statement. 

Please read http://www.cs.rpi.edu/~szymansk/OOF90/bugs.html#4
for more details.

Other files are just a little bit polished
This commit is contained in:
Martin Diehl 2012-03-07 10:07:29 +00:00
parent d00c3c9e19
commit 2a7888c7e1
3 changed files with 361 additions and 362 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
code/IO.f90
View File

@ -546,7 +546,7 @@ integer(pInt) function IO_countSections(myFile,part)
integer(pInt), intent(in) :: myFile integer(pInt), intent(in) :: myFile
character(len=*), intent(in) :: part character(len=*), intent(in) :: part
character(len=1024) :: line = '' character(len=1024) :: line
IO_countSections = 0_pInt IO_countSections = 0_pInt
rewind(myFile) rewind(myFile)
@ -583,12 +583,13 @@ function IO_countTagInPart(myFile,part,myTag,Nsections)
integer(pInt), dimension(Nsections) :: counter integer(pInt), dimension(Nsections) :: counter
integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt), dimension(1+2*maxNchunks) :: positions
integer(pInt) :: section = 0_pInt integer(pInt) :: section
character(len=1024) :: line ='', & character(len=1024) :: line, &
tag tag
rewind(myFile) rewind(myFile)
counter = 0_pInt counter = 0_pInt
section = 0_pInt
do while (IO_getTag(line,'<','>') /= part) ! search for part do while (IO_getTag(line,'<','>') /= part) ! search for part
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
@ -635,7 +636,6 @@ function IO_spotTagInPart(myFile,part,myTag,Nsections)
IO_spotTagInPart = .false. ! assume to nowhere spot tag IO_spotTagInPart = .false. ! assume to nowhere spot tag
section = 0_pInt section = 0_pInt
line = ''
rewind(myFile) rewind(myFile)
do while (IO_getTag(line,'<','>') /= part) ! search for part do while (IO_getTag(line,'<','>') /= part) ! search for part
@ -851,7 +851,6 @@ pure function IO_lc(line)
implicit none implicit none
character(len=*), intent(in) :: line character(len=*), intent(in) :: line
character(len=len(line)) :: IO_lc character(len=len(line)) :: IO_lc
integer :: i ! no pInt (len returns default integer) integer :: i ! no pInt (len returns default integer)
@ -871,8 +870,8 @@ subroutine IO_lcInplace(line)
implicit none implicit none
character(len=*), intent(inout) :: line character(len=*), intent(inout) :: line
character(len=len(line)) :: IO_lc character(len=len(line)) :: IO_lc
integer :: i ! no pInt (len returns default integer) integer :: i ! no pInt (len returns default integer)
IO_lc = line IO_lc = line
@ -892,6 +891,7 @@ subroutine IO_skipChunks(myUnit,N)
implicit none implicit none
integer(pInt), intent(in) :: myUnit, & integer(pInt), intent(in) :: myUnit, &
N N
integer(pInt), parameter :: maxNchunks = 64_pInt integer(pInt), parameter :: maxNchunks = 64_pInt
integer(pInt) :: remainingChunks integer(pInt) :: remainingChunks
@ -1444,6 +1444,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
unit2 unit2
integer(pInt), parameter :: maxNchunks = 6_pInt integer(pInt), parameter :: maxNchunks = 6_pInt
integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt), dimension(1+2*maxNchunks) :: positions
character(len=300) :: line,fname character(len=300) :: line,fname
logical :: createSuccess,fexist logical :: createSuccess,fexist

112
code/kdtree2.f90
View File

@ -585,18 +585,18 @@ module kdtree2_module
! !
integer(pInt) :: dimen integer(pInt) :: dimen
integer(pInt) :: nn, nfound integer(pInt) :: nn, nfound
real(pReal) :: ballsize real(pReal) :: ballsize
integer(pInt) :: centeridx=999_pInt, correltime=9999_pInt integer(pInt) :: centeridx=999_pInt, correltime=9999_pInt
! exclude points within 'correltime' of 'centeridx', iff centeridx >= 0 ! exclude points within 'correltime' of 'centeridx', iff centeridx >= 0
integer(pInt) :: nalloc ! how much allocated for results(:)? integer(pInt) :: nalloc ! how much allocated for results(:)?
logical :: rearrange ! are the data rearranged or original? logical :: rearrange ! are the data rearranged or original?
! did the # of points found overflow the storage provided? ! did the # of points found overflow the storage provided?
logical :: overflow logical :: overflow
real(pReal), pointer :: qv(:) ! query vector real(pReal), pointer :: qv(:) ! query vector
type(kdtree2_result), pointer :: results(:) ! results type(kdtree2_result), pointer :: results(:) ! results
type(pq) :: pq type(pq) :: pq
real(pReal), pointer :: myData(:,:) ! temp pointer to data real(pReal), pointer :: myData(:,:) ! temp pointer to data
integer(pInt), pointer :: ind(:) ! temp pointer to indexes integer(pInt), pointer :: ind(:) ! temp pointer to indexes
end type tree_search_record end type tree_search_record
type(tree_search_record), save, target :: sr ! A GLOBAL VARIABLE for search type(tree_search_record), save, target :: sr ! A GLOBAL VARIABLE for search
@ -630,15 +630,15 @@ function kdtree2_create(input_data,myDim,sort,rearrange) result (mr)
use IO, only: IO_error use IO, only: IO_error
implicit none implicit none
type (kdtree2), pointer :: mr type (kdtree2), pointer :: mr
integer(pInt), intent(in), optional :: myDim integer(pInt), intent(in), optional :: myDim
logical, intent(in), optional :: sort logical, intent(in), optional :: sort
logical, intent(in), optional :: rearrange logical, intent(in), optional :: rearrange
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
real(pReal), target :: input_data(:,:) real(pReal), target :: input_data(:,:)
! !
integer(pInt) :: i integer(pInt) :: i
! .. ! ..
allocate (mr) allocate (mr)
mr%the_data => input_data mr%the_data => input_data
@ -1298,9 +1298,11 @@ function kdtree2_r_count_around_point(tp,idxin,correltime,r2) result(nfound)
! point 'idxin' with decorrelation time 'correltime'. ! point 'idxin' with decorrelation time 'correltime'.
! !
implicit none implicit none
type (kdtree2), pointer :: tp type (kdtree2), pointer :: tp
integer(pInt), intent (In) :: correltime, idxin integer(pInt), intent (In) :: correltime, idxin
real(pReal), intent(in) :: r2 real(pReal), intent(in) :: r2
integer(pInt) :: nfound integer(pInt) :: nfound
! .. ! ..
! .. ! ..
@ -1384,16 +1386,16 @@ recursive subroutine search(node)
! "box in bounds", whether the sear ! "box in bounds", whether the sear
! !
implicit none implicit none
type (Tree_node), pointer :: node type (Tree_node), pointer :: node
! .. ! ..
type(tree_node),pointer :: ncloser, nfarther type(tree_node),pointer :: ncloser, nfarther
! !
integer(pInt) :: cut_dim, i integer(pInt) :: cut_dim, i
! .. ! ..
real(pReal) :: qval, dis real(pReal) :: qval, dis
real(pReal) :: ballsize real(pReal) :: ballsize
real(pReal), pointer :: qv(:) real(pReal), pointer :: qv(:)
type(interval), pointer :: box(:) type(interval), pointer :: box(:)
if ((associated(node%left) .and. associated(node%right)) .eqv. .false.) then if ((associated(node%left) .and. associated(node%right)) .eqv. .false.) then
! we are on a terminal node ! we are on a terminal node
@ -1481,12 +1483,12 @@ logical function box_in_search_range(node, sr) result(res)
! contribute nothing to the distance. ! contribute nothing to the distance.
! !
implicit none implicit none
type (tree_node), pointer :: node type (tree_node), pointer :: node
type (tree_search_record), pointer :: sr type (tree_search_record), pointer :: sr
integer(pInt) :: dimen, i integer(pInt) :: dimen, i
real(pReal) :: dis, ballsize real(pReal) :: dis, ballsize
real(pReal) :: l, u real(pReal) :: l, u
dimen = sr%dimen dimen = sr%dimen
ballsize = sr%ballsize ballsize = sr%ballsize
@ -1512,16 +1514,16 @@ subroutine process_terminal_node(node)
! the search results on the sr data structure. ! the search results on the sr data structure.
! !
implicit none implicit none
type (tree_node), pointer :: node type (tree_node), pointer :: node
! !
real(pReal), pointer :: qv(:) real(pReal), pointer :: qv(:)
integer(pInt), pointer :: ind(:) integer(pInt), pointer :: ind(:)
real(pReal), pointer :: myData(:,:) real(pReal), pointer :: myData(:,:)
! !
integer(pInt) :: dimen, i, indexofi, k, centeridx, correltime integer(pInt) :: dimen, i, indexofi, k, centeridx, correltime
real(pReal) :: ballsize, sd, newpri real(pReal) :: ballsize, sd, newpri
logical :: rearrange logical :: rearrange
type(pq), pointer :: pqp type(pq), pointer :: pqp
! !
! copy values from sr to local variables ! copy values from sr to local variables
! !
@ -1619,17 +1621,17 @@ subroutine process_terminal_node_fixedball(node)
! save all within a fixed ball. ! save all within a fixed ball.
! !
implicit none implicit none
type (tree_node), pointer :: node type (tree_node), pointer :: node
! !
real(pReal), pointer :: qv(:) real(pReal), pointer :: qv(:)
integer(pInt), pointer :: ind(:) integer(pInt), pointer :: ind(:)
real(pReal), pointer :: myData(:,:) real(pReal), pointer :: myData(:,:)
! !
integer(pInt) :: nfound integer(pInt) :: nfound
integer(pInt) :: dimen, i, indexofi, k integer(pInt) :: dimen, i, indexofi, k
integer(pInt) :: centeridx, correltime, nn integer(pInt) :: centeridx, correltime, nn
real(pReal) :: ballsize, sd real(pReal) :: ballsize, sd
logical :: rearrange logical :: rearrange
! !
! copy values from sr to local variables ! copy values from sr to local variables
@ -1710,13 +1712,13 @@ subroutine kdtree2_n_nearest_brute_force(tp,qv,nn,results)
! whole point of a k-d tree is to avoid doing what this subroutine ! whole point of a k-d tree is to avoid doing what this subroutine
! does. ! does.
implicit none implicit none
type (kdtree2), pointer :: tp type (kdtree2), pointer :: tp
real(pReal), intent (In) :: qv(:) real(pReal), intent(in) :: qv(:)
integer(pInt), intent (In) :: nn integer(pInt), intent(in) :: nn
type(kdtree2_result) :: results(:) type(kdtree2_result) :: results(:)
integer(pInt) :: i, j, k integer(pInt) :: i, j, k
real(pReal), allocatable :: all_distances(:) real(pReal), allocatable :: all_distances(:)
! .. ! ..
allocate (all_distances(tp%n)) allocate (all_distances(tp%n))
do i = 1_pInt, tp%n do i = 1_pInt, tp%n
@ -1751,11 +1753,11 @@ subroutine kdtree2_r_nearest_brute_force(tp,qv,r2,nfound,results)
! whole point of a k-d tree is to avoid doing what this subroutine ! whole point of a k-d tree is to avoid doing what this subroutine
! does. ! does.
implicit none implicit none
type (kdtree2), pointer :: tp type (kdtree2), pointer :: tp
real(pReal), intent (In) :: qv(:) real(pReal), intent(in) :: qv(:)
real(pReal), intent (In) :: r2 real(pReal), intent(in) :: r2
integer(pInt), intent(out) :: nfound integer(pInt), intent(out) :: nfound
type(kdtree2_result) :: results(:) type(kdtree2_result) :: results(:)
integer(pInt) :: i integer(pInt) :: i
integer :: nalloc integer :: nalloc
@ -1810,9 +1812,9 @@ subroutine heapsort(a,ind,n)
! If ind(k) = k upon input, then it will give a sort index upon output. ! If ind(k) = k upon input, then it will give a sort index upon output.
! !
implicit none implicit none
integer(pInt),intent(in) :: n integer(pInt),intent(in) :: n
real(pReal), intent(inout) :: a(:) real(pReal), intent(inout) :: a(:)
integer(pInt), intent(inout) :: ind(:) integer(pInt), intent(inout) :: ind(:)
! !
! !
@ -1869,7 +1871,7 @@ subroutine heapsort_struct(a,n)
! !
! !
implicit none implicit none
integer(pInt),intent(in) :: n integer(pInt),intent(in) :: n
type(kdtree2_result),intent(inout) :: a(:) type(kdtree2_result),intent(inout) :: a(:)
! !

560
code/numerics.f90
View File

@ -19,14 +19,15 @@
!############################################################## !##############################################################
!* $Id$ !* $Id$
!############################################################## !##############################################################
MODULE numerics module numerics
!############################################################## !##############################################################
use prec, only: pInt, pReal use prec, only: pInt, pReal
use IO, only: IO_warning
implicit none
character(len=64), parameter :: numerics_configFile = 'numerics.config' ! name of configuration file implicit none
character(len=64), parameter, private ::&
numerics_configFile = 'numerics.config' ! name of configuration file
integer(pInt) :: iJacoStiffness = 1_pInt, & ! frequency of stiffness update integer(pInt) :: iJacoStiffness = 1_pInt, & ! frequency of stiffness update
iJacoLpresiduum = 1_pInt, & ! frequency of Jacobian update of residuum in Lp iJacoLpresiduum = 1_pInt, & ! frequency of Jacobian update of residuum in Lp
nHomog = 20_pInt, & ! homogenization loop limit (only for debugging info, loop limit is determined by "subStepMinHomog") nHomog = 20_pInt, & ! homogenization loop limit (only for debugging info, loop limit is determined by "subStepMinHomog")
@ -94,39 +95,33 @@ CONTAINS
!******************************************* !*******************************************
! initialization subroutine ! initialization subroutine
!******************************************* !*******************************************
subroutine numerics_init() subroutine numerics_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
!*** variables and functions from other modules ***! use IO, only: IO_error, &
use prec, only: pInt, & IO_open_file_stat, &
pReal IO_isBlank, &
use IO, only: IO_error, & IO_stringPos, &
IO_open_file_stat, & IO_stringValue, &
IO_isBlank, & IO_lc, &
IO_stringPos, & IO_floatValue, &
IO_stringValue, & IO_intValue, &
IO_lc, & IO_warning
IO_floatValue, &
IO_intValue
!$ use OMP_LIB ! the openMP function library !$ use OMP_LIB ! the openMP function library
implicit none implicit none
integer(pInt), parameter :: fileunit = 300_pInt ,&
!*** local variables ***! maxNchunks = 2_pInt
integer(pInt), parameter :: fileunit = 300_pInt !$ integer :: gotDAMASK_NUM_THREADS = 1
integer(pInt), parameter :: maxNchunks = 2_pInt integer(pInt), dimension(1+2*maxNchunks) :: positions
!$ integer :: gotDAMASK_NUM_THREADS = 1 character(len=64) :: tag
integer(pInt), dimension(1+2*maxNchunks) :: positions character(len=1024) :: line
character(len=64) :: tag
character(len=1024) :: line
! OpenMP variable
!$ character(len=6) DAMASK_NumThreadsString !environment variable DAMASK_NUM_THREADS !$ character(len=6) DAMASK_NumThreadsString !environment variable DAMASK_NUM_THREADS
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,*)
write(6,*) '<<<+- numerics init -+>>>' write(6,*) '<<<+- numerics init -+>>>'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -137,294 +132,295 @@ subroutine numerics_init()
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! ...and use it as number of threads for parallel execution !$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! ...and use it as number of threads for parallel execution
! try to open the config file ! try to open the config file
if(IO_open_file_stat(fileunit,numerics_configFile)) then if(IO_open_file_stat(fileunit,numerics_configFile)) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) ' ... using values from config file' write(6,*) ' ... using values from config file'
write(6,*) write(6,*)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
!* read variables from config file and overwrite parameters !* read variables from config file and overwrite parameters
line = '' line = ''
do do
read(fileunit,'(a1024)',END=100) line read(fileunit,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
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 ('relevantstrain') case ('relevantstrain')
relevantStrain = IO_floatValue(line,positions,2_pInt) relevantStrain = IO_floatValue(line,positions,2_pInt)
case ('defgradtolerance') case ('defgradtolerance')
defgradTolerance = IO_floatValue(line,positions,2_pInt) defgradTolerance = IO_floatValue(line,positions,2_pInt)
case ('ijacostiffness') case ('ijacostiffness')
iJacoStiffness = IO_intValue(line,positions,2_pInt) iJacoStiffness = IO_intValue(line,positions,2_pInt)
case ('ijacolpresiduum') case ('ijacolpresiduum')
iJacoLpresiduum = IO_intValue(line,positions,2_pInt) iJacoLpresiduum = IO_intValue(line,positions,2_pInt)
case ('pert_fg') case ('pert_fg')
pert_Fg = IO_floatValue(line,positions,2_pInt) pert_Fg = IO_floatValue(line,positions,2_pInt)
case ('pert_method') case ('pert_method')
pert_method = IO_intValue(line,positions,2_pInt) pert_method = IO_intValue(line,positions,2_pInt)
case ('nhomog') case ('nhomog')
nHomog = IO_intValue(line,positions,2_pInt) nHomog = IO_intValue(line,positions,2_pInt)
case ('nmpstate') case ('nmpstate')
nMPstate = IO_intValue(line,positions,2_pInt) nMPstate = IO_intValue(line,positions,2_pInt)
case ('ncryst') case ('ncryst')
nCryst = IO_intValue(line,positions,2_pInt) nCryst = IO_intValue(line,positions,2_pInt)
case ('nstate') case ('nstate')
nState = IO_intValue(line,positions,2_pInt) nState = IO_intValue(line,positions,2_pInt)
case ('nstress') case ('nstress')
nStress = IO_intValue(line,positions,2_pInt) nStress = IO_intValue(line,positions,2_pInt)
case ('substepmincryst') case ('substepmincryst')
subStepMinCryst = IO_floatValue(line,positions,2_pInt) subStepMinCryst = IO_floatValue(line,positions,2_pInt)
case ('substepsizecryst') case ('substepsizecryst')
subStepSizeCryst = IO_floatValue(line,positions,2_pInt) subStepSizeCryst = IO_floatValue(line,positions,2_pInt)
case ('stepincreasecryst') case ('stepincreasecryst')
stepIncreaseCryst = IO_floatValue(line,positions,2_pInt) stepIncreaseCryst = IO_floatValue(line,positions,2_pInt)
case ('substepminhomog') case ('substepminhomog')
subStepMinHomog = IO_floatValue(line,positions,2_pInt) subStepMinHomog = IO_floatValue(line,positions,2_pInt)
case ('substepsizehomog') case ('substepsizehomog')
subStepSizeHomog = IO_floatValue(line,positions,2_pInt) subStepSizeHomog = IO_floatValue(line,positions,2_pInt)
case ('stepincreasehomog') case ('stepincreasehomog')
stepIncreaseHomog = IO_floatValue(line,positions,2_pInt) stepIncreaseHomog = IO_floatValue(line,positions,2_pInt)
case ('rtol_crystallitestate') case ('rtol_crystallitestate')
rTol_crystalliteState = IO_floatValue(line,positions,2_pInt) rTol_crystalliteState = IO_floatValue(line,positions,2_pInt)
case ('rtol_crystallitetemperature') case ('rtol_crystallitetemperature')
rTol_crystalliteTemperature = IO_floatValue(line,positions,2_pInt) rTol_crystalliteTemperature = IO_floatValue(line,positions,2_pInt)
case ('rtol_crystallitestress') case ('rtol_crystallitestress')
rTol_crystalliteStress = IO_floatValue(line,positions,2_pInt) rTol_crystalliteStress = IO_floatValue(line,positions,2_pInt)
case ('atol_crystallitestress') case ('atol_crystallitestress')
aTol_crystalliteStress = IO_floatValue(line,positions,2_pInt) aTol_crystalliteStress = IO_floatValue(line,positions,2_pInt)
case ('integrator') case ('integrator')
numerics_integrator(1) = IO_intValue(line,positions,2_pInt) numerics_integrator(1) = IO_intValue(line,positions,2_pInt)
case ('integratorstiffness') case ('integratorstiffness')
numerics_integrator(2) = IO_intValue(line,positions,2_pInt) numerics_integrator(2) = IO_intValue(line,positions,2_pInt)
case ('lp_frac') case ('lp_frac')
Lp_frac = IO_floatValue(line,positions,2_pInt) Lp_frac = IO_floatValue(line,positions,2_pInt)
case ('analyticjaco') case ('analyticjaco')
analyticJaco = IO_intValue(line,positions,2_pInt) > 0_pInt analyticJaco = IO_intValue(line,positions,2_pInt) > 0_pInt
case ('time_sensitive') case ('time_sensitive')
time_sensitive = IO_intValue(line,positions,2_pInt) > 0_pInt time_sensitive = IO_intValue(line,positions,2_pInt) > 0_pInt
!* RGC parameters: !* RGC parameters:
case ('atol_rgc') case ('atol_rgc')
absTol_RGC = IO_floatValue(line,positions,2_pInt) absTol_RGC = IO_floatValue(line,positions,2_pInt)
case ('rtol_rgc') case ('rtol_rgc')
relTol_RGC = IO_floatValue(line,positions,2_pInt) relTol_RGC = IO_floatValue(line,positions,2_pInt)
case ('amax_rgc') case ('amax_rgc')
absMax_RGC = IO_floatValue(line,positions,2_pInt) absMax_RGC = IO_floatValue(line,positions,2_pInt)
case ('rmax_rgc') case ('rmax_rgc')
relMax_RGC = IO_floatValue(line,positions,2_pInt) relMax_RGC = IO_floatValue(line,positions,2_pInt)
case ('perturbpenalty_rgc') case ('perturbpenalty_rgc')
pPert_RGC = IO_floatValue(line,positions,2_pInt) pPert_RGC = IO_floatValue(line,positions,2_pInt)
case ('relevantmismatch_rgc') case ('relevantmismatch_rgc')
xSmoo_RGC = IO_floatValue(line,positions,2_pInt) xSmoo_RGC = IO_floatValue(line,positions,2_pInt)
case ('viscositypower_rgc') case ('viscositypower_rgc')
viscPower_RGC = IO_floatValue(line,positions,2_pInt) viscPower_RGC = IO_floatValue(line,positions,2_pInt)
case ('viscositymodulus_rgc') case ('viscositymodulus_rgc')
viscModus_RGC = IO_floatValue(line,positions,2_pInt) viscModus_RGC = IO_floatValue(line,positions,2_pInt)
case ('refrelaxationrate_rgc') case ('refrelaxationrate_rgc')
refRelaxRate_RGC = IO_floatValue(line,positions,2_pInt) refRelaxRate_RGC = IO_floatValue(line,positions,2_pInt)
case ('maxrelaxation_rgc') case ('maxrelaxation_rgc')
maxdRelax_RGC = IO_floatValue(line,positions,2_pInt) maxdRelax_RGC = IO_floatValue(line,positions,2_pInt)
case ('maxvoldiscrepancy_rgc') case ('maxvoldiscrepancy_rgc')
maxVolDiscr_RGC = IO_floatValue(line,positions,2_pInt) maxVolDiscr_RGC = IO_floatValue(line,positions,2_pInt)
case ('voldiscrepancymod_rgc') case ('voldiscrepancymod_rgc')
volDiscrMod_RGC = IO_floatValue(line,positions,2_pInt) volDiscrMod_RGC = IO_floatValue(line,positions,2_pInt)
case ('discrepancypower_rgc') case ('discrepancypower_rgc')
volDiscrPow_RGC = IO_floatValue(line,positions,2_pInt) volDiscrPow_RGC = IO_floatValue(line,positions,2_pInt)
!* spectral parameters !* spectral parameters
case ('err_div_tol') case ('err_div_tol')
err_div_tol = IO_floatValue(line,positions,2_pInt) err_div_tol = IO_floatValue(line,positions,2_pInt)
case ('err_stress_tolrel') case ('err_stress_tolrel')
err_stress_tolrel = IO_floatValue(line,positions,2_pInt) err_stress_tolrel = IO_floatValue(line,positions,2_pInt)
case ('itmax') case ('itmax')
itmax = IO_intValue(line,positions,2_pInt) itmax = IO_intValue(line,positions,2_pInt)
case ('itmin') case ('itmin')
itmin = IO_intValue(line,positions,2_pInt) itmin = IO_intValue(line,positions,2_pInt)
case ('memory_efficient') case ('memory_efficient')
memory_efficient = IO_intValue(line,positions,2_pInt) > 0_pInt memory_efficient = IO_intValue(line,positions,2_pInt) > 0_pInt
case ('fftw_timelimit') case ('fftw_timelimit')
fftw_timelimit = IO_floatValue(line,positions,2_pInt) fftw_timelimit = IO_floatValue(line,positions,2_pInt)
case ('fftw_plan_mode') case ('fftw_plan_mode')
fftw_plan_mode = IO_stringValue(line,positions,2_pInt) fftw_plan_mode = IO_stringValue(line,positions,2_pInt)
case ('rotation_tol') case ('rotation_tol')
rotation_tol = IO_floatValue(line,positions,2_pInt) rotation_tol = IO_floatValue(line,positions,2_pInt)
case ('divergence_correction') case ('divergence_correction')
divergence_correction = IO_intValue(line,positions,2_pInt) > 0_pInt divergence_correction = IO_intValue(line,positions,2_pInt) > 0_pInt
case ('update_gamma') case ('update_gamma')
update_gamma = IO_intValue(line,positions,2_pInt) > 0_pInt update_gamma = IO_intValue(line,positions,2_pInt) > 0_pInt
!* Random seeding parameters !* Random seeding parameters
case ('fixed_seed') case ('fixed_seed')
fixedSeed = IO_intValue(line,positions,2_pInt) fixedSeed = IO_intValue(line,positions,2_pInt)
case default case default
call IO_error(300_pInt,ext_msg=tag) call IO_error(300_pInt,ext_msg=tag)
endselect endselect
enddo enddo
100 close(fileunit) 100 close(fileunit)
! no config file, so we use standard values ! no config file, so we use standard values
else else
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) ' ... using standard values' write(6,*) ' ... using standard values'
write(6,*) write(6,*)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif endif
select case(IO_lc(fftw_plan_mode)) ! setting parameters for the plan creation of FFTW. Basically a translation from fftw3.f select case(IO_lc(fftw_plan_mode)) ! setting parameters for the plan creation of FFTW. Basically a translation from fftw3.f
case('estimate','fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution case('estimate','fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution
fftw_planner_flag = 64_pInt fftw_planner_flag = 64_pInt
case('measure','fftw_measure') case('measure','fftw_measure')
fftw_planner_flag = 0_pInt fftw_planner_flag = 0_pInt
case('patient','fftw_patient') case('patient','fftw_patient')
fftw_planner_flag= 32_pInt fftw_planner_flag= 32_pInt
case('exhaustive','fftw_exhaustive') case('exhaustive','fftw_exhaustive')
fftw_planner_flag = 8_pInt fftw_planner_flag = 8_pInt
case default case default
call IO_warning(warning_ID=47_pInt,ext_msg=trim(IO_lc(fftw_plan_mode))) call IO_warning(warning_ID=47_pInt,ext_msg=trim(IO_lc(fftw_plan_mode)))
fftw_planner_flag = 32_pInt fftw_planner_flag = 32_pInt
end select end select
!* writing parameters to output file !* writing parameters to output file
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a24,1x,e8.1)') ' relevantStrain: ',relevantStrain write(6,'(a24,1x,e8.1)') ' relevantStrain: ',relevantStrain
write(6,'(a24,1x,e8.1)') ' defgradTolerance: ',defgradTolerance write(6,'(a24,1x,e8.1)') ' defgradTolerance: ',defgradTolerance
write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness
write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum
write(6,'(a24,1x,e8.1)') ' pert_Fg: ',pert_Fg write(6,'(a24,1x,e8.1)') ' pert_Fg: ',pert_Fg
write(6,'(a24,1x,i8)') ' pert_method: ',pert_method write(6,'(a24,1x,i8)') ' pert_method: ',pert_method
write(6,'(a24,1x,i8)') ' nCryst: ',nCryst write(6,'(a24,1x,i8)') ' nCryst: ',nCryst
write(6,'(a24,1x,e8.1)') ' subStepMinCryst: ',subStepMinCryst write(6,'(a24,1x,e8.1)') ' subStepMinCryst: ',subStepMinCryst
write(6,'(a24,1x,e8.1)') ' subStepSizeCryst: ',subStepSizeCryst write(6,'(a24,1x,e8.1)') ' subStepSizeCryst: ',subStepSizeCryst
write(6,'(a24,1x,e8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst write(6,'(a24,1x,e8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst
write(6,'(a24,1x,i8)') ' nState: ',nState write(6,'(a24,1x,i8)') ' nState: ',nState
write(6,'(a24,1x,i8)') ' nStress: ',nStress write(6,'(a24,1x,i8)') ' nStress: ',nStress
write(6,'(a24,1x,e8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState write(6,'(a24,1x,e8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState
write(6,'(a24,1x,e8.1)') ' rTol_crystalliteTemp: ',rTol_crystalliteTemperature write(6,'(a24,1x,e8.1)') ' rTol_crystalliteTemp: ',rTol_crystalliteTemperature
write(6,'(a24,1x,e8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress write(6,'(a24,1x,e8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress
write(6,'(a24,1x,e8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress write(6,'(a24,1x,e8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress
write(6,'(a24,2(1x,i8),/)')' integrator: ',numerics_integrator write(6,'(a24,2(1x,i8),/)')' integrator: ',numerics_integrator
write(6,'(a24,1x,e8.1)') ' Lp_frac: ',Lp_frac write(6,'(a24,1x,e8.1)') ' Lp_frac: ',Lp_frac
write(6,'(a24,1x,L8)') ' analytic Jacobian: ',analyticJaco write(6,'(a24,1x,L8)') ' analytic Jacobian: ',analyticJaco
write(6,'(a24,1x,L8)') ' time sensitive: ',time_sensitive write(6,'(a24,1x,L8)') ' time sensitive: ',time_sensitive
write(6,'(a24,1x,i8)') ' nHomog: ',nHomog write(6,'(a24,1x,i8)') ' nHomog: ',nHomog
write(6,'(a24,1x,e8.1)') ' subStepMinHomog: ',subStepMinHomog write(6,'(a24,1x,e8.1)') ' subStepMinHomog: ',subStepMinHomog
write(6,'(a24,1x,e8.1)') ' subStepSizeHomog: ',subStepSizeHomog write(6,'(a24,1x,e8.1)') ' subStepSizeHomog: ',subStepSizeHomog
write(6,'(a24,1x,e8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog write(6,'(a24,1x,e8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog
write(6,'(a24,1x,i8,/)') ' nMPstate: ',nMPstate write(6,'(a24,1x,i8,/)') ' nMPstate: ',nMPstate
!* RGC parameters !* RGC parameters
write(6,'(a24,1x,e8.1)') ' aTol_RGC: ',absTol_RGC write(6,'(a24,1x,e8.1)') ' aTol_RGC: ',absTol_RGC
write(6,'(a24,1x,e8.1)') ' rTol_RGC: ',relTol_RGC write(6,'(a24,1x,e8.1)') ' rTol_RGC: ',relTol_RGC
write(6,'(a24,1x,e8.1)') ' aMax_RGC: ',absMax_RGC write(6,'(a24,1x,e8.1)') ' aMax_RGC: ',absMax_RGC
write(6,'(a24,1x,e8.1)') ' rMax_RGC: ',relMax_RGC write(6,'(a24,1x,e8.1)') ' rMax_RGC: ',relMax_RGC
write(6,'(a24,1x,e8.1)') ' perturbPenalty_RGC: ',pPert_RGC write(6,'(a24,1x,e8.1)') ' perturbPenalty_RGC: ',pPert_RGC
write(6,'(a24,1x,e8.1)') ' relevantMismatch_RGC: ',xSmoo_RGC write(6,'(a24,1x,e8.1)') ' relevantMismatch_RGC: ',xSmoo_RGC
write(6,'(a24,1x,e8.1)') ' viscosityrate_RGC: ',viscPower_RGC write(6,'(a24,1x,e8.1)') ' viscosityrate_RGC: ',viscPower_RGC
write(6,'(a24,1x,e8.1)') ' viscositymodulus_RGC: ',viscModus_RGC write(6,'(a24,1x,e8.1)') ' viscositymodulus_RGC: ',viscModus_RGC
write(6,'(a24,1x,e8.1)') ' maxrelaxation_RGC: ',maxdRelax_RGC write(6,'(a24,1x,e8.1)') ' maxrelaxation_RGC: ',maxdRelax_RGC
write(6,'(a24,1x,e8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC write(6,'(a24,1x,e8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC
write(6,'(a24,1x,e8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC write(6,'(a24,1x,e8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC
write(6,'(a24,1x,e8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC write(6,'(a24,1x,e8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC
!* spectral parameters !* spectral parameters
write(6,'(a24,1x,e8.1)') ' err_div_tol: ',err_div_tol write(6,'(a24,1x,e8.1)') ' err_div_tol: ',err_div_tol
write(6,'(a24,1x,e8.1)') ' err_stress_tolrel: ',err_stress_tolrel write(6,'(a24,1x,e8.1)') ' err_stress_tolrel: ',err_stress_tolrel
write(6,'(a24,1x,i8)') ' itmax: ',itmax write(6,'(a24,1x,i8)') ' itmax: ',itmax
write(6,'(a24,1x,i8)') ' itmin: ',itmin write(6,'(a24,1x,i8)') ' itmin: ',itmin
write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient
if(fftw_timelimit<0.0_pReal) then if(fftw_timelimit<0.0_pReal) then
write(6,'(a24,1x,L8)') ' fftw_timelimit: ',.false. write(6,'(a24,1x,L8)') ' fftw_timelimit: ',.false.
else else
write(6,'(a24,1x,e8.1)') ' fftw_timelimit: ',fftw_timelimit write(6,'(a24,1x,e8.1)') ' fftw_timelimit: ',fftw_timelimit
endif endif
write(6,'(a24,1x,a)') ' fftw_plan_mode: ',trim(fftw_plan_mode) write(6,'(a24,1x,a)') ' fftw_plan_mode: ',trim(fftw_plan_mode)
write(6,'(a24,1x,i8)') ' fftw_planner_flag: ',fftw_planner_flag write(6,'(a24,1x,i8)') ' fftw_planner_flag: ',fftw_planner_flag
write(6,'(a24,1x,e8.1)') ' rotation_tol: ',rotation_tol write(6,'(a24,1x,e8.1)') ' rotation_tol: ',rotation_tol
write(6,'(a24,1x,L8,/)') ' divergence_correction: ',divergence_correction write(6,'(a24,1x,L8,/)') ' divergence_correction: ',divergence_correction
write(6,'(a24,1x,L8,/)') ' update_gamma: ',update_gamma write(6,'(a24,1x,L8,/)') ' update_gamma: ',update_gamma
!* Random seeding parameters !* Random seeding parameters
write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
!* openMP parameter !* openMP parameter
!$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt !$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt
!* sanity check !* sanity check
if (relevantStrain <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relevantStrain') if (relevantStrain <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relevantStrain')
if (defgradTolerance <= 0.0_pReal) call IO_error(301_pInt,ext_msg='defgradTolerance') if (defgradTolerance <= 0.0_pReal) call IO_error(301_pInt,ext_msg='defgradTolerance')
if (iJacoStiffness < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoStiffness') if (iJacoStiffness < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoStiffness')
if (iJacoLpresiduum < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoLpresiduum') if (iJacoLpresiduum < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoLpresiduum')
if (pert_Fg <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pert_Fg') if (pert_Fg <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pert_Fg')
if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) & if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) &
call IO_error(301_pInt,ext_msg='pert_method') call IO_error(301_pInt,ext_msg='pert_method')
if (nHomog < 1_pInt) call IO_error(301_pInt,ext_msg='nHomog') if (nHomog < 1_pInt) call IO_error(301_pInt,ext_msg='nHomog')
if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate') if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate')
if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst') if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst')
if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState') if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState')
if (nStress < 1_pInt) call IO_error(301_pInt,ext_msg='nStress') if (nStress < 1_pInt) call IO_error(301_pInt,ext_msg='nStress')
if (subStepMinCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinCryst') if (subStepMinCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinCryst')
if (subStepSizeCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeCryst') if (subStepSizeCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeCryst')
if (stepIncreaseCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseCryst') if (stepIncreaseCryst <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseCryst')
if (subStepMinHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinHomog') if (subStepMinHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinHomog')
if (subStepSizeHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeHomog') if (subStepSizeHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeHomog')
if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseHomog') if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseHomog')
if (rTol_crystalliteState <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteState') if (rTol_crystalliteState <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteState')
if (rTol_crystalliteTemperature <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteTemperature') if (rTol_crystalliteTemperature <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteTemperature')
if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteStress') if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteStress')
if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='aTol_crystalliteStress') if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='aTol_crystalliteStress')
if (any(numerics_integrator <= 0_pInt) .or. any(numerics_integrator >= 6_pInt)) & if (any(numerics_integrator <= 0_pInt) .or. any(numerics_integrator >= 6_pInt)) &
call IO_error(301_pInt,ext_msg='integrator') call IO_error(301_pInt,ext_msg='integrator')
!* RGC parameters !* RGC parameters
if (absTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absTol_RGC') if (absTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absTol_RGC')
if (relTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relTol_RGC') if (relTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relTol_RGC')
if (absMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absMax_RGC') if (absMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absMax_RGC')
if (relMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relMax_RGC') if (relMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relMax_RGC')
if (pPert_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pPert_RGC') if (pPert_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pPert_RGC')
if (xSmoo_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='xSmoo_RGC') if (xSmoo_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='xSmoo_RGC')
if (viscPower_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscPower_RGC') if (viscPower_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscPower_RGC')
if (viscModus_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscModus_RGC') if (viscModus_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscModus_RGC')
if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='refRelaxRate_RGC') if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='refRelaxRate_RGC')
if (maxdRelax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxdRelax_RGC') if (maxdRelax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxdRelax_RGC')
if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxVolDiscr_RGC') if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxVolDiscr_RGC')
if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrMod_RGC') if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrMod_RGC')
if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrPw_RGC') if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrPw_RGC')
!* spectral parameters !* spectral parameters
if (err_div_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tol') if (err_div_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tol')
if (err_stress_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolrel') if (err_stress_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolrel')
if (itmax <= 1.0_pInt) call IO_error(301_pInt,ext_msg='itmax') if (itmax <= 1.0_pInt) call IO_error(301_pInt,ext_msg='itmax')
if (itmin > itmax) call IO_error(301_pInt,ext_msg='itmin') if (itmin > itmax) call IO_error(301_pInt,ext_msg='itmin')
if (fixedSeed <= 0_pInt) then if (fixedSeed <= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a)') ' Random is random!' write(6,'(a)') ' Random is random!'
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif endif
endsubroutine
END MODULE numerics end subroutine numerics_init
end module numerics