signal handling implemented

allows to trigger action in running simulation, i.e. writing restart or results

src/C_routines.c

@@ -6,9 +6,11 @@
 #include <sys/stat.h>
 #include <stdio.h>
 #include <string.h>
+#include <signal.h>
 
 /* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */
 
+
 int isdirectory_c(const char *dir){
   struct stat statbuf;
   if(stat(dir, &statbuf) != 0)                                                                      /* error */
@@ -44,3 +46,11 @@ void gethostname_c(char hostname[], int *stat){
 int chdir_c(const char *dir){
   return chdir(dir);
 }
+
+void signalusr1_c(void (*handler)(int)){
+  signal(SIGUSR1, handler);
+}
+
+void signalusr2_c(void (*handler)(int)){
+  signal(SIGUSR2, handler);
+}

src/DAMASK_interface.f90

@@ -12,9 +12,9 @@
 module DAMASK_interface
  use prec, only: &
    pInt
-
  implicit none
  private
+ logical, public, protected :: SIGUSR1,SIGUSR2
  integer(pInt),       public, protected :: &
    interface_restartInc = 0_pInt                                                                    !< Increment at which calculation starts
  character(len=1024), public, protected :: &
@@ -42,6 +42,8 @@ contains
 subroutine DAMASK_interface_init()
  use, intrinsic :: &
    iso_fortran_env
+ use :: &
+   iso_c_binding
 #include <petsc/finclude/petscsys.h>
 #if defined(__GFORTRAN__) &&  __GNUC__ < 5
 ===================================================================================================
@@ -81,6 +83,8 @@ subroutine DAMASK_interface_init()
 
  use PETScSys
  use system_routines, only: &
+   signalusr1_C, &
+   signalusr2_C, &
    getHostName, &
    getCWD
 
@@ -229,6 +233,12 @@ subroutine DAMASK_interface_init()
  if (interface_restartInc > 0_pInt) &
    write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc
 
+ call signalusr1_c(c_funloc(setSIGUSR1))
+ call signalusr2_c(c_funloc(setSIGUSR2))
+ SIGUSR1 = .false.
+ SIGUSR2 = .false.
+
+
 end subroutine DAMASK_interface_init
 
 
@@ -412,6 +422,35 @@ character(len=1024) function makeRelativePath(a,b)
 
 end function makeRelativePath
 
+!--------------------------------------------------------------------------------------------------
+!> @brief sets global variable SIGUSR1 to .true. if program receives SIGUSR1
+!--------------------------------------------------------------------------------------------------
+subroutine setSIGUSR1(signal) bind(C)
+ use :: iso_c_binding
+   
+ implicit none
+ integer(C_INT), value :: signal
+ SIGUSR1 = .true.
+ 
+ write(6,*) 'received signal ',signal, 'set SIGUSR1'
+ 
+end subroutine setSIGUSR1
+ 
+ 
+!--------------------------------------------------------------------------------------------------
+!> @brief sets global variable SIGUSR2 to .true. if program receives SIGUSR2
+!--------------------------------------------------------------------------------------------------
+subroutine setSIGUSR2(signal) bind(C)
+ use :: iso_c_binding
+
+ implicit none
+ integer(C_INT), value :: signal
+ SIGUSR2 = .true.
+
+ write(6,*) 'received signal ',signal, 'set SIGUSR2'
+  
+end subroutine setSIGUSR2
+
 
 !--------------------------------------------------------------------------------------------------
 !> @brief taken from IO, check IO_stringValue for documentation 
@@ -469,7 +508,6 @@ pure function IIO_stringPos(string)
  do while (verify(string(right+1:),SEP)>0)
    left  = right + verify(string(right+1:),SEP)
    right = left + scan(string(left:),SEP) - 2
-   if ( string(left:left) == '#' ) exit
    IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)]
    IIO_stringPos(1) = IIO_stringPos(1)+1_pInt
  enddo

src/system_routines.f90

@@ -3,11 +3,17 @@
 !> @brief    provides wrappers to C routines
 !--------------------------------------------------------------------------------------------------
 module system_routines
+ use, intrinsic :: ISO_C_Binding, only: &
+   C_INT, &
+   C_CHAR, &
+   C_NULL_CHAR
 
  implicit none
  private
  
  public :: &
+   signalusr1_C, &
+   signalusr2_C, &
    isDirectory, &
    getCWD, &
    getHostName, &
@@ -47,8 +53,19 @@ interface
    character(kind=C_CHAR), dimension(1024), intent(in) :: path                                      ! C string is an array
  end function chdir_C
  
-end interface
+ subroutine signalusr1_C(handler) bind(C)
+   use, intrinsic :: ISO_C_Binding, only: &
+     C_FUNPTR
+   type(C_FUNPTR), intent(in), value :: handler
+ end subroutine signalusr1_C
  
+  subroutine signalusr2_C(handler) bind(C)
+   use, intrinsic :: ISO_C_Binding, only: &
+     C_FUNPTR
+   type(C_FUNPTR), intent(in), value :: handler
+ end subroutine signalusr2_C
+
+end interface
 
 contains
 
@@ -56,14 +73,10 @@ 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
+ character(kind=C_CHAR), dimension(1024) :: strFixedLength                                         ! C string as array
  integer :: i 
 
  strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
@@ -79,10 +92,6 @@ end function isDirectory
 !> @brief gets the current working directory
 !--------------------------------------------------------------------------------------------------
 character(len=1024) function getCWD()
-  use, intrinsic :: ISO_C_Binding, only: &
-    C_INT, &
-    C_CHAR, &
-    C_NULL_CHAR
 
  implicit none
  character(kind=C_CHAR), dimension(1024) :: charArray                                               ! C string is an array
@@ -110,11 +119,6 @@ end function getCWD
 !> @brief gets the current host name
 !--------------------------------------------------------------------------------------------------
 character(len=1024) function getHostName()
-  use, intrinsic :: ISO_C_Binding, only: &
-    C_INT, &
-    C_CHAR, &
-    C_NULL_CHAR
-
  implicit none
  character(kind=C_CHAR), dimension(1024) :: charArray                                              ! C string is an array
  integer(C_INT) :: stat
@@ -136,15 +140,11 @@ character(len=1024) function getHostName()
 
 end function getHostName
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief changes the current working directory
 !--------------------------------------------------------------------------------------------------
 logical function setCWD(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                                          ! C string is an array