clear separation between solver and DAMASK

This commit is contained in:
Martin Diehl 2020-01-25 09:12:09 +01:00
parent bdae2a40cc
commit 624ede8177
3 changed files with 122 additions and 137 deletions

View File

@ -86,7 +86,6 @@ subroutine CPFEM_initAll(el,ip)
call config_init call config_init
call math_init call math_init
call rotations_init call rotations_init
call FE_init
call HDF5_utilities_init call HDF5_utilities_init
call results_init call results_init
call mesh_init(ip, el) call mesh_init(ip, el)

View File

@ -29,23 +29,24 @@
#include "prec.f90" #include "prec.f90"
module DAMASK_interface module DAMASK_interface
use prec use prec
#if __INTEL_COMPILER >= 1800 #if __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: & use, intrinsic :: iso_fortran_env, only: &
compiler_version, & compiler_version, &
compiler_options compiler_options
#endif #endif
use ifport, only: & use ifport, only: &
CHDIR CHDIR
implicit none implicit none
private private
character(len=*), parameter, public :: INPUTFILEEXTENSION = '.dat' logical, public :: symmetricSolver
character(len=*), parameter, public :: INPUTFILEEXTENSION = '.dat'
public :: & public :: &
DAMASK_interface_init, & DAMASK_interface_init, &
getSolverJobName getSolverJobName
contains contains
@ -54,40 +55,41 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init subroutine DAMASK_interface_init
integer, dimension(8) :: & integer, dimension(8) :: &
dateAndTime dateAndTime
integer :: ierr integer :: ierr
character(len=1024) :: wd character(len=1024) :: wd
write(6,'(/,a)') ' <<<+- DAMASK_marc init -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_marc init -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420478, 2019' write(6,'(/,a)') ' Roters et al., Computational Materials Science 158:420478, 2019'
write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(/,a)') ' Version: '//DAMASKVERSION
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md ! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
#if __INTEL_COMPILER >= 1800 #if __INTEL_COMPILER >= 1800
write(6,'(/,a)') ' Compiled with: '//compiler_version() write(6,'(/,a)') ' Compiled with: '//compiler_version()
write(6,'(a)') ' Compiler options: '//compiler_options() write(6,'(a)') ' Compiler options: '//compiler_options()
#else #else
write(6,'(/,a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& write(6,'(/,a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE ', build date :', __INTEL_COMPILER_BUILD_DATE
#endif #endif
write(6,'(/,a)') ' Compiled on: '//__DATE__//' at '//__TIME__ write(6,'(/,a)') ' Compiled on: '//__DATE__//' at '//__TIME__
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
write(6,'(/,a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) write(6,'(/,a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
inquire(5, name=wd) inquire(5, name=wd)
wd = wd(1:scan(wd,'/',back=.true.)) wd = wd(1:scan(wd,'/',back=.true.))
ierr = CHDIR(wd) ierr = CHDIR(wd)
if (ierr /= 0) then if (ierr /= 0) then
write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist' write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist'
call quit(1) call quit(1)
endif endif
symmetricSolver = solverIsSymmetric()
end subroutine DAMASK_interface_init end subroutine DAMASK_interface_init
@ -97,19 +99,66 @@ end subroutine DAMASK_interface_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function getSolverJobName() function getSolverJobName()
character(len=:), allocatable :: getSolverJobName character(len=:), allocatable :: getSolverJobName
character(1024) :: inputName character(1024) :: inputName
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
integer :: extPos integer :: extPos
inputName='' inputName=''
inquire(5, name=inputName) ! determine inputfile inquire(5, name=inputName) ! determine inputfile
extPos = len_trim(inputName)-4 extPos = len_trim(inputName)-4
getSolverJobName=inputName(scan(inputName,pathSep,back=.true.)+1:extPos) getSolverJobName=inputName(scan(inputName,pathSep,back=.true.)+1:extPos)
end function getSolverJobName end function getSolverJobName
!--------------------------------------------------------------------------------------------------
!> @brief determines whether a symmetric solver is used
!--------------------------------------------------------------------------------------------------
logical function solverIsSymmetric()
character(len=pStringLen) :: line
integer :: myStat,fileUnit,s,e
integer, allocatable, dimension(:) :: chunkPos
open(newunit=fileUnit, file=getSolverJobName()//INPUTFILEEXTENSION, &
status='old', position='rewind', action='read',iostat=myStat)
do
read (fileUnit,'(A)',END=100) line
if(index(trim(lc(line)),'solver') == 1) then
read (fileUnit,'(A)',END=100) line ! next line
s = verify(line, ' ') ! start of first chunk
s = s + verify(line(s+1:),' ') ! start of second chunk
e = s + scan (line(s+1:),' ') ! end of second chunk
solverIsSymmetric = line(s:e) /= '1'
endif
enddo
100 close(fileUnit)
contains
!--------------------------------------------------------------------------------------------------
!> @brief changes characters in string to lower case
!> @details copied from IO_lc
!--------------------------------------------------------------------------------------------------
function lc(string)
character(len=*), intent(in) :: string !< string to convert
character(len=len(string)) :: lc
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n
do i=1,len(string)
lc(i:i) = string(i:i)
n = index(UPPER,lc(i:i))
if (n/=0) lc(i:i) = LOWER(n:n)
enddo
end function lc
end function solverIsSymmetric
end module DAMASK_interface end module DAMASK_interface
@ -128,6 +177,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, & strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, &
jtype,lclass,ifr,ifu) jtype,lclass,ifr,ifu)
use prec use prec
use DAMASK_interface
use numerics use numerics
use FEsolving use FEsolving
use debug use debug
@ -329,21 +379,21 @@ end subroutine hypela2
!> @brief calculate internal heat generated due to inelastic energy dissipation !> @brief calculate internal heat generated due to inelastic energy dissipation
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine flux(f,ts,n,time) subroutine flux(f,ts,n,time)
use prec use prec
use thermal_conduction use thermal_conduction
use mesh use mesh
implicit none implicit none
real(pReal), dimension(6), intent(in) :: & real(pReal), dimension(6), intent(in) :: &
ts ts
integer, dimension(10), intent(in) :: & integer, dimension(10), intent(in) :: &
n n
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
time time
real(pReal), dimension(2), intent(out) :: & real(pReal), dimension(2), intent(out) :: &
f f
call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEasCP('elem',n(1))) call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEasCP('elem',n(1)))
end subroutine flux end subroutine flux

View File

@ -1,88 +1,24 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @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 !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief holds some global variables and gets extra information for commercial FEM !> @brief global variables for flow control
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module FEsolving module FEsolving
use prec use prec
use DAMASK_interface
implicit none implicit none
private
logical, public :: & logical :: &
terminallyIll = .false. !< at least one material point is terminally ill terminallyIll = .false. !< at least one material point is terminally ill
integer, dimension(:,:), allocatable, public :: & integer, dimension(:,:), allocatable :: &
FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP
integer, dimension(2), public :: & integer, dimension(2) :: &
FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element
#if defined(Marc4DAMASK) || defined(Abaqus) #if defined(Marc4DAMASK) || defined(Abaqus)
logical, public, protected :: & logical, dimension(:,:), allocatable :: &
symmetricSolver = .false. !< use a symmetric FEM solver
logical, dimension(:,:), allocatable, public :: &
calcMode !< do calculation or simply collect when using ping pong scheme calcMode !< do calculation or simply collect when using ping pong scheme
public :: FE_init
#endif #endif
contains
#if defined(Marc4DAMASK) || defined(Abaqus)
!--------------------------------------------------------------------------------------------------
!> @brief determine whether a symmetric solver is used
!--------------------------------------------------------------------------------------------------
subroutine FE_init
write(6,'(/,a)') ' <<<+- FEsolving init -+>>>'
#if defined(Marc4DAMASK)
block
character(len=pStringLen) :: line
integer :: myStat,fileUnit,s,e
integer, allocatable, dimension(:) :: chunkPos
open(newunit=fileUnit, file=getSolverJobName()//INPUTFILEEXTENSION, &
status='old', position='rewind', action='read',iostat=myStat)
do
read (fileUnit,'(A)',END=100) line
if(index(trim(lc(line)),'solver') == 1) then
read (fileUnit,'(A)',END=100) line ! next line
s = verify(line, ' ') ! start of first chunk
s = s + verify(line(s+1:),' ') ! start of second chunk
e = s + scan (line(s+1:),' ') ! end of second chunk
symmetricSolver = line(s:e) /= '1'
endif
enddo
100 close(fileUnit)
end block
contains
!--------------------------------------------------------------------------------------------------
!> @brief changes characters in string to lower case
!> @details copied from IO_lc
!--------------------------------------------------------------------------------------------------
function lc(string)
character(len=*), intent(in) :: string !< string to convert
character(len=len(string)) :: lc
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n
do i=1,len(string)
lc(i:i) = string(i:i)
n = index(UPPER,lc(i:i))
if (n/=0) lc(i:i) = LOWER(n:n)
enddo
end function lc
#endif
end subroutine FE_init
#endif
end module FEsolving end module FEsolving