Merge branch 'development' of magit1.mpie.de:damask/DAMASK into development
This commit is contained in:
commit
6a4260ac07
2
PRIVATE
2
PRIVATE
|
@ -1 +1 @@
|
|||
Subproject commit ae79bc96d9dd1fd5ea06b916b0be098169f34a1e
|
||||
Subproject commit 58fcddbe62a071d027c0e2a876f07483b2d1e20e
|
|
@ -3,20 +3,12 @@
|
|||
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @author Koen Janssens, Paul Scherrer Institut
|
||||
!> @author Arun Prakash, Fraunhofer IWM
|
||||
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @brief interfaces DAMASK with Abaqus/Standard
|
||||
!> @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
|
||||
!> 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
|
||||
|
||||
#include "prec.f90"
|
||||
|
@ -24,17 +16,29 @@
|
|||
module DAMASK_interface
|
||||
|
||||
implicit none
|
||||
character(len=4), dimension(2), parameter :: INPUTFILEEXTENSION = ['.pes','.inp']
|
||||
character(len=4), parameter :: LOGFILEEXTENSION = '.log'
|
||||
private
|
||||
character(len=4), dimension(2), parameter, public :: INPUTFILEEXTENSION = ['.pes','.inp']
|
||||
character(len=4), parameter, public :: LOGFILEEXTENSION = '.log'
|
||||
|
||||
public :: &
|
||||
DAMASK_interface_init, &
|
||||
getSolverJobName
|
||||
|
||||
contains
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief just reporting
|
||||
!> @brief reports and sets working directory
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine DAMASK_interface_init
|
||||
use ifport, only: &
|
||||
CHDIR
|
||||
|
||||
implicit none
|
||||
integer, dimension(8) :: &
|
||||
dateAndTime ! type default integer
|
||||
integer :: lenOutDir,ierr
|
||||
character(len=256) :: wd
|
||||
|
||||
call date_and_time(values = dateAndTime)
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>'
|
||||
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018'
|
||||
|
@ -46,26 +50,19 @@ subroutine DAMASK_interface_init
|
|||
dateAndTime(6),':',&
|
||||
dateAndTime(7)
|
||||
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"
|
||||
|
||||
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
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
@ -79,10 +76,17 @@ character(1024) function getSolverJobName()
|
|||
|
||||
end function getSolverJobName
|
||||
|
||||
|
||||
end module DAMASK_interface
|
||||
|
||||
|
||||
|
||||
|
||||
#include "commercialFEM_fileList.f90"
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief This is the Abaqus std user subroutine for defining material behavior
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
|
||||
RPL,DDSDDT,DRPLDE,DRPLDT,STRAN,DSTRAN,&
|
||||
TIME,DTIME,TEMP,DTEMP,PREDEF,DPRED,CMNAME,NDI,NSHR,NTENS,&
|
||||
|
|
|
@ -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 Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
|
||||
|
@ -17,13 +5,12 @@
|
|||
!> @author W.A. Counts
|
||||
!> @author Denny Tjahjanto, 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 - choose material as hypela2
|
||||
!> @details - set statevariable 2 to index of homogenization
|
||||
!> @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 - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used, i.e uncheck "non-symmetric"
|
||||
!> @details Marc subroutines used:
|
||||
|
@ -34,23 +21,36 @@
|
|||
!> @details - concom: lovl, inc
|
||||
!> @details - creeps: timinc
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
#define QUOTE(x) #x
|
||||
#define PASTE(x,y) x ## y
|
||||
|
||||
#include "prec.f90"
|
||||
|
||||
module DAMASK_interface
|
||||
|
||||
implicit none
|
||||
character(len=4), parameter :: InputFileExtension = '.dat'
|
||||
character(len=4), parameter :: LogFileExtension = '.log'
|
||||
private
|
||||
character(len=4), parameter, public :: InputFileExtension = '.dat'
|
||||
character(len=4), parameter, public :: LogFileExtension = '.log'
|
||||
|
||||
public :: &
|
||||
DAMASK_interface_init, &
|
||||
getSolverJobName
|
||||
|
||||
contains
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief only output of current version
|
||||
!> @brief reports and sets working directory
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine DAMASK_interface_init
|
||||
use ifport, only: &
|
||||
CHDIR
|
||||
|
||||
implicit none
|
||||
integer, dimension(8) :: &
|
||||
dateAndTime ! type default integer
|
||||
integer :: ierr
|
||||
character(len=1024) :: wd
|
||||
|
||||
call date_and_time(values = dateAndTime)
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>'
|
||||
|
@ -64,27 +64,17 @@ subroutine DAMASK_interface_init
|
|||
dateAndTime(7)
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
|
||||
#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
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @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
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
@ -109,6 +99,9 @@ end function getSolverJobName
|
|||
|
||||
end module DAMASK_interface
|
||||
|
||||
|
||||
|
||||
|
||||
#include "commercialFEM_fileList.f90"
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
@ -118,17 +111,6 @@ end module DAMASK_interface
|
|||
!> @details
|
||||
!> @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
|
||||
!> @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, &
|
||||
dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, &
|
||||
|
|
|
@ -20,11 +20,12 @@ program DAMASK_spectral
|
|||
pReal, &
|
||||
tol_math_check, &
|
||||
dNeq
|
||||
use system_routines, only: &
|
||||
getCWD
|
||||
use DAMASK_interface, only: &
|
||||
DAMASK_interface_init, &
|
||||
loadCaseFile, &
|
||||
geometryFile, &
|
||||
getSolverWorkingDirectoryName, &
|
||||
getSolverJobName, &
|
||||
appendToOutFile
|
||||
use IO, only: &
|
||||
|
@ -133,7 +134,9 @@ program DAMASK_spectral
|
|||
lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written
|
||||
stagIter
|
||||
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(tSolutionState), allocatable, dimension(:) :: solres
|
||||
integer(MPI_OFFSET_KIND) :: fileOffset
|
||||
|
@ -381,10 +384,11 @@ program DAMASK_spectral
|
|||
! write header of output file
|
||||
if (worldrank == 0) then
|
||||
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')
|
||||
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) 'grid:', grid
|
||||
write(resUnit) 'size:', geomSize
|
||||
|
@ -397,14 +401,14 @@ program DAMASK_spectral
|
|||
write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc
|
||||
write(resUnit) 'eoh'
|
||||
close(resUnit) ! end of header
|
||||
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
|
||||
open(newunit=statUnit,file=trim(getSolverJobName())//&
|
||||
'.sta',form='FORMATTED',status='REPLACE')
|
||||
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
|
||||
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) &
|
||||
write(6,'(/,a)') ' header of result and statistics file written out'
|
||||
flush(6)
|
||||
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')
|
||||
endif
|
||||
endif
|
||||
|
@ -415,8 +419,7 @@ program DAMASK_spectral
|
|||
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
|
||||
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce')
|
||||
call MPI_file_open(PETSC_COMM_WORLD, &
|
||||
trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.spectralOut', &
|
||||
call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', &
|
||||
MPI_MODE_WRONLY + MPI_MODE_APPEND, &
|
||||
MPI_INFO_NULL, &
|
||||
resUnit, &
|
||||
|
|
63
src/IO.f90
63
src/IO.f90
|
@ -195,18 +195,14 @@ end subroutine IO_checkAndRewind
|
|||
!> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return
|
||||
!! value
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine IO_open_file(fileUnit,relPath)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName
|
||||
subroutine IO_open_file(fileUnit,path)
|
||||
|
||||
implicit none
|
||||
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
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//relPath
|
||||
open(fileUnit,status='old',iostat=myStat,file=path)
|
||||
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
|
||||
|
||||
|
@ -218,18 +214,14 @@ end subroutine IO_open_file
|
|||
!! directory
|
||||
!> @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)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName
|
||||
logical function IO_open_file_stat(fileUnit,path)
|
||||
|
||||
implicit none
|
||||
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
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//relPath
|
||||
open(fileUnit,status='old',iostat=myStat,file=path)
|
||||
IO_open_file_stat = (myStat == 0_pInt)
|
||||
|
||||
|
@ -244,7 +236,6 @@ end function IO_open_file_stat
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine IO_open_jobFile(fileUnit,ext)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName, &
|
||||
getSolverJobName
|
||||
|
||||
implicit none
|
||||
|
@ -254,7 +245,7 @@ subroutine IO_open_jobFile(fileUnit,ext)
|
|||
integer(pInt) :: myStat
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
|
||||
path = trim(getSolverJobName())//'.'//ext
|
||||
open(fileUnit,status='old',iostat=myStat,file=path)
|
||||
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
|
||||
|
||||
|
@ -269,7 +260,6 @@ end subroutine IO_open_jobFile
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
logical function IO_open_jobFile_stat(fileUnit,ext)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName, &
|
||||
getSolverJobName
|
||||
|
||||
implicit none
|
||||
|
@ -279,7 +269,7 @@ logical function IO_open_jobFile_stat(fileUnit,ext)
|
|||
integer(pInt) :: myStat
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
|
||||
path = trim(getSolverJobName())//'.'//ext
|
||||
open(fileUnit,status='old',iostat=myStat,file=path)
|
||||
IO_open_jobFile_stat = (myStat == 0_pInt)
|
||||
|
||||
|
@ -292,7 +282,6 @@ end function IO_open_JobFile_stat
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine IO_open_inputFile(fileUnit,modelName)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName,&
|
||||
getSolverJobName, &
|
||||
inputFileExtension
|
||||
|
||||
|
@ -306,23 +295,23 @@ subroutine IO_open_inputFile(fileUnit,modelName)
|
|||
integer(pInt) :: fileType
|
||||
|
||||
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)
|
||||
if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp"
|
||||
fileType = 2_pInt
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)
|
||||
path = trim(modelName)//inputFileExtension(fileType)
|
||||
open(fileUnit+1,status='old',iostat=myStat,file=path)
|
||||
endif
|
||||
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)
|
||||
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
|
||||
close(fileUnit+1_pInt)
|
||||
#endif
|
||||
#ifdef Marc4DAMASK
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension
|
||||
path = trim(modelName)//inputFileExtension
|
||||
open(fileUnit,status='old',iostat=myStat,file=path)
|
||||
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
|
||||
#endif
|
||||
|
@ -336,7 +325,6 @@ end subroutine IO_open_inputFile
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine IO_open_logFile(fileUnit)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName, &
|
||||
getSolverJobName, &
|
||||
LogFileExtension
|
||||
|
||||
|
@ -346,7 +334,7 @@ subroutine IO_open_logFile(fileUnit)
|
|||
integer(pInt) :: myStat
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//LogFileExtension
|
||||
path = trim(getSolverJobName())//LogFileExtension
|
||||
open(fileUnit,status='old',iostat=myStat,file=path)
|
||||
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
|
||||
|
||||
|
@ -360,7 +348,6 @@ end subroutine IO_open_logFile
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine IO_write_jobFile(fileUnit,ext)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName, &
|
||||
getSolverJobName
|
||||
|
||||
implicit none
|
||||
|
@ -370,7 +357,7 @@ subroutine IO_write_jobFile(fileUnit,ext)
|
|||
integer(pInt) :: myStat
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
|
||||
path = trim(getSolverJobName())//'.'//ext
|
||||
open(fileUnit,status='replace',iostat=myStat,file=path)
|
||||
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
|
||||
|
||||
|
@ -383,7 +370,6 @@ end subroutine IO_write_jobFile
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName, &
|
||||
getSolverJobName
|
||||
|
||||
implicit none
|
||||
|
@ -394,7 +380,7 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier)
|
|||
integer(pInt) :: myStat
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
|
||||
path = trim(getSolverJobName())//'.'//ext
|
||||
if (present(recMultiplier)) then
|
||||
open(fileUnit,status='replace',form='unformatted',access='direct', &
|
||||
recl=pReal*recMultiplier,iostat=myStat,file=path)
|
||||
|
@ -414,7 +400,6 @@ end subroutine IO_write_jobRealFile
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName, &
|
||||
getSolverJobName
|
||||
|
||||
implicit none
|
||||
|
@ -425,7 +410,7 @@ subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier)
|
|||
integer(pInt) :: myStat
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
|
||||
path = trim(getSolverJobName())//'.'//ext
|
||||
if (present(recMultiplier)) then
|
||||
open(fileUnit,status='replace',form='unformatted',access='direct', &
|
||||
recl=pInt*recMultiplier,iostat=myStat,file=path)
|
||||
|
@ -444,8 +429,6 @@ end subroutine IO_write_jobIntFile
|
|||
!! located in current working directory
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: fileUnit !< file unit
|
||||
|
@ -456,7 +439,7 @@ subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier)
|
|||
integer(pInt) :: myStat
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext
|
||||
path = trim(modelName)//'.'//ext
|
||||
if (present(recMultiplier)) then
|
||||
open(fileUnit,status='old',form='unformatted',access='direct', &
|
||||
recl=pReal*recMultiplier,iostat=myStat,file=path)
|
||||
|
@ -474,8 +457,6 @@ end subroutine IO_read_realFile
|
|||
!! located in current working directory
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: fileUnit !< file unit
|
||||
|
@ -486,7 +467,7 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier)
|
|||
integer(pInt) :: myStat
|
||||
character(len=1024) :: path
|
||||
|
||||
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext
|
||||
path = trim(modelName)//'.'//ext
|
||||
if (present(recMultiplier)) then
|
||||
open(fileUnit,status='old',form='unformatted',access='direct', &
|
||||
recl=pInt*recMultiplier,iostat=myStat,file=path)
|
||||
|
@ -1007,11 +988,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent)
|
|||
|
||||
logical :: warn
|
||||
|
||||
if (.not. present(silent)) then
|
||||
warn = .false.
|
||||
else
|
||||
warn = silent
|
||||
endif
|
||||
warn = merge(silent,.false.,present(silent))
|
||||
|
||||
IO_stringValue = ''
|
||||
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then
|
||||
|
@ -1534,6 +1511,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
|
|||
msg = '{input} recursion limit reached'
|
||||
case (105_pInt)
|
||||
msg = 'unknown output:'
|
||||
case (106_pInt)
|
||||
msg = 'working directory does not exist:'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! lattice error messages
|
||||
|
@ -1905,8 +1884,6 @@ end function IO_verifyFloatValue
|
|||
!> including "include"s
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
|
||||
use DAMASK_interface, only: &
|
||||
getSolverWorkingDirectoryName
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: unit1, &
|
||||
|
@ -1923,7 +1900,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
|
|||
chunkPos = IO_stringPos(line)
|
||||
|
||||
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)
|
||||
if (.not.(fexist)) then
|
||||
!$OMP CRITICAL (write2out)
|
||||
|
|
|
@ -283,8 +283,6 @@ end subroutine debug_reset
|
|||
subroutine debug_info
|
||||
|
||||
implicit none
|
||||
character(len=1) :: exceed
|
||||
|
||||
|
||||
!$OMP CRITICAL (write2out)
|
||||
|
||||
|
|
|
@ -19,21 +19,19 @@ module DAMASK_interface
|
|||
character(len=1024), public, protected :: &
|
||||
geometryFile = '', & !< parameter given for geometry 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 :: &
|
||||
getSolverWorkingDirectoryName, &
|
||||
getSolverJobName, &
|
||||
DAMASK_interface_init
|
||||
private :: &
|
||||
storeWorkingDirectory, &
|
||||
setWorkingDirectory, &
|
||||
getGeometryFile, &
|
||||
getLoadCaseFile, &
|
||||
rectifyPath, &
|
||||
makeRelativePath, &
|
||||
IIO_stringValue, &
|
||||
IIO_intValue, &
|
||||
IIO_lc, &
|
||||
IIO_stringPos
|
||||
contains
|
||||
|
||||
|
@ -57,7 +55,7 @@ subroutine DAMASK_interface_init()
|
|||
implicit none
|
||||
character(len=1024) :: &
|
||||
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
|
||||
workingDirArg = '', & !< -w argument given to DAMASK_spectral.exe
|
||||
hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME)
|
||||
|
@ -114,7 +112,7 @@ subroutine DAMASK_interface_init()
|
|||
|
||||
call date_and_time(values = dateAndTime)
|
||||
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,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
|
||||
dateAndTime(2),'/',&
|
||||
|
@ -128,9 +126,8 @@ subroutine DAMASK_interface_init()
|
|||
|
||||
call get_command(commandLine)
|
||||
chunkPos = IIO_stringPos(commandLine)
|
||||
do i = 1, chunkPos(1)
|
||||
tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key
|
||||
select case(tag)
|
||||
do i = 2_pInt, chunkPos(1)
|
||||
select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key
|
||||
case ('-h','--help')
|
||||
write(6,'(a)') ' #######################################################################'
|
||||
write(6,'(a)') ' DAMASK_spectral:'
|
||||
|
@ -179,23 +176,25 @@ subroutine DAMASK_interface_init()
|
|||
write(6,'(a,/)')' Prints this message and exits'
|
||||
call quit(0_pInt) ! normal Termination
|
||||
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')
|
||||
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')
|
||||
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')
|
||||
if (i < chunkPos(1)) then
|
||||
spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt)
|
||||
appendToOutFile = .true.
|
||||
endif
|
||||
end select
|
||||
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)'
|
||||
call quit(1_pInt)
|
||||
endif
|
||||
|
||||
workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg)))
|
||||
workingDirectory = trim(setWorkingDirectory(trim(workingDirArg)))
|
||||
geometryFile = getGeometryFile(geometryArg)
|
||||
loadCaseFile = getLoadCaseFile(loadCaseArg)
|
||||
|
||||
|
@ -208,7 +207,7 @@ subroutine DAMASK_interface_init()
|
|||
write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg)
|
||||
write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg)
|
||||
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)') ' Loadcase file: ', trim(loadCaseFile)
|
||||
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,
|
||||
!! 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: &
|
||||
isDirectory, &
|
||||
getCWD
|
||||
getCWD, &
|
||||
setCWD
|
||||
|
||||
implicit none
|
||||
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
|
||||
character(len=*), intent(in) :: geometryArg !< geometry argument
|
||||
character(len=1024) :: cwd
|
||||
logical :: error
|
||||
external :: quit
|
||||
|
||||
wdGiven: if (len(workingDirectoryArg)>0) then
|
||||
absolutePath: if (workingDirectoryArg(1:1) == '/') then
|
||||
storeWorkingDirectory = workingDirectoryArg
|
||||
setWorkingDirectory = workingDirectoryArg
|
||||
else absolutePath
|
||||
error = getCWD(cwd)
|
||||
error = getCWD(setWorkingDirectory)
|
||||
if (error) call quit(1_pInt)
|
||||
storeWorkingDirectory = trim(cwd)//'/'//workingDirectoryArg
|
||||
setWorkingDirectory = trim(setWorkingDirectory)//'/'//workingDirectoryArg
|
||||
endif absolutePath
|
||||
if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= '/') &
|
||||
storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it
|
||||
else wdGiven
|
||||
if (geometryArg(1:1) == '/') then ! absolute path given as command line argument
|
||||
storeWorkingDirectory = geometryArg(1:scan(geometryArg,'/',back=.true.))
|
||||
else
|
||||
error = getCWD(cwd) ! relative path given as command line argument
|
||||
error = getCWD(setWorkingDirectory) ! 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
|
||||
|
||||
storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory))
|
||||
if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists
|
||||
write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist'
|
||||
setWorkingDirectory = trim(rectifyPath(setWorkingDirectory))
|
||||
|
||||
error = setCWD(trim(setWorkingDirectory))
|
||||
if(error) then
|
||||
write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist'
|
||||
call quit(1_pInt)
|
||||
endif
|
||||
|
||||
end function storeWorkingDirectory
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief simply returns the private string workingDir
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character(len=1024) function getSolverWorkingDirectoryName()
|
||||
|
||||
implicit none
|
||||
|
||||
getSolverWorkingDirectoryName = workingDirectory
|
||||
|
||||
end function getSolverWorkingDirectoryName
|
||||
end function setWorkingDirectory
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
@ -306,32 +285,23 @@ end function getSolverJobName
|
|||
!> @brief basename of geometry file with extension from command line arguments
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character(len=1024) function getGeometryFile(geometryParameter)
|
||||
use system_routines, only: &
|
||||
getCWD
|
||||
|
||||
implicit none
|
||||
character(len=1024), intent(in) :: &
|
||||
geometryParameter
|
||||
character(len=1024) :: &
|
||||
cwd
|
||||
integer :: posExt, posSep
|
||||
logical :: error
|
||||
external :: quit
|
||||
|
||||
getGeometryFile = geometryParameter
|
||||
getGeometryFile = trim(geometryParameter)
|
||||
posExt = scan(getGeometryFile,'.',back=.true.)
|
||||
posSep = scan(getGeometryFile,'/',back=.true.)
|
||||
|
||||
if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present
|
||||
if (scan(getGeometryFile,'/') /= 1) then ! relative path given as command line argument
|
||||
error = getcwd(cwd)
|
||||
if (error) call quit(1_pInt)
|
||||
getGeometryFile = rectifyPath(trim(cwd)//'/'//getGeometryFile)
|
||||
else
|
||||
getGeometryFile = rectifyPath(getGeometryFile)
|
||||
endif
|
||||
if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom')
|
||||
if (scan(getGeometryFile,'/') /= 1) &
|
||||
getGeometryFile = trim(workingDirectory)//'/'//trim(getGeometryFile)
|
||||
|
||||
getGeometryFile = makeRelativePath(workingDirectory, getGeometryFile)
|
||||
|
||||
getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile)
|
||||
|
||||
end function getGeometryFile
|
||||
|
||||
|
@ -340,38 +310,29 @@ end function getGeometryFile
|
|||
!> @brief relative path of loadcase from command line arguments
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character(len=1024) function getLoadCaseFile(loadCaseParameter)
|
||||
use system_routines, only: &
|
||||
getCWD
|
||||
|
||||
implicit none
|
||||
character(len=1024), intent(in) :: &
|
||||
loadCaseParameter
|
||||
character(len=1024) :: &
|
||||
cwd
|
||||
integer :: posExt, posSep
|
||||
logical :: error
|
||||
external :: quit
|
||||
|
||||
getLoadCaseFile = loadcaseParameter
|
||||
getLoadCaseFile = trim(loadCaseParameter)
|
||||
posExt = scan(getLoadCaseFile,'.',back=.true.)
|
||||
posSep = scan(getLoadCaseFile,'/',back=.true.)
|
||||
|
||||
if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present
|
||||
if (scan(getLoadCaseFile,'/') /= 1) then ! relative path given as command line argument
|
||||
error = getcwd(cwd)
|
||||
if (error) call quit(1_pInt)
|
||||
getLoadCaseFile = rectifyPath(trim(cwd)//'/'//getLoadCaseFile)
|
||||
else
|
||||
getLoadCaseFile = rectifyPath(getLoadCaseFile)
|
||||
endif
|
||||
if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load')
|
||||
if (scan(getLoadCaseFile,'/') /= 1) &
|
||||
getLoadCaseFile = trim(workingDirectory)//'/'//trim(getLoadCaseFile)
|
||||
|
||||
getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile)
|
||||
getLoadCaseFile = makeRelativePath(workingDirectory, 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)
|
||||
|
||||
|
@ -385,14 +346,21 @@ function rectifyPath(path)
|
|||
l = len_trim(path)
|
||||
rectifyPath = path
|
||||
do i = l,3,-1
|
||||
if (rectifyPath(i-2:i) == '/'//'.'//'/') &
|
||||
rectifyPath(i-1:l) = rectifyPath(i+1:l)//' '
|
||||
if (rectifyPath(i-2:i) == '/./') 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
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! remove ../ and corresponding directory from rectifyPath
|
||||
l = len_trim(rectifyPath)
|
||||
i = index(rectifyPath(i:l),'..'//'/')
|
||||
i = index(rectifyPath(i:l),'../')
|
||||
j = 0
|
||||
do while (i > j)
|
||||
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(k:k) = ' '
|
||||
endif
|
||||
i = j+index(rectifyPath(j+1:l),'..'//'/')
|
||||
i = j+index(rectifyPath(j+1:l),'../')
|
||||
enddo
|
||||
if(len_trim(rectifyPath) == 0) rectifyPath = '/'
|
||||
|
||||
|
@ -415,20 +383,24 @@ end function rectifyPath
|
|||
character(len=1024) function makeRelativePath(a,b)
|
||||
|
||||
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
|
||||
|
||||
posLastCommonSlash = 0
|
||||
remainingSlashes = 0
|
||||
a_cleaned = rectifyPath(trim(a)//'/')
|
||||
b_cleaned = rectifyPath(b)
|
||||
|
||||
do i = 1, min(1024,len_trim(a),len_trim(b))
|
||||
if (a(i:i) /= b(i:i)) exit
|
||||
if (a(i:i) == '/') posLastCommonSlash = i
|
||||
do i = 1, min(1024,len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned)))
|
||||
if (a_cleaned(i:i) /= b_cleaned(i:i)) exit
|
||||
if (a_cleaned(i:i) == '/') posLastCommonSlash = i
|
||||
enddo
|
||||
do i = posLastCommonSlash+1,len_trim(a)
|
||||
if (a(i:i) == '/') remainingSlashes = remainingSlashes + 1
|
||||
do i = posLastCommonSlash+1,len_trim(a_cleaned)
|
||||
if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1
|
||||
enddo
|
||||
makeRelativePath = repeat('..'//'/',remainingSlashes)//b(posLastCommonSlash+1:len_trim(b))
|
||||
|
||||
makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned))
|
||||
|
||||
end function makeRelativePath
|
||||
|
||||
|
@ -441,15 +413,10 @@ pure function IIO_stringValue(string,chunkPos,myChunk)
|
|||
implicit none
|
||||
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
|
||||
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
|
||||
|
||||
|
||||
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
|
||||
|
||||
|
@ -476,29 +443,6 @@ integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk)
|
|||
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
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
Loading…
Reference in New Issue