C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_status_error.F,v 1.1 2013/08/14 00:54:45 jmc Exp $ C $Name: $ #include "DIAG_OPTIONS.h" C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP 0 C !ROUTINE: DIAGNOSTICS_STATUS_ERROR C !INTERFACE: SUBROUTINE DIAGNOSTICS_STATUS_ERROR ( I callerSubR, errMsg, diagName, I expectStatus, myThid ) C !DESCRIPTION: C Routine to print the appropriate error message when one of the public C diagnostics interface S/R (e.g., DIAGNOSTICS_ADDTOLIST or one of the C DIAGNOSTICS_[]_FILL S/R) is called at the wrong place in the sequence C of calls (initialisation stages or time-stepping part). C !USES: IMPLICIT NONE #include "SIZE.h" #include "EEPARAMS.h" C- needed to get "useFizhi": #include "PARAMS.h" #include "DIAGNOSTICS_SIZE.h" #include "DIAGNOSTICS.h" C !INPUT PARAMETERS: C callerSubR :: name of subroutine which is calling this S/R C errMsg :: additional error message to print C diagName :: diagnostic name (if relevant for this call) C expectStatus :: expected pkg-status when this S/R is called C myThid :: my Thread Id number CHARACTER*(*) callerSubR CHARACTER*(*) errMsg CHARACTER*8 diagName INTEGER expectStatus INTEGER myThid CEOP C !LOCAL VARIABLES: C msgBuf :: Informational/error message buffer CHARACTER*(MAX_LEN_MBUF) msgBuf C-- Initialise _BEGIN_MASTER( myThid) C-- Check if this S/R is called from the right place WRITE(msgBuf,'(4A)') '*** DIAGNOSTICS_STATUS_ERROR ***', & ' from: ', callerSubR, ' call' CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, & SQUEEZE_RIGHT, myThid ) IF ( diagName.EQ.blkName ) THEN WRITE(msgBuf,'(1A,2(A,I3),2A)') callerSubR, & ': expectStatus=', expectStatus, & ', pkgStatus=', diag_pkgStatus, ' : ', errMsg CALL PRINT_ERROR( msgBuf, myThid ) ELSE WRITE(msgBuf,'(3A,2(A,I3))') callerSubR, & ': diagName="', diagName, '", expectStatus=', & expectStatus, ', pkgStatus=', diag_pkgStatus CALL PRINT_ERROR( msgBuf, myThid ) ENDIF IF ( diag_pkgStatus.EQ.-1 ) THEN WRITE(msgBuf,'(4A)') callerSubR, & ': cannot be used if useDiagnostics=FALSE (data.pkg)' CALL PRINT_ERROR( msgBuf, myThid ) IF ( .NOT.useFizhi ) & STOP 'ABNORMAL END: S/R DIAGNOSTICS_STATUS_ERROR' ELSEIF ( diag_pkgStatus.GT.expectStatus ) THEN C-- case pkgStatus > expectStatus WRITE(msgBuf,'(3A)') callerSubR, & ': <== called from the WRONG place, i.e.' CALL PRINT_ERROR( msgBuf, myThid ) IF ( expectStatus.EQ.1 ) THEN WRITE(msgBuf,'(3A)') callerSubR, ': after ', & 'DIAGNOSTICS_INIT_EARLY call in PACKAGES_INIT_FIXED' ELSEIF ( expectStatus.EQ.2 ) THEN WRITE(msgBuf,'(3A)') callerSubR, ': after ', & 'DIAGNOSTICS_INIT_FIXED call in PACKAGES_INIT_FIXED' ELSEIF ( expectStatus.EQ.3 ) THEN WRITE(msgBuf,'(3A)') callerSubR, ': after ', & 'DIAGNOSTICS_INIT_VARIA call in PACKAGES_INIT_VARIABLES' ELSEIF ( expectStatus.EQ.10 ) THEN WRITE(msgBuf,'(3A)') callerSubR, ': after ', & 'DIAGNOSTICS_SWITCH_ONOFF call in FORWARD_STEP' ELSE WRITE(msgBuf,'(3A)') callerSubR, ': after ', & 'the last DIAGNOSTICS_WRITE call in DO_THE_MODEL_IO' ENDIF CALL PRINT_ERROR( msgBuf, myThid ) STOP 'ABNORMAL END: S/R DIAGNOSTICS_STATUS_ERROR' ELSEIF ( diag_pkgStatus.GE.1 ) THEN C-- case pkgStatus < expectStatus WRITE(msgBuf,'(2A)') callerSubR, & ': <== called from the WRONG place, i.e.' CALL PRINT_ERROR( msgBuf, myThid ) IF ( expectStatus.EQ.2 ) THEN WRITE(msgBuf,'(3A)') callerSubR, ': before ', & 'DIAGNOSTICS_INIT_EARLY call in PACKAGES_INIT_FIXED' ELSEIF ( expectStatus.EQ.3 ) THEN WRITE(msgBuf,'(3A)') callerSubR, ': before ', & 'DIAGNOSTICS_INIT_FIXED call in PACKAGES_INIT_FIXED' ELSEIF ( expectStatus.EQ.10 ) THEN WRITE(msgBuf,'(3A)') callerSubR, ': before ', & 'DIAGNOSTICS_INIT_VARIA call in PACKAGES_INIT_VARIABLES' ELSEIF ( expectStatus.EQ.20 ) THEN WRITE(msgBuf,'(3A)') callerSubR, ': before ', & 'DIAGNOSTICS_SWITCH_ONOFF call in FORWARD_STEP' ELSE WRITE(msgBuf,'(3A)') callerSubR, ': before ', & 'the last DIAGNOSTICS_WRITE call in DO_THE_MODEL_IO' ENDIF CALL PRINT_ERROR( msgBuf, myThid ) IF ( .NOT.useFizhi ) & STOP 'ABNORMAL END: S/R DIAGNOSTICS_STATUS_ERROR' ELSE C-- case pkgStatus < 1 (most likely: pkgStatus=0 ) WRITE(msgBuf,'(4A)') callerSubR, & ': called but nothing set in pkg/diagnostics' CALL PRINT_ERROR( msgBuf, myThid ) STOP 'ABNORMAL END: S/R DIAGNOSTICS_STATUS_ERROR' ENDIF _END_MASTER( myThid ) RETURN END