** Warning **
Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.
Last-Modified: Sun, 30 May 2026 05:09:18 GMT
Content-Type: text/html; charset=utf-8
MITgcm/MITgcm/pkg/diagnostics/diagnostics_status_error.F
File indexing completed on 2018-03-02 18:39:03 UTC
view on github raw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
e5b461e586 Jean* 0001 #include "DIAG_OPTIONS.h "
0002
0003
0004
0005
0006
0007
0008 SUBROUTINE DIAGNOSTICS_STATUS_ERROR (
0009 I callerSubR , errMsg , diagName ,
0010 I expectStatus , myThid )
0011
0012
0013
0014
0015
0016
0017
0018
0019 IMPLICIT NONE
0020 #include "SIZE.h "
0021 #include "EEPARAMS.h "
0022
0023 #include "PARAMS.h "
0024 #include "DIAGNOSTICS_SIZE.h "
0025 #include "DIAGNOSTICS.h "
0026
0027
0028
0029
0030
0031
0032
0033 CHARACTER *(*) callerSubR
0034 CHARACTER *(*) errMsg
0035 CHARACTER *8 diagName
0036 INTEGER expectStatus
0037 INTEGER myThid
0038
0039
0040
0041
0042 CHARACTER *(MAX_LEN_MBUF ) msgBuf
0043
0044
0045
0046 _BEGIN_MASTER ( myThid )
0047
0048
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
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
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
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