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

code/C_routines.c

@@ -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);
+}

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,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)
+	$(PREFIX) $(FCOMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -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
+ifeq "$(F90)" "gfortran"
-#      -->   allows the use of 'getcwd'
+prec.o:                        prec.f90 \
-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
@@ -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:                        prec.f90 \
-                               prec.o
+                               system_routines.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
 
+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)"
 

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
@@ -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,48 +218,44 @@ end subroutine DAMASK_interface_init
 !> @todo  change working directory with call chdir(storeWorkingDirectory)?
 !--------------------------------------------------------------------------------------------------
 character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryArg)
-#ifdef __INTEL_COMPILER
+ use system_routines, only: &
- use IFPORT
+   isDirectory, &
-#endif
+   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
+ 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
+   else absolutePath
-     error = getcwd(cwd)                                                                            ! relative path given as command line argument
+     error = getCWD(cwd)
+     if (error) call quit(1_pInt)
      storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg
-   endif
+   endif absolutePath
-   if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) &   ! if path seperator is not given, append it
+   if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= pathSep) &
-      /= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep
+     storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep                                   ! if path seperator is not given, append it
-#ifdef __INTEL_COMPILER
+ else wdGiven
-   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
    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
-     storeWorkingDirectory = trim(cwd)//pathSep//&
+     if (error) call quit(1_pInt)
-                              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
- 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 system_routines, only: &
- use IFPORT
+   getCWD
-#endif
 
  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 system_routines, only: &
- use IFPORT
+   getCWD
-#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

code/system_routines.f90

@@ -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
+