almost working

code/C_helper.c

@@ -1,24 +0,0 @@
-/* Unix */
-#include <unistd.h>
-#include <dirent.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-
-#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);
-}

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

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
+prec.o:                        prec.f90 \
-#                   and no user-defined procedure with the same name as any intrinsic will be called except when it is explicitly declared external
+                               system_routines.o
-#      -->   allows the use of 'getcwd'
+
-prec.o:                        prec.f90
+C_routines.o:               C_routines.c
-	$(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
+system_routines.o:          system_routines.f90 \
-#      -->   allows the definition of DAMASK_NaN
+                            C_routines.o
-#-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
 
 %.o : %.f90
 	$(PREFIX) $(COMPILERNAME) $(COMPILE) -c $< $(SUFFIX)
 
+%.o : %.c
+	$(CCOMPILERNAME) -c $<
+
 .PHONY: tidy
 tidy:
 	@rm -rf *.o

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 system_routines, only: &
- use IFPORT
+   isDirectory, &
-#endif
+   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
+   if(.not. isDirectory(trim(storeWorkingDirectory))) then                                          ! check if the directory exists
-   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
@@ -257,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 = 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
@@ -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)

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
+