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

Merge branch 'development' into 36-faster-file-handling-for-material-config-use-stream-access-instead-of-line-wise-reading

This commit is contained in:
Martin Diehl 2018-08-03 22:21:37 +02:00
parent 38183fdbf6 c05337a21b
commit 8c07825d7e
7 changed files with 169 additions and 259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PRIVATE

@ -1 +1 @@
Subproject commit 50eb21714e2f501b111bb62096ebb6a5bfc6708a Subproject commit 38c969591a4c22b6a17f8815e294874b55191cef

2
VERSION
View File

@ -1 +1 @@
v2.0.2-261-gbc3f6ae9 v2.0.2-263-gb305d913

60
src/DAMASK_abaqus.f
View File

@ -3,38 +3,42 @@
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Koen Janssens, Paul Scherrer Institut !> @author Koen Janssens, Paul Scherrer Institut
!> @author Arun Prakash, Fraunhofer IWM !> @author Arun Prakash, Fraunhofer IWM
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief interfaces DAMASK with Abaqus/Standard !> @brief interfaces DAMASK with Abaqus/Standard
!> @details put the included file abaqus_v6.env in either your home or model directory, !> @details put the included file abaqus_v6.env in either your home or model directory,
!> it is a minimum Abaqus environment file containing all changes necessary to use the !> it is a minimum Abaqus environment file containing all changes necessary to use the
!> DAMASK subroutine (see Abaqus documentation for more information on the use of abaqus_v6.env) !> DAMASK subroutine (see Abaqus documentation for more information on the use of abaqus_v6.env)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
#ifndef INT
#define INT 4
#endif
#ifndef FLOAT
#define FLOAT 8
#endif
#define Abaqus #define Abaqus
#include "prec.f90" #include "prec.f90"
module DAMASK_interface module DAMASK_interface
implicit none implicit none
character(len=4), dimension(2), parameter :: INPUTFILEEXTENSION = ['.pes','.inp'] private
character(len=4), parameter :: LOGFILEEXTENSION = '.log' character(len=4), dimension(2), parameter, public :: INPUTFILEEXTENSION = ['.pes','.inp']
character(len=4), parameter, public :: LOGFILEEXTENSION = '.log'
public :: &
DAMASK_interface_init, &
getSolverJobName
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief just reporting !> @brief reports and sets working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init subroutine DAMASK_interface_init
use ifport, only: &
CHDIR
implicit none
integer, dimension(8) :: & integer, dimension(8) :: &
dateAndTime ! type default integer dateAndTime ! type default integer
integer :: lenOutDir,ierr
character(len=256) :: wd
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018'
@ -46,26 +50,19 @@ subroutine DAMASK_interface_init
dateAndTime(6),':',& dateAndTime(6),':',&
dateAndTime(7) dateAndTime(7)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
call getoutdir(wd, lenOutDir)
ierr = CHDIR(wd)
if (ierr /= 0) then
write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist'
call quit(1)
endif
#include "compilation_info.f90" #include "compilation_info.f90"
end subroutine DAMASK_interface_init end subroutine DAMASK_interface_init
!--------------------------------------------------------------------------------------------------
!> @brief using Abaqus/Standard function to get working directory name
!--------------------------------------------------------------------------------------------------
character(1024) function getSolverWorkingDirectoryName()
implicit none
integer :: lenOutDir
getSolverWorkingDirectoryName=''
call getoutdir(getSolverWorkingDirectoryName, lenOutDir)
getSolverWorkingDirectoryName=trim(getSolverWorkingDirectoryName)//'/'
end function getSolverWorkingDirectoryName
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief using Abaqus/Standard function to get solver job name !> @brief using Abaqus/Standard function to get solver job name
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -79,10 +76,17 @@ character(1024) function getSolverJobName()
end function getSolverJobName end function getSolverJobName
end module DAMASK_interface end module DAMASK_interface
#include "commercialFEM_fileList.f90" #include "commercialFEM_fileList.f90"
!--------------------------------------------------------------------------------------------------
!> @brief This is the Abaqus std user subroutine for defining material behavior
!--------------------------------------------------------------------------------------------------
subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,& subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
RPL,DDSDDT,DRPLDE,DRPLDT,STRAN,DSTRAN,& RPL,DDSDDT,DRPLDE,DRPLDT,STRAN,DSTRAN,&
TIME,DTIME,TEMP,DTEMP,PREDEF,DPRED,CMNAME,NDI,NSHR,NTENS,& TIME,DTIME,TEMP,DTEMP,PREDEF,DPRED,CMNAME,NDI,NSHR,NTENS,&

76
src/DAMASK_marc.f90
View File

@ -1,15 +1,3 @@
#define QUOTE(x) #x
#define PASTE(x,y) x ## y
#ifndef INT
#define INT 4
#endif
#ifndef FLOAT
#define FLOAT 8
#endif
#include "prec.f90"
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
@ -17,13 +5,12 @@
!> @author W.A. Counts !> @author W.A. Counts
!> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH !> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH !> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Material subroutine for MSC.Marc !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Interfaces DAMASK with MSC.Marc
!> @details Usage: !> @details Usage:
!> @details - choose material as hypela2 !> @details - choose material as hypela2
!> @details - set statevariable 2 to index of homogenization !> @details - set statevariable 2 to index of homogenization
!> @details - set statevariable 3 to index of microstructure !> @details - set statevariable 3 to index of microstructure
!> @details - make sure the file "material.config" exists in the working directory
!> @details - make sure the file "numerics.config" exists in the working directory
!> @details - use nonsymmetric option for solver (e.g. direct profile or multifrontal sparse, the latter seems to be faster!) !> @details - use nonsymmetric option for solver (e.g. direct profile or multifrontal sparse, the latter seems to be faster!)
!> @details - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used, i.e uncheck "non-symmetric" !> @details - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used, i.e uncheck "non-symmetric"
!> @details Marc subroutines used: !> @details Marc subroutines used:
@ -34,23 +21,36 @@
!> @details - concom: lovl, inc !> @details - concom: lovl, inc
!> @details - creeps: timinc !> @details - creeps: timinc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
#define QUOTE(x) #x
#define PASTE(x,y) x ## y
#include "prec.f90"
module DAMASK_interface module DAMASK_interface
implicit none implicit none
character(len=4), parameter :: InputFileExtension = '.dat' private
character(len=4), parameter :: LogFileExtension = '.log' character(len=4), parameter, public :: InputFileExtension = '.dat'
character(len=4), parameter, public :: LogFileExtension = '.log'
public :: &
DAMASK_interface_init, &
getSolverJobName
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief only output of current version !> @brief reports and sets working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init subroutine DAMASK_interface_init
use ifport, only: &
CHDIR
implicit none implicit none
integer, dimension(8) :: & integer, dimension(8) :: &
dateAndTime ! type default integer dateAndTime ! type default integer
integer :: ierr
character(len=1024) :: wd
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>'
@ -64,27 +64,17 @@ subroutine DAMASK_interface_init
dateAndTime(7) dateAndTime(7)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
#include "compilation_info.f90" #include "compilation_info.f90"
inquire(5, name=wd) ! determine inputputfile
wd = wd(1:scan(wd,'/',back=.true.))
ierr = CHDIR(wd)
if (ierr /= 0) then
write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist'
call quit(1)
endif
end subroutine DAMASK_interface_init end subroutine DAMASK_interface_init
!--------------------------------------------------------------------------------------------------
!> @brief returns the current workingDir
!--------------------------------------------------------------------------------------------------
function getSolverWorkingDirectoryName()
implicit none
character(1024) getSolverWorkingDirectoryName, inputName
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
getSolverWorkingDirectoryName=''
inputName=''
inquire(5, name=inputName) ! determine inputputfile
getSolverWorkingDirectoryName=inputName(1:scan(inputName,pathSep,back=.true.))
end function getSolverWorkingDirectoryName
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief solver job name (no extension) as combination of geometry and load case name !> @brief solver job name (no extension) as combination of geometry and load case name
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -109,6 +99,9 @@ end function getSolverJobName
end module DAMASK_interface end module DAMASK_interface
#include "commercialFEM_fileList.f90" #include "commercialFEM_fileList.f90"
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -118,17 +111,6 @@ end module DAMASK_interface
!> @details !> @details
!> @details (2) Use the -> 'Plasticity,3' card(=update+finite+large disp+constant d) !> @details (2) Use the -> 'Plasticity,3' card(=update+finite+large disp+constant d)
!> @details in the parameter section of input deck (updated Lagrangian formulation). !> @details in the parameter section of input deck (updated Lagrangian formulation).
!> @details
!> @details The following operation obtains U (stretch tensor) at t=n+1 :
!> @details
!> @details call scla(un1,0.d0,itel,itel,1)
!> @details do k=1,3
!> @details do i=1,3
!> @details do j=1,3
!> @details un1(i,j)=un1(i,j)+dsqrt(strechn1(k))*eigvn1(i,k)*eigvn1(j,k)
!> @details enddo
!> @details enddo
!> @details enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, & dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, &

19
src/DAMASK_spectral.f90
View File

@ -20,11 +20,12 @@ program DAMASK_spectral
pReal, & pReal, &
tol_math_check, & tol_math_check, &
dNeq dNeq
use system_routines, only: &
getCWD
use DAMASK_interface, only: & use DAMASK_interface, only: &
DAMASK_interface_init, & DAMASK_interface_init, &
loadCaseFile, & loadCaseFile, &
geometryFile, & geometryFile, &
getSolverWorkingDirectoryName, &
getSolverJobName, & getSolverJobName, &
appendToOutFile appendToOutFile
use IO, only: & use IO, only: &
@ -133,7 +134,9 @@ program DAMASK_spectral
lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written
stagIter stagIter
character(len=6) :: loadcase_string character(len=6) :: loadcase_string
character(len=1024) :: incInfo !< string parsed to solution with information about current load case character(len=1024) :: &
incInfo, & !< string parsed to solution with information about current load case
workingDir
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
type(tSolutionState), allocatable, dimension(:) :: solres type(tSolutionState), allocatable, dimension(:) :: solres
integer(MPI_OFFSET_KIND) :: fileOffset integer(MPI_OFFSET_KIND) :: fileOffset
@ -381,10 +384,11 @@ program DAMASK_spectral
! write header of output file ! write header of output file
if (worldrank == 0) then if (worldrank == 0) then
if (.not. appendToOutFile) then ! after restart, append to existing results file if (.not. appendToOutFile) then ! after restart, append to existing results file
open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& if (getCWD(workingDir)) call IO_error(106_pInt,ext_msg=trim(workingDir))
open(newunit=resUnit,file=trim(getSolverJobName())//&
'.spectralOut',form='UNFORMATTED',status='REPLACE') '.spectralOut',form='UNFORMATTED',status='REPLACE')
write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header
write(resUnit) 'workingdir:', trim(getSolverWorkingDirectoryName()) write(resUnit) 'workingdir:', trim(workingDir)
write(resUnit) 'geometry:', trim(geometryFile) write(resUnit) 'geometry:', trim(geometryFile)
write(resUnit) 'grid:', grid write(resUnit) 'grid:', grid
write(resUnit) 'size:', geomSize write(resUnit) 'size:', geomSize
@ -397,14 +401,14 @@ program DAMASK_spectral
write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc
write(resUnit) 'eoh' write(resUnit) 'eoh'
close(resUnit) ! end of header close(resUnit) ! end of header
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& open(newunit=statUnit,file=trim(getSolverJobName())//&
'.sta',form='FORMATTED',status='REPLACE') '.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) &
write(6,'(/,a)') ' header of result and statistics file written out' write(6,'(/,a)') ' header of result and statistics file written out'
flush(6) flush(6)
else ! open new files ... else ! open new files ...
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& open(newunit=statUnit,file=trim(getSolverJobName())//&
'.sta',form='FORMATTED', position='APPEND', status='OLD') '.sta',form='FORMATTED', position='APPEND', status='OLD')
endif endif
endif endif
@ -415,8 +419,7 @@ program DAMASK_spectral
outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND) outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND)
call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce') if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce')
call MPI_file_open(PETSC_COMM_WORLD, & call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', &
trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.spectralOut', &
MPI_MODE_WRONLY + MPI_MODE_APPEND, & MPI_MODE_WRONLY + MPI_MODE_APPEND, &
MPI_INFO_NULL, & MPI_INFO_NULL, &
resUnit, & resUnit, &

63
src/IO.f90
View File

@ -250,18 +250,14 @@ end subroutine IO_checkAndRewind
!> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return !> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return
!! value !! value
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_file(fileUnit,relPath) subroutine IO_open_file(fileUnit,path)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: fileUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: relPath !< relative path from working directory character(len=*), intent(in) :: path !< relative path from working directory
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//relPath
open(fileUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
@ -273,18 +269,14 @@ end subroutine IO_open_file
!! directory !! directory
!> @details Like IO_open_file, but error is handled via return value and not via call to IO_error !> @details Like IO_open_file, but error is handled via return value and not via call to IO_error
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function IO_open_file_stat(fileUnit,relPath) logical function IO_open_file_stat(fileUnit,path)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: fileUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: relPath !< relative path from working directory character(len=*), intent(in) :: path !< relative path from working directory
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//relPath
open(fileUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
IO_open_file_stat = (myStat == 0_pInt) IO_open_file_stat = (myStat == 0_pInt)
@ -299,7 +291,6 @@ end function IO_open_file_stat
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_jobFile(fileUnit,ext) subroutine IO_open_jobFile(fileUnit,ext)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
@ -309,7 +300,7 @@ subroutine IO_open_jobFile(fileUnit,ext)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverJobName())//'.'//ext
open(fileUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
@ -324,7 +315,6 @@ end subroutine IO_open_jobFile
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function IO_open_jobFile_stat(fileUnit,ext) logical function IO_open_jobFile_stat(fileUnit,ext)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
@ -334,7 +324,7 @@ logical function IO_open_jobFile_stat(fileUnit,ext)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverJobName())//'.'//ext
open(fileUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
IO_open_jobFile_stat = (myStat == 0_pInt) IO_open_jobFile_stat = (myStat == 0_pInt)
@ -347,7 +337,6 @@ end function IO_open_JobFile_stat
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_inputFile(fileUnit,modelName) subroutine IO_open_inputFile(fileUnit,modelName)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName,&
getSolverJobName, & getSolverJobName, &
inputFileExtension inputFileExtension
@ -361,23 +350,23 @@ subroutine IO_open_inputFile(fileUnit,modelName)
integer(pInt) :: fileType integer(pInt) :: fileType
fileType = 1_pInt ! assume .pes fileType = 1_pInt ! assume .pes
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used
open(fileUnit+1,status='old',iostat=myStat,file=path) open(fileUnit+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"
fileType = 2_pInt fileType = 2_pInt
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) path = trim(modelName)//inputFileExtension(fileType)
open(fileUnit+1,status='old',iostat=myStat,file=path) open(fileUnit+1,status='old',iostat=myStat,file=path)
endif endif
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)//'_assembly' path = trim(modelName)//inputFileExtension(fileType)//'_assembly'
open(fileUnit,iostat=myStat,file=path) open(fileUnit,iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s
close(fileUnit+1_pInt) close(fileUnit+1_pInt)
#endif #endif
#ifdef Marc4DAMASK #ifdef Marc4DAMASK
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension path = trim(modelName)//inputFileExtension
open(fileUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
#endif #endif
@ -391,7 +380,6 @@ end subroutine IO_open_inputFile
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_logFile(fileUnit) subroutine IO_open_logFile(fileUnit)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName, & getSolverJobName, &
LogFileExtension LogFileExtension
@ -401,7 +389,7 @@ subroutine IO_open_logFile(fileUnit)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//LogFileExtension path = trim(getSolverJobName())//LogFileExtension
open(fileUnit,status='old',iostat=myStat,file=path) open(fileUnit,status='old',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
@ -415,7 +403,6 @@ end subroutine IO_open_logFile
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_write_jobFile(fileUnit,ext) subroutine IO_write_jobFile(fileUnit,ext)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
@ -425,7 +412,7 @@ subroutine IO_write_jobFile(fileUnit,ext)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverJobName())//'.'//ext
open(fileUnit,status='replace',iostat=myStat,file=path) open(fileUnit,status='replace',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
@ -438,7 +425,6 @@ end subroutine IO_write_jobFile
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
@ -449,7 +435,7 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverJobName())//'.'//ext
if (present(recMultiplier)) then if (present(recMultiplier)) then
open(fileUnit,status='replace',form='unformatted',access='direct', & open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pReal*recMultiplier,iostat=myStat,file=path) recl=pReal*recMultiplier,iostat=myStat,file=path)
@ -469,7 +455,6 @@ end subroutine IO_write_jobRealFile
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
@ -480,7 +465,7 @@ subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext path = trim(getSolverJobName())//'.'//ext
if (present(recMultiplier)) then if (present(recMultiplier)) then
open(fileUnit,status='replace',form='unformatted',access='direct', & open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pInt*recMultiplier,iostat=myStat,file=path) recl=pInt*recMultiplier,iostat=myStat,file=path)
@ -499,8 +484,6 @@ end subroutine IO_write_jobIntFile
!! located in current working directory !! located in current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: fileUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
@ -511,7 +494,7 @@ subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext path = trim(modelName)//'.'//ext
if (present(recMultiplier)) then if (present(recMultiplier)) then
open(fileUnit,status='old',form='unformatted',access='direct', & open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pReal*recMultiplier,iostat=myStat,file=path) recl=pReal*recMultiplier,iostat=myStat,file=path)
@ -529,8 +512,6 @@ end subroutine IO_read_realFile
!! located in current working directory !! located in current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: fileUnit !< file unit integer(pInt), intent(in) :: fileUnit !< file unit
@ -541,7 +522,7 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext path = trim(modelName)//'.'//ext
if (present(recMultiplier)) then if (present(recMultiplier)) then
open(fileUnit,status='old',form='unformatted',access='direct', & open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pInt*recMultiplier,iostat=myStat,file=path) recl=pInt*recMultiplier,iostat=myStat,file=path)
@ -1062,11 +1043,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent)
logical :: warn logical :: warn
if (.not. present(silent)) then warn = merge(silent,.false.,present(silent))
warn = .false.
else
warn = silent
endif
IO_stringValue = '' IO_stringValue = ''
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then
@ -1589,6 +1566,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
msg = '{input} recursion limit reached' msg = '{input} recursion limit reached'
case (105_pInt) case (105_pInt)
msg = 'unknown output:' msg = 'unknown output:'
case (106_pInt)
msg = 'working directory does not exist:'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! lattice error messages ! lattice error messages
@ -1960,8 +1939,6 @@ end function IO_verifyFloatValue
!> including "include"s !> including "include"s
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: unit1, & integer(pInt), intent(in) :: unit1, &
@ -1978,7 +1955,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then
fname = trim(getSolverWorkingDirectoryName())//trim(line(9+scan(line(9:),'='):)) fname = trim(line(9+scan(line(9:),'='):))
inquire(file=fname, exist=fexist) inquire(file=fname, exist=fexist)
if (.not.(fexist)) then if (.not.(fexist)) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)

202
src/spectral_interface.f90
View File

@ -19,21 +19,19 @@ module DAMASK_interface
character(len=1024), public, protected :: & character(len=1024), public, protected :: &
geometryFile = '', & !< parameter given for geometry file geometryFile = '', & !< parameter given for geometry file
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
public :: & public :: &
getSolverWorkingDirectoryName, &
getSolverJobName, & getSolverJobName, &
DAMASK_interface_init DAMASK_interface_init
private :: & private :: &
storeWorkingDirectory, & setWorkingDirectory, &
getGeometryFile, & getGeometryFile, &
getLoadCaseFile, & getLoadCaseFile, &
rectifyPath, & rectifyPath, &
makeRelativePath, & makeRelativePath, &
IIO_stringValue, & IIO_stringValue, &
IIO_intValue, & IIO_intValue, &
IIO_lc, &
IIO_stringPos IIO_stringPos
contains contains
@ -57,9 +55,9 @@ subroutine DAMASK_interface_init()
implicit none implicit none
character(len=1024) :: & character(len=1024) :: &
commandLine, & !< command line call as string commandLine, & !< command line call as string
loadCaseArg ='', & !< -l argument given to DAMASK_spectral.exe loadcaseArg = '', & !< -l argument given to DAMASK_spectral.exe
geometryArg ='', & !< -g argument given to DAMASK_spectral.exe geometryArg = '', & !< -g argument given to DAMASK_spectral.exe
workingDirArg ='', & !< -w argument given to DAMASK_spectral.exe workingDirArg = '', & !< -w argument given to DAMASK_spectral.exe
hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME) hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME)
userName, & !< name of user calling DAMASK_spectral.exe userName, & !< name of user calling DAMASK_spectral.exe
tag tag
@ -114,7 +112,7 @@ subroutine DAMASK_interface_init()
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018'
write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(/,a)') ' Version: '//DAMASKVERSION
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',& dateAndTime(2),'/',&
@ -128,9 +126,8 @@ subroutine DAMASK_interface_init()
call get_command(commandLine) call get_command(commandLine)
chunkPos = IIO_stringPos(commandLine) chunkPos = IIO_stringPos(commandLine)
do i = 1, chunkPos(1) do i = 2_pInt, chunkPos(1)
tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key
select case(tag)
case ('-h','--help') case ('-h','--help')
write(6,'(a)') ' #######################################################################' write(6,'(a)') ' #######################################################################'
write(6,'(a)') ' DAMASK_spectral:' write(6,'(a)') ' DAMASK_spectral:'
@ -179,23 +176,25 @@ subroutine DAMASK_interface_init()
write(6,'(a,/)')' Prints this message and exits' write(6,'(a,/)')' Prints this message and exits'
call quit(0_pInt) ! normal Termination call quit(0_pInt) ! normal Termination
case ('-l', '--load', '--loadcase') case ('-l', '--load', '--loadcase')
loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) if ( i < chunkPos(1)) loadcaseArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt))
case ('-g', '--geom', '--geometry') case ('-g', '--geom', '--geometry')
geometryArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) if (i < chunkPos(1)) geometryArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt))
case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory') case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory')
workingDirArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) if (i < chunkPos(1)) workingDirArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt))
case ('-r', '--rs', '--restart') case ('-r', '--rs', '--restart')
spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) if (i < chunkPos(1)) then
appendToOutFile = .true. spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt)
appendToOutFile = .true.
endif
end select end select
enddo enddo
if (len(trim(loadcaseArg)) == 0 .or. len(trim(geometryArg)) == 0) then if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then
write(6,'(a)') ' Please specify geometry AND load case (-h for help)' write(6,'(a)') ' Please specify geometry AND load case (-h for help)'
call quit(1_pInt) call quit(1_pInt)
endif endif
workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg))) workingDirectory = trim(setWorkingDirectory(trim(workingDirArg)))
geometryFile = getGeometryFile(geometryArg) geometryFile = getGeometryFile(geometryArg)
loadCaseFile = getLoadCaseFile(loadCaseArg) loadCaseFile = getLoadCaseFile(loadCaseArg)
@ -208,7 +207,7 @@ subroutine DAMASK_interface_init()
write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg)
write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg)
write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg)
write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName()) write(6,'(a,a)') ' Working directory: ', trim(workingDirectory)
write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) write(6,'(a,a)') ' Geometry file: ', trim(geometryFile)
write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile)
write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName())
@ -222,59 +221,39 @@ end subroutine DAMASK_interface_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief extract working directory from given argument or from location of geometry file, !> @brief extract working directory from given argument or from location of geometry file,
!! possibly converting relative arguments to absolut path !! possibly converting relative arguments to absolut path
!> @todo change working directory with call chdir(storeWorkingDirectory)?
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryArg) character(len=1024) function setWorkingDirectory(workingDirectoryArg)
use system_routines, only: & use system_routines, only: &
isDirectory, & getCWD, &
getCWD setCWD
implicit none implicit none
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
character(len=*), intent(in) :: geometryArg !< geometry argument
character(len=1024) :: cwd
logical :: error logical :: error
external :: quit external :: quit
wdGiven: if (len(workingDirectoryArg)>0) then wdGiven: if (len(workingDirectoryArg)>0) then
absolutePath: if (workingDirectoryArg(1:1) == '/') then absolutePath: if (workingDirectoryArg(1:1) == '/') then
storeWorkingDirectory = workingDirectoryArg setWorkingDirectory = workingDirectoryArg
else absolutePath else absolutePath
error = getCWD(cwd) error = getCWD(setWorkingDirectory)
if (error) call quit(1_pInt) if (error) call quit(1_pInt)
storeWorkingDirectory = trim(cwd)//'/'//workingDirectoryArg setWorkingDirectory = trim(setWorkingDirectory)//'/'//workingDirectoryArg
endif absolutePath endif absolutePath
if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= '/') &
storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it
else wdGiven else wdGiven
if (geometryArg(1:1) == '/') then ! absolute path given as command line argument error = getCWD(setWorkingDirectory) ! relative path given as command line argument
storeWorkingDirectory = geometryArg(1:scan(geometryArg,'/',back=.true.)) if (error) call quit(1_pInt)
else
error = getCWD(cwd) ! relative path given as command line argument
if (error) call quit(1_pInt)
storeWorkingDirectory = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.))
endif
endif wdGiven endif wdGiven
storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory)) setWorkingDirectory = trim(rectifyPath(setWorkingDirectory))
if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists
write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist' error = setCWD(trim(setWorkingDirectory))
call quit(1_pInt) if(error) then
write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist'
call quit(1_pInt)
endif endif
end function storeWorkingDirectory end function setWorkingDirectory
!--------------------------------------------------------------------------------------------------
!> @brief simply returns the private string workingDir
!--------------------------------------------------------------------------------------------------
character(len=1024) function getSolverWorkingDirectoryName()
implicit none
getSolverWorkingDirectoryName = workingDirectory
end function getSolverWorkingDirectoryName
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -306,32 +285,23 @@ end function getSolverJobName
!> @brief basename of geometry file with extension from command line arguments !> @brief basename of geometry file with extension from command line arguments
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=1024) function getGeometryFile(geometryParameter) character(len=1024) function getGeometryFile(geometryParameter)
use system_routines, only: &
getCWD
implicit none implicit none
character(len=1024), intent(in) :: & character(len=1024), intent(in) :: &
geometryParameter geometryParameter
character(len=1024) :: &
cwd
integer :: posExt, posSep integer :: posExt, posSep
logical :: error
external :: quit external :: quit
getGeometryFile = geometryParameter getGeometryFile = trim(geometryParameter)
posExt = scan(getGeometryFile,'.',back=.true.) posExt = scan(getGeometryFile,'.',back=.true.)
posSep = scan(getGeometryFile,'/',back=.true.) posSep = scan(getGeometryFile,'/',back=.true.)
if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom')
if (scan(getGeometryFile,'/') /= 1) then ! relative path given as command line argument if (scan(getGeometryFile,'/') /= 1) &
error = getcwd(cwd) getGeometryFile = trim(workingDirectory)//'/'//trim(getGeometryFile)
if (error) call quit(1_pInt)
getGeometryFile = rectifyPath(trim(cwd)//'/'//getGeometryFile) getGeometryFile = makeRelativePath(workingDirectory, getGeometryFile)
else
getGeometryFile = rectifyPath(getGeometryFile)
endif
getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile)
end function getGeometryFile end function getGeometryFile
@ -340,38 +310,29 @@ end function getGeometryFile
!> @brief relative path of loadcase from command line arguments !> @brief relative path of loadcase from command line arguments
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=1024) function getLoadCaseFile(loadCaseParameter) character(len=1024) function getLoadCaseFile(loadCaseParameter)
use system_routines, only: &
getCWD
implicit none implicit none
character(len=1024), intent(in) :: & character(len=1024), intent(in) :: &
loadCaseParameter loadCaseParameter
character(len=1024) :: &
cwd
integer :: posExt, posSep integer :: posExt, posSep
logical :: error
external :: quit external :: quit
getLoadCaseFile = loadcaseParameter getLoadCaseFile = trim(loadCaseParameter)
posExt = scan(getLoadCaseFile,'.',back=.true.) posExt = scan(getLoadCaseFile,'.',back=.true.)
posSep = scan(getLoadCaseFile,'/',back=.true.) posSep = scan(getLoadCaseFile,'/',back=.true.)
if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load')
if (scan(getLoadCaseFile,'/') /= 1) then ! relative path given as command line argument if (scan(getLoadCaseFile,'/') /= 1) &
error = getcwd(cwd) getLoadCaseFile = trim(workingDirectory)//'/'//trim(getLoadCaseFile)
if (error) call quit(1_pInt)
getLoadCaseFile = rectifyPath(trim(cwd)//'/'//getLoadCaseFile)
else
getLoadCaseFile = rectifyPath(getLoadCaseFile)
endif
getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile) getLoadCaseFile = makeRelativePath(workingDirectory, getLoadCaseFile)
end function getLoadCaseFile end function getLoadCaseFile
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief remove ../ and /./ from path !> @brief remove ../, /./, and // from path.
!> @details works only if absolute path is given
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function rectifyPath(path) function rectifyPath(path)
@ -385,14 +346,21 @@ function rectifyPath(path)
l = len_trim(path) l = len_trim(path)
rectifyPath = path rectifyPath = path
do i = l,3,-1 do i = l,3,-1
if (rectifyPath(i-2:i) == '/'//'.'//'/') & if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' '
rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' enddo
!--------------------------------------------------------------------------------------------------
! remove // from path
l = len_trim(path)
rectifyPath = path
do i = l,2,-1
if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' '
enddo enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! remove ../ and corresponding directory from rectifyPath ! remove ../ and corresponding directory from rectifyPath
l = len_trim(rectifyPath) l = len_trim(rectifyPath)
i = index(rectifyPath(i:l),'..'//'/') i = index(rectifyPath(i:l),'../')
j = 0 j = 0
do while (i > j) do while (i > j)
j = scan(rectifyPath(1:i-2),'/',back=.true.) j = scan(rectifyPath(1:i-2),'/',back=.true.)
@ -402,7 +370,7 @@ function rectifyPath(path)
rectifyPath(j+1:k-1) = rectifyPath(j+2:k) rectifyPath(j+1:k-1) = rectifyPath(j+2:k)
rectifyPath(k:k) = ' ' rectifyPath(k:k) = ' '
endif endif
i = j+index(rectifyPath(j+1:l),'..'//'/') i = j+index(rectifyPath(j+1:l),'../')
enddo enddo
if(len_trim(rectifyPath) == 0) rectifyPath = '/' if(len_trim(rectifyPath) == 0) rectifyPath = '/'
@ -415,20 +383,24 @@ end function rectifyPath
character(len=1024) function makeRelativePath(a,b) character(len=1024) function makeRelativePath(a,b)
implicit none implicit none
character (len=*) :: a,b character (len=*), intent(in) :: a,b
character (len=1024) :: a_cleaned,b_cleaned
integer :: i,posLastCommonSlash,remainingSlashes !no pInt integer :: i,posLastCommonSlash,remainingSlashes !no pInt
posLastCommonSlash = 0 posLastCommonSlash = 0
remainingSlashes = 0 remainingSlashes = 0
a_cleaned = rectifyPath(trim(a)//'/')
b_cleaned = rectifyPath(b)
do i = 1, min(1024,len_trim(a),len_trim(b)) do i = 1, min(1024,len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned)))
if (a(i:i) /= b(i:i)) exit if (a_cleaned(i:i) /= b_cleaned(i:i)) exit
if (a(i:i) == '/') posLastCommonSlash = i if (a_cleaned(i:i) == '/') posLastCommonSlash = i
enddo enddo
do i = posLastCommonSlash+1,len_trim(a) do i = posLastCommonSlash+1,len_trim(a_cleaned)
if (a(i:i) == '/') remainingSlashes = remainingSlashes + 1 if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1
enddo enddo
makeRelativePath = repeat('..'//'/',remainingSlashes)//b(posLastCommonSlash+1:len_trim(b))
makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned))
end function makeRelativePath end function makeRelativePath
@ -439,17 +411,12 @@ end function makeRelativePath
pure function IIO_stringValue(string,chunkPos,myChunk) pure function IIO_stringValue(string,chunkPos,myChunk)
implicit none implicit none
integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer(pInt), intent(in) :: myChunk !< position number of desired chunk integer(pInt), intent(in) :: myChunk !< position number of desired chunk
character(len=1+chunkPos(myChunk*2+1)-chunkPos(myChunk*2)) :: IIO_stringValue character(len=chunkPos(myChunk*2+1)-chunkPos(myChunk*2)+1) :: IIO_stringValue
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then
IIO_stringValue = ''
else valuePresent
IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
endif valuePresent
end function IIO_stringValue end function IIO_stringValue
@ -476,29 +443,6 @@ integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk)
end function IIO_intValue end function IIO_intValue
!--------------------------------------------------------------------------------------------------
!> @brief taken from IO, check IO_lc for documentation
!--------------------------------------------------------------------------------------------------
pure function IIO_lc(string)
implicit none
character(len=*), intent(in) :: string !< string to convert
character(len=len(string)) :: IIO_lc
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n ! no pInt (len returns default integer)
IIO_lc = string
do i=1,len(string)
n = index(UPPER,IIO_lc(i:i))
if (n/=0) IIO_lc(i:i) = LOWER(n:n)
enddo
end function IIO_lc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief taken from IO, check IO_stringPos for documentation !> @brief taken from IO, check IO_stringPos for documentation
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------