pkg/diagnostics/diagstats_output.F

3e5de6a370 Jean*0001 #include "DIAG_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: DIAGSTATS_OUTPUT
                0006
                0007 C     !INTERFACE:
ab01bc8ab2 Jean*0008       SUBROUTINE DIAGSTATS_OUTPUT(
3e5de6a370 Jean*0009      I     listId,
f7d6890156 Ed H*0010      I     myTime, myIter, myThid )
3e5de6a370 Jean*0011
                0012 C     !DESCRIPTION:
                0013 C     Write output for diagnostics fields.
3ae5f90260 Jean*0014
3e5de6a370 Jean*0015 C     !USES:
                0016       IMPLICIT NONE
                0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
                0020 #include "GRID.h"
                0021 #include "DIAGNOSTICS_SIZE.h"
                0022 #include "DIAGNOSTICS.h"
                0023
                0024       INTEGER nLev
5f3f8cd7a5 Jean*0025       PARAMETER( nLev = numLevels )
3e5de6a370 Jean*0026
                0027 C     !INPUT PARAMETERS:
430053b70d Ed H*0028 C     listId  :: Diagnostics list number being written
3e5de6a370 Jean*0029 C     myIter  :: current iteration number
430053b70d Ed H*0030 C     myTime  :: Current time of simulation (s)
3e5de6a370 Jean*0031 C     myThid  :: my Thread Id number
f7d6890156 Ed H*0032       _RL     myTime
                0033       INTEGER listId, myIter, myThid
3e5de6a370 Jean*0034 CEOP
                0035
f8e6aa21ed Jean*0036 C     !FUNCTIONS:
                0037 c     INTEGER ILNBLNK
                0038 c     EXTERNAL ILNBLNK
                0039 #ifdef ALLOW_FIZHI
                0040       _RL   getcon
                0041       EXTERNAL getcon
                0042 #endif
                0043
3e5de6a370 Jean*0044 C     !LOCAL VARIABLES:
3ae5f90260 Jean*0045       INTEGER j, m, ndId, iSp, iSm
931cda44c0 Jean*0046       CHARACTER*10 gcode
3e5de6a370 Jean*0047       INTEGER mate
                0048       _RL statGlob(0:nStats,0:nLev,0:nRegions)
                0049       _RL tmp_Glob(0:nStats,0:nLev)
f8e6aa21ed Jean*0050       _RL undef
3e5de6a370 Jean*0051
                0052       INTEGER ioUnit
                0053       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0054
                0055 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0056
                0057       ioUnit= standardMessageUnit
f8e6aa21ed Jean*0058       undef = UNSET_RL
                0059 #ifdef ALLOW_FIZHI
                0060       IF ( useFIZHI ) undef = getcon('UNDEF')
                0061 #endif
3e5de6a370 Jean*0062
                0063       DO m = 1,diagSt_nbFlds(listId)
                0064        ndId = jSdiag(m,listId)
931cda44c0 Jean*0065        gcode = gdiag(ndId)(1:10)
                0066        IF ( iSdiag(m,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN
3e5de6a370 Jean*0067 C--    Start processing 1 Fld :
                0068
931cda44c0 Jean*0069          IF ( gcode(5:5).EQ.'C' ) THEN
3e5de6a370 Jean*0070 C          Check for Mate of a Counter Diagnostic
                0071 C          --------------------------------------
931cda44c0 Jean*0072            mate = hdiag(ndId)
3e5de6a370 Jean*0073          ELSE
                0074            mate = 0
                0075          ENDIF
                0076
                0077          DO j=0,nRegions
                0078           IF ( diagSt_region(j,listId).GT.0 ) THEN
3ae5f90260 Jean*0079             iSp = ABS(iSdiag(m,listId))
                0080             iSm = mSdiag(m,listId)
3e5de6a370 Jean*0081             CALL DIAGSTATS_GLOBAL(
                0082      O                       statGlob(0,0,j), tmp_Glob,
3ae5f90260 Jean*0083      I                       undef, nLev, j,
                0084      I                       ndId, mate, iSp, iSm, myThid )
3e5de6a370 Jean*0085
                0086 C-          Check for empty Diag (= not filled or using empty mask)
bb07131fcb Jean*0087             IF ( tmp_Glob(0,0).EQ.0. ) THEN
3e5de6a370 Jean*0088              _BEGIN_MASTER( myThid )
acacc28f7f Jean*0089              WRITE(msgBuf,'(2A,I10,A,I4)') '- WARNING -',
                0090      &         ' from DIAGSTATS_OUTPUT at iter=', myIter,
                0091      &         ' , region:', j
3e5de6a370 Jean*0092              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
acacc28f7f Jean*0093      &                           SQUEEZE_RIGHT, myThid )
                0094              WRITE(msgBuf,'(2A,I6,3A,I4,2A)') '- WARNING -',
                0095      &         ' diagSt.#', ndId, ' : ', diagSt_Flds(m,listId),
                0096      &         ' (#', m, ' ) in outp.Stream: ', diagSt_Fname(listId)
3e5de6a370 Jean*0097              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
acacc28f7f Jean*0098      &                           SQUEEZE_RIGHT, myThid )
5f3f8cd7a5 Jean*0099              IF ( kdiag(ndId).GT.nLev ) THEN
                0100               WRITE(msgBuf,'(2(A,I4))') '- WARNING - kdiag=',
                0101      &                     kdiag(ndId), ' exceeds local nLev=', nLev
                0102              ELSE
                0103               WRITE(msgBuf,'(2A)') '- WARNING - has not been filled,',
                0104      &                             ' OR using empty mask/region'
                0105              ENDIF
3e5de6a370 Jean*0106              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
acacc28f7f Jean*0107      &                           SQUEEZE_RIGHT, myThid )
3e5de6a370 Jean*0108              WRITE(msgBuf,'(A)')
acacc28f7f Jean*0109      &         'WARNING DIAGSTATS_OUTPUT  => write UNDEF instead'
3e5de6a370 Jean*0110              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
acacc28f7f Jean*0111      &                           SQUEEZE_RIGHT, myThid )
3e5de6a370 Jean*0112              _END_MASTER( myThid )
                0113             ENDIF
                0114
41c4545f8f Jean*0115             IF ( diag_dBugLevel .GE. debLevB ) THEN
3e5de6a370 Jean*0116              _BEGIN_MASTER( myThid )
acacc28f7f Jean*0117               WRITE(ioUnit,'(A,I6,3A,I3,3A,I3,A,1PE10.3)')
                0118      &          ' Compute Stats, Diag. #', ndId, ' "', cdiag(ndId),
                0119      &          '" (list#', listId, ') Parms "', gdiag(ndId),
                0120      &          '", vol(',j,' )=', statGlob(0,0,j)
3e5de6a370 Jean*0121              IF ( mate.GT.0 ) THEN
acacc28f7f Jean*0122               WRITE(ioUnit,'(A,I6,3A,I3,2(A,1PE10.3))')
                0123      &          '     use Counter Mate #', mate, ' "', cdiag(mate),
                0124      &          '" vol(',j,' )=', tmp_Glob(0,0),
                0125      &          ', integral=', tmp_Glob(1,0)
3e5de6a370 Jean*0126              ENDIF
                0127              _END_MASTER( myThid )
                0128             ENDIF
                0129           ENDIF
                0130          ENDDO
                0131
106a65ba8a Ed H*0132 C--      Write to ASCII file:
3e5de6a370 Jean*0133          IF (diagSt_Ascii) THEN
                0134            CALL DIAGSTATS_ASCII_OUT( statGlob, nLev, ndId,
                0135      &                               m, listId, myIter, myThid )
                0136          ENDIF
                0137
2249cb9b23 Andr*0138 #ifdef ALLOW_MNC
106a65ba8a Ed H*0139          IF (diagSt_mnc) THEN
931cda44c0 Jean*0140            CALL DIAGSTATS_MNC_OUT(
106a65ba8a Ed H*0141      &          statGlob, nLev, ndId,
f7d6890156 Ed H*0142      &          m, listId, myTime, myIter, myThid )
106a65ba8a Ed H*0143          ENDIF
2249cb9b23 Andr*0144 #endif
106a65ba8a Ed H*0145
3e5de6a370 Jean*0146 C--    end of Processing Fld # m
                0147        ENDIF
                0148       ENDDO
                0149
3ae5f90260 Jean*0150       RETURN
3e5de6a370 Jean*0151       END
3ae5f90260 Jean*0152
3e5de6a370 Jean*0153 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|