223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

signal handling implemented 

allows to trigger action in running simulation, i.e. writing restart or results
This commit is contained in:
Arko Jyoti Bhattacharjee 2019-02-11 18:46:14 +01:00
parent b0c20beefa
commit 1a471bcd8a
3 changed files with 125 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/C_routines.c
View File

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

42
src/DAMASK_interface.f90
View File

@ -12,9 +12,9 @@
module DAMASK_interface module DAMASK_interface
use prec, only: & use prec, only: &
pInt pInt
implicit none implicit none
private private
logical, public, protected :: SIGUSR1,SIGUSR2
integer(pInt), public, protected :: & integer(pInt), public, protected :: &
interface_restartInc = 0_pInt !< Increment at which calculation starts interface_restartInc = 0_pInt !< Increment at which calculation starts
character(len=1024), public, protected :: & character(len=1024), public, protected :: &
@ -42,6 +42,8 @@ contains
subroutine DAMASK_interface_init() subroutine DAMASK_interface_init()
use, intrinsic :: & use, intrinsic :: &
iso_fortran_env iso_fortran_env
use :: &
iso_c_binding
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
#if defined(__GFORTRAN__) && __GNUC__ < 5 #if defined(__GFORTRAN__) && __GNUC__ < 5
=================================================================================================== ===================================================================================================
@ -81,6 +83,8 @@ subroutine DAMASK_interface_init()
use PETScSys use PETScSys
use system_routines, only: & use system_routines, only: &
signalusr1_C, &
signalusr2_C, &
getHostName, & getHostName, &
getCWD getCWD
@ -229,6 +233,12 @@ subroutine DAMASK_interface_init()
if (interface_restartInc > 0_pInt) & if (interface_restartInc > 0_pInt) &
write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc 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 end subroutine DAMASK_interface_init
@ -412,6 +422,35 @@ character(len=1024) function makeRelativePath(a,b)
end function makeRelativePath 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 !> @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) do while (verify(string(right+1:),SEP)>0)
left = right + verify(string(right+1:),SEP) left = right + verify(string(right+1:),SEP)
right = left + scan(string(left:),SEP) - 2 right = left + scan(string(left:),SEP) - 2
if ( string(left:left) == '#' ) exit
IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)] IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)]
IIO_stringPos(1) = IIO_stringPos(1)+1_pInt IIO_stringPos(1) = IIO_stringPos(1)+1_pInt
enddo enddo

146
src/system_routines.f90
View File

@ -3,11 +3,17 @@
!> @brief provides wrappers to C routines !> @brief provides wrappers to C routines
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module system_routines module system_routines
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none implicit none
private private
public :: & public :: &
signalusr1_C, &
signalusr2_C, &
isDirectory, & isDirectory, &
getCWD, & getCWD, &
getHostName, & getHostName, &
@ -27,7 +33,7 @@ interface
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_INT, & C_INT, &
C_CHAR 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 integer(C_INT),intent(out) :: stat
end subroutine getCurrentWorkDir_C end subroutine getCurrentWorkDir_C
@ -35,7 +41,7 @@ interface
use, intrinsic :: ISO_C_Binding, only: & use, intrinsic :: ISO_C_Binding, only: &
C_INT, & C_INT, &
C_CHAR 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 integer(C_INT),intent(out) :: stat
end subroutine getHostName_C end subroutine getHostName_C
@ -47,8 +53,19 @@ interface
character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array
end function chdir_C 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 contains
@ -56,21 +73,17 @@ contains
!> @brief figures out if a given path is a directory (and not an ordinary file) !> @brief figures out if a given path is a directory (and not an ordinary file)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function isDirectory(path) logical function isDirectory(path)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none implicit none
character(len=*), intent(in) :: path 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 integer :: i
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i) strFixedLength(i)=path(i:i)
enddo enddo
isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT) isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT)
end function isDirectory end function isDirectory
@ -79,29 +92,25 @@ end function isDirectory
!> @brief gets the current working directory !> @brief gets the current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=1024) function getCWD() character(len=1024) function getCWD()
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none implicit none
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat integer(C_INT) :: stat
integer :: i integer :: i
call getCurrentWorkDir_C(charArray,stat) call getCurrentWorkDir_C(charArray,stat)
if (stat /= 0_C_INT) then if (stat /= 0_C_INT) then
getCWD = 'Error occured when getting currend working directory' getCWD = 'Error occured when getting currend working directory'
else else
getCWD = repeat('',len(getCWD)) getCWD = repeat('',len(getCWD))
arrayToString: do i=1,len(getCWD) arrayToString: do i=1,len(getCWD)
if (charArray(i) /= C_NULL_CHAR) then if (charArray(i) /= C_NULL_CHAR) then
getCWD(i:i)=charArray(i) getCWD(i:i)=charArray(i)
else else
exit exit
endif endif
enddo arrayToString enddo arrayToString
endif endif
end function getCWD end function getCWD
@ -110,51 +119,42 @@ end function getCWD
!> @brief gets the current host name !> @brief gets the current host name
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=1024) function getHostName() character(len=1024) function getHostName()
use, intrinsic :: ISO_C_Binding, only: & implicit none
C_INT, & character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
C_CHAR, & integer(C_INT) :: stat
C_NULL_CHAR integer :: i
implicit none call getHostName_C(charArray,stat)
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array if (stat /= 0_C_INT) then
integer(C_INT) :: stat getHostName = 'Error occured when getting host name'
integer :: i else
getHostName = repeat('',len(getHostName))
call getHostName_C(charArray,stat) arrayToString: do i=1,len(getHostName)
if (stat /= 0_C_INT) then if (charArray(i) /= C_NULL_CHAR) then
getHostName = 'Error occured when getting host name' getHostName(i:i)=charArray(i)
else else
getHostName = repeat('',len(getHostName)) exit
arrayToString: do i=1,len(getHostName) endif
if (charArray(i) /= C_NULL_CHAR) then enddo arrayToString
getHostName(i:i)=charArray(i) endif
else
exit
endif
enddo arrayToString
endif
end function getHostName end function getHostName
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief changes the current working directory !> @brief changes the current working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function setCWD(path) logical function setCWD(path)
use, intrinsic :: ISO_C_Binding, only: & implicit none
C_INT, & character(len=*), intent(in) :: path
C_CHAR, & character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
C_NULL_CHAR integer :: i
implicit none strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
character(len=*), intent(in) :: path do i=1,len(path) ! copy array components
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array strFixedLength(i)=path(i:i)
integer :: i enddo
setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
end function setCWD end function setCWD