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