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

removed unused variables and declared external functions as external

This commit is contained in:
Martin Diehl 2013-02-11 09:44:17 +00:00
parent a89efaa4a6
commit c7c81a5ab5
7 changed files with 326 additions and 319 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
code/DAMASK_spectral_interface.f90
View File

@ -45,19 +45,25 @@ module DAMASK_interface
loadCaseFile = '' !< parameter given for load case file loadCaseFile = '' !< parameter given for load case file
character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons
public :: getSolverWorkingDirectoryName, & public :: &
getSolverJobName, & getSolverWorkingDirectoryName, &
DAMASK_interface_init getSolverJobName, &
private :: storeWorkingDirectory, & DAMASK_interface_init
getGeometryFile, & private :: &
getLoadCaseFile, & storeWorkingDirectory, &
rectifyPath, & getGeometryFile, &
makeRelativePath, & getLoadCaseFile, &
getPathSep, & rectifyPath, &
IIO_stringValue, & makeRelativePath, &
IIO_intValue, & getPathSep, &
IIO_lc, & IIO_stringValue, &
IIO_stringPos IIO_intValue, &
IIO_lc, &
IIO_stringPos
external :: &
quit, &
PetscInitialize, &
MPI_abort
contains contains
@ -243,6 +249,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA
endif endif
if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it
/= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep /= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep
!here check if exists and use chdir!
else ! using path to geometry file as working dir else ! using path to geometry file as working dir
if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument
storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.))

17
code/FEsolving.f90
View File

@ -66,17 +66,16 @@ module FEsolving
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief determine whether a symmetric solver is used and whether restart is requested !> @brief determine whether a symmetric solver is used and whether restart is requested
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FE_init subroutine FE_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)
use debug, only: & use debug, only: &
debug_level, & debug_level, &
debug_FEsolving, & debug_FEsolving, &
debug_levelBasic debug_levelBasic
use IO, only: & use IO, only: &
IO_stringPos, & IO_stringPos, &
IO_stringValue, & IO_stringValue, &
@ -87,23 +86,21 @@ subroutine FE_init
IO_open_logFile, & IO_open_logFile, &
#endif #endif
IO_warning IO_warning
use DAMASK_interface use DAMASK_interface
implicit none implicit none
#ifndef Spectral
integer(pInt), parameter :: & integer(pInt), parameter :: &
fileunit = 222_pInt, & fileunit = 222_pInt, &
maxNchunks = 6_pInt maxNchunks = 6_pInt
#ifndef Spectral
integer(pInt) :: j integer(pInt) :: j
character(len=64) :: tag character(len=64) :: tag
character(len=1024) :: line character(len=1024) :: line
integer(pInt), dimension(1_pInt+2_pInt*maxNchunks) :: positions integer(pInt), dimension(1_pInt+2_pInt*maxNchunks) :: positions
#endif #endif
write(6,*)
write(6,*) '<<<+- FEsolving init -+>>>' write(6,'(/,a)') ' <<<+- FEsolving init -+>>>'
write(6,*) '$Id$' write(6,'(a)') ' $Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
modelName = getSolverJobName() modelName = getSolverJobName()
@ -173,7 +170,9 @@ subroutine FE_init
#endif #endif
200 close(fileunit) 200 close(fileunit)
endif endif
! the following array are allocated by mesh.f90 and need to be deallocated in case of regridding
!--------------------------------------------------------------------------------------------------
! the following array are allocated by mesh.f90 and need to be deallocated in case of regridding
if (allocated(calcMode)) deallocate(calcMode) if (allocated(calcMode)) deallocate(calcMode)
if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP) if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP)
#endif #endif

294
code/IO.f90
View File

@ -26,61 +26,68 @@
!> @brief input/output functions, partly depending on chosen solver !> @brief input/output functions, partly depending on chosen solver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module IO module IO
use prec, only: pInt, pReal use prec, only: &
pInt, &
pReal
implicit none implicit none
private private
public :: IO_init, & public :: &
IO_checkAndRewind, & IO_init, &
IO_open_file_stat, & IO_checkAndRewind, &
IO_open_jobFile_stat, & IO_open_file_stat, &
IO_open_file, & IO_open_jobFile_stat, &
IO_open_jobFile, & IO_open_file, &
IO_write_jobFile, & IO_open_jobFile, &
IO_write_jobBinaryFile, & IO_write_jobFile, &
IO_write_jobBinaryIntFile, & IO_write_jobBinaryFile, &
IO_read_jobBinaryFile, & IO_write_jobBinaryIntFile, &
IO_read_jobBinaryIntFile, & IO_read_jobBinaryFile, &
IO_hybridIA, & IO_read_jobBinaryIntFile, &
IO_isBlank, & IO_hybridIA, &
IO_getTag, & IO_isBlank, &
IO_countSections, & IO_getTag, &
IO_countTagInPart, & IO_countSections, &
IO_spotTagInPart, & IO_countTagInPart, &
IO_globalTagInPart, & IO_spotTagInPart, &
IO_stringPos, & IO_globalTagInPart, &
IO_stringValue, & IO_stringPos, &
IO_fixedStringValue ,& IO_stringValue, &
IO_floatValue, & IO_fixedStringValue ,&
IO_fixedNoEFloatValue, & IO_floatValue, &
IO_intValue, & IO_fixedNoEFloatValue, &
IO_fixedIntValue, & IO_intValue, &
IO_lc, & IO_fixedIntValue, &
IO_skipChunks, & IO_lc, &
IO_extractValue, & IO_skipChunks, &
IO_countDataLines, & IO_extractValue, &
IO_countContinuousIntValues, & IO_countDataLines, &
IO_continuousIntValues, & IO_countContinuousIntValues, &
IO_error, & IO_continuousIntValues, &
IO_warning, & IO_error, &
IO_intOut IO_warning, &
IO_intOut
#ifndef Spectral #ifndef Spectral
public :: IO_open_inputFile, & public :: &
IO_open_logFile IO_open_inputFile, &
IO_open_logFile
#endif #endif
#ifdef Abaqus #ifdef Abaqus
public :: IO_abaqus_hasNoPart public :: &
IO_abaqus_hasNoPart
#endif #endif
private :: &
private :: IO_fixedFloatValue, & IO_fixedFloatValue, &
IO_lcInplace ,& IO_lcInplace ,&
hybridIA_reps hybridIA_reps
#ifdef Abaqus #ifdef Abaqus
private :: abaqus_assembleInputFile private :: &
abaqus_assembleInputFile
#endif #endif
external :: &
quit
contains contains
@ -90,11 +97,9 @@ contains
subroutine IO_init subroutine IO_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)
write(6,*) write(6,'(/,a)') ' <<<+- IO init -+>>>'
write(6,*) '<<<+- IO init -+>>>' write(6,'(a)') ' $Id$'
write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
flush(6)
end subroutine IO_init end subroutine IO_init
@ -163,8 +168,8 @@ end function IO_open_JobFile_stat
!> @brief Open existing file to given unit path to file is relative to working directory !> @brief Open existing file to given unit path to file is relative to working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_file(myUnit,relPath) subroutine IO_open_file(myUnit,relPath)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: myUnit
@ -184,9 +189,9 @@ end subroutine IO_open_file
!> @brief Open (write) file related to current job but with different extension to given unit !> @brief Open (write) file related to current job but with different extension to given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_jobFile(myUnit,newExt) subroutine IO_open_jobFile(myUnit,newExt)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: myUnit
@ -208,7 +213,6 @@ end subroutine IO_open_jobFile
!> @brief open FEM input file to given unit !> @brief open FEM input file to given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_inputFile(myUnit,model) subroutine IO_open_inputFile(myUnit,model)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName,& getSolverWorkingDirectoryName,&
getSolverJobName, & getSolverJobName, &
@ -220,10 +224,9 @@ subroutine IO_open_inputFile(myUnit,model)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
character(len=4) :: InputFileExtension2 character(len=4), parameter :: InputFileExtension2 = '.pes'
#ifdef Abaqus #ifdef Abaqus
InputFileExtension2='.pes'
path = trim(getSolverWorkingDirectoryName())//trim(model)//InputFileExtension2 ! attempt .pes, if it exists: it should be used path = trim(getSolverWorkingDirectoryName())//trim(model)//InputFileExtension2 ! attempt .pes, if it exists: it should be used
open(myUnit+1,status='old',iostat=myStat,file=path) open(myUnit+1,status='old',iostat=myStat,file=path)
if(myStat /= 0_pInt) then !if .pes does not work / exist; use conventional extension, i.e.".inp" if(myStat /= 0_pInt) then !if .pes does not work / exist; use conventional extension, i.e.".inp"
@ -252,7 +255,6 @@ end subroutine IO_open_inputFile
!> @brief open FEM log file to given Unit !> @brief open FEM log file to given Unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_logFile(myUnit) subroutine IO_open_logFile(myUnit)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName, & getSolverJobName, &
@ -330,9 +332,9 @@ end subroutine IO_write_jobBinaryFile
!> given unit !> given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_write_jobBinaryIntFile(myUnit,newExt,recMultiplier) subroutine IO_write_jobBinaryIntFile(myUnit,newExt,recMultiplier)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: myUnit
@ -361,8 +363,8 @@ end subroutine IO_write_jobBinaryIntFile
!> given unit !> given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier) subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: myUnit
@ -390,8 +392,8 @@ end subroutine IO_read_jobBinaryFile
!> given unit !> given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_read_jobBinaryIntFile(myUnit,newExt,jobName,recMultiplier) subroutine IO_read_jobBinaryIntFile(myUnit,newExt,jobName,recMultiplier)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: myUnit
@ -454,6 +456,8 @@ function IO_hybridIA(Nast,ODFfileName)
character(len=*), intent(in) :: ODFfileName character(len=*), intent(in) :: ODFfileName
!--------------------------------------------------------------------------------------------------
! math module is not available
real(pReal), parameter :: PI = 3.14159265358979323846264338327950288419716939937510_pReal real(pReal), parameter :: PI = 3.14159265358979323846264338327950288419716939937510_pReal
real(pReal), parameter :: INRAD = PI/180.0_pReal real(pReal), parameter :: INRAD = PI/180.0_pReal
character(len=*), parameter :: fileFormat = '(A80)' character(len=*), parameter :: fileFormat = '(A80)'
@ -469,11 +473,13 @@ function IO_hybridIA(Nast,ODFfileName)
real(pReal), dimension(:,:,:), allocatable :: dV_V real(pReal), dimension(:,:,:), allocatable :: dV_V
character(len=80) :: line character(len=80) :: line
!--- parse header of ODF file --- !--------------------------------------------------------------------------------------------------
! parse header of ODF file
call IO_open_file(999_pInt,ODFfileName) call IO_open_file(999_pInt,ODFfileName)
IO_hybridIA = -1.0_pReal ! initialize return value for case of error IO_hybridIA = -1.0_pReal ! initialize return value for case of error
!--- limits in phi1, Phi, phi2 --- !--------------------------------------------------------------------------------------------------
! limits in phi1, Phi, phi2
read(999,fmt=fileFormat,end=100) line read(999,fmt=fileFormat,end=100) line
myPos = IO_stringPos(line,3_pInt) myPos = IO_stringPos(line,3_pInt)
if (myPos(1) == 3) then ! found 3 chunks if (myPos(1) == 3) then ! found 3 chunks
@ -485,7 +491,8 @@ function IO_hybridIA(Nast,ODFfileName)
return return
endif endif
!--- deltas in phi1, Phi, phi2 --- !--------------------------------------------------------------------------------------------------
! deltas in phi1, Phi, phi2
read(999,fmt=fileFormat,end=100) line read(999,fmt=fileFormat,end=100) line
myPos = IO_stringPos(line,3_pInt) myPos = IO_stringPos(line,3_pInt)
if (myPos(1) == 3) then ! found 3 chunks if (myPos(1) == 3) then ! found 3 chunks
@ -500,7 +507,8 @@ function IO_hybridIA(Nast,ODFfileName)
steps = nint(limits/deltas,pInt) steps = nint(limits/deltas,pInt)
allocate(dV_V(steps(3),steps(2),steps(1))) allocate(dV_V(steps(3),steps(2),steps(1)))
!--- box boundary/center at origin? --- !--------------------------------------------------------------------------------------------------
! box boundary/center at origin?
read(999,fmt=fileFormat,end=100) line read(999,fmt=fileFormat,end=100) line
if (index(IO_lc(line),'bound')>0) then if (index(IO_lc(line),'bound')>0) then
center = 0.5_pReal center = 0.5_pReal
@ -508,8 +516,7 @@ function IO_hybridIA(Nast,ODFfileName)
center = 0.0_pReal center = 0.0_pReal
endif endif
!--- skip blank line --- read(999,fmt=fileFormat,end=100) line ! skip blank line
read(999,fmt=fileFormat,end=100) line
sum_dV_V = 0.0_pReal sum_dV_V = 0.0_pReal
dV_V = 0.0_pReal dV_V = 0.0_pReal
@ -531,10 +538,11 @@ function IO_hybridIA(Nast,ODFfileName)
enddo enddo
enddo enddo
dV_V = dV_V/sum_dV_V ! normalize to 1 dV_V = dV_V/sum_dV_V ! normalize to 1
!--- now fix bounds --- !--------------------------------------------------------------------------------------------------
Nset = max(Nast,NnonZero) ! if less than non-zero voxel count requested, sample at least that much ! now fix bounds
Nset = max(Nast,NnonZero) ! if less than non-zero voxel count requested, sample at least that much
lowerC = 0.0_pReal lowerC = 0.0_pReal
upperC = real(Nset, pReal) upperC = real(Nset, pReal)
@ -542,7 +550,9 @@ function IO_hybridIA(Nast,ODFfileName)
lowerC = upperC lowerC = upperC
upperC = upperC*2.0_pReal upperC = upperC*2.0_pReal
enddo enddo
!--- binary search for best C ---
!--------------------------------------------------------------------------------------------------
! binary search for best C
do do
C = (upperC+lowerC)/2.0_pReal C = (upperC+lowerC)/2.0_pReal
Nreps = hybridIA_reps(dV_V,steps,C) Nreps = hybridIA_reps(dV_V,steps,C)
@ -560,15 +570,15 @@ function IO_hybridIA(Nast,ODFfileName)
enddo enddo
allocate(binSet(Nreps)) allocate(binSet(Nreps))
bin = 0_pInt ! bin counter bin = 0_pInt ! bin counter
i = 1_pInt ! set counter i = 1_pInt ! set counter
do phi1=1_pInt,steps(1) do phi1=1_pInt,steps(1)
do Phi=1_pInt,steps(2) do Phi=1_pInt,steps(2)
do phi2=1_pInt,steps(3) do phi2=1_pInt,steps(3)
reps = nint(C*dV_V(phi2,Phi,phi1), pInt) reps = nint(C*dV_V(phi2,Phi,phi1), pInt)
binSet(i:i+reps-1) = bin binSet(i:i+reps-1) = bin
bin = bin+1_pInt ! advance bin bin = bin+1_pInt ! advance bin
i = i+reps ! advance set i = i+reps ! advance set
enddo enddo
enddo enddo
enddo enddo
@ -600,10 +610,10 @@ logical pure function IO_isBlank(line)
implicit none implicit none
character(len=*), intent(in) :: line character(len=*), intent(in) :: line
character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
character(len=*), parameter :: comment = achar(35) ! comment id '#' character(len=*), parameter :: comment = achar(35) ! comment id '#'
integer :: posNonBlank, posComment ! no pInt integer :: posNonBlank, posComment ! no pInt
posNonBlank = verify(line,blankChar) posNonBlank = verify(line,blankChar)
posComment = scan(line,comment) posComment = scan(line,comment)
@ -624,15 +634,15 @@ pure function IO_getTag(line,openChar,closeChar)
character(len=*), intent(in) :: openChar, & character(len=*), intent(in) :: openChar, &
closeChar closeChar
character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer :: left,right ! no pInt integer :: left,right ! no pInt
IO_getTag = '' IO_getTag = ''
left = scan(line,openChar) left = scan(line,openChar)
right = scan(line,closeChar) right = scan(line,closeChar)
if (left == verify(line,sep) .and. right > left) & ! openChar is first and closeChar occurs if (left == verify(line,sep) .and. right > left) & ! openChar is first and closeChar occurs
IO_getTag = line(left+1:right-1) IO_getTag = line(left+1:right-1)
end function IO_getTag end function IO_getTag
@ -653,15 +663,15 @@ integer(pInt) function IO_countSections(myFile,part)
IO_countSections = 0_pInt IO_countSections = 0_pInt
rewind(myFile) rewind(myFile)
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
enddo enddo
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
IO_countSections = IO_countSections + 1_pInt IO_countSections = IO_countSections + 1_pInt
enddo enddo
@ -693,20 +703,20 @@ function IO_countTagInPart(myFile,part,myTag,Nsections)
section = 0_pInt section = 0_pInt
rewind(myFile) rewind(myFile)
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
enddo enddo
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
section = section + 1_pInt section = section + 1_pInt
if (section > 0) then if (section > 0) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
if (tag == myTag) & ! match if (tag == myTag) & ! match
counter(section) = counter(section) + 1_pInt counter(section) = counter(section) + 1_pInt
endif endif
enddo enddo
@ -736,38 +746,38 @@ function IO_spotTagInPart(myFile,part,myTag,Nsections)
character(len=1024) :: line, & character(len=1024) :: line, &
tag tag
IO_spotTagInPart = .false. ! assume to nowhere spot tag IO_spotTagInPart = .false. ! assume to nowhere spot tag
section = 0_pInt section = 0_pInt
line ='' line =''
rewind(myFile) rewind(myFile)
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
enddo enddo
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
section = section + 1_pInt section = section + 1_pInt
if (section > 0_pInt) then if (section > 0_pInt) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
if (tag == myTag) & ! match if (tag == myTag) & ! match
IO_spotTagInPart(section) = .true. IO_spotTagInPart(section) = .true.
endif endif
enddo enddo
100 end function IO_spotTagInPart 100 end function IO_spotTagInPart
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief return logical whether myTag is present within <part> before any [sections] !> @brief return logical whether myTag is present within <part> before any [sections]
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function IO_globalTagInPart(myFile,part,myTag) logical function IO_globalTagInPart(myFile,part,myTag)
implicit none implicit none
integer(pInt), intent(in) :: myFile integer(pInt), intent(in) :: myFile
character(len=*), intent(in) :: part, & character(len=*), intent(in) :: part, &
myTag myTag
@ -779,20 +789,20 @@ logical function IO_globalTagInPart(myFile,part,myTag)
character(len=1024) :: line, & character(len=1024) :: line, &
tag tag
IO_globalTagInPart = .false. ! assume to nowhere spot tag IO_globalTagInPart = .false. ! assume to nowhere spot tag
section = 0_pInt section = 0_pInt
line ='' line =''
rewind(myFile) rewind(myFile)
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
enddo enddo
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
section = section + 1_pInt section = section + 1_pInt
if (section == 0_pInt) then if (section == 0_pInt) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
@ -1101,7 +1111,7 @@ pure subroutine IO_lcInplace(line)
character(len=*), intent(inout) :: line character(len=*), intent(inout) :: line
character(len=len(line)) :: IO_lc character(len=len(line)) :: IO_lc
integer :: i,n ! no pInt (len returns default integer) integer :: i,n ! no pInt (len returns default integer)
do i=1,len(line) do i=1,len(line)
n = index(upper,line(i:i)) n = index(upper,line(i:i))
@ -1112,7 +1122,7 @@ pure subroutine IO_lcInplace(line)
endif endif
enddo enddo
end subroutine IO_lcInplace end subroutine IO_lcInplace
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1181,7 +1191,7 @@ integer(pInt) function IO_countDataLines(myUnit)
read(myUnit,'(A300)',end=100) line read(myUnit,'(A300)',end=100) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
tmp = IO_lc(IO_stringValue(line,myPos,1_pInt)) tmp = IO_lc(IO_stringValue(line,myPos,1_pInt))
if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword
exit exit
else else
if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt
@ -1216,7 +1226,7 @@ integer(pInt) function IO_countContinuousIntValues(myUnit)
do do
read(myUnit,'(A300)',end=100) line read(myUnit,'(A300)',end=100) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
if (myPos(1) < 1_pInt) then ! empty line if (myPos(1) < 1_pInt) then ! empty line
exit exit
elseif (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator elseif (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator
IO_countContinuousIntValues = 1_pInt + IO_intValue(line,myPos,3_pInt) & IO_countContinuousIntValues = 1_pInt + IO_intValue(line,myPos,3_pInt) &
@ -1242,7 +1252,7 @@ integer(pInt) function IO_countContinuousIntValues(myUnit)
do l = 1_pInt,c do l = 1_pInt,c
read(myUnit,'(A300)',end=100) line read(myUnit,'(A300)',end=100) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation
(IO_intValue(line,myPos,2_pInt)-IO_intValue(line,myPos,1_pInt))/& (IO_intValue(line,myPos,2_pInt)-IO_intValue(line,myPos,1_pInt))/&
max(1_pInt,IO_intValue(line,myPos,3_pInt)) max(1_pInt,IO_intValue(line,myPos,3_pInt))
enddo enddo
@ -1323,7 +1333,8 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
backspace(myUnit) backspace(myUnit)
enddo enddo
!check if the element values in the elset are auto generated !--------------------------------------------------------------------------------------------------
! check if the element values in the elset are auto generated
backspace(myUnit) backspace(myUnit)
read(myUnit,'(A65536)',end=100) line read(myUnit,'(A65536)',end=100) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
@ -1392,13 +1403,13 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
select case (error_ID) select case (error_ID)
!* internal errors !--------------------------------------------------------------------------------------------------
! internal errors
case (0_pInt) case (0_pInt)
msg = 'internal check failed:' msg = 'internal check failed:'
!* file handling errors !--------------------------------------------------------------------------------------------------
! file handling errors
case (100_pInt) case (100_pInt)
msg = 'could not open file:' msg = 'could not open file:'
case (101_pInt) case (101_pInt)
@ -1408,9 +1419,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (103_pInt) case (103_pInt)
msg = 'could not assemble input files' msg = 'could not assemble input files'
!--------------------------------------------------------------------------------------------------
!* material error messages and related messages in mesh ! material error messages and related messages in mesh
case (150_pInt) case (150_pInt)
msg = 'crystallite index out of bounds' msg = 'crystallite index out of bounds'
case (151_pInt) case (151_pInt)
@ -1432,9 +1442,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (180_pInt) case (180_pInt)
msg = 'no microstructure specified via State Variable 3' msg = 'no microstructure specified via State Variable 3'
!--------------------------------------------------------------------------------------------------
!* plasticity error messages ! plasticity error messages
case (200_pInt) case (200_pInt)
msg = 'unknown elasticity specified:' msg = 'unknown elasticity specified:'
case (201_pInt) case (201_pInt)
@ -1454,17 +1463,15 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (253_pInt) case (253_pInt)
msg = 'element type not supported for nonlocal plasticity' msg = 'element type not supported for nonlocal plasticity'
!--------------------------------------------------------------------------------------------------
!* numerics error messages ! numerics error messages
case (300_pInt) case (300_pInt)
msg = 'unknown numerics parameter:' msg = 'unknown numerics parameter:'
case (301_pInt) case (301_pInt)
msg = 'numerics parameter out of bounds:' msg = 'numerics parameter out of bounds:'
!--------------------------------------------------------------------------------------------------
!* math errors ! math errors
case (400_pInt) case (400_pInt)
msg = 'matrix inversion error' msg = 'matrix inversion error'
case (401_pInt) case (401_pInt)
@ -1488,20 +1495,18 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (460_pInt) case (460_pInt)
msg = 'kdtree2 error' msg = 'kdtree2 error'
!* homogenization errors !-------------------------------------------------------------------------------------------------
! homogenization errors
case (500_pInt) case (500_pInt)
msg = 'unknown homogenization specified' msg = 'unknown homogenization specified'
!-------------------------------------------------------------------------------------------------
!* DAMASK_marc errors ! DAMASK_marc errors
case (700_pInt) case (700_pInt)
msg = 'invalid materialpoint result requested' msg = 'invalid materialpoint result requested'
!-------------------------------------------------------------------------------------------------
!* errors related to spectral solver ! errors related to spectral solver
case (809_pInt) case (809_pInt)
msg = 'initializing FFTW' msg = 'initializing FFTW'
case (831_pInt) case (831_pInt)
@ -1543,8 +1548,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (892_pInt) case (892_pInt)
msg = 'unknown filter type selected' msg = 'unknown filter type selected'
!* Error messages related to parsing of Abaqus input file !-------------------------------------------------------------------------------------------------
! error messages related to parsing of Abaqus input file
case (900_pInt) case (900_pInt)
msg = 'improper definition of nodes in input file (Nnodes < 2)' msg = 'improper definition of nodes in input file (Nnodes < 2)'
case (901_pInt) case (901_pInt)
@ -1569,8 +1574,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
msg = 'incorrect element type mapping in ' msg = 'incorrect element type mapping in '
!* general error messages !-------------------------------------------------------------------------------------------------
! general error messages
case (666_pInt) case (666_pInt)
msg = 'memory leak detected' msg = 'memory leak detected'
case default case default
@ -1689,7 +1694,9 @@ subroutine IO_warning(warning_ID,e,i,g,ext_msg)
end subroutine IO_warning end subroutine IO_warning
! INTERNAL (HELPER) FUNCTIONS: !--------------------------------------------------------------------------------------------------
! internal helper functions
#ifdef Abaqus #ifdef Abaqus
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1747,6 +1754,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
end function abaqus_assembleInputFile end function abaqus_assembleInputFile
#endif #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief hybrid IA repetition counter !> @brief hybrid IA repetition counter
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

172
code/debug.f90
View File

@ -33,13 +33,12 @@ module debug
implicit none implicit none
private private
integer(pInt), parameter, public :: & integer(pInt), parameter, public :: &
debug_levelSelective = 2_pInt**0_pInt, & debug_levelSelective = 2_pInt**0_pInt, &
debug_levelBasic = 2_pInt**1_pInt, & debug_levelBasic = 2_pInt**1_pInt, &
debug_levelExtensive = 2_pInt**2_pInt debug_levelExtensive = 2_pInt**2_pInt
integer(pInt), parameter, private :: & integer(pInt), parameter, private :: &
debug_maxGeneral = debug_levelExtensive ! must be set to the last bitcode used by (potentially) all debug types debug_maxGeneral = debug_levelExtensive ! must be set to the last bitcode used by (potentially) all debug types
integer(pInt), parameter, public :: & integer(pInt), parameter, public :: &
debug_spectralRestart = debug_maxGeneral*2_pInt**1_pInt, & debug_spectralRestart = debug_maxGeneral*2_pInt**1_pInt, &
debug_spectralFFTW = debug_maxGeneral*2_pInt**2_pInt, & debug_spectralFFTW = debug_maxGeneral*2_pInt**2_pInt, &
@ -116,11 +115,10 @@ module debug
contains contains
!******************************************************************** !--------------------------------------------------------------------------------------------------
! initialize the debugging capabilities !> @brief reads in parameters from debug.config and allocates arrays
!******************************************************************** !--------------------------------------------------------------------------------------------------
subroutine debug_init subroutine debug_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)
use numerics, only: nStress, & use numerics, only: nStress, &
nState, & nState, &
@ -144,6 +142,7 @@ subroutine debug_init
integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt), dimension(1+2*maxNchunks) :: positions
character(len=64) :: tag character(len=64) :: tag
character(len=1024) :: line character(len=1024) :: line
write(6,'(/,a)') ' <<<+- debug init -+>>>' write(6,'(/,a)') ' <<<+- debug init -+>>>'
write(6,'(a)') ' $Id$' write(6,'(a)') ' $Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
@ -169,11 +168,9 @@ subroutine debug_init
allocate(debug_MaterialpointLoopDistribution(nHomog+1)) allocate(debug_MaterialpointLoopDistribution(nHomog+1))
debug_MaterialpointLoopDistribution = 0_pInt debug_MaterialpointLoopDistribution = 0_pInt
!--------------------------------------------------------------------------------------------------
! try to open the config file ! try to open the config file
if(IO_open_file_stat(fileunit,debug_configFile)) then fileExists: if(IO_open_file_stat(fileunit,debug_configFile)) then
! read variables from config file and overwrite parameters
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
@ -246,22 +243,20 @@ subroutine debug_init
do i = 1_pInt, debug_maxNtype do i = 1_pInt, debug_maxNtype
if (debug_level(i) == 0) & if (debug_level(i) == 0) &
debug_level(i) = ior(debug_level(i), debug_level(debug_maxNtype + 2_pInt)) ! fill undefined debug types with levels specified by "other" debug_level(i) = ior(debug_level(i), debug_level(debug_maxNtype + 2_pInt)) ! fill undefined debug types with levels specified by "other"
debug_level(i) = ior(debug_level(i), debug_level(debug_maxNtype + 1_pInt)) ! fill all debug types with levels specified by "all" debug_level(i) = ior(debug_level(i), debug_level(debug_maxNtype + 1_pInt)) ! fill all debug types with levels specified by "all"
enddo enddo
if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) & if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) &
write(6,'(a,/)') ' using values from config file' write(6,'(a,/)') ' using values from config file'
else fileExists
! no config file, so we use standard values
else
if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) & if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) &
write(6,'(a,/)') ' using standard values' write(6,'(a,/)') ' using standard values'
endif endif fileExists
!output switched on (debug level for debug must be extensive) !--------------------------------------------------------------------------------------------------
! output switched on (debug level for debug must be extensive)
if (iand(debug_level(debug_debug),debug_levelExtensive) /= 0) then if (iand(debug_level(debug_debug),debug_levelExtensive) /= 0) then
do i = 1_pInt, debug_maxNtype do i = 1_pInt, debug_maxNtype
select case(i) select case(i)
@ -312,14 +307,15 @@ subroutine debug_init
end subroutine debug_init end subroutine debug_init
!********************************************************************
! reset debug distributions !--------------------------------------------------------------------------------------------------
!******************************************************************** !> @brief resets all debug values
!--------------------------------------------------------------------------------------------------
subroutine debug_reset subroutine debug_reset
implicit none implicit none
debug_StressLoopDistribution = 0_pInt ! initialize debugging data debug_StressLoopDistribution = 0_pInt
debug_StateLoopDistribution = 0_pInt debug_StateLoopDistribution = 0_pInt
debug_CrystalliteLoopDistribution = 0_pInt debug_CrystalliteLoopDistribution = 0_pInt
debug_MaterialpointStateLoopDistribution = 0_pInt debug_MaterialpointStateLoopDistribution = 0_pInt
@ -343,29 +339,28 @@ subroutine debug_reset
end subroutine debug_reset end subroutine debug_reset
!********************************************************************
! write debug statements to standard out
!********************************************************************
subroutine debug_info
use numerics, only: nStress, & !--------------------------------------------------------------------------------------------------
nState, & !> @brief writes debug statements to standard out
nCryst, & !--------------------------------------------------------------------------------------------------
nMPstate, & subroutine debug_info
nHomog use numerics, only: &
nStress, &
nState, &
nCryst, &
nMPstate, &
nHomog
implicit none implicit none
integer(pInt) :: i,integral integer(pInt) :: j,integral
integer(pLongInt) :: tickrate integer(pLongInt) :: tickrate
character(len=1) :: exceed character(len=1) :: exceed
call system_clock(count_rate=tickrate) call system_clock(count_rate=tickrate)
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0) then debugOutputCryst: if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0) then
write(6,*) write(6,'(/,a,/)') ' DEBUG Info (from previous cycle)'
write(6,*) 'DEBUG Info (from previous cycle)'
write(6,*)
write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls
if (debug_cumLpCalls > 0_pInt) then if (debug_cumLpCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumLpTicks,pReal)& write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumLpTicks,pReal)&
@ -373,8 +368,7 @@ subroutine debug_info
write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',& write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',&
real(debug_cumLpTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)/real(debug_cumLpCalls,pReal) real(debug_cumLpTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)/real(debug_cumLpCalls,pReal)
endif endif
write(6,*) write(6,'(/,a33,1x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls
write(6,'(a33,1x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls
if (debug_cumdotStateCalls > 0_pInt) then if (debug_cumdotStateCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotStateTicks,pReal)& write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotStateTicks,pReal)&
/real(tickrate,pReal) /real(tickrate,pReal)
@ -382,8 +376,7 @@ subroutine debug_info
real(debug_cumDotStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)& real(debug_cumDotStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)&
/real(debug_cumDotStateCalls,pReal) /real(debug_cumDotStateCalls,pReal)
endif endif
write(6,*) write(6,'(/,a33,1x,i12)') 'total calls to collectDeltaState:',debug_cumDeltaStateCalls
write(6,'(a33,1x,i12)') 'total calls to collectDeltaState:',debug_cumDeltaStateCalls
if (debug_cumDeltaStateCalls > 0_pInt) then if (debug_cumDeltaStateCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDeltaStateTicks,pReal)& write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDeltaStateTicks,pReal)&
/real(tickrate,pReal) /real(tickrate,pReal)
@ -391,8 +384,7 @@ subroutine debug_info
real(debug_cumDeltaStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)& real(debug_cumDeltaStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)&
/real(debug_cumDeltaStateCalls,pReal) /real(debug_cumDeltaStateCalls,pReal)
endif endif
write(6,*) write(6,'(/,a33,1x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls
write(6,'(a33,1x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls
if (debug_cumdotTemperatureCalls > 0_pInt) then if (debug_cumdotTemperatureCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotTemperatureTicks,pReal)& write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotTemperatureTicks,pReal)&
/real(tickrate,pReal) /real(tickrate,pReal)
@ -402,88 +394,78 @@ subroutine debug_info
endif endif
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(3/,a)') 'distribution_StressLoop : stress stiffness'
write(6,*) do j=1_pInt,nStress+1_pInt
write(6,*) 'distribution_StressLoop : stress stiffness' if (any(debug_StressLoopDistribution(j,:) /= 0_pInt )) then
do i=1_pInt,nStress+1_pInt integral = integral + j*(debug_StressLoopDistribution(j,1) + debug_StressLoopDistribution(j,2))
if (any(debug_StressLoopDistribution(i,:) /= 0_pInt )) then
integral = integral + i*(debug_StressLoopDistribution(i,1) + debug_StressLoopDistribution(i,2))
exceed = ' ' exceed = ' '
if (i > nStress) exceed = '+' ! last entry gets "+" if (j > nStress) exceed = '+' ! last entry gets "+"
write(6,'(i25,a1,i10,1x,i10)') min(nStress,i),exceed,debug_StressLoopDistribution(i,1),& write(6,'(i25,a1,i10,1x,i10)') min(nStress,j),exceed,debug_StressLoopDistribution(j,1),&
debug_StressLoopDistribution(i,2) debug_StressLoopDistribution(j,2)
endif endif
enddo enddo
write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StressLoopDistribution(:,1)), & write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StressLoopDistribution(:,1)), &
sum(debug_StressLoopDistribution(:,2)) sum(debug_StressLoopDistribution(:,2))
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(2/,a)') 'distribution_CrystalliteStateLoop :'
write(6,*) 'distribution_CrystalliteStateLoop :' do j=1_pInt,nState+1_pInt
do i=1_pInt,nState+1_pInt if (any(debug_StateLoopDistribution(j,:) /= 0)) then
if (any(debug_StateLoopDistribution(i,:) /= 0)) then integral = integral + j*(debug_StateLoopDistribution(j,1) + debug_StateLoopDistribution(j,2))
integral = integral + i*(debug_StateLoopDistribution(i,1) + debug_StateLoopDistribution(i,2))
exceed = ' ' exceed = ' '
if (i > nState) exceed = '+' ! last entry gets "+" if (j > nState) exceed = '+' ! last entry gets "+"
write(6,'(i25,a1,i10,1x,i10)') min(nState,i),exceed,debug_StateLoopDistribution(i,1),& write(6,'(i25,a1,i10,1x,i10)') min(nState,j),exceed,debug_StateLoopDistribution(j,1),&
debug_StateLoopDistribution(i,2) debug_StateLoopDistribution(j,2)
endif endif
enddo enddo
write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StateLoopDistribution(:,1)), & write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StateLoopDistribution(:,1)), &
sum(debug_StateLoopDistribution(:,2)) sum(debug_StateLoopDistribution(:,2))
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(2/,a)') 'distribution_CrystalliteCutbackLoop :'
write(6,*) 'distribution_CrystalliteCutbackLoop :' do j=1_pInt,nCryst+1_pInt
do i=1_pInt,nCryst+1_pInt if (debug_CrystalliteLoopDistribution(j) /= 0) then
if (debug_CrystalliteLoopDistribution(i) /= 0) then integral = integral + j*debug_CrystalliteLoopDistribution(j)
integral = integral + i*debug_CrystalliteLoopDistribution(i)
exceed = ' ' exceed = ' '
if (i > nCryst) exceed = '+' if (j > nCryst) exceed = '+'
write(6,'(i25,a1,i10)') min(nCryst,i),exceed,debug_CrystalliteLoopDistribution(i) write(6,'(i25,a1,i10)') min(nCryst,j),exceed,debug_CrystalliteLoopDistribution(j)
endif endif
enddo enddo
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution) write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution)
endif endif debugOutputCryst
if (iand(debug_level(debug_homogenization),debug_levelBasic) /= 0) then debugOutputHomog: if (iand(debug_level(debug_homogenization),debug_levelBasic) /= 0) then
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(2/,a)') 'distribution_MaterialpointStateLoop :'
write(6,*) 'distribution_MaterialpointStateLoop :' do j=1_pInt,nMPstate
do i=1_pInt,nMPstate if (debug_MaterialpointStateLoopDistribution(j) /= 0) then
if (debug_MaterialpointStateLoopDistribution(i) /= 0) then integral = integral + j*debug_MaterialpointStateLoopDistribution(j)
integral = integral + i*debug_MaterialpointStateLoopDistribution(i) write(6,'(i25,1x,i10)') j,debug_MaterialpointStateLoopDistribution(j)
write(6,'(i25,1x,i10)') i,debug_MaterialpointStateLoopDistribution(i)
endif endif
enddo enddo
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution) write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution)
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(2/,a)') 'distribution_MaterialpointCutbackLoop :'
write(6,*) 'distribution_MaterialpointCutbackLoop :' do j=1_pInt,nHomog+1_pInt
do i=1_pInt,nHomog+1_pInt if (debug_MaterialpointLoopDistribution(j) /= 0) then
if (debug_MaterialpointLoopDistribution(i) /= 0) then integral = integral + j*debug_MaterialpointLoopDistribution(j)
integral = integral + i*debug_MaterialpointLoopDistribution(i)
exceed = ' ' exceed = ' '
if (i > nHomog) exceed = '+' if (j > nHomog) exceed = '+'
write(6,'(i25,a1,i10)') min(nHomog,i),exceed,debug_MaterialpointLoopDistribution(i) write(6,'(i25,a1,i10)') min(nHomog,j),exceed,debug_MaterialpointLoopDistribution(j)
endif endif
enddo enddo
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution) write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution)
endif endif debugOutputHomog
if (iand(debug_level(debug_CPFEM),debug_levelBasic) /= 0) then debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_levelBasic) /= 0) then
write(6,*) write(6,'(2/,a,/)') ' Extreme values of returned stress and jacobian'
write(6,*)
write(6,*) 'Extreme values of returned stress and jacobian'
write(6,*)
write(6,'(a39)') ' value el ip' write(6,'(a39)') ' value el ip'
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') 'stress min :', debug_stressMin, debug_stressMinLocation write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') 'jacobian min :', debug_jacobianMin, debug_jacobianMinLocation write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' jacobian min :', debug_jacobianMin, debug_jacobianMinLocation
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation write(6,'(a14,1x,e12.3,1x,i6,1x,i4,/)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation
write(6,*) endif debugOutputCPFEM
endif
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
end subroutine debug_info end subroutine debug_info

7
code/math.f90
View File

@ -234,7 +234,6 @@ real(pReal), dimension(4,36), parameter, private :: &
math_cauchy, & math_cauchy, &
math_periodicNearestNeighbor math_periodicNearestNeighbor
#endif #endif
private :: & private :: &
math_partition, & math_partition, &
halton, & halton, &
@ -243,6 +242,10 @@ real(pReal), dimension(4,36), parameter, private :: &
halton_seed_set, & halton_seed_set, &
i_to_halton, & i_to_halton, &
prime prime
external :: &
dsyev, &
dgetrf, &
dgetri
contains contains
@ -2689,8 +2692,10 @@ integer(pInt) function prime(n)
else if (n <= prime_max) then else if (n <= prime_max) then
prime = npvec(n) prime = npvec(n)
else else
prime = -1_pInt
call IO_error(error_ID=406_pInt) call IO_error(error_ID=406_pInt)
end if end if
end function prime end function prime

109
code/numerics.f90
View File

@ -16,11 +16,14 @@
! You should have received a copy of the GNU General Public License ! You should have received a copy of the GNU General Public License
! along with DAMASK. If not, see <http://www.gnu.org/licenses/>. ! along with DAMASK. If not, see <http://www.gnu.org/licenses/>.
! !
!############################################################## !--------------------------------------------------------------------------------------------------
!* $Id$ ! $Id$
!############################################################## !--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Managing of parameters related to numerics
!--------------------------------------------------------------------------------------------------
module numerics module numerics
!##############################################################
use prec, only: & use prec, only: &
pInt, & pInt, &
pReal pReal
@ -116,11 +119,12 @@ module numerics
contains contains
!*******************************************
! initialization subroutine
!*******************************************
subroutine numerics_init
!--------------------------------------------------------------------------------------------------
!> @brief reads in parameters from numerics.config and sets openMP related parameters. Also does
! a sanity check
!--------------------------------------------------------------------------------------------------
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)
use IO, only: & use IO, only: &
IO_error, & IO_error, &
@ -138,7 +142,7 @@ subroutine numerics_init
#endif #endif
implicit none implicit none
#ifdef Marc #ifdef Marc
!$ include "omp_lib.h" ! use the non F90 standard include file to prevent crashes with some versions of MSC.Marc !$ include "omp_lib.h" ! use the not F90 standard conforming include file to prevent crashes with some versions of MSC.Marc
#endif #endif
integer(pInt), parameter :: fileunit = 300_pInt ,& integer(pInt), parameter :: fileunit = 300_pInt ,&
maxNchunks = 2_pInt maxNchunks = 2_pInt
@ -148,9 +152,8 @@ subroutine numerics_init
character(len=1024) :: line character(len=1024) :: line
!$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS !$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS
write(6,*) write(6,'(/,a)') ' <<<+- numerics init -+>>>'
write(6,*) '<<<+- numerics init -+>>>' write(6,'(a)') ' $Id$'
write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
!$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS... !$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS...
@ -159,20 +162,19 @@ subroutine numerics_init
!$ if (DAMASK_NumThreadsInt < 1_pInt) DAMASK_NumThreadsInt = 1_pInt ! ...ensure that its at least one... !$ if (DAMASK_NumThreadsInt < 1_pInt) DAMASK_NumThreadsInt = 1_pInt ! ...ensure that its at least one...
!$ 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 !--------------------------------------------------------------------------------------------------
if(IO_open_file_stat(fileunit,numerics_configFile)) then ! try to open the config file
fileExists: if(IO_open_file_stat(fileunit,numerics_configFile)) then
write(6,*) ' ... using values from config file' write(6,'(a,/)') ' using values from config file'
write(6,*)
!* read variables from config file and overwrite parameters
!--------------------------------------------------------------------------------------------------
! read variables from config file and overwrite default parameters if keyword is present
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)
@ -227,8 +229,8 @@ subroutine numerics_init
case ('unitlength') case ('unitlength')
numerics_unitlength = IO_floatValue(line,positions,2_pInt) numerics_unitlength = IO_floatValue(line,positions,2_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')
@ -255,10 +257,14 @@ subroutine numerics_init
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)
!* 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)
!* spectral parameters
!--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef Spectral #ifdef Spectral
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)
@ -299,31 +305,30 @@ subroutine numerics_init
err_p_tol = IO_floatValue(line,positions,2_pInt) err_p_tol = IO_floatValue(line,positions,2_pInt)
#endif #endif
#ifndef PETSc #ifndef PETSc
case ('myspectralsolver', 'petsc_options','err_f_tol', 'err_p_tol') case ('myspectralsolver', 'petsc_options','err_f_tol', 'err_p_tol') ! found PETSc parameter, but compiled without PETSc
call IO_warning(41_pInt,ext_msg=tag) call IO_warning(41_pInt,ext_msg=tag)
#endif #endif
#endif #endif
#ifndef Spectral #ifndef Spectral
case ('err_div_tol','err_stress_tolrel','err_stress_tolabs',& case ('err_div_tol','err_stress_tolrel','err_stress_tolabs',& ! found spectral parameter for FEM build
'itmax', 'itmin','memory_efficient','fftw_timelimit','fftw_plan_mode','myspectralsolver', & 'itmax', 'itmin','memory_efficient','fftw_timelimit','fftw_plan_mode','myspectralsolver', &
'rotation_tol','divergence_correction','update_gamma','petsc_options','myfilter', & 'rotation_tol','divergence_correction','update_gamma','petsc_options','myfilter', &
'err_f_tol', 'err_p_tol', 'maxcutback') 'err_f_tol', 'err_p_tol', 'maxcutback')
call IO_warning(40_pInt,ext_msg=tag) call IO_warning(40_pInt,ext_msg=tag)
#endif #endif
case default case default ! found unknown keyword
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 else fileExists
else write(6,'(a,/)') ' using standard values'
write(6,*) ' ... using standard values' endif fileExists
write(6,*)
endif
#ifdef Spectral #ifdef Spectral
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
@ -337,10 +342,10 @@ subroutine numerics_init
end select end select
#endif #endif
numerics_timeSyncing = numerics_timeSyncing .and. all(numerics_integrator==2_pInt) ! timeSyncing only allowed for explicit Euler integrator numerics_timeSyncing = numerics_timeSyncing .and. all(numerics_integrator==2_pInt) ! timeSyncing only allowed for explicit Euler integrator
!* writing parameters to output file
!--------------------------------------------------------------------------------------------------
! writing parameters to output file
write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain
write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance
write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness
@ -368,8 +373,8 @@ subroutine numerics_init
write(6,'(a24,1x,es8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog write(6,'(a24,1x,es8.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,es8.1)') ' aTol_RGC: ',absTol_RGC write(6,'(a24,1x,es8.1)') ' aTol_RGC: ',absTol_RGC
write(6,'(a24,1x,es8.1)') ' rTol_RGC: ',relTol_RGC write(6,'(a24,1x,es8.1)') ' rTol_RGC: ',relTol_RGC
write(6,'(a24,1x,es8.1)') ' aMax_RGC: ',absMax_RGC write(6,'(a24,1x,es8.1)') ' aMax_RGC: ',absMax_RGC
@ -382,13 +387,17 @@ subroutine numerics_init
write(6,'(a24,1x,es8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC write(6,'(a24,1x,es8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC
write(6,'(a24,1x,es8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC write(6,'(a24,1x,es8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC
write(6,'(a24,1x,es8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC write(6,'(a24,1x,es8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC
!* Random seeding parameters
!--------------------------------------------------------------------------------------------------
! Random seeding parameter
write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed
!* openMP parameter
!--------------------------------------------------------------------------------------------------
! openMP parameter
!$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt !$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt
!* spectral parameters !--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef Spectral #ifdef Spectral
write(6,'(a24,1x,es8.1)') ' err_div_tol: ',err_div_tol write(6,'(a24,1x,es8.1)') ' err_div_tol: ',err_div_tol
write(6,'(a24,1x,es8.1)') ' err_stress_tolrel: ',err_stress_tolrel write(6,'(a24,1x,es8.1)') ' err_stress_tolrel: ',err_stress_tolrel
@ -419,8 +428,8 @@ subroutine numerics_init
#endif #endif
#endif #endif
!* sanity check !--------------------------------------------------------------------------------------------------
! sanity checks
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')
@ -446,9 +455,6 @@ subroutine numerics_init
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')
if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength') if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength')
!* 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')
@ -462,8 +468,6 @@ subroutine numerics_init
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
#ifdef Spectral #ifdef Spectral
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')
@ -480,9 +484,8 @@ subroutine numerics_init
if (err_p_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_p_tol') if (err_p_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_p_tol')
#endif #endif
#endif #endif
if (fixedSeed <= 0_pInt) then if (fixedSeed <= 0_pInt) &
write(6,'(a,/)') ' Random is random!' write(6,'(a,/)') ' No fixed Seed: Random is random!'
endif
end subroutine numerics_init end subroutine numerics_init

5
code/prec.f90
View File

@ -70,7 +70,10 @@ module prec
real(pReal), dimension(:), pointer :: p real(pReal), dimension(:), pointer :: p
end type p_vec end type p_vec
public :: prec_init public :: &
prec_init
external :: &
quit
contains contains