Merge branch 'CCodeUse' into 'development'
C code use Use a standard conforming C-to-Fortran wrapper to have access to system routines available in C but not in standard Fortran. Having PETSc as a backend ensures that we have a C compiler (don't make it as complex as with f2py). No need to use vendor specific extensions to figure out if a path is a directory and to get the current working directory anymore. Simplifies the makefiles (only exceptions currently are for NaN to be compatible to older gfortran). See merge request !6
This commit is contained in:
Philip Eisenlohr
commit
0b5ce0ed80
|
|
@ -0,0 +1,28 @@
|
|||
/* Unix */
|
||||
#include <stdio.h>
|
||||
#include <unistd.h>
|
||||
#include <dirent.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
/* 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){
|
||||
strcpy(cwd,cwd_tmp);
|
||||
*stat = 0;
|
||||
}
|
||||
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);
|
||||
}
|
||||
|
|
@ -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,8 @@ 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)
|
||||
|
||||
# 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 \
|
||||
|
|
@ -368,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
|
||||
|
|
@ -415,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
|
||||
|
|
@ -440,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 \
|
||||
|
|
@ -584,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 \
|
||||
|
|
@ -599,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
|
||||
|
|
@ -619,16 +620,15 @@ 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)
|
||||
$(PREFIX) $(FCOMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -o DAMASK_interface.o $(SUFFIX)
|
||||
|
||||
ifeq "$(F90)" "gfortran"
|
||||
prec.o: prec.f90 \
|
||||
system_routines.o
|
||||
$(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
|
||||
|
|
@ -637,17 +637,22 @@ prec.o: prec.f90
|
|||
#-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)
|
||||
|
||||
prec.o: prec.f90 \
|
||||
system_routines.o
|
||||
endif
|
||||
|
||||
system_routines.o: system_routines.f90 \
|
||||
C_routines.o
|
||||
|
||||
C_routines.o: C_routines.c
|
||||
|
||||
|
||||
%.o : %.f90
|
||||
$(PREFIX) $(COMPILERNAME) $(COMPILE) -c $< $(SUFFIX)
|
||||
$(PREFIX) $(FCOMPILERNAME) $(COMPILE) -c $< $(SUFFIX)
|
||||
|
||||
%.o : %.c
|
||||
$(CCOMPILERNAME) -c $<
|
||||
|
||||
.PHONY: tidy
|
||||
tidy:
|
||||
|
|
@ -674,6 +679,6 @@ cleanDAMASK:
|
|||
.PHONY: help
|
||||
help:
|
||||
F90="$(F90)"
|
||||
COMPILERNAME="$(COMPILERNAME)"
|
||||
FCOMPILERNAME="$(FCOMPILERNAME)"
|
||||
COMPILEROUT="$(COMPILEROUT)"
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -188,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)
|
||||
|
||||
|
|
@ -221,49 +218,45 @@ 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, &
|
||||
getCWD
|
||||
|
||||
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
|
||||
wdGiven: if (len(workingDirectoryArg)>0) then
|
||||
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)
|
||||
if (error) call quit(1_pInt)
|
||||
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
|
||||
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
|
||||
endif absolutePath
|
||||
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
|
||||
storeWorkingDirectory = trim(cwd)//pathSep//&
|
||||
geometryArg(1:scan(geometryArg,pathSep,back=.true.))
|
||||
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
|
||||
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
|
||||
storeWorkingDirectory = rectifyPath(storeWorkingDirectory)
|
||||
|
||||
|
||||
end function storeWorkingDirectory
|
||||
|
||||
|
||||
|
|
@ -309,9 +302,8 @@ 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
|
||||
use system_routines, only: &
|
||||
getCWD
|
||||
|
||||
implicit none
|
||||
character(len=1024), intent(in) :: &
|
||||
|
|
@ -319,8 +311,8 @@ character(len=1024) function getGeometryFile(geometryParameter)
|
|||
character(len=1024) :: &
|
||||
cwd
|
||||
integer :: posExt, posSep
|
||||
logical :: error
|
||||
character :: pathSep
|
||||
integer :: error
|
||||
|
||||
getGeometryFile = geometryParameter
|
||||
pathSep = getPathSep()
|
||||
|
|
@ -344,16 +336,16 @@ end function getGeometryFile
|
|||
!> @brief relative path of loadcase from command line arguments
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character(len=1024) function getLoadCaseFile(loadCaseParameter)
|
||||
#ifdef __INTEL_COMPILER
|
||||
use IFPORT
|
||||
#endif
|
||||
use system_routines, only: &
|
||||
getCWD
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -0,0 +1,89 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @brief provides wrappers to C routines
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module system_routines
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
public :: &
|
||||
isDirectory, &
|
||||
getCWD
|
||||
|
||||
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), 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
|
||||
integer(C_INT),intent(out) :: stat
|
||||
end subroutine getCurrentWorkDir_C
|
||||
|
||||
end interface
|
||||
|
||||
|
||||
contains
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @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, &
|
||||
C_CHAR, &
|
||||
C_NULL_CHAR
|
||||
|
||||
implicit none
|
||||
character(len=*), intent(in) :: path
|
||||
character(kind=C_CHAR), dimension(1024) :: strFixedLength
|
||||
integer :: i
|
||||
|
||||
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
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @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(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
|
||||
integer(C_INT) :: stat
|
||||
integer :: i
|
||||
|
||||
str = repeat('',len(str))
|
||||
call getCurrentWorkDir_C(strFixedLength,stat)
|
||||
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
|
||||
|
||||
end module system_routines
|
||||
|
||||
Loading…
Reference in New Issue