diff --git a/code/DAMASK_spectral_interface.f90 b/code/DAMASK_spectral_interface.f90 index 1b8c524d5..3fb4c2c10 100644 --- a/code/DAMASK_spectral_interface.f90 +++ b/code/DAMASK_spectral_interface.f90 @@ -45,19 +45,25 @@ module DAMASK_interface loadCaseFile = '' !< parameter given for load case file character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons - public :: getSolverWorkingDirectoryName, & - getSolverJobName, & - DAMASK_interface_init - private :: storeWorkingDirectory, & - getGeometryFile, & - getLoadCaseFile, & - rectifyPath, & - makeRelativePath, & - getPathSep, & - IIO_stringValue, & - IIO_intValue, & - IIO_lc, & - IIO_stringPos + public :: & + getSolverWorkingDirectoryName, & + getSolverJobName, & + DAMASK_interface_init + private :: & + storeWorkingDirectory, & + getGeometryFile, & + getLoadCaseFile, & + rectifyPath, & + makeRelativePath, & + getPathSep, & + IIO_stringValue, & + IIO_intValue, & + IIO_lc, & + IIO_stringPos + external :: & + quit, & + PetscInitialize, & + MPI_abort contains @@ -243,6 +249,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA endif if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it /= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep + !here check if exists and use chdir! else ! using path to geometry file as working dir if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) diff --git a/code/FEsolving.f90 b/code/FEsolving.f90 index 2230477ab..2d56a5770 100644 --- a/code/FEsolving.f90 +++ b/code/FEsolving.f90 @@ -66,17 +66,16 @@ module FEsolving contains + !-------------------------------------------------------------------------------------------------- !> @brief determine whether a symmetric solver is used and whether restart is requested !-------------------------------------------------------------------------------------------------- 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 debug, only: & debug_level, & debug_FEsolving, & debug_levelBasic - use IO, only: & IO_stringPos, & IO_stringValue, & @@ -87,23 +86,21 @@ subroutine FE_init IO_open_logFile, & #endif IO_warning - use DAMASK_interface implicit none +#ifndef Spectral integer(pInt), parameter :: & fileunit = 222_pInt, & maxNchunks = 6_pInt - -#ifndef Spectral integer(pInt) :: j character(len=64) :: tag character(len=1024) :: line integer(pInt), dimension(1_pInt+2_pInt*maxNchunks) :: positions #endif - write(6,*) - write(6,*) '<<<+- FEsolving init -+>>>' - write(6,*) '$Id$' + + write(6,'(/,a)') ' <<<+- FEsolving init -+>>>' + write(6,'(a)') ' $Id$' #include "compilation_info.f90" modelName = getSolverJobName() @@ -173,7 +170,9 @@ subroutine FE_init #endif 200 close(fileunit) 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(FEsolving_execIP)) deallocate(FEsolving_execIP) #endif diff --git a/code/IO.f90 b/code/IO.f90 index 0a4f6fc2a..39510f82d 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -26,61 +26,68 @@ !> @brief input/output functions, partly depending on chosen solver !-------------------------------------------------------------------------------------------------- module IO - use prec, only: pInt, pReal + use prec, only: & + pInt, & + pReal implicit none private - public :: IO_init, & - IO_checkAndRewind, & - IO_open_file_stat, & - IO_open_jobFile_stat, & - IO_open_file, & - IO_open_jobFile, & - IO_write_jobFile, & - IO_write_jobBinaryFile, & - IO_write_jobBinaryIntFile, & - IO_read_jobBinaryFile, & - IO_read_jobBinaryIntFile, & - IO_hybridIA, & - IO_isBlank, & - IO_getTag, & - IO_countSections, & - IO_countTagInPart, & - IO_spotTagInPart, & - IO_globalTagInPart, & - IO_stringPos, & - IO_stringValue, & - IO_fixedStringValue ,& - IO_floatValue, & - IO_fixedNoEFloatValue, & - IO_intValue, & - IO_fixedIntValue, & - IO_lc, & - IO_skipChunks, & - IO_extractValue, & - IO_countDataLines, & - IO_countContinuousIntValues, & - IO_continuousIntValues, & - IO_error, & - IO_warning, & - IO_intOut + public :: & + IO_init, & + IO_checkAndRewind, & + IO_open_file_stat, & + IO_open_jobFile_stat, & + IO_open_file, & + IO_open_jobFile, & + IO_write_jobFile, & + IO_write_jobBinaryFile, & + IO_write_jobBinaryIntFile, & + IO_read_jobBinaryFile, & + IO_read_jobBinaryIntFile, & + IO_hybridIA, & + IO_isBlank, & + IO_getTag, & + IO_countSections, & + IO_countTagInPart, & + IO_spotTagInPart, & + IO_globalTagInPart, & + IO_stringPos, & + IO_stringValue, & + IO_fixedStringValue ,& + IO_floatValue, & + IO_fixedNoEFloatValue, & + IO_intValue, & + IO_fixedIntValue, & + IO_lc, & + IO_skipChunks, & + IO_extractValue, & + IO_countDataLines, & + IO_countContinuousIntValues, & + IO_continuousIntValues, & + IO_error, & + IO_warning, & + IO_intOut #ifndef Spectral - public :: IO_open_inputFile, & - IO_open_logFile + public :: & + IO_open_inputFile, & + IO_open_logFile #endif - #ifdef Abaqus - public :: IO_abaqus_hasNoPart + public :: & + IO_abaqus_hasNoPart #endif - - private :: IO_fixedFloatValue, & - IO_lcInplace ,& - hybridIA_reps - + private :: & + IO_fixedFloatValue, & + IO_lcInplace ,& + hybridIA_reps #ifdef Abaqus - private :: abaqus_assembleInputFile + private :: & + abaqus_assembleInputFile #endif + external :: & + quit + contains @@ -90,11 +97,9 @@ contains subroutine IO_init 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,*) '<<<+- IO init -+>>>' - write(6,*) '$Id$' + write(6,'(/,a)') ' <<<+- IO init -+>>>' + write(6,'(a)') ' $Id$' #include "compilation_info.f90" - flush(6) 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 !-------------------------------------------------------------------------------------------------- subroutine IO_open_file(myUnit,relPath) - - use DAMASK_interface, only: getSolverWorkingDirectoryName + use DAMASK_interface, only: & + getSolverWorkingDirectoryName implicit none 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 !-------------------------------------------------------------------------------------------------- subroutine IO_open_jobFile(myUnit,newExt) - - use DAMASK_interface, only: getSolverWorkingDirectoryName, & - getSolverJobName + use DAMASK_interface, only: & + getSolverWorkingDirectoryName, & + getSolverJobName implicit none integer(pInt), intent(in) :: myUnit @@ -208,7 +213,6 @@ end subroutine IO_open_jobFile !> @brief open FEM input file to given unit !-------------------------------------------------------------------------------------------------- subroutine IO_open_inputFile(myUnit,model) - use DAMASK_interface, only: & getSolverWorkingDirectoryName,& getSolverJobName, & @@ -220,10 +224,9 @@ subroutine IO_open_inputFile(myUnit,model) integer(pInt) :: myStat character(len=1024) :: path - character(len=4) :: InputFileExtension2 + character(len=4), parameter :: InputFileExtension2 = '.pes' #ifdef Abaqus - InputFileExtension2='.pes' path = trim(getSolverWorkingDirectoryName())//trim(model)//InputFileExtension2 ! attempt .pes, if it exists: it should be used 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" @@ -252,7 +255,6 @@ end subroutine IO_open_inputFile !> @brief open FEM log file to given Unit !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(myUnit) - use DAMASK_interface, only: & getSolverWorkingDirectoryName, & getSolverJobName, & @@ -330,9 +332,9 @@ end subroutine IO_write_jobBinaryFile !> given unit !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobBinaryIntFile(myUnit,newExt,recMultiplier) - - use DAMASK_interface, only: getSolverWorkingDirectoryName, & - getSolverJobName + use DAMASK_interface, only: & + getSolverWorkingDirectoryName, & + getSolverJobName implicit none integer(pInt), intent(in) :: myUnit @@ -361,8 +363,8 @@ end subroutine IO_write_jobBinaryIntFile !> given unit !-------------------------------------------------------------------------------------------------- subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier) - - use DAMASK_interface, only: getSolverWorkingDirectoryName + use DAMASK_interface, only: & + getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: myUnit @@ -390,8 +392,8 @@ end subroutine IO_read_jobBinaryFile !> given unit !-------------------------------------------------------------------------------------------------- subroutine IO_read_jobBinaryIntFile(myUnit,newExt,jobName,recMultiplier) - - use DAMASK_interface, only: getSolverWorkingDirectoryName + use DAMASK_interface, only: & + getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: myUnit @@ -453,7 +455,9 @@ function IO_hybridIA(Nast,ODFfileName) real(pReal), dimension(3,Nast) :: IO_hybridIA character(len=*), intent(in) :: ODFfileName - + +!-------------------------------------------------------------------------------------------------- +! math module is not available real(pReal), parameter :: PI = 3.14159265358979323846264338327950288419716939937510_pReal real(pReal), parameter :: INRAD = PI/180.0_pReal character(len=*), parameter :: fileFormat = '(A80)' @@ -469,11 +473,13 @@ function IO_hybridIA(Nast,ODFfileName) real(pReal), dimension(:,:,:), allocatable :: dV_V character(len=80) :: line -!--- parse header of ODF file --- +!-------------------------------------------------------------------------------------------------- +! parse header of ODF file call IO_open_file(999_pInt,ODFfileName) 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 myPos = IO_stringPos(line,3_pInt) if (myPos(1) == 3) then ! found 3 chunks @@ -485,7 +491,8 @@ function IO_hybridIA(Nast,ODFfileName) return endif -!--- deltas in phi1, Phi, phi2 --- +!-------------------------------------------------------------------------------------------------- +! deltas in phi1, Phi, phi2 read(999,fmt=fileFormat,end=100) line myPos = IO_stringPos(line,3_pInt) if (myPos(1) == 3) then ! found 3 chunks @@ -500,7 +507,8 @@ function IO_hybridIA(Nast,ODFfileName) steps = nint(limits/deltas,pInt) 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 if (index(IO_lc(line),'bound')>0) then center = 0.5_pReal @@ -508,8 +516,7 @@ function IO_hybridIA(Nast,ODFfileName) center = 0.0_pReal endif -!--- skip blank line --- - read(999,fmt=fileFormat,end=100) line + read(999,fmt=fileFormat,end=100) line ! skip blank line sum_dV_V = 0.0_pReal dV_V = 0.0_pReal @@ -531,10 +538,11 @@ function IO_hybridIA(Nast,ODFfileName) 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 upperC = real(Nset, pReal) @@ -542,7 +550,9 @@ function IO_hybridIA(Nast,ODFfileName) lowerC = upperC upperC = upperC*2.0_pReal enddo -!--- binary search for best C --- + +!-------------------------------------------------------------------------------------------------- +! binary search for best C do C = (upperC+lowerC)/2.0_pReal Nreps = hybridIA_reps(dV_V,steps,C) @@ -560,15 +570,15 @@ function IO_hybridIA(Nast,ODFfileName) enddo allocate(binSet(Nreps)) - bin = 0_pInt ! bin counter - i = 1_pInt ! set counter + bin = 0_pInt ! bin counter + i = 1_pInt ! set counter do phi1=1_pInt,steps(1) do Phi=1_pInt,steps(2) do phi2=1_pInt,steps(3) reps = nint(C*dV_V(phi2,Phi,phi1), pInt) binSet(i:i+reps-1) = bin - bin = bin+1_pInt ! advance bin - i = i+reps ! advance set + bin = bin+1_pInt ! advance bin + i = i+reps ! advance set enddo enddo enddo @@ -600,10 +610,10 @@ logical pure function IO_isBlank(line) implicit none character(len=*), intent(in) :: line - character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces - character(len=*), parameter :: comment = achar(35) ! comment id '#' + character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces + character(len=*), parameter :: comment = achar(35) ! comment id '#' - integer :: posNonBlank, posComment ! no pInt + integer :: posNonBlank, posComment ! no pInt posNonBlank = verify(line,blankChar) posComment = scan(line,comment) @@ -624,15 +634,15 @@ pure function IO_getTag(line,openChar,closeChar) character(len=*), intent(in) :: openChar, & 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 = '' left = scan(line,openChar) 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) end function IO_getTag @@ -653,15 +663,15 @@ integer(pInt) function IO_countSections(myFile,part) IO_countSections = 0_pInt 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 enddo do read(myFile,'(a1024)',END=100) line - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') exit ! stop at next part - if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') exit ! stop at next part + if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier IO_countSections = IO_countSections + 1_pInt enddo @@ -693,20 +703,20 @@ function IO_countTagInPart(myFile,part,myTag,Nsections) section = 0_pInt 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 enddo do read(myFile,'(a1024)',END=100) line - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') exit ! stop at next part - if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') exit ! stop at next part + if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier section = section + 1_pInt if (section > 0) then positions = IO_stringPos(line,maxNchunks) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key - if (tag == myTag) & ! match + tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + if (tag == myTag) & ! match counter(section) = counter(section) + 1_pInt endif enddo @@ -736,38 +746,38 @@ function IO_spotTagInPart(myFile,part,myTag,Nsections) character(len=1024) :: line, & tag - IO_spotTagInPart = .false. ! assume to nowhere spot tag + IO_spotTagInPart = .false. ! assume to nowhere spot tag section = 0_pInt line ='' 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 enddo do read(myFile,'(a1024)',END=100) line - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') exit ! stop at next part - if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') exit ! stop at next part + if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier section = section + 1_pInt if (section > 0_pInt) then positions = IO_stringPos(line,maxNchunks) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key - if (tag == myTag) & ! match + tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + if (tag == myTag) & ! match IO_spotTagInPart(section) = .true. endif enddo 100 end function IO_spotTagInPart + !-------------------------------------------------------------------------------------------------- !> @brief return logical whether myTag is present within before any [sections] !-------------------------------------------------------------------------------------------------- logical function IO_globalTagInPart(myFile,part,myTag) implicit none - integer(pInt), intent(in) :: myFile character(len=*), intent(in) :: part, & myTag @@ -779,20 +789,20 @@ logical function IO_globalTagInPart(myFile,part,myTag) character(len=1024) :: line, & tag - IO_globalTagInPart = .false. ! assume to nowhere spot tag + IO_globalTagInPart = .false. ! assume to nowhere spot tag section = 0_pInt line ='' 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 enddo do read(myFile,'(a1024)',END=100) line - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') exit ! stop at next part - if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') exit ! stop at next part + if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier section = section + 1_pInt if (section == 0_pInt) then positions = IO_stringPos(line,maxNchunks) @@ -1101,7 +1111,7 @@ pure subroutine IO_lcInplace(line) character(len=*), intent(inout) :: line 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) n = index(upper,line(i:i)) @@ -1112,7 +1122,7 @@ pure subroutine IO_lcInplace(line) endif 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 myPos = IO_stringPos(line,maxNchunks) 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 else if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt @@ -1216,7 +1226,7 @@ integer(pInt) function IO_countContinuousIntValues(myUnit) do read(myUnit,'(A300)',end=100) line myPos = IO_stringPos(line,maxNchunks) - if (myPos(1) < 1_pInt) then ! empty line + if (myPos(1) < 1_pInt) then ! empty line exit elseif (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator 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 read(myUnit,'(A300)',end=100) line 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))/& max(1_pInt,IO_intValue(line,myPos,3_pInt)) enddo @@ -1323,7 +1333,8 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN) backspace(myUnit) 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) read(myUnit,'(A65536)',end=100) line myPos = IO_stringPos(line,maxNchunks) @@ -1392,13 +1403,13 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) select case (error_ID) - !* internal errors - +!-------------------------------------------------------------------------------------------------- +! internal errors case (0_pInt) msg = 'internal check failed:' - !* file handling errors - +!-------------------------------------------------------------------------------------------------- +! file handling errors case (100_pInt) msg = 'could not open file:' case (101_pInt) @@ -1408,9 +1419,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) case (103_pInt) 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) msg = 'crystallite index out of bounds' case (151_pInt) @@ -1432,9 +1442,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) case (180_pInt) msg = 'no microstructure specified via State Variable 3' - - !* plasticity error messages - +!-------------------------------------------------------------------------------------------------- +! plasticity error messages case (200_pInt) msg = 'unknown elasticity specified:' case (201_pInt) @@ -1454,17 +1463,15 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) case (253_pInt) msg = 'element type not supported for nonlocal plasticity' - - !* numerics error messages - +!-------------------------------------------------------------------------------------------------- +! numerics error messages case (300_pInt) msg = 'unknown numerics parameter:' case (301_pInt) msg = 'numerics parameter out of bounds:' - - !* math errors - +!-------------------------------------------------------------------------------------------------- +! math errors case (400_pInt) msg = 'matrix inversion error' case (401_pInt) @@ -1488,20 +1495,18 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) case (460_pInt) msg = 'kdtree2 error' - !* homogenization errors - +!------------------------------------------------------------------------------------------------- +! homogenization errors case (500_pInt) msg = 'unknown homogenization specified' - - !* DAMASK_marc errors - +!------------------------------------------------------------------------------------------------- +! DAMASK_marc errors case (700_pInt) msg = 'invalid materialpoint result requested' - - !* errors related to spectral solver - +!------------------------------------------------------------------------------------------------- +! errors related to spectral solver case (809_pInt) msg = 'initializing FFTW' case (831_pInt) @@ -1543,8 +1548,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) case (892_pInt) 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) msg = 'improper definition of nodes in input file (Nnodes < 2)' case (901_pInt) @@ -1569,8 +1574,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) msg = 'incorrect element type mapping in ' - !* general error messages - +!------------------------------------------------------------------------------------------------- +! general error messages case (666_pInt) msg = 'memory leak detected' case default @@ -1689,7 +1694,9 @@ subroutine IO_warning(warning_ID,e,i,g,ext_msg) end subroutine IO_warning -! INTERNAL (HELPER) FUNCTIONS: +!-------------------------------------------------------------------------------------------------- +! internal helper functions + #ifdef Abaqus !-------------------------------------------------------------------------------------------------- @@ -1747,6 +1754,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) end function abaqus_assembleInputFile #endif + !-------------------------------------------------------------------------------------------------- !> @brief hybrid IA repetition counter !-------------------------------------------------------------------------------------------------- diff --git a/code/debug.f90 b/code/debug.f90 index 7e5ce98e0..b499dd97c 100644 --- a/code/debug.f90 +++ b/code/debug.f90 @@ -33,13 +33,12 @@ module debug implicit none private - integer(pInt), parameter, public :: & debug_levelSelective = 2_pInt**0_pInt, & debug_levelBasic = 2_pInt**1_pInt, & debug_levelExtensive = 2_pInt**2_pInt 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 :: & debug_spectralRestart = debug_maxGeneral*2_pInt**1_pInt, & debug_spectralFFTW = debug_maxGeneral*2_pInt**2_pInt, & @@ -116,11 +115,10 @@ module debug contains -!******************************************************************** -! initialize the debugging capabilities -!******************************************************************** +!-------------------------------------------------------------------------------------------------- +!> @brief reads in parameters from debug.config and allocates arrays +!-------------------------------------------------------------------------------------------------- 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 numerics, only: nStress, & nState, & @@ -144,6 +142,7 @@ subroutine debug_init integer(pInt), dimension(1+2*maxNchunks) :: positions character(len=64) :: tag character(len=1024) :: line + write(6,'(/,a)') ' <<<+- debug init -+>>>' write(6,'(a)') ' $Id$' #include "compilation_info.f90" @@ -169,11 +168,9 @@ subroutine debug_init allocate(debug_MaterialpointLoopDistribution(nHomog+1)) debug_MaterialpointLoopDistribution = 0_pInt - - ! try to open the config file - if(IO_open_file_stat(fileunit,debug_configFile)) then - - ! read variables from config file and overwrite parameters +!-------------------------------------------------------------------------------------------------- +! try to open the config file + fileExists: if(IO_open_file_stat(fileunit,debug_configFile)) then do read(fileunit,'(a1024)',END=100) line if (IO_isBlank(line)) cycle ! skip empty lines @@ -246,22 +243,20 @@ subroutine debug_init do i = 1_pInt, debug_maxNtype 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 if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) & write(6,'(a,/)') ' using values from config file' - - - ! no config file, so we use standard values - else + else fileExists if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) & - write(6,'(a,/)') ' using standard values' - endif + write(6,'(a,/)') ' using standard values' + 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 do i = 1_pInt, debug_maxNtype select case(i) @@ -312,14 +307,15 @@ subroutine debug_init end subroutine debug_init -!******************************************************************** -! reset debug distributions -!******************************************************************** + +!-------------------------------------------------------------------------------------------------- +!> @brief resets all debug values +!-------------------------------------------------------------------------------------------------- subroutine debug_reset implicit none - debug_StressLoopDistribution = 0_pInt ! initialize debugging data + debug_StressLoopDistribution = 0_pInt debug_StateLoopDistribution = 0_pInt debug_CrystalliteLoopDistribution = 0_pInt debug_MaterialpointStateLoopDistribution = 0_pInt @@ -343,29 +339,28 @@ subroutine debug_reset end subroutine debug_reset -!******************************************************************** -! write debug statements to standard out -!******************************************************************** -subroutine debug_info - use numerics, only: nStress, & - nState, & - nCryst, & - nMPstate, & - nHomog +!-------------------------------------------------------------------------------------------------- +!> @brief writes debug statements to standard out +!-------------------------------------------------------------------------------------------------- +subroutine debug_info + use numerics, only: & + nStress, & + nState, & + nCryst, & + nMPstate, & + nHomog implicit none - integer(pInt) :: i,integral + integer(pInt) :: j,integral integer(pLongInt) :: tickrate character(len=1) :: exceed call system_clock(count_rate=tickrate) !$OMP CRITICAL (write2out) - if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0) then - write(6,*) - write(6,*) 'DEBUG Info (from previous cycle)' - write(6,*) + debugOutputCryst: if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0) then + write(6,'(/,a,/)') ' DEBUG Info (from previous cycle)' write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls if (debug_cumLpCalls > 0_pInt) then 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 :',& real(debug_cumLpTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)/real(debug_cumLpCalls,pReal) 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 write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotStateTicks,pReal)& /real(tickrate,pReal) @@ -382,8 +376,7 @@ subroutine debug_info real(debug_cumDotStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)& /real(debug_cumDotStateCalls,pReal) 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 write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDeltaStateTicks,pReal)& /real(tickrate,pReal) @@ -391,8 +384,7 @@ subroutine debug_info real(debug_cumDeltaStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)& /real(debug_cumDeltaStateCalls,pReal) 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 write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotTemperatureTicks,pReal)& /real(tickrate,pReal) @@ -402,88 +394,78 @@ subroutine debug_info endif integral = 0_pInt - write(6,*) - write(6,*) - write(6,*) 'distribution_StressLoop : stress stiffness' - do i=1_pInt,nStress+1_pInt - if (any(debug_StressLoopDistribution(i,:) /= 0_pInt )) then - integral = integral + i*(debug_StressLoopDistribution(i,1) + debug_StressLoopDistribution(i,2)) + write(6,'(3/,a)') 'distribution_StressLoop : stress stiffness' + do j=1_pInt,nStress+1_pInt + if (any(debug_StressLoopDistribution(j,:) /= 0_pInt )) then + integral = integral + j*(debug_StressLoopDistribution(j,1) + debug_StressLoopDistribution(j,2)) exceed = ' ' - if (i > nStress) exceed = '+' ! last entry gets "+" - write(6,'(i25,a1,i10,1x,i10)') min(nStress,i),exceed,debug_StressLoopDistribution(i,1),& - debug_StressLoopDistribution(i,2) + if (j > nStress) exceed = '+' ! last entry gets "+" + write(6,'(i25,a1,i10,1x,i10)') min(nStress,j),exceed,debug_StressLoopDistribution(j,1),& + debug_StressLoopDistribution(j,2) endif enddo write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StressLoopDistribution(:,1)), & sum(debug_StressLoopDistribution(:,2)) integral = 0_pInt - write(6,*) - write(6,*) 'distribution_CrystalliteStateLoop :' - do i=1_pInt,nState+1_pInt - if (any(debug_StateLoopDistribution(i,:) /= 0)) then - integral = integral + i*(debug_StateLoopDistribution(i,1) + debug_StateLoopDistribution(i,2)) + write(6,'(2/,a)') 'distribution_CrystalliteStateLoop :' + do j=1_pInt,nState+1_pInt + if (any(debug_StateLoopDistribution(j,:) /= 0)) then + integral = integral + j*(debug_StateLoopDistribution(j,1) + debug_StateLoopDistribution(j,2)) exceed = ' ' - if (i > nState) exceed = '+' ! last entry gets "+" - write(6,'(i25,a1,i10,1x,i10)') min(nState,i),exceed,debug_StateLoopDistribution(i,1),& - debug_StateLoopDistribution(i,2) + if (j > nState) exceed = '+' ! last entry gets "+" + write(6,'(i25,a1,i10,1x,i10)') min(nState,j),exceed,debug_StateLoopDistribution(j,1),& + debug_StateLoopDistribution(j,2) endif enddo write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StateLoopDistribution(:,1)), & sum(debug_StateLoopDistribution(:,2)) integral = 0_pInt - write(6,*) - write(6,*) 'distribution_CrystalliteCutbackLoop :' - do i=1_pInt,nCryst+1_pInt - if (debug_CrystalliteLoopDistribution(i) /= 0) then - integral = integral + i*debug_CrystalliteLoopDistribution(i) + write(6,'(2/,a)') 'distribution_CrystalliteCutbackLoop :' + do j=1_pInt,nCryst+1_pInt + if (debug_CrystalliteLoopDistribution(j) /= 0) then + integral = integral + j*debug_CrystalliteLoopDistribution(j) exceed = ' ' - if (i > nCryst) exceed = '+' - write(6,'(i25,a1,i10)') min(nCryst,i),exceed,debug_CrystalliteLoopDistribution(i) + if (j > nCryst) exceed = '+' + write(6,'(i25,a1,i10)') min(nCryst,j),exceed,debug_CrystalliteLoopDistribution(j) endif enddo 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 - write(6,*) - write(6,*) 'distribution_MaterialpointStateLoop :' - do i=1_pInt,nMPstate - if (debug_MaterialpointStateLoopDistribution(i) /= 0) then - integral = integral + i*debug_MaterialpointStateLoopDistribution(i) - write(6,'(i25,1x,i10)') i,debug_MaterialpointStateLoopDistribution(i) + write(6,'(2/,a)') 'distribution_MaterialpointStateLoop :' + do j=1_pInt,nMPstate + if (debug_MaterialpointStateLoopDistribution(j) /= 0) then + integral = integral + j*debug_MaterialpointStateLoopDistribution(j) + write(6,'(i25,1x,i10)') j,debug_MaterialpointStateLoopDistribution(j) endif enddo write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution) integral = 0_pInt - write(6,*) - write(6,*) 'distribution_MaterialpointCutbackLoop :' - do i=1_pInt,nHomog+1_pInt - if (debug_MaterialpointLoopDistribution(i) /= 0) then - integral = integral + i*debug_MaterialpointLoopDistribution(i) + write(6,'(2/,a)') 'distribution_MaterialpointCutbackLoop :' + do j=1_pInt,nHomog+1_pInt + if (debug_MaterialpointLoopDistribution(j) /= 0) then + integral = integral + j*debug_MaterialpointLoopDistribution(j) exceed = ' ' - if (i > nHomog) exceed = '+' - write(6,'(i25,a1,i10)') min(nHomog,i),exceed,debug_MaterialpointLoopDistribution(i) + if (j > nHomog) exceed = '+' + write(6,'(i25,a1,i10)') min(nHomog,j),exceed,debug_MaterialpointLoopDistribution(j) endif enddo write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution) - endif + endif debugOutputHomog - if (iand(debug_level(debug_CPFEM),debug_levelBasic) /= 0) then - write(6,*) - write(6,*) - write(6,*) 'Extreme values of returned stress and jacobian' - write(6,*) + debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_levelBasic) /= 0) then + write(6,'(2/,a,/)') ' Extreme values of returned stress and jacobian' 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)') ' 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)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation - write(6,*) - endif + 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)') ' jacobian min :', debug_jacobianMin, debug_jacobianMinLocation + write(6,'(a14,1x,e12.3,1x,i6,1x,i4,/)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation + endif debugOutputCPFEM !$OMP END CRITICAL (write2out) end subroutine debug_info diff --git a/code/math.f90 b/code/math.f90 index ac3f54322..994aaea27 100644 --- a/code/math.f90 +++ b/code/math.f90 @@ -233,8 +233,7 @@ real(pReal), dimension(4,36), parameter, private :: & math_logstrainMat, & math_cauchy, & math_periodicNearestNeighbor -#endif - +#endif private :: & math_partition, & halton, & @@ -243,6 +242,10 @@ real(pReal), dimension(4,36), parameter, private :: & halton_seed_set, & i_to_halton, & prime + external :: & + dsyev, & + dgetrf, & + dgetri contains @@ -2689,8 +2692,10 @@ integer(pInt) function prime(n) else if (n <= prime_max) then prime = npvec(n) else + prime = -1_pInt call IO_error(error_ID=406_pInt) end if + end function prime diff --git a/code/numerics.f90 b/code/numerics.f90 index 99b99af73..89595b13c 100644 --- a/code/numerics.f90 +++ b/code/numerics.f90 @@ -16,11 +16,14 @@ ! You should have received a copy of the GNU General Public License ! along with DAMASK. If not, see . ! -!############################################################## -!* $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 -!############################################################## use prec, only: & pInt, & pReal @@ -116,11 +119,12 @@ module numerics contains -!******************************************* -! initialization subroutine -!******************************************* + +!-------------------------------------------------------------------------------------------------- +!> @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 IO, only: & IO_error, & @@ -138,7 +142,7 @@ subroutine numerics_init #endif implicit none #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 integer(pInt), parameter :: fileunit = 300_pInt ,& maxNchunks = 2_pInt @@ -148,9 +152,8 @@ subroutine numerics_init character(len=1024) :: line !$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS - write(6,*) - write(6,*) '<<<+- numerics init -+>>>' - write(6,*) '$Id$' + write(6,'(/,a)') ' <<<+- numerics init -+>>>' + write(6,'(a)') ' $Id$' #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... @@ -159,20 +162,19 @@ subroutine numerics_init !$ 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 - ! try to open the config file - if(IO_open_file_stat(fileunit,numerics_configFile)) then - - write(6,*) ' ... using values from config file' - write(6,*) +!-------------------------------------------------------------------------------------------------- +! try to open the config file + fileExists: if(IO_open_file_stat(fileunit,numerics_configFile)) then + write(6,'(a,/)') ' using values from config file' - !* read variables from config file and overwrite parameters - +!-------------------------------------------------------------------------------------------------- +! read variables from config file and overwrite default parameters if keyword is present line = '' do 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) - 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) case ('relevantstrain') relevantStrain = IO_floatValue(line,positions,2_pInt) @@ -227,8 +229,8 @@ subroutine numerics_init case ('unitlength') numerics_unitlength = IO_floatValue(line,positions,2_pInt) - !* RGC parameters: - +!-------------------------------------------------------------------------------------------------- +! RGC parameters case ('atol_rgc') absTol_RGC = IO_floatValue(line,positions,2_pInt) case ('rtol_rgc') @@ -255,10 +257,14 @@ subroutine numerics_init volDiscrMod_RGC = IO_floatValue(line,positions,2_pInt) case ('discrepancypower_rgc') volDiscrPow_RGC = IO_floatValue(line,positions,2_pInt) - !* Random seeding parameters + +!-------------------------------------------------------------------------------------------------- +! random seeding parameters case ('fixed_seed') fixedSeed = IO_intValue(line,positions,2_pInt) - !* spectral parameters + +!-------------------------------------------------------------------------------------------------- +! spectral parameters #ifdef Spectral case ('err_div_tol') 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) #endif #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) #endif #endif #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', & 'rotation_tol','divergence_correction','update_gamma','petsc_options','myfilter', & 'err_f_tol', 'err_p_tol', 'maxcutback') call IO_warning(40_pInt,ext_msg=tag) #endif - case default + case default ! found unknown keyword call IO_error(300_pInt,ext_msg=tag) endselect enddo 100 close(fileunit) - - ! no config file, so we use standard values - else - write(6,*) ' ... using standard values' - write(6,*) - endif + + else fileExists + write(6,'(a,/)') ' using standard values' + endif fileExists + #ifdef Spectral - 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 + 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 fftw_planner_flag = 64_pInt case('measure','fftw_measure') fftw_planner_flag = 0_pInt @@ -337,10 +342,10 @@ subroutine numerics_init end select #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)') ' defgradTolerance: ',defgradTolerance 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,i8,/)') ' nMPstate: ',nMPstate - !* RGC parameters - +!-------------------------------------------------------------------------------------------------- +! RGC parameters 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)') ' 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)') ' volDiscrepancyMod_RGC: ',volDiscrMod_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 - !* openMP parameter + +!-------------------------------------------------------------------------------------------------- +! openMP parameter !$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt - !* spectral parameters +!-------------------------------------------------------------------------------------------------- +! spectral parameters #ifdef Spectral write(6,'(a24,1x,es8.1)') ' err_div_tol: ',err_div_tol write(6,'(a24,1x,es8.1)') ' err_stress_tolrel: ',err_stress_tolrel @@ -419,8 +428,8 @@ subroutine numerics_init #endif #endif - !* sanity check - +!-------------------------------------------------------------------------------------------------- +! sanity checks 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 (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)) & call IO_error(301_pInt,ext_msg='integrator') 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 (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') @@ -462,8 +468,6 @@ subroutine numerics_init 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 (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrPw_RGC') - - !* spectral parameters #ifdef Spectral 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') @@ -480,9 +484,8 @@ subroutine numerics_init if (err_p_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_p_tol') #endif #endif - if (fixedSeed <= 0_pInt) then - write(6,'(a,/)') ' Random is random!' - endif + if (fixedSeed <= 0_pInt) & + write(6,'(a,/)') ' No fixed Seed: Random is random!' end subroutine numerics_init diff --git a/code/prec.f90 b/code/prec.f90 index 7753c9cfc..0f6ab7a12 100644 --- a/code/prec.f90 +++ b/code/prec.f90 @@ -70,7 +70,10 @@ module prec real(pReal), dimension(:), pointer :: p end type p_vec - public :: prec_init + public :: & + prec_init + external :: & + quit contains