From 564ff68fbbf333609498537bd90c6d97d49ed8b4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 8 Mar 2016 23:32:18 +0100 Subject: [PATCH 01/10] first ideas --- code/C_helper.c | 24 ++++++++++++++++++++++++ code/IO.f90 | 3 +-- 2 files changed, 25 insertions(+), 2 deletions(-) create mode 100644 code/C_helper.c diff --git a/code/C_helper.c b/code/C_helper.c new file mode 100644 index 000000000..950a5999e --- /dev/null +++ b/code/C_helper.c @@ -0,0 +1,24 @@ +/* Unix */ +#include +#include +#include +#include + +#define GETCWD getcwd + + +void getCurrentWorkDir(char *str,int *stat){ + if(GETCWD(str, sizeof(str)) == str){ + *stat = 0; + } + else{ + *stat = 1; + } +} + +int isDirectory(const char *path){ + struct stat statbuf; + if(stat(path, &statbuf) != 0) + return 0; + return S_ISDIR(statbuf.st_mode); +} diff --git a/code/IO.f90 b/code/IO.f90 index 1a36269c5..57eb23cb5 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -1237,8 +1237,7 @@ character(len=300) pure function IO_extractValue(pair,key) IO_extractValue = '' myChunk = scan(pair,SEP) - if (myChunk > 0 .and. pair(:myChunk-1) == key(:myChunk-1)) & - IO_extractValue = pair(myChunk+1:) ! extract value if key matches + if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches end function IO_extractValue From b9b490d02d322f5984dc8492127ff31685ec22cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 11 Mar 2016 20:59:14 +0100 Subject: [PATCH 02/10] almost working --- code/C_helper.c | 24 -------------- code/C_routines.c | 28 +++++++++++++++++ code/Makefile | 38 +++++++++------------- code/spectral_interface.f90 | 42 +++++++++---------------- code/system_routines.f90 | 63 +++++++++++++++++++++++++++++++++++++ 5 files changed, 120 insertions(+), 75 deletions(-) delete mode 100644 code/C_helper.c create mode 100644 code/C_routines.c create mode 100644 code/system_routines.f90 diff --git a/code/C_helper.c b/code/C_helper.c deleted file mode 100644 index 950a5999e..000000000 --- a/code/C_helper.c +++ /dev/null @@ -1,24 +0,0 @@ -/* Unix */ -#include -#include -#include -#include - -#define GETCWD getcwd - - -void getCurrentWorkDir(char *str,int *stat){ - if(GETCWD(str, sizeof(str)) == str){ - *stat = 0; - } - else{ - *stat = 1; - } -} - -int isDirectory(const char *path){ - struct stat statbuf; - if(stat(path, &statbuf) != 0) - return 0; - return S_ISDIR(statbuf.st_mode); -} diff --git a/code/C_routines.c b/code/C_routines.c new file mode 100644 index 000000000..a212680bb --- /dev/null +++ b/code/C_routines.c @@ -0,0 +1,28 @@ +/* Unix */ +#include +#include +#include +#include +#include +#include +#include + +/* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */ + +void getcurrentworkdir_c(char cwd[], int *stat ){ + char cwd_tmp[1024]; + if(getcwd(cwd_tmp, sizeof(cwd_tmp)) == cwd_tmp){ + *stat = 0; + strcpy(cwd, cwd_tmp); + } + else{ + *stat = 1; + } +} + +int isdirectory_c(const char *dir){ + struct stat statbuf; + if(stat(dir, &statbuf) != 0) + return 0; + return S_ISDIR(statbuf.st_mode); +} diff --git a/code/Makefile b/code/Makefile index a9054310d..a0d5ffd26 100644 --- a/code/Makefile +++ b/code/Makefile @@ -25,6 +25,7 @@ include ${PETSC_DIR}/lib/petsc/conf/rules INCLUDE_DIRS := $(PETSC_FC_INCLUDES) -DPETSc -I../lib LIBRARIES := $(PETSC_WITH_EXTERNAL_LIB) COMPILERNAME ?= $(FC) +CCOMPILERNAME ?= $(CC) LINKERNAME ?= $(FLINKER) # MPI compiler wrappers will tell if they are pointing to ifort or gfortran @@ -350,7 +351,7 @@ DAMASK_spectral.o: INTERFACENAME := spectral_interface.f90 SPECTRAL_SOLVER_FILES = spectral_mech_AL.o spectral_mech_Basic.o spectral_mech_Polarisation.o \ spectral_thermal.o spectral_damage.o -SPECTRAL_FILES = prec.o DAMASK_interface.o IO.o libs.o numerics.o debug.o math.o \ +SPECTRAL_FILES = C_routines.o system_routines.o prec.o DAMASK_interface.o IO.o libs.o numerics.o debug.o math.o \ FEsolving.o mesh.o material.o lattice.o \ $(SOURCE_FILES) $(KINEMATICS_FILES) $(PLASTIC_FILES) constitutive.o \ crystallite.o \ @@ -622,36 +623,25 @@ libs.o: libs.f90 \ IO.o: IO.f90 \ DAMASK_interface.o -ifeq "$(F90)" "gfortran" DAMASK_interface.o: spectral_interface.f90 \ $(wildcard DAMASK_FEM_interface.f90) \ prec.o - $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -fall-intrinsics -o DAMASK_interface.o $(SUFFIX) -#-fall-intrinsics: all intrinsic procedures (including the GNU-specific extensions) are accepted. -Wintrinsics-std will be ignored -# and no user-defined procedure with the same name as any intrinsic will be called except when it is explicitly declared external -# --> allows the use of 'getcwd' -prec.o: prec.f90 - $(PREFIX) $(COMPILERNAME) $(COMPILE) -c prec.f90 -fno-range-check -fall-intrinsics -fno-fast-math $(SUFFIX) -# fno-range-check: Disable range checking on results of simplification of constant expressions during compilation -# --> allows the definition of DAMASK_NaN -#-fall-intrinsics: all intrinsic procedures (including the GNU-specific extensions) are accepted. -Wintrinsics-std will be ignored -# and no user-defined procedure with the same name as any intrinsic will be called except when it is explicitly declared external -# --> allows the use of 'isnan' -#-fno-fast-math: -# --> otherwise, when setting -ffast-math, isnan always evaluates to false (I would call it a bug) -else -DAMASK_interface.o: spectral_interface.f90 \ - $(wildcard DAMASK_FEM_interface.f90) \ - prec.o - $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -diag-remark 7410 -stand none -warn nostderrors -o DAMASK_interface.o $(SUFFIX) -# -diag-disable 7410 should disable warning about directory statement in inquire function, but does not work. hence the other 2 statements -prec.o: prec.f90 - $(PREFIX) $(COMPILERNAME) $(COMPILE) -c prec.f90 $(SUFFIX) -endif + +prec.o: prec.f90 \ + system_routines.o + +C_routines.o: C_routines.c + +system_routines.o: system_routines.f90 \ + C_routines.o + %.o : %.f90 $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $< $(SUFFIX) +%.o : %.c + $(CCOMPILERNAME) -c $< + .PHONY: tidy tidy: @rm -rf *.o diff --git a/code/spectral_interface.f90 b/code/spectral_interface.f90 index ad0ee4082..4010b07ca 100644 --- a/code/spectral_interface.f90 +++ b/code/spectral_interface.f90 @@ -11,7 +11,6 @@ module DAMASK_interface use prec, only: & pInt - implicit none private #ifdef PETSc @@ -39,7 +38,6 @@ module DAMASK_interface IIO_intValue, & IIO_lc, & IIO_stringPos - contains !-------------------------------------------------------------------------------------------------- @@ -99,7 +97,6 @@ subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' #include "compilation_info.f90" endif mainProcess - if ( present(loadcaseParameterIn) .and. present(geometryParameterIn)) then ! both mandatory parameters given in function call geometryArg = geometryParameterIn loadcaseArg = loadcaseParameterIn @@ -221,35 +218,31 @@ end subroutine DAMASK_interface_init !> @todo change working directory with call chdir(storeWorkingDirectory)? !-------------------------------------------------------------------------------------------------- character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryArg) -#ifdef __INTEL_COMPILER - use IFPORT -#endif + use system_routines, only: & + isDirectory, & + getCWD2 implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument character(len=*), intent(in) :: geometryArg !< geometry argument character(len=1024) :: cwd character :: pathSep - logical :: dirExists + logical :: error external :: quit - integer :: error + + pathSep = getPathSep() if (len(workingDirectoryArg)>0) then ! got working directory as input if (workingDirectoryArg(1:1) == pathSep) then ! absolute path given as command line argument storeWorkingDirectory = workingDirectoryArg else - error = getcwd(cwd) ! relative path given as command line argument + error = getCWD2(cwd) ! relative path given as command line argument storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg endif if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it /= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep -#ifdef __INTEL_COMPILER - inquire(directory = trim(storeWorkingDirectory)//'.', exist=dirExists) -#else - inquire(file = trim(storeWorkingDirectory), exist=dirExists) -#endif - if(.not. dirExists) then ! check if the directory exists + if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist' call quit(1_pInt) endif @@ -257,13 +250,13 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) else - error = getcwd(cwd) ! relative path given as command line argument + error = getCWD2(cwd) ! relative path given as command line argument storeWorkingDirectory = trim(cwd)//pathSep//& geometryArg(1:scan(geometryArg,pathSep,back=.true.)) endif endif storeWorkingDirectory = rectifyPath(storeWorkingDirectory) - + end function storeWorkingDirectory @@ -309,9 +302,6 @@ end function getSolverJobName !> @brief basename of geometry file with extension from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getGeometryFile(geometryParameter) -#ifdef __INTEL_COMPILER - use IFPORT -#endif implicit none character(len=1024), intent(in) :: & @@ -320,7 +310,7 @@ character(len=1024) function getGeometryFile(geometryParameter) cwd integer :: posExt, posSep character :: pathSep - integer :: error + logical :: error getGeometryFile = geometryParameter pathSep = getPathSep() @@ -329,7 +319,7 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present if (scan(getGeometryFile,pathSep) /= 1) then ! relative path given as command line argument - error = getcwd(cwd) + error = getCWD2(cwd) getGeometryFile = rectifyPath(trim(cwd)//pathSep//getGeometryFile) else getGeometryFile = rectifyPath(getGeometryFile) @@ -344,16 +334,14 @@ end function getGeometryFile !> @brief relative path of loadcase from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getLoadCaseFile(loadCaseParameter) -#ifdef __INTEL_COMPILER - use IFPORT -#endif implicit none character(len=1024), intent(in) :: & loadCaseParameter character(len=1024) :: & cwd - integer :: posExt, posSep, error + integer :: posExt, posSep + logical :: error character :: pathSep getLoadCaseFile = loadcaseParameter @@ -363,7 +351,7 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present if (scan(getLoadCaseFile,pathSep) /= 1) then ! relative path given as command line argument - error = getcwd(cwd) + error = getCWD2(cwd) getLoadCaseFile = rectifyPath(trim(cwd)//pathSep//getLoadCaseFile) else getLoadCaseFile = rectifyPath(getLoadCaseFile) diff --git a/code/system_routines.f90 b/code/system_routines.f90 new file mode 100644 index 000000000..5a8d9ef22 --- /dev/null +++ b/code/system_routines.f90 @@ -0,0 +1,63 @@ +module system_routines + + implicit none + private + + public :: & + isDirectory, & + getCWD2 + +interface + + function isDirectory_C(path) BIND(C) + use, intrinsic :: ISO_C_Binding, only: & + C_INT, & + C_CHAR + integer(C_INT) :: isDirectory_C + character(kind=C_CHAR),intent(in) :: path(*) + end function isDirectory_C + + subroutine getCurrentWorkDir_C(str_out, stat) bind(C) + use, intrinsic :: ISO_C_Binding, only: & + C_INT, & + C_CHAR + character( kind=c_char ), dimension(*), intent(inout) :: str_out + integer(C_INT),intent(out) :: stat + + end subroutine getCurrentWorkDir_C + +end interface + + +contains + + logical function isDirectory(path) + use, intrinsic :: ISO_C_Binding, only: & + C_INT + + implicit none + character(len=*), intent(in) :: path + + isDirectory=merge(.True.,.False.,isDirectory_C(trim(path)) /= 0_C_INT) + + end function isDirectory + + + logical function getCWD2(str) + use, intrinsic :: ISO_C_Binding, only: & + C_INT, & + C_CHAR, & + C_NULL_CHAR + + implicit none + character(len=1024), intent(out) :: str + integer(C_INT) :: stat + + str = repeat(C_NULL_CHAR,1024) + call getCurrentWorkDir_C(str,stat) + getCWD2=merge(.True.,.False.,stat /= 0_C_INT) + + end function getCWD2 + +end module system_routines + From cf21d5ad49e67f9e21deb9d270120523536adc1e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Mar 2016 19:01:01 +0100 Subject: [PATCH 03/10] did not compile without these statements --- code/Makefile | 1 + code/spectral_interface.f90 | 8 +++++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/code/Makefile b/code/Makefile index a0d5ffd26..00639ea52 100644 --- a/code/Makefile +++ b/code/Makefile @@ -626,6 +626,7 @@ IO.o: IO.f90 \ DAMASK_interface.o: spectral_interface.f90 \ $(wildcard DAMASK_FEM_interface.f90) \ prec.o + $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -o DAMASK_interface.o $(SUFFIX) prec.o: prec.f90 \ system_routines.o diff --git a/code/spectral_interface.f90 b/code/spectral_interface.f90 index 4010b07ca..731225884 100644 --- a/code/spectral_interface.f90 +++ b/code/spectral_interface.f90 @@ -250,7 +250,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) else - error = getCWD2(cwd) ! relative path given as command line argument + error = getCWD2(cwd) ! relative path given as command line argument storeWorkingDirectory = trim(cwd)//pathSep//& geometryArg(1:scan(geometryArg,pathSep,back=.true.)) endif @@ -264,6 +264,8 @@ end function storeWorkingDirectory !> @brief simply returns the private string workingDir !-------------------------------------------------------------------------------------------------- character(len=1024) function getSolverWorkingDirectoryName() + use system_routines, only: & + getCWD2 implicit none getSolverWorkingDirectoryName = workingDirectory @@ -302,6 +304,8 @@ end function getSolverJobName !> @brief basename of geometry file with extension from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getGeometryFile(geometryParameter) + use system_routines, only: & + getCWD2 implicit none character(len=1024), intent(in) :: & @@ -334,6 +338,8 @@ end function getGeometryFile !> @brief relative path of loadcase from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getLoadCaseFile(loadCaseParameter) + use system_routines, only: & + getCWD2 implicit none character(len=1024), intent(in) :: & From d3579d78fddeb58ebbf00ee28fce0773ad3e920e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Mar 2016 21:09:45 +0100 Subject: [PATCH 04/10] fixed string handling and enabled compilation (unfortunately, gfortran needs exceptions) --- code/Makefile | 20 +++++++++++++++++--- code/spectral_interface.f90 | 12 +++++------- code/system_routines.f90 | 6 ++++-- 3 files changed, 26 insertions(+), 12 deletions(-) diff --git a/code/Makefile b/code/Makefile index 00639ea52..03d486d66 100644 --- a/code/Makefile +++ b/code/Makefile @@ -628,13 +628,27 @@ DAMASK_interface.o: spectral_interface.f90 \ prec.o $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -o DAMASK_interface.o $(SUFFIX) +ifeq "$(F90)" "gfortran" prec.o: prec.f90 \ system_routines.o + $(PREFIX) $(COMPILERNAME) $(COMPILE) -c prec.f90 -fno-range-check -fall-intrinsics -fno-fast-math $(SUFFIX) +# fno-range-check: Disable range checking on results of simplification of constant expressions during compilation +# --> allows the definition of DAMASK_NaN +#-fall-intrinsics: all intrinsic procedures (including the GNU-specific extensions) are accepted. -Wintrinsics-std will be ignored +# and no user-defined procedure with the same name as any intrinsic will be called except when it is explicitly declared external +# --> allows the use of 'isnan' +#-fno-fast-math: +# --> otherwise, when setting -ffast-math, isnan always evaluates to false (I would call it a bug) +else -C_routines.o: C_routines.c +prec.o: prec.f90 \ + system_routines.o +endif -system_routines.o: system_routines.f90 \ - C_routines.o +system_routines.o: system_routines.f90 \ + C_routines.o + +C_routines.o: C_routines.c %.o : %.f90 diff --git a/code/spectral_interface.f90 b/code/spectral_interface.f90 index 731225884..8362a2feb 100644 --- a/code/spectral_interface.f90 +++ b/code/spectral_interface.f90 @@ -233,20 +233,20 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA pathSep = getPathSep() - if (len(workingDirectoryArg)>0) then ! got working directory as input + wdGiven: if (len(workingDirectoryArg)>0) then if (workingDirectoryArg(1:1) == pathSep) then ! absolute path given as command line argument storeWorkingDirectory = workingDirectoryArg else error = getCWD2(cwd) ! relative path given as command line argument storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg endif - if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it - /= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep + if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory)))/= pathSep) & + storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep ! if path seperator is not given, append it if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist' call quit(1_pInt) endif - else ! using path to geometry file as working dir + else wdGiven if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) else @@ -254,7 +254,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA storeWorkingDirectory = trim(cwd)//pathSep//& geometryArg(1:scan(geometryArg,pathSep,back=.true.)) endif - endif + endif wdGiven storeWorkingDirectory = rectifyPath(storeWorkingDirectory) end function storeWorkingDirectory @@ -264,8 +264,6 @@ end function storeWorkingDirectory !> @brief simply returns the private string workingDir !-------------------------------------------------------------------------------------------------- character(len=1024) function getSolverWorkingDirectoryName() - use system_routines, only: & - getCWD2 implicit none getSolverWorkingDirectoryName = workingDirectory diff --git a/code/system_routines.f90 b/code/system_routines.f90 index 5a8d9ef22..15107db5a 100644 --- a/code/system_routines.f90 +++ b/code/system_routines.f90 @@ -50,11 +50,13 @@ contains C_NULL_CHAR implicit none - character(len=1024), intent(out) :: str + character(len=*), intent(out) :: str + character(len=1024) :: strFixedLength integer(C_INT) :: stat str = repeat(C_NULL_CHAR,1024) - call getCurrentWorkDir_C(str,stat) + call getCurrentWorkDir_C(strFixedLength,stat) + str = strFixedLength(1:scan(strFixedLength,C_NULL_CHAR,.True.)-1) getCWD2=merge(.True.,.False.,stat /= 0_C_INT) end function getCWD2 From ba0b278aca485541d8b6b0aef57b93e1c719c01c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 5 May 2016 13:00:46 +0200 Subject: [PATCH 05/10] better name --- code/Makefile | 24 ++++++++-------- code/spectral_interface.f90 | 14 +++++----- code/system_routines.f90 | 56 ++++++++++++++++++++++--------------- 3 files changed, 52 insertions(+), 42 deletions(-) diff --git a/code/Makefile b/code/Makefile index 454d86e51..110d595f3 100644 --- a/code/Makefile +++ b/code/Makefile @@ -7,11 +7,11 @@ SHELL = /bin/sh # OPTIONS = standard (alternative): meaning #------------------------------------------------------------- # F90 = ifort (gfortran): compiler type, choose Intel or GNU -# COMPILERNAME = name of the compiler executable (if not the same as the ype), e.g. using mpich-g90 instead of ifort +# FCOMPILERNAME = name of the compiler executable (if not the same as the ype), e.g. using mpich-g90 instead of ifort # PORTABLE = TRUE (FALSE): decision, if executable is optimized for the machine on which it was built. # OPTIMIZATION = DEFENSIVE (OFF,AGGRESSIVE,ULTRA): Optimization mode: O2, O0, O3 + further options for most files, O3 + further options for all files # OPENMP = TRUE (FALSE): OpenMP multiprocessor support -# PREFIX = arbitrary prefix (before compilername) +# PREFIX = arbitrary prefix (before FCOMPILERNAME) # OPTION = arbitrary option (just before file to compile) # SUFFIX = arbitrary suffix (after file to compile) # STANDARD_CHECK = checking for Fortran 2008, compiler dependend @@ -24,7 +24,7 @@ include ${PETSC_DIR}/lib/petsc/conf/rules INCLUDE_DIRS := $(PETSC_FC_INCLUDES) -DPETSc -I../lib LIBRARIES := $(PETSC_WITH_EXTERNAL_LIB) -COMPILERNAME ?= $(FC) +FCOMPILERNAME ?= $(FC) CCOMPILERNAME ?= $(CC) LINKERNAME ?= $(FLINKER) @@ -369,7 +369,7 @@ DAMASK_spectral.exe: DAMASK_spectral.o DAMASK_spectral.o: DAMASK_spectral.f90 \ $(SPECTRAL_SOLVER_FILES) - $(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) -c DAMASK_spectral.f90 $(SUFFIX) + $(PREFIX) $(FCOMPILERNAME) $(COMPILE_MAXOPTI) -c DAMASK_spectral.f90 $(SUFFIX) spectral_mech_AL.o: spectral_mech_AL.f90 \ spectral_utilities.o @@ -416,7 +416,7 @@ DAMASK_FEM.exe: DAMASK_FEM_driver.o $(FEM_FILES) $(LIBRARIES) $(SUFFIX) DAMASK_FEM_driver.o: DAMASK_FEM_driver.f90 $(FEM_SOLVER_FILES) - $(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) -c ../private/FEM/code/DAMASK_FEM_driver.f90 $(SUFFIX) + $(PREFIX) $(FCOMPILERNAME) $(COMPILE_MAXOPTI) -c ../private/FEM/code/DAMASK_FEM_driver.f90 $(SUFFIX) FEM_mech.o: FEM_mech.f90 \ FEM_utilities.o @@ -441,7 +441,7 @@ FEM_utilities.o: FEM_utilities.f90 \ FEZoo.o: $(wildcard FEZoo.f90) \ IO.o - $(IGNORE) $(PREFIX) $(COMPILERNAME) $(COMPILE) -c ../private/FEM/code/FEZoo.f90 $(SUFFIX) + $(IGNORE) $(PREFIX) $(FCOMPILERNAME) $(COMPILE) -c ../private/FEM/code/FEZoo.f90 $(SUFFIX) touch FEZoo.o CPFEM.o: CPFEM.f90 \ @@ -585,7 +585,7 @@ plastic_none.o: plastic_none.f90 \ ifeq "$(F90)" "gfortran" lattice.o: lattice.f90 \ material.o - $(PREFIX) $(COMPILERNAME) $(COMPILE) -ffree-line-length-240 -c lattice.f90 $(SUFFIX) + $(PREFIX) $(FCOMPILERNAME) $(COMPILE) -ffree-line-length-240 -c lattice.f90 $(SUFFIX) # long lines for interaction matrix else lattice.o: lattice.f90 \ @@ -600,7 +600,7 @@ mesh.o: mesh.f90 \ FEsolving.o \ math.o \ FEZoo.o - $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(MESHNAME) -o mesh.o $(SUFFIX) + $(PREFIX) $(FCOMPILERNAME) $(COMPILE) -c $(MESHNAME) -o mesh.o $(SUFFIX) FEsolving.o: FEsolving.f90 \ debug.o @@ -623,12 +623,12 @@ IO.o: IO.f90 \ DAMASK_interface.o: spectral_interface.f90 \ $(wildcard DAMASK_FEM_interface.f90) \ prec.o - $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -o DAMASK_interface.o $(SUFFIX) + $(PREFIX) $(FCOMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -o DAMASK_interface.o $(SUFFIX) ifeq "$(F90)" "gfortran" prec.o: prec.f90 \ system_routines.o - $(PREFIX) $(COMPILERNAME) $(COMPILE) -c prec.f90 -fno-range-check -fall-intrinsics -fno-fast-math $(SUFFIX) + $(PREFIX) $(FCOMPILERNAME) $(COMPILE) -c prec.f90 -fno-range-check -fall-intrinsics -fno-fast-math $(SUFFIX) # fno-range-check: Disable range checking on results of simplification of constant expressions during compilation # --> allows the definition of DAMASK_NaN #-fall-intrinsics: all intrinsic procedures (including the GNU-specific extensions) are accepted. -Wintrinsics-std will be ignored @@ -649,7 +649,7 @@ C_routines.o: C_routines.c %.o : %.f90 - $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $< $(SUFFIX) + $(PREFIX) $(FCOMPILERNAME) $(COMPILE) -c $< $(SUFFIX) %.o : %.c $(CCOMPILERNAME) -c $< @@ -679,6 +679,6 @@ cleanDAMASK: .PHONY: help help: F90="$(F90)" - COMPILERNAME="$(COMPILERNAME)" + FCOMPILERNAME="$(FCOMPILERNAME)" COMPILEROUT="$(COMPILEROUT)" diff --git a/code/spectral_interface.f90 b/code/spectral_interface.f90 index 8362a2feb..f02b3f412 100644 --- a/code/spectral_interface.f90 +++ b/code/spectral_interface.f90 @@ -220,7 +220,7 @@ end subroutine DAMASK_interface_init character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryArg) use system_routines, only: & isDirectory, & - getCWD2 + getCWD implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument @@ -237,7 +237,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA if (workingDirectoryArg(1:1) == pathSep) then ! absolute path given as command line argument storeWorkingDirectory = workingDirectoryArg else - error = getCWD2(cwd) ! relative path given as command line argument + error = getCWD(cwd) ! relative path given as command line argument storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg endif if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory)))/= pathSep) & @@ -250,7 +250,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) else - error = getCWD2(cwd) ! relative path given as command line argument + error = getCWD(cwd) ! relative path given as command line argument storeWorkingDirectory = trim(cwd)//pathSep//& geometryArg(1:scan(geometryArg,pathSep,back=.true.)) endif @@ -303,7 +303,7 @@ end function getSolverJobName !-------------------------------------------------------------------------------------------------- character(len=1024) function getGeometryFile(geometryParameter) use system_routines, only: & - getCWD2 + getCWD implicit none character(len=1024), intent(in) :: & @@ -321,7 +321,7 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present if (scan(getGeometryFile,pathSep) /= 1) then ! relative path given as command line argument - error = getCWD2(cwd) + error = getCWD(cwd) getGeometryFile = rectifyPath(trim(cwd)//pathSep//getGeometryFile) else getGeometryFile = rectifyPath(getGeometryFile) @@ -337,7 +337,7 @@ end function getGeometryFile !-------------------------------------------------------------------------------------------------- character(len=1024) function getLoadCaseFile(loadCaseParameter) use system_routines, only: & - getCWD2 + getCWD implicit none character(len=1024), intent(in) :: & @@ -355,7 +355,7 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present if (scan(getLoadCaseFile,pathSep) /= 1) then ! relative path given as command line argument - error = getCWD2(cwd) + error = getCWD(cwd) getLoadCaseFile = rectifyPath(trim(cwd)//pathSep//getLoadCaseFile) else getLoadCaseFile = rectifyPath(getLoadCaseFile) diff --git a/code/system_routines.f90 b/code/system_routines.f90 index 15107db5a..ebcd8e50b 100644 --- a/code/system_routines.f90 +++ b/code/system_routines.f90 @@ -1,3 +1,7 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief provides wrappers to C routines +!-------------------------------------------------------------------------------------------------- module system_routines implicit none @@ -5,7 +9,7 @@ module system_routines public :: & isDirectory, & - getCWD2 + getCWD interface @@ -31,35 +35,41 @@ end interface contains - logical function isDirectory(path) - use, intrinsic :: ISO_C_Binding, only: & - C_INT +!-------------------------------------------------------------------------------------------------- +!> @brief figures out if a given path is a directory (and not an ordinary file) +!-------------------------------------------------------------------------------------------------- +logical function isDirectory(path) + use, intrinsic :: ISO_C_Binding, only: & + C_INT - implicit none - character(len=*), intent(in) :: path + implicit none + character(len=*), intent(in) :: path - isDirectory=merge(.True.,.False.,isDirectory_C(trim(path)) /= 0_C_INT) + isDirectory=merge(.True.,.False.,isDirectory_C(trim(path)) /= 0_C_INT) - end function isDirectory +end function isDirectory - logical function getCWD2(str) - use, intrinsic :: ISO_C_Binding, only: & - C_INT, & - C_CHAR, & - C_NULL_CHAR +!-------------------------------------------------------------------------------------------------- +!> @brief gets the current working directory +!-------------------------------------------------------------------------------------------------- +logical function getCWD(str) + use, intrinsic :: ISO_C_Binding, only: & + C_INT, & + C_CHAR, & + C_NULL_CHAR - implicit none - character(len=*), intent(out) :: str - character(len=1024) :: strFixedLength - integer(C_INT) :: stat - - str = repeat(C_NULL_CHAR,1024) - call getCurrentWorkDir_C(strFixedLength,stat) - str = strFixedLength(1:scan(strFixedLength,C_NULL_CHAR,.True.)-1) - getCWD2=merge(.True.,.False.,stat /= 0_C_INT) + implicit none + character(len=*), intent(out) :: str + character(len=1024) :: strFixedLength + integer(C_INT) :: stat - end function getCWD2 + str = repeat(C_NULL_CHAR,1024) + call getCurrentWorkDir_C(strFixedLength,stat) + str = strFixedLength(1:scan(strFixedLength,C_NULL_CHAR,.True.)-1) + getCWD=merge(.True.,.False.,stat /= 0_C_INT) + +end function getCWD end module system_routines From 0c105658c3ddc428f9e66b883721eba01f8a8603 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 5 May 2016 15:11:28 +0200 Subject: [PATCH 06/10] simplifying --- code/C_routines.c | 2 +- code/spectral_interface.f90 | 28 ++++++++-------------------- code/system_routines.f90 | 2 +- 3 files changed, 10 insertions(+), 22 deletions(-) diff --git a/code/C_routines.c b/code/C_routines.c index a212680bb..242d5344c 100644 --- a/code/C_routines.c +++ b/code/C_routines.c @@ -14,7 +14,7 @@ void getcurrentworkdir_c(char cwd[], int *stat ){ if(getcwd(cwd_tmp, sizeof(cwd_tmp)) == cwd_tmp){ *stat = 0; strcpy(cwd, cwd_tmp); - } + } else{ *stat = 1; } diff --git a/code/spectral_interface.f90 b/code/spectral_interface.f90 index f02b3f412..11339ccb3 100644 --- a/code/spectral_interface.f90 +++ b/code/spectral_interface.f90 @@ -185,7 +185,7 @@ subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn) call quit(1_pInt) endif - workingDirectory = storeWorkingDirectory(trim(workingDirArg),trim(geometryArg)) + workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg))) geometryFile = getGeometryFile(geometryArg) loadCaseFile = getLoadCaseFile(loadCaseArg) @@ -230,16 +230,14 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA logical :: error external :: quit - - pathSep = getPathSep() wdGiven: if (len(workingDirectoryArg)>0) then - if (workingDirectoryArg(1:1) == pathSep) then ! absolute path given as command line argument + absolutePath: if (workingDirectoryArg(1:1) == pathSep) then storeWorkingDirectory = workingDirectoryArg - else - error = getCWD(cwd) ! relative path given as command line argument + else absolutePath + error = getCWD(cwd) storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg - endif + endif absolutePath if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory)))/= pathSep) & storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep ! if path seperator is not given, append it if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists @@ -255,7 +253,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA geometryArg(1:scan(geometryArg,pathSep,back=.true.)) endif endif wdGiven - storeWorkingDirectory = rectifyPath(storeWorkingDirectory) + storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory)) end function storeWorkingDirectory @@ -302,14 +300,10 @@ 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 character :: pathSep logical :: error @@ -321,8 +315,7 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present if (scan(getGeometryFile,pathSep) /= 1) then ! relative path given as command line argument - error = getCWD(cwd) - getGeometryFile = rectifyPath(trim(cwd)//pathSep//getGeometryFile) + getGeometryFile = rectifyPath(trim(workingDirectory)//pathSep//getGeometryFile) else getGeometryFile = rectifyPath(getGeometryFile) endif @@ -336,14 +329,10 @@ 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 character :: pathSep @@ -355,8 +344,7 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present if (scan(getLoadCaseFile,pathSep) /= 1) then ! relative path given as command line argument - error = getCWD(cwd) - getLoadCaseFile = rectifyPath(trim(cwd)//pathSep//getLoadCaseFile) + getLoadCaseFile = rectifyPath(trim(workingDirectory)//pathSep//getLoadCaseFile) else getLoadCaseFile = rectifyPath(getLoadCaseFile) endif diff --git a/code/system_routines.f90 b/code/system_routines.f90 index ebcd8e50b..98c7be098 100644 --- a/code/system_routines.f90 +++ b/code/system_routines.f90 @@ -64,7 +64,7 @@ logical function getCWD(str) character(len=1024) :: strFixedLength integer(C_INT) :: stat - str = repeat(C_NULL_CHAR,1024) + str = repeat(C_NULL_CHAR,len(str)) call getCurrentWorkDir_C(strFixedLength,stat) str = strFixedLength(1:scan(strFixedLength,C_NULL_CHAR,.True.)-1) getCWD=merge(.True.,.False.,stat /= 0_C_INT) From e0cc66950f485be30825cf112b8edc2a3be7b755 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 5 May 2016 15:47:15 +0200 Subject: [PATCH 07/10] fixed intent in/out --- code/system_routines.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/code/system_routines.f90 b/code/system_routines.f90 index 98c7be098..cfd326277 100644 --- a/code/system_routines.f90 +++ b/code/system_routines.f90 @@ -21,11 +21,11 @@ interface character(kind=C_CHAR),intent(in) :: path(*) end function isDirectory_C - subroutine getCurrentWorkDir_C(str_out, stat) bind(C) + subroutine getCurrentWorkDir_C(str, stat) bind(C) use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR - character( kind=c_char ), dimension(*), intent(inout) :: str_out + character(kind=c_char), dimension(*), intent(out) :: str integer(C_INT),intent(out) :: stat end subroutine getCurrentWorkDir_C From 8a9c5efbe707542186f3c506d8d19482646bfd65 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 5 May 2016 16:16:21 +0200 Subject: [PATCH 08/10] working for ifort --- code/C_routines.c | 2 +- code/spectral_interface.f90 | 4 ++-- code/system_routines.f90 | 16 +++++++++++----- 3 files changed, 14 insertions(+), 8 deletions(-) diff --git a/code/C_routines.c b/code/C_routines.c index 242d5344c..7be6264d7 100644 --- a/code/C_routines.c +++ b/code/C_routines.c @@ -12,8 +12,8 @@ void getcurrentworkdir_c(char cwd[], int *stat ){ char cwd_tmp[1024]; if(getcwd(cwd_tmp, sizeof(cwd_tmp)) == cwd_tmp){ + strcpy(cwd,cwd_tmp); *stat = 0; - strcpy(cwd, cwd_tmp); } else{ *stat = 1; diff --git a/code/spectral_interface.f90 b/code/spectral_interface.f90 index 11339ccb3..e827904b9 100644 --- a/code/spectral_interface.f90 +++ b/code/spectral_interface.f90 @@ -236,6 +236,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA storeWorkingDirectory = workingDirectoryArg else absolutePath error = getCWD(cwd) + if (error) call quit(1_pInt) storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg endif absolutePath if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory)))/= pathSep) & @@ -249,6 +250,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) else error = getCWD(cwd) ! relative path given as command line argument + if (error) call quit(1_pInt) storeWorkingDirectory = trim(cwd)//pathSep//& geometryArg(1:scan(geometryArg,pathSep,back=.true.)) endif @@ -306,7 +308,6 @@ character(len=1024) function getGeometryFile(geometryParameter) geometryParameter integer :: posExt, posSep character :: pathSep - logical :: error getGeometryFile = geometryParameter pathSep = getPathSep() @@ -334,7 +335,6 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) character(len=1024), intent(in) :: & loadCaseParameter integer :: posExt, posSep - logical :: error character :: pathSep getLoadCaseFile = loadcaseParameter diff --git a/code/system_routines.f90 b/code/system_routines.f90 index cfd326277..8d8845dad 100644 --- a/code/system_routines.f90 +++ b/code/system_routines.f90 @@ -25,7 +25,7 @@ interface use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR - character(kind=c_char), dimension(*), intent(out) :: str + character(kind=c_char), dimension(1024), intent(out) :: str ! C string is an array integer(C_INT),intent(out) :: stat end subroutine getCurrentWorkDir_C @@ -58,15 +58,21 @@ logical function getCWD(str) C_INT, & C_CHAR, & C_NULL_CHAR - implicit none character(len=*), intent(out) :: str - character(len=1024) :: strFixedLength + character(kind=c_char), dimension(1024) :: strFixedLength ! C string is an array integer(C_INT) :: stat + integer :: i - str = repeat(C_NULL_CHAR,len(str)) + str = repeat('',len(str)) call getCurrentWorkDir_C(strFixedLength,stat) - str = strFixedLength(1:scan(strFixedLength,C_NULL_CHAR,.True.)-1) + do i=1,1024 ! copy array components until Null string is found + if (strFixedLength(i) /= C_NULL_CHAR) then + str(i:i)=strFixedLength(i) + else + exit + endif + enddo getCWD=merge(.True.,.False.,stat /= 0_C_INT) end function getCWD From 97f7abf9156fb6593b298c9a45066f9080010348 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 17 May 2016 23:16:17 +0200 Subject: [PATCH 09/10] cleaner declaration --- code/system_routines.f90 | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/code/system_routines.f90 b/code/system_routines.f90 index 8d8845dad..ab1aae03f 100644 --- a/code/system_routines.f90 +++ b/code/system_routines.f90 @@ -18,16 +18,15 @@ interface C_INT, & C_CHAR integer(C_INT) :: isDirectory_C - character(kind=C_CHAR),intent(in) :: path(*) + character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array end function isDirectory_C subroutine getCurrentWorkDir_C(str, stat) bind(C) use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR - character(kind=c_char), dimension(1024), intent(out) :: str ! C string is an array + character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array integer(C_INT),intent(out) :: stat - end subroutine getCurrentWorkDir_C end interface @@ -40,12 +39,20 @@ contains !-------------------------------------------------------------------------------------------------- logical function isDirectory(path) use, intrinsic :: ISO_C_Binding, only: & - C_INT + C_INT, & + C_CHAR, & + C_NULL_CHAR implicit none character(len=*), intent(in) :: path + character(kind=C_CHAR), dimension(1024) :: strFixedLength + integer :: i - isDirectory=merge(.True.,.False.,isDirectory_C(trim(path)) /= 0_C_INT) + strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) + do i=1,len(path) ! copy array components + strFixedLength(i)=path(i:i) + enddo + isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT) end function isDirectory @@ -58,9 +65,10 @@ logical function getCWD(str) C_INT, & C_CHAR, & C_NULL_CHAR + implicit none character(len=*), intent(out) :: str - character(kind=c_char), dimension(1024) :: strFixedLength ! C string is an array + character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array integer(C_INT) :: stat integer :: i From 91f96cf69b7f449a7231b30fb363c390ded9529c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 18 May 2016 07:52:19 +0200 Subject: [PATCH 10/10] reverted handling back --- code/spectral_interface.f90 | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/code/spectral_interface.f90 b/code/spectral_interface.f90 index e827904b9..911e6c72e 100644 --- a/code/spectral_interface.f90 +++ b/code/spectral_interface.f90 @@ -239,23 +239,23 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA if (error) call quit(1_pInt) storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg endif absolutePath - if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory)))/= pathSep) & - storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep ! if path seperator is not given, append it - if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists - write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist' - call quit(1_pInt) - endif + if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= pathSep) & + storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep ! if path seperator is not given, append it else wdGiven if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) else - error = getCWD(cwd) ! relative path given as command line argument + error = getCWD(cwd) ! relative path given as command line argument if (error) call quit(1_pInt) - storeWorkingDirectory = trim(cwd)//pathSep//& - geometryArg(1:scan(geometryArg,pathSep,back=.true.)) + storeWorkingDirectory = trim(cwd)//pathSep//geometryArg(1:scan(geometryArg,pathSep,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' + call quit(1_pInt) + endif end function storeWorkingDirectory @@ -302,11 +302,16 @@ 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 character :: pathSep getGeometryFile = geometryParameter @@ -316,7 +321,8 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present if (scan(getGeometryFile,pathSep) /= 1) then ! relative path given as command line argument - getGeometryFile = rectifyPath(trim(workingDirectory)//pathSep//getGeometryFile) + error = getcwd(cwd) + getGeometryFile = rectifyPath(trim(cwd)//pathSep//getGeometryFile) else getGeometryFile = rectifyPath(getGeometryFile) endif @@ -330,11 +336,16 @@ 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 character :: pathSep getLoadCaseFile = loadcaseParameter @@ -344,7 +355,8 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present if (scan(getLoadCaseFile,pathSep) /= 1) then ! relative path given as command line argument - getLoadCaseFile = rectifyPath(trim(workingDirectory)//pathSep//getLoadCaseFile) + error = getcwd(cwd) + getLoadCaseFile = rectifyPath(trim(cwd)//pathSep//getLoadCaseFile) else getLoadCaseFile = rectifyPath(getLoadCaseFile) endif