diff --git a/src/basic_mod.F90 b/src/basic_mod.F90
index 29f0d4f0cc46573dd8c0fb09eec9905020c43325..599fefbcc97546de9d813059fc0c9c1cb315ca91 100644
--- a/src/basic_mod.F90
+++ b/src/basic_mod.F90
@@ -39,7 +39,7 @@ MODULE basic
 
   !  List of logical file units
   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
   real     :: start, finish
diff --git a/src/tesend.F90 b/src/tesend.F90
index a07955066ae33eb4a9a5625aa5a10e068ef3bad9..16ef0764513719474a401b01ff7c06e74a14184f 100644
--- a/src/tesend.F90
+++ b/src/tesend.F90
@@ -5,8 +5,10 @@ SUBROUTINE tesend
 
   use prec_const
   IMPLICIT NONE
-  LOGICAL :: mlend
-  real    :: tnow
+  LOGICAL :: mlend, mlexist
+  REAL    :: tnow
+  INTEGER :: ncheck_stop = 100
+  CHARACTER(len=*), PARAMETER :: stop_file = 'mystop'
 
   !________________________________________________________________________________
   !                   1.  Some processors had set nlend
@@ -49,6 +51,19 @@ SUBROUTINE tesend
      IF(my_id.EQ.0) WRITE(*,'(/a)') 'Max run time reached'
      RETURN
   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
   !