File: RELATIVE:/../../../mfix.git/model/check_bqend.f

1     !----------------------------------------------------------------------!
2     !                                                                      !
3     !  Subroutine: CHECK_BATCH_QUEUE_END                                   !
4     !  Author: A.Gel                                      Date:            !
5     !                                                                      !
6     !  Purpose:                                                            !
7     !                                                                      !
8     !----------------------------------------------------------------------!
9           SUBROUTINE CHECK_BATCH_QUEUE_END(pEXIT_SIGNAL)
10     
11           use run, only: BATCH_WALLCLOCK
12           use run, only: TERM_BUFFER
13     
14           use mpi_utility, only: BCAST
15           use time_cpu, only: WALL_START
16     
17           use machine, only: WALL_TIME
18           use compar, only: PE_IO
19     
20           use error_manager
21     
22     
23           IMPLICIT NONE
24     
25           LOGICAL, INTENT(INOUT) :: pEXIT_SIGNAL
26     
27     ! Logical flags for hault cases.
28           LOGICAL :: USER_HAULT, WALL_HAULT
29     ! Elapsed wall time, and fancy formatted buffer/batch queue times.
30           DOUBLE PRECISION :: WALL_STOP, FANCY_BUFF, FANCY_BATCH
31     ! Time units for formatted output.
32           CHARACTER(LEN=4) :: WT_UNIT, BF_UNIT, BC_UNIT
33     
34     ! Calculate the current elapsed wall time.
35           WALL_STOP = WALL_TIME()
36           WALL_STOP = WALL_STOP - WALL_START
37     
38     ! Set flags for wall time exceeded or user specified hault.
39           WALL_HAULT = ((WALL_STOP+TERM_BUFFER) >= BATCH_WALLCLOCK)
40           INQUIRE(file="MFIX.STOP", exist=USER_HAULT)
41     
42     ! Report that the max user wall time was reached and exit.
43           IF(WALL_HAULT) THEN
44              CALL GET_TUNIT(WALL_STOP,WT_UNIT)
45              FANCY_BUFF = TERM_BUFFER
46              CALL GET_TUNIT(FANCY_BUFF, BF_UNIT)
47              FANCY_BATCH = BATCH_WALLCLOCK
48              CALL GET_TUNIT(FANCY_BATCH, BC_UNIT)
49              WRITE(ERR_MSG, 1100) WALL_STOP, WT_UNIT, FANCY_BUFF, BF_UNIT, &
50                 FANCY_BATCH, BC_UNIT
51              CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
52           ENDIF
53     
54      1100 FORMAT(2/,15('='),' REQUESTED CPU TIME LIMIT REACHED ',('='),/   &
55              'Batch Wall Time:',3X,F9.2,1X,A,/'Elapsed Wall Time: ',F9.2,  &
56              1X,A,/'Term Buffer:',7X,F9.2,A,/15('='),' REQUESTED CPU ',    &
57              'TIME LIMIT REACHED ',('='))
58     
59     ! Report that the hault signal was detected.
60           IF(USER_HAULT) THEN
61              WRITE(ERR_MSG, 1200)
62              CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
63           ENDIF
64     
65      1200 FORMAT(2/,19('='),' MFIX STOP SIGNAL DETECTED ',19('='),/'MFIX.',&
66              'STOP file detected in run directory. Terminating MFIX.',/    &
67              'Please DO NOT FORGET to erase the MFIX.STOP file before ',   &
68              'restarting',/19('='),'MFIX STOP SIGNAL DETECTED ',19('='))
69     
70     ! This routine was restructured so all MPI ranks to the same action. As
71     ! a result, broadcasting the BATCHQ flag may not be needed.
72           pEXIT_SIGNAL = (WALL_HAULT .OR. USER_HAULT) .OR. pEXIT_SIGNAL
73           call bcast (pEXIT_SIGNAL,PE_IO)
74     
75           END SUBROUTINE CHECK_BATCH_QUEUE_END
76