Skip to content
Snippets Groups Projects
Commit b05d4f91 authored by Antoine Cyril David Hoffmann's avatar Antoine Cyril David Hoffmann
Browse files

Now a file named "stop" in the sim dir stops to the current simulation

parent a6ace5a7
No related branches found
No related tags found
No related merge requests found
...@@ -39,7 +39,7 @@ MODULE basic ...@@ -39,7 +39,7 @@ MODULE basic
! List of logical file units ! List of logical file units
INTEGER :: lu_in = 90 ! File duplicated from STDIN INTEGER :: lu_in = 90 ! File duplicated from STDIN
INTEGER :: lu_job = 91 ! myjob file INTEGER :: lu_stop = 91 ! stop file, see subroutine TESEND
! To measure computation time ! To measure computation time
real :: start, finish real :: start, finish
......
...@@ -5,8 +5,10 @@ SUBROUTINE tesend ...@@ -5,8 +5,10 @@ SUBROUTINE tesend
use prec_const use prec_const
IMPLICIT NONE IMPLICIT NONE
LOGICAL :: mlend LOGICAL :: mlend, mlexist
real :: tnow REAL :: tnow
INTEGER :: ncheck_stop = 100
CHARACTER(len=*), PARAMETER :: stop_file = 'mystop'
!________________________________________________________________________________ !________________________________________________________________________________
! 1. Some processors had set nlend ! 1. Some processors had set nlend
...@@ -49,6 +51,19 @@ SUBROUTINE tesend ...@@ -49,6 +51,19 @@ SUBROUTINE tesend
IF(my_id.EQ.0) WRITE(*,'(/a)') 'Max run time reached' IF(my_id.EQ.0) WRITE(*,'(/a)') 'Max run time reached'
RETURN RETURN
END IF END IF
!________________________________________________________________________________
! 5. NRUN modified throught "stop file"
!
IF( (my_id .EQ. 0) .AND. (MOD(cstep, ncheck_stop) == 0) ) THEN
INQUIRE(file=stop_file, exist=mlexist)
IF( mlexist ) THEN
OPEN(lu_stop, file=stop_file)
mlend = mlexist ! Send stop status asa the file exists
WRITE(*,'(/a,i4,a)') 'Stop file found -> finishing..'
CLOSE(lu_stop, status='delete')
END IF
END IF
CALL mpi_allreduce(mlend, nlend, 1, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr)
! !
RETURN RETURN
! !
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment