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 )
931cda44c0 Jean*0089              WRITE(msgBuf,'(A,I10,A,I4)')
3e5de6a370 Jean*0090      &        '- WARNING - from DIAGSTATS_OUTPUT at iter=', myIter,
                0091      &        ' , region:', j
                0092              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0093      &                           SQUEEZE_RIGHT, myThid)
931cda44c0 Jean*0094              WRITE(msgBuf,'(A,I6,3A,I4,2A)')
3e5de6a370 Jean*0095      &       '- WARNING - diagSt.#',ndId, ' : ',diagSt_Flds(m,listId),
                0096      &       ' (#',m,' ) in outp.Stream: ',diagSt_Fname(listId)
                0097              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                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,
                0107      &                           SQUEEZE_RIGHT, myThid)
                0108              WRITE(msgBuf,'(A)')
                0109      &       'WARNING DIAGSTATS_OUTPUT  => write UNDEF instead'
                0110              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0111      &                           SQUEEZE_RIGHT, myThid)
                0112              _END_MASTER( myThid )
                0113             ENDIF
                0114
41c4545f8f Jean*0115             IF ( diag_dBugLevel .GE. debLevB ) THEN
3e5de6a370 Jean*0116              _BEGIN_MASTER( myThid )
931cda44c0 Jean*0117               WRITE(ioUnit,'(A,I6,3A,I4,A,1PE10.3,2A)')
3e5de6a370 Jean*0118      &         ' Compute Stats, Diag. # ',ndId, '  ', cdiag(ndId),
                0119      &         '  vol(',j,' ):', statGlob(0,0,j),'  Parms: ',gdiag(ndId)
                0120              IF ( mate.GT.0 ) THEN
931cda44c0 Jean*0121               WRITE(ioUnit,'(A,I6,3A,I4,2(A,1PE10.3))')
3e5de6a370 Jean*0122      &         '    use Counter Mate  # ', mate,'  ',cdiag(mate),
                0123      &         '  vol(',j,' ):',tmp_Glob(0,0), ' integral',tmp_Glob(1,0)
                0124              ENDIF
                0125              _END_MASTER( myThid )
                0126             ENDIF
                0127           ENDIF
                0128          ENDDO
                0129
106a65ba8a Ed H*0130 C--      Write to ASCII file:
3e5de6a370 Jean*0131          IF (diagSt_Ascii) THEN
                0132            CALL DIAGSTATS_ASCII_OUT( statGlob, nLev, ndId,
                0133      &                               m, listId, myIter, myThid )
                0134          ENDIF
                0135
2249cb9b23 Andr*0136 #ifdef ALLOW_MNC
106a65ba8a Ed H*0137          IF (diagSt_mnc) THEN
931cda44c0 Jean*0138            CALL DIAGSTATS_MNC_OUT(
106a65ba8a Ed H*0139      &          statGlob, nLev, ndId,
f7d6890156 Ed H*0140      &          m, listId, myTime, myIter, myThid )
106a65ba8a Ed H*0141          ENDIF
2249cb9b23 Andr*0142 #endif
106a65ba8a Ed H*0143
3e5de6a370 Jean*0144 C--    end of Processing Fld # m
                0145        ENDIF
                0146       ENDDO
                0147
3ae5f90260 Jean*0148       RETURN
3e5de6a370 Jean*0149       END
3ae5f90260 Jean*0150
3e5de6a370 Jean*0151 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|