|
||||
File indexing completed on 2018-03-02 18:38:30 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTCbe1eeeb849 Jean*0001 CBOP 0002 C !INTERFACE: 0003 SUBROUTINE MITCPLR_ALL_CHECK( errFlag, errMsg ) 0004 0005 C !DESCRIPTION: 0006 C *==========================================================* 0007 C | SUBROUTINE MITCPLR_ALL_CHECK 0008 C | o Stop every Processes in World if flag is true 0009 C *==========================================================* 0010 C | Gather error-flag from all processes in World and 0011 C | stop if one is in error. This assumes that every-one 0012 C | (all coupler procs and all components) call this routine 0013 C *==========================================================* 0014 0015 IMPLICIT NONE 0016 0017 C Predefined constants/arrays 0018 #include "CPLR_SIG.h" 0019 C MPI variables 0020 #include "mpif.h" 0021 0022 C !INPUT/OUTPUT PARAMETERS: 0023 C errFlag :: stop if this logical flag is true 0024 C errMsg :: error message to print in case it stops 0025 LOGICAL errFlag 0026 CHARACTER*(*) errMsg 0027 0028 C !LOCAL VARIABLES: 0029 C msgBuf :: I/O Buffer 0030 C errCount :: error counter 0031 c CHARACTER*(MAX_LEN_MBUF) msgBuf 0032 INTEGER errCount, errLoc, mpiRC 0033 CEOP 0034 0035 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0036 0037 C-- Collect error from all Procs 0038 errLoc = 0 0039 IF ( errFlag ) THEN 0040 errLoc = 1 0041 ENDIF 0042 CALL MPI_Allreduce( errLoc, errCount, 1, MPI_INTEGER, MPI_SUM, 0043 & MPI_COMM_WORLD, mpiRC ) 0044 0045 IF ( errCount.GE.1 ) THEN 0046 C-- Print message 0047 IF ( errFlag .AND. errMsg.NE.' ' ) THEN 0048 WRITE(LogUnit,'(2A)') ' *** ERROR *** ', errMsg 0049 ENDIF 0050 WRITE(LogUnit,'(A,I8,A)') 0051 & 'FATAL ERROR for ', errCount, ' Proc(s) ==> Stop here' 0052 C-- Finishes 0053 c CALL ALL_PROC_DIE( myThid ) 0054 CALL MPI_FINALIZE( mpiRC ) 0055 STOP 'ABNORMAL END: S/R MITCPLR_ALL_CHECK' 0056 ENDIF 0057 0058 RETURN 0059 END
[ Source navigation ] | [ Diff markup ] | [ Identifier search ] | [ general search ] |
This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine. The LXR team |