pkg/diagnostics/diagnostics_addtolist.F

931cda44c0 Jean*0001 #include "DIAG_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: DIAGNOSTICS_ADDTOLIST
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE DIAGNOSTICS_ADDTOLIST (
                0009      O     diagNum,
                0010      I     diagName, diagCode, diagUnits, diagTitle, diagMate,
                0011      I     myThid )
                0012
                0013 C     !DESCRIPTION:
                0014 C     routine to add 1 diagnostics to the list of available diagnostics:
                0015 C     set the attributes:
                0016 C     name (=cdiag), parsing code (=gdiag), units (=udiag), title (=tdiag)
                0017 C     and diagnostic mate number (=hdiag) of the new diagnostic and
                0018 C     update the total number of available diagnostics
                0019 C     Note: needs to be called after DIAGNOSTICS_INIT_EARLY
                0020 C                         and before DIAGNOSTICS_INIT_FIXED
                0021
                0022 C     !USES:
                0023        IMPLICIT NONE
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "DIAGNOSTICS_SIZE.h"
                0027 #include "DIAGNOSTICS.h"
                0028
                0029 C     !INPUT PARAMETERS:
                0030 C     diagName  :: diagnostic name to declare
                0031 C     diagCode  :: parser code for this diagnostic
                0032 C     diagUnits :: field units for this diagnostic
                0033 C     diagTitle :: field description for this diagnostic
                0034 C     diagMate  :: diagnostic mate number
                0035 C     myThid    :: my Thread Id number
                0036       CHARACTER*8   diagName
                0037       CHARACTER*16  diagCode
                0038       CHARACTER*16  diagUnits
                0039       CHARACTER*(*) diagTitle
                0040       INTEGER diagMate
                0041       INTEGER myThid
                0042
                0043 C     !OUTPUT PARAMETERS:
                0044 C     numDiag :: diagnostic number in the list of available diagnostics
                0045       INTEGER diagNum
                0046 CEOP
                0047
                0048 C     !LOCAL VARIABLES:
698bc6a39a Jean*0049 C     msgBuf :: Informational/error message buffer
931cda44c0 Jean*0050       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0051       INTEGER n
                0052
                0053 C--   Initialise
                0054       diagNum = 0
                0055
                0056       _BEGIN_MASTER( myThid)
                0057
a0bbeea03c Jean*0058 C--   Check if this S/R is called from the right place ;
                0059 C     needs to be after DIAGNOSTICS_INIT_EARLY and before DIAGNOSTICS_INIT_FIXED
8a1f6fb317 Jean*0060       IF ( diag_pkgStatus.NE.ready2setDiags ) THEN
                0061         CALL DIAGNOSTICS_STATUS_ERROR( 'DIAGNOSTICS_ADDTOLIST',
                0062      &                   ' ', diagName, ready2setDiags, myThid )
a0bbeea03c Jean*0063       ENDIF
                0064
931cda44c0 Jean*0065 C--   Search for "diagName" in the list of available diagnostics:
                0066       DO n=1,ndiagt
                0067        IF ( cdiag(n).EQ.diagName ) THEN
                0068          diagNum = n
                0069          IF ( gdiag(n).EQ.diagCode .AND. hdiag(n).EQ.diagMate ) THEN
                0070 C-    diagnostics is already defined and has the same characteristics
                0071           WRITE(msgBuf,'(3A,I6,A)') 'DIAGNOSTICS_ADDTOLIST: diag=',
                0072      &     diagName,' is already defined (# ',n,' )'
                0073           CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0074      &                        SQUEEZE_RIGHT , myThid)
                0075           WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_ADDTOLIST:',
                0076      &     ' with same parser => update Title & Units '
                0077           CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0078      &                        SQUEEZE_RIGHT , myThid)
                0079           udiag(diagNum) = diagUnits
                0080           tdiag(diagNum) = diagTitle
                0081          ELSE
                0082 C-    diagnostics is already defined but with different characteristics
                0083           WRITE(msgBuf,'(3A,I6,A)') 'DIAGNOSTICS_ADDTOLIST: diag=',
                0084      &     diagName,' is already defined (# ',n,' )'
                0085           CALL PRINT_ERROR( msgBuf , myThid)
                0086           WRITE(msgBuf,'(4A,I6)')   'DIAGNOSTICS_ADDTOLIST: cannot ',
                0087      &     'change parser="',gdiag(n),'" & mate=',hdiag(n)
                0088           CALL PRINT_ERROR( msgBuf , myThid)
                0089           WRITE(msgBuf,'(4A,I6,A)') 'DIAGNOSTICS_ADDTOLIST:',
                0090      &     '  to : "',diagCode,'" and mate=',diagMate,' ; => STOP'
                0091           CALL PRINT_ERROR( msgBuf , myThid)
                0092           STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADDTOLIST'
                0093          ENDIF
                0094        ENDIF
                0095       ENDDO
                0096
                0097 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0098
                0099       IF ( diagNum.EQ.0 ) THEN
                0100 C--   Add one diagnostic to the list of available diagnostics:
                0101        diagNum = ndiagt + 1
                0102
                0103        IF ( diagNum .LE. ndiagMax ) THEN
                0104         cdiag(diagNum) = diagName
                0105         gdiag(diagNum) = diagCode
                0106         hdiag(diagNum) = diagMate
                0107         udiag(diagNum) = diagUnits
                0108         tdiag(diagNum) = diagTitle
                0109         ndiagt = diagNum
                0110        ELSE
                0111         WRITE(msgBuf,'(2A,I6)') 'DIAGNOSTICS_ADDTOLIST:',
                0112      &   ' Exceed Max.Number of diagnostics ndiagMax=', ndiagMax
                0113         CALL PRINT_ERROR( msgBuf , myThid)
                0114         WRITE(msgBuf,'(2A)')
                0115      &   'DIAGNOSTICS_ADDTOLIST: when setting diagnostic: ',diagName
                0116         CALL PRINT_ERROR( msgBuf , myThid)
                0117         STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADDTOLIST'
                0118        ENDIF
                0119
                0120       ENDIF
                0121
                0122       _END_MASTER( myThid )
                0123
                0124       RETURN
                0125       END