pkg/diagnostics/diagnostics_status_error.F

e5b461e586 Jean*0001 #include "DIAG_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: DIAGNOSTICS_STATUS_ERROR
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE DIAGNOSTICS_STATUS_ERROR (
                0009      I                       callerSubR, errMsg, diagName,
                0010      I                       expectStatus, myThid )
                0011
                0012 C     !DESCRIPTION:
                0013 C     Routine to print the appropriate error message when one of the public
                0014 C     diagnostics interface S/R (e.g., DIAGNOSTICS_ADDTOLIST or one of the
                0015 C     DIAGNOSTICS_[]_FILL S/R) is called at the wrong place in the sequence
                0016 C     of calls (initialisation stages or time-stepping part).
                0017
                0018 C     !USES:
                0019        IMPLICIT NONE
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 C- needed to get "useFizhi":
                0023 #include "PARAMS.h"
                0024 #include "DIAGNOSTICS_SIZE.h"
                0025 #include "DIAGNOSTICS.h"
                0026
                0027 C     !INPUT PARAMETERS:
                0028 C     callerSubR   :: name of subroutine which is calling this S/R
                0029 C     errMsg       :: additional error message to print
                0030 C     diagName     :: diagnostic name (if relevant for this call)
                0031 C     expectStatus :: expected pkg-status when this S/R is called
                0032 C     myThid       :: my Thread Id number
                0033       CHARACTER*(*) callerSubR
                0034       CHARACTER*(*) errMsg
                0035       CHARACTER*8   diagName
                0036       INTEGER expectStatus
                0037       INTEGER myThid
                0038 CEOP
                0039
                0040 C     !LOCAL VARIABLES:
                0041 C     msgBuf :: Informational/error message buffer
                0042       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0043
                0044 C--   Initialise
                0045
                0046       _BEGIN_MASTER( myThid)
                0047
                0048 C--   Check if this S/R is called from the right place
                0049       WRITE(msgBuf,'(4A)') '*** DIAGNOSTICS_STATUS_ERROR ***',
                0050      &                     ' from: ', callerSubR, ' call'
                0051       CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0052      &                    SQUEEZE_RIGHT, myThid )
                0053       IF ( diagName.EQ.blkName ) THEN
                0054         WRITE(msgBuf,'(1A,2(A,I3),2A)') callerSubR,
                0055      &     ': expectStatus=', expectStatus,
                0056      &     ', pkgStatus=',  diag_pkgStatus, ' : ', errMsg
                0057         CALL PRINT_ERROR( msgBuf, myThid )
                0058       ELSE
                0059         WRITE(msgBuf,'(3A,2(A,I3))') callerSubR,
                0060      &     ': diagName="', diagName, '", expectStatus=',
                0061      &     expectStatus, ', pkgStatus=', diag_pkgStatus
                0062         CALL PRINT_ERROR( msgBuf, myThid )
                0063       ENDIF
                0064
                0065       IF ( diag_pkgStatus.EQ.-1 ) THEN
                0066         WRITE(msgBuf,'(4A)') callerSubR,
                0067      &    ': cannot be used if useDiagnostics=FALSE (data.pkg)'
                0068         CALL PRINT_ERROR( msgBuf, myThid )
                0069         IF ( .NOT.useFizhi )
                0070      &  STOP 'ABNORMAL END: S/R DIAGNOSTICS_STATUS_ERROR'
                0071       ELSEIF ( diag_pkgStatus.GT.expectStatus ) THEN
                0072 C--   case pkgStatus > expectStatus
                0073         WRITE(msgBuf,'(3A)') callerSubR,
                0074      &    ': <== called from the WRONG place, i.e.'
                0075         CALL PRINT_ERROR( msgBuf, myThid )
                0076         IF ( expectStatus.EQ.1 ) THEN
                0077          WRITE(msgBuf,'(3A)') callerSubR, ': after ',
                0078      &    'DIAGNOSTICS_INIT_EARLY call in PACKAGES_INIT_FIXED'
                0079         ELSEIF ( expectStatus.EQ.2 ) THEN
                0080          WRITE(msgBuf,'(3A)') callerSubR, ': after ',
                0081      &    'DIAGNOSTICS_INIT_FIXED call in PACKAGES_INIT_FIXED'
                0082         ELSEIF ( expectStatus.EQ.3 ) THEN
                0083          WRITE(msgBuf,'(3A)') callerSubR, ': after ',
                0084      &    'DIAGNOSTICS_INIT_VARIA call in PACKAGES_INIT_VARIABLES'
                0085         ELSEIF ( expectStatus.EQ.10 ) THEN
                0086          WRITE(msgBuf,'(3A)') callerSubR, ': after ',
                0087      &    'DIAGNOSTICS_SWITCH_ONOFF call in FORWARD_STEP'
                0088         ELSE
                0089          WRITE(msgBuf,'(3A)') callerSubR, ': after ',
                0090      &    'the last DIAGNOSTICS_WRITE call in DO_THE_MODEL_IO'
                0091         ENDIF
                0092         CALL PRINT_ERROR( msgBuf, myThid )
                0093         STOP 'ABNORMAL END: S/R DIAGNOSTICS_STATUS_ERROR'
                0094       ELSEIF ( diag_pkgStatus.GE.1 ) THEN
                0095 C--   case pkgStatus < expectStatus
                0096         WRITE(msgBuf,'(2A)') callerSubR,
                0097      &    ': <== called from the WRONG place, i.e.'
                0098         CALL PRINT_ERROR( msgBuf, myThid )
                0099         IF ( expectStatus.EQ.2 ) THEN
                0100          WRITE(msgBuf,'(3A)') callerSubR, ': before ',
                0101      &    'DIAGNOSTICS_INIT_EARLY call in PACKAGES_INIT_FIXED'
                0102         ELSEIF ( expectStatus.EQ.3 ) THEN
                0103          WRITE(msgBuf,'(3A)') callerSubR, ': before ',
                0104      &    'DIAGNOSTICS_INIT_FIXED call in PACKAGES_INIT_FIXED'
                0105         ELSEIF ( expectStatus.EQ.10 ) THEN
                0106          WRITE(msgBuf,'(3A)') callerSubR, ': before ',
                0107      &    'DIAGNOSTICS_INIT_VARIA call in PACKAGES_INIT_VARIABLES'
                0108         ELSEIF ( expectStatus.EQ.20 ) THEN
                0109          WRITE(msgBuf,'(3A)') callerSubR, ': before ',
                0110      &    'DIAGNOSTICS_SWITCH_ONOFF call in FORWARD_STEP'
                0111         ELSE
                0112          WRITE(msgBuf,'(3A)') callerSubR, ': before ',
                0113      &    'the last DIAGNOSTICS_WRITE call in DO_THE_MODEL_IO'
                0114         ENDIF
                0115         CALL PRINT_ERROR( msgBuf, myThid )
                0116         IF ( .NOT.useFizhi )
                0117      &  STOP 'ABNORMAL END: S/R DIAGNOSTICS_STATUS_ERROR'
                0118       ELSE
                0119 C--   case pkgStatus < 1 (most likely: pkgStatus=0 )
                0120         WRITE(msgBuf,'(4A)') callerSubR,
                0121      &        ': called but nothing set in pkg/diagnostics'
                0122         CALL PRINT_ERROR( msgBuf, myThid )
                0123         STOP 'ABNORMAL END: S/R DIAGNOSTICS_STATUS_ERROR'
                0124       ENDIF
                0125
                0126       _END_MASTER( myThid )
                0127
                0128       RETURN
                0129       END