pkg/diagnostics/diagnostics_out.F

09ceb40cd6 Jean*0001 #include "DIAG_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: DIAGNOSTICS_OUT
                0006
                0007 C     !INTERFACE:
4b158a6b20 Jean*0008       SUBROUTINE DIAGNOSTICS_OUT(
df5a9764ba Jean*0009      I                       listId, myTime, myIter, myThid )
09ceb40cd6 Jean*0010
                0011 C     !DESCRIPTION:
                0012 C     Write output for diagnostics fields.
3ae5f90260 Jean*0013
09ceb40cd6 Jean*0014 C     !USES:
1549d90dc4 Jean*0015       IMPLICIT NONE
09ceb40cd6 Jean*0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
                0018 #include "PARAMS.h"
e8743b4419 Ed H*0019 #include "GRID.h"
1549d90dc4 Jean*0020 #include "DIAGNOSTICS_SIZE.h"
                0021 #include "DIAGNOSTICS.h"
09ceb40cd6 Jean*0022
861a196fd3 Jean*0023       INTEGER NrMax
49f3c51920 Jean*0024       PARAMETER( NrMax = numLevels )
09ceb40cd6 Jean*0025
                0026 C     !INPUT PARAMETERS:
3ae5f90260 Jean*0027 C     listId  :: Diagnostics list number being written
1549d90dc4 Jean*0028 C     myIter  :: current iteration number
3ae5f90260 Jean*0029 C     myTime  :: current time of simulation (s)
1549d90dc4 Jean*0030 C     myThid  :: my Thread Id number
987ff12cb6 Ed H*0031       _RL     myTime
3ae5f90260 Jean*0032       INTEGER listId, myIter, myThid
09ceb40cd6 Jean*0033 CEOP
                0034
f8e6aa21ed Jean*0035 C     !FUNCTIONS:
                0036       INTEGER ILNBLNK
                0037       EXTERNAL ILNBLNK
                0038
1549d90dc4 Jean*0039 C     !LOCAL VARIABLES:
3ae5f90260 Jean*0040 C     i,j,k :: loop indices
4b158a6b20 Jean*0041 C     bi,bj :: tile indices
666b944083 Jean*0042 C     lm    :: loop index (averageCycle)
3ae5f90260 Jean*0043 C     md    :: field number in the list "listId".
                0044 C     ndId  :: diagnostics  Id number (in available diagnostics list)
                0045 C     ip    :: diagnostics  pointer to storage array
                0046 C     im    :: counter-mate pointer to storage array
06752a6f1f Jean*0047 C     mate  :: counter mate Id number (in available diagnostics list)
                0048 C     mDbl  :: processing mate Id number (in case processing requires 2 diags)
                0049 C     mVec  :: vector mate Id number
                0050 C     ppFld :: post-processed diag or not (=0): =1 stored in qtmp1 ; =2 in qtmp2
                0051 C   isComputed :: previous post-processed diag (still available in qtmp)
4b158a6b20 Jean*0052 C     nLevOutp :: number of levels to write in output file
feacf2fd9c Jean*0053 C
                0054 C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)
21170727e9 Jean*0055 C     qtmp1 :: temporary array; used to store a copy of diag. output field.
                0056 C     qtmp2 :: temporary array; used to store a copy of a 2nd diag. field.
                0057 C-  Note: local common block no longer needed.
                0058 c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1
feacf2fd9c Jean*0059       _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
21170727e9 Jean*0060       _RL qtmp2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
feacf2fd9c Jean*0061
0d603ffc5e Jean*0062       INTEGER i, j, k, lm
3ae5f90260 Jean*0063       INTEGER bi, bj
48a533dac6 Jean*0064       INTEGER md, ndId, nn, ip, im
                0065       INTEGER mate, mDbl, mVec
06752a6f1f Jean*0066       INTEGER ppFld, isComputed
931cda44c0 Jean*0067       CHARACTER*10 gcode
21170727e9 Jean*0068       _RL undefRL
                0069       INTEGER nLevOutp, kLev
09ceb40cd6 Jean*0070
1f837e63b3 Gael*0071       INTEGER iLen,jLen
7341edc359 Jean*0072       INTEGER ioUnit
c326bcb45b Jean*0073       CHARACTER*(MAX_LEN_FNAM) fn
df5a9764ba Jean*0074       CHARACTER*(10) suff
1549d90dc4 Jean*0075       CHARACTER*(MAX_LEN_MBUF) msgBuf
c5e9c73fa2 Jean*0076       INTEGER prec, nRec, nTimRec
                0077       _RL     timeRec(2)
21170727e9 Jean*0078       _RL     tmpLoc
666b944083 Jean*0079 #ifdef ALLOW_MDSIO
1549d90dc4 Jean*0080       LOGICAL glf
666b944083 Jean*0081 #endif
09ceb40cd6 Jean*0082 #ifdef ALLOW_MNC
                0083       CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
                0084 #endif /*  ALLOW_MNC  */
                0085
1549d90dc4 Jean*0086 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0087
c5e9c73fa2 Jean*0088 C---  set file properties
7341edc359 Jean*0089       ioUnit= standardMessageUnit
ace73a8de7 Jean*0090       undefRL = misValFlt(listId)
a22b7a769d Jean*0091
df5a9764ba Jean*0092       IF ( rwSuffixType.EQ.0 ) THEN
                0093         WRITE(suff,'(I10.10)') myIter
                0094       ELSE
                0095         CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0096       ENDIF
380c427652 Jean*0097       iLen = ILNBLNK(fnames(listId))
acacc28f7f Jean*0098       WRITE(fn,'(3A)') fnames(listId)(1:iLen), '.', suff
1f837e63b3 Gael*0099       IF ( diag_mdsio.AND.(diagMdsDir.NE.' ') ) THEN
                0100         jLen = ILNBLNK(diagMdsDir)
acacc28f7f Jean*0101         WRITE(fn,'(5A)') diagMdsDir(1:jLen), '/',
                0102      &                 fnames(listId)(1:iLen), '.', suff
1f837e63b3 Gael*0103       ENDIF
df5a9764ba Jean*0104
4b158a6b20 Jean*0105 C-    for now, if integrate vertically, output field has just 1 level:
                0106       nLevOutp = nlevels(listId)
                0107       IF ( fflags(listId)(2:2).EQ.'I' ) nLevOutp = 1
09ceb40cd6 Jean*0108
c5e9c73fa2 Jean*0109 C--   Set time information:
                0110       IF ( freq(listId).LT.0. ) THEN
                0111 C-    Snap-shot: store a unique time (which is consistent with State-Var timing)
                0112         nTimRec = 1
                0113         timeRec(1) = myTime
                0114       ELSE
                0115 C-    Time-average: store the 2 edges of the time-averaging interval.
                0116 C      this time is consitent with intermediate Var (i.e., non-state, e.g, flux,
                0117 C      tendencies) timing. For State-Var, this is shifted by + halt time-step.
                0118         nTimRec = 2
                0119
                0120 C-    end of time-averaging interval:
                0121         timeRec(2) = myTime
                0122
                0123 C-    begining of time-averaging interval:
                0124 c       timeRec(1) = myTime - freq(listId)
                0125 C     a) find the time of the previous multiple of output freq:
                0126         timeRec(1) = myTime-deltaTClock*0.5 _d 0
                0127         timeRec(1) = (timeRec(1)-phase(listId))/freq(listId)
e9b2d4871a Timo*0128         tmpLoc     = DINT( timeRec(1) )
                0129         IF ( timeRec(1).LT.zeroRL ) THEN
                0130           IF ( timeRec(1).NE.tmpLoc ) tmpLoc = tmpLoc - 1. _d 0
c6c046bad6 Jean*0131         ENDIF
e9b2d4871a Timo*0132         timeRec(1) = phase(listId) + freq(listId)*tmpLoc
                0133 c       WRITE(0,'(3I5,A,2F17.4)') myProcId, myThid, listId,
                0134 c    &                     ' f ', tmpLoc, timeRec(1)/deltaTClock
c5e9c73fa2 Jean*0135         timeRec(1) = MAX( timeRec(1), startTime )
                0136
                0137 C     b) round off to nearest multiple of time-step:
                0138         timeRec(1) = (timeRec(1)-baseTime)/deltaTClock
e9b2d4871a Timo*0139         tmpLoc = DNINT( timeRec(1) )
c5e9c73fa2 Jean*0140 C     if just half way, NINT will return the next time-step: correct this
e9b2d4871a Timo*0141         IF ( (timeRec(1)+halfRL).EQ.tmpLoc ) tmpLoc = tmpLoc - 1. _d 0
                0142         timeRec(1) = baseTime + deltaTClock*tmpLoc
                0143 c       WRITE(0,'(3I5,A,2F17.4)') myProcId, myThid, listId,
                0144 c    &                     '   ', tmpLoc, timeRec(1)/deltaTClock
c5e9c73fa2 Jean*0145       ENDIF
c6c046bad6 Jean*0146 C--   Convert time to iteration number (debug)
                0147 c     DO i=1,nTimRec
                0148 c       timeRec(i) = timeRec(i)/deltaTClock
                0149 c     ENDDO
c5e9c73fa2 Jean*0150
10a11947ff Jean*0151 C--   Place the loop on lm (= averagePeriod) outside the loop on md (= field):
                0152       DO lm=1,averageCycle(listId)
b3aac8af38 Jean*0153
10a11947ff Jean*0154 #ifdef ALLOW_MNC
b3aac8af38 Jean*0155        IF (useMNC .AND. diag_mnc) THEN
380c427652 Jean*0156          CALL DIAGNOSTICS_MNC_SET(
10a11947ff Jean*0157      I                    nLevOutp, listId, lm,
9473248f34 Jean*0158      O                    diag_mnc_bn,
a22b7a769d Jean*0159      I                    undefRL, myTime, myIter, myThid )
b3aac8af38 Jean*0160        ENDIF
09ceb40cd6 Jean*0161 #endif /*  ALLOW_MNC  */
                0162
666b944083 Jean*0163 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0164
06752a6f1f Jean*0165        isComputed = 0
b3aac8af38 Jean*0166        DO md = 1,nfields(listId)
b38beaf3c1 Jean*0167         ndId = ABS(jdiag(md,listId))
931cda44c0 Jean*0168         gcode = gdiag(ndId)(1:10)
666b944083 Jean*0169         mate = 0
                0170         mVec = 0
48a533dac6 Jean*0171         mDbl = 0
06752a6f1f Jean*0172         ppFld = 0
931cda44c0 Jean*0173         IF ( gcode(5:5).EQ.'C' ) THEN
666b944083 Jean*0174 C-      Check for Mate of a Counter Diagnostic
931cda44c0 Jean*0175            mate = hdiag(ndId)
48a533dac6 Jean*0176         ELSEIF ( gcode(5:5).EQ.'P' ) THEN
06752a6f1f Jean*0177            ppFld = 1
                0178            IF ( gdiag(hdiag(ndId))(5:5).EQ.'P' ) ppFld = 2
48a533dac6 Jean*0179 C-      Also load the mate (if stored) for Post-Processing
                0180            nn = ndId
                0181            DO WHILE ( gdiag(nn)(5:5).EQ.'P' )
                0182              nn = hdiag(nn)
                0183            ENDDO
                0184            IF ( mdiag(md,listId).NE.0 ) mDbl = hdiag(nn)
06752a6f1f Jean*0185 c          write(0,*) ppFld,' ndId=', ndId, nn, mDbl, isComputed
931cda44c0 Jean*0186         ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN
666b944083 Jean*0187 C-      Check for Mate of a Vector Diagnostic
6ffe6533fa Jean*0188            mVec = hdiag(ndId)
666b944083 Jean*0189         ENDIF
931cda44c0 Jean*0190         IF ( idiag(md,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN
1549d90dc4 Jean*0191 C--     Start processing 1 Fld :
                0192
666b944083 Jean*0193           ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)
3ae5f90260 Jean*0194           im = mdiag(md,listId)
666b944083 Jean*0195           IF (mate.GT.0) im = im + kdiag(mate)*(lm-1)
48a533dac6 Jean*0196           IF (mDbl.GT.0) im = im + kdiag(mDbl)*(lm-1)
666b944083 Jean*0197           IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)
                0198
06752a6f1f Jean*0199           IF ( ppFld.EQ.2 .AND. isComputed.EQ.hdiag(ndId) ) THEN
                0200 C-        Post-Processed diag from an other Post-Processed diag -and-
                0201 C         both of them have just been calculated and are still stored in qtmp:
                0202 C         => skip computation and just write qtmp2
41c4545f8f Jean*0203             IF ( diag_dBugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN
acacc28f7f Jean*0204               WRITE(ioUnit,'(A,I6,3A,I6)')
                0205      &          '  get Post-Proc. Diag # ', ndId, '  ', cdiag(ndId),
                0206      &          ' from previous computation of Diag # ', isComputed
06752a6f1f Jean*0207             ENDIF
                0208             isComputed = 0
                0209           ELSEIF ( ndiag(ip,1,1).EQ.0 ) THEN
1549d90dc4 Jean*0210 C-        Empty diagnostics case :
06752a6f1f Jean*0211             isComputed = 0
1549d90dc4 Jean*0212
                0213             _BEGIN_MASTER( myThid )
                0214             WRITE(msgBuf,'(A,I10)')
                0215      &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter
3ae5f90260 Jean*0216             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
acacc28f7f Jean*0217      &                          SQUEEZE_RIGHT, myThid )
931cda44c0 Jean*0218             WRITE(msgBuf,'(A,I6,3A,I4,2A)')
acacc28f7f Jean*0219      &        '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),
                0220      &        ' (#',md,' ) in outp.Stream: ',fnames(listId)
3ae5f90260 Jean*0221             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
acacc28f7f Jean*0222      &                          SQUEEZE_RIGHT, myThid )
666b944083 Jean*0223             IF ( averageCycle(listId).GT.1 ) THEN
931cda44c0 Jean*0224              WRITE(msgBuf,'(A,2(I3,A))')
acacc28f7f Jean*0225      &         '- WARNING -   has not been filled (ndiag(lm=',lm,')=',
                0226      &                                             ndiag(ip,1,1), ' )'
666b944083 Jean*0227             ELSE
931cda44c0 Jean*0228              WRITE(msgBuf,'(A,2(I3,A))')
acacc28f7f Jean*0229      &         '- WARNING -   has not been filled (ndiag=',
                0230      &                                             ndiag(ip,1,1), ' )'
666b944083 Jean*0231             ENDIF
3ae5f90260 Jean*0232             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
acacc28f7f Jean*0233      &                          SQUEEZE_RIGHT, myThid )
1549d90dc4 Jean*0234             WRITE(msgBuf,'(A)')
acacc28f7f Jean*0235      &        'WARNING DIAGNOSTICS_OUT  => write ZEROS instead'
3ae5f90260 Jean*0236             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
acacc28f7f Jean*0237      &                          SQUEEZE_RIGHT, myThid )
1549d90dc4 Jean*0238             _END_MASTER( myThid )
                0239             DO bj = myByLo(myThid), myByHi(myThid)
                0240               DO bi = myBxLo(myThid), myBxHi(myThid)
4b158a6b20 Jean*0241                 DO k = 1,nLevOutp
1549d90dc4 Jean*0242                   DO j = 1-OLy,sNy+OLy
                0243                     DO i = 1-OLx,sNx+OLx
                0244                       qtmp1(i,j,k,bi,bj) = 0. _d 0
                0245                     ENDDO
                0246                   ENDDO
                0247                 ENDDO
                0248               ENDDO
                0249             ENDDO
                0250
48a533dac6 Jean*0251           ELSE
1549d90dc4 Jean*0252 C-        diagnostics is not empty :
06752a6f1f Jean*0253             isComputed = 0
1549d90dc4 Jean*0254
41c4545f8f Jean*0255             IF ( diag_dBugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN
06752a6f1f Jean*0256               IF ( ppFld.GE.1 ) THEN
acacc28f7f Jean*0257                WRITE(ioUnit,'(A,I6,3A,I3,3A)')
                0258      &           ' Post-Processing Diag #', ndId, ' "', cdiag(ndId),
                0259      &           '" (list#', listId, ') Parms "', gdiag(ndId), '"'
48a533dac6 Jean*0260                IF ( mDbl.EQ.0 ) THEN
                0261                 WRITE(ioUnit,'(2(3A,I6,A,I8))') '   from diag: ',
                0262      &            cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1)
                0263                ELSE
                0264                 WRITE(ioUnit,'(2(3A,I6,A,I8))') '   from diag: ',
                0265      &            cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1),
acacc28f7f Jean*0266      &            ' and diag: ',
                0267      &            cdiag(mDbl), ' (#', mDbl, ') Cnt=', ndiag(im,1,1)
48a533dac6 Jean*0268                ENDIF
                0269               ELSE
acacc28f7f Jean*0270                WRITE(ioUnit,'(A,I6,3A,I3,3A,I8)')
                0271      &           ' Computing Diagnostic #', ndId, ' "', cdiag(ndId),
                0272      &           '" (list#', listId, ') Parms "', gdiag(ndId),
                0273      &           '", Count=', ndiag(ip,1,1)
48a533dac6 Jean*0274               ENDIF
666b944083 Jean*0275               IF ( mate.GT.0 ) THEN
acacc28f7f Jean*0276                WRITE(ioUnit,'(3A,I6,3A)')
                0277      &           '         use Counter Mate for "', cdiag(ndId),
                0278      &           '" :  Diagnostic #', mate, ' "', cdiag(mate), '"'
666b944083 Jean*0279               ELSEIF ( mVec.GT.0 ) THEN
acacc28f7f Jean*0280                IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN
                0281                 WRITE(ioUnit,'(3A,I6,3A)')
                0282      &            '             Vector  Mate for "', cdiag(ndId),
                0283      &            '" :  Diagnostic # ', mVec, ' "', cdiag(mVec),
                0284      &            '" exists'
                0285                ELSE
                0286                 WRITE(ioUnit,'(3A,I6,3A)')
                0287      &            '             Vector  Mate for "', cdiag(ndId),
                0288      &            '" :  Diagnostic # ', mVec, ' "', cdiag(mVec),
                0289      &            '" not enabled'
                0290                ENDIF
1549d90dc4 Jean*0291               ENDIF
7341edc359 Jean*0292             ENDIF
1549d90dc4 Jean*0293
21170727e9 Jean*0294             IF ( fflags(listId)(2:2).EQ.' ' ) THEN
                0295 C-       get only selected levels:
861a196fd3 Jean*0296               DO bj = myByLo(myThid), myByHi(myThid)
                0297                DO bi = myBxLo(myThid), myBxHi(myThid)
21170727e9 Jean*0298                 DO k = 1,nlevels(listId)
                0299                   kLev = NINT(levs(k,listId))
                0300                   CALL DIAGNOSTICS_GET_DIAG(
                0301      I                         kLev, undefRL,
861a196fd3 Jean*0302      O                         qtmp1(1-OLx,1-OLy,k,bi,bj),
48a533dac6 Jean*0303      I                         ndId, mate, ip, im, bi, bj, myThid )
861a196fd3 Jean*0304                 ENDDO
                0305                ENDDO
1549d90dc4 Jean*0306               ENDDO
48a533dac6 Jean*0307               IF ( mDbl.GT.0 ) THEN
                0308                DO bj = myByLo(myThid), myByHi(myThid)
                0309                 DO bi = myBxLo(myThid), myBxHi(myThid)
                0310                  DO k = 1,nlevels(listId)
                0311                   kLev = NINT(levs(k,listId))
                0312                   CALL DIAGNOSTICS_GET_DIAG(
                0313      I                         kLev, undefRL,
                0314      O                         qtmp2(1-OLx,1-OLy,k,bi,bj),
                0315      I                         mDbl, 0, im, 0, bi, bj, myThid )
                0316                  ENDDO
                0317                 ENDDO
                0318                ENDDO
                0319               ENDIF
861a196fd3 Jean*0320             ELSE
21170727e9 Jean*0321 C-       get all the levels (for vertical post-processing)
861a196fd3 Jean*0322               DO bj = myByLo(myThid), myByHi(myThid)
                0323                DO bi = myBxLo(myThid), myBxHi(myThid)
21170727e9 Jean*0324                   CALL DIAGNOSTICS_GET_DIAG(
                0325      I                         0, undefRL,
                0326      O                         qtmp1(1-OLx,1-OLy,1,bi,bj),
48a533dac6 Jean*0327      I                         ndId, mate, ip, im, bi, bj, myThid )
861a196fd3 Jean*0328                ENDDO
                0329               ENDDO
48a533dac6 Jean*0330               IF ( mDbl.GT.0 ) THEN
                0331                DO bj = myByLo(myThid), myByHi(myThid)
                0332                 DO bi = myBxLo(myThid), myBxHi(myThid)
                0333                   CALL DIAGNOSTICS_GET_DIAG(
                0334      I                         0, undefRL,
d103f91726 Jean*0335      O                         qtmp2(1-OLx,1-OLy,1,bi,bj),
48a533dac6 Jean*0336      I                         mDbl, 0, im, 0, bi, bj, myThid )
                0337                 ENDDO
                0338                ENDDO
                0339               ENDIF
861a196fd3 Jean*0340             ENDIF
1549d90dc4 Jean*0341
82453b0e18 Andr*0342 C-----------------------------------------------------------------------
4b158a6b20 Jean*0343 C--     Apply specific post-processing (e.g., interpolate) before output
82453b0e18 Andr*0344 C-----------------------------------------------------------------------
4b158a6b20 Jean*0345             IF ( fflags(listId)(2:2).EQ.'P' ) THEN
                0346 C-          Do vertical interpolation:
                0347              IF ( fluidIsAir ) THEN
666b944083 Jean*0348 C jmc: for now, this can only work in an atmospheric set-up (fluidIsAir);
4b158a6b20 Jean*0349               CALL DIAGNOSTICS_INTERP_VERT(
                0350      I                         listId, md, ndId, ip, im, lm,
21170727e9 Jean*0351      U                         qtmp1, qtmp2,
                0352      I                         undefRL, myTime, myIter, myThid )
4b158a6b20 Jean*0353              ELSE
                0354                WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
                0355      &           'INTERP_VERT not allowed in this config'
                0356                CALL PRINT_ERROR( msgBuf , myThid )
                0357                STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
                0358              ENDIF
                0359             ENDIF
                0360             IF ( fflags(listId)(2:2).EQ.'I' ) THEN
                0361 C-          Integrate vertically: for now, output field has just 1 level:
                0362               CALL DIAGNOSTICS_SUM_LEVELS(
                0363      I                         listId, md, ndId, ip, im, lm,
                0364      U                         qtmp1,
21170727e9 Jean*0365      I                         undefRL, myTime, myIter, myThid )
4b158a6b20 Jean*0366             ENDIF
06752a6f1f Jean*0367             IF ( ppFld.GE.1 ) THEN
48a533dac6 Jean*0368 C-          Do Post-Processing:
                0369              IF ( flds(md,listId).EQ.'PhiVEL  '
06752a6f1f Jean*0370      &       .OR. flds(md,listId).EQ.'PsiVEL  '
48a533dac6 Jean*0371      &          ) THEN
                0372               CALL DIAGNOSTICS_CALC_PHIVEL(
                0373      I                         listId, md, ndId, ip, im, lm,
06752a6f1f Jean*0374      I                         NrMax,
48a533dac6 Jean*0375      U                         qtmp1, qtmp2,
                0376      I                         myTime, myIter, myThid )
06752a6f1f Jean*0377               isComputed = ndId
48a533dac6 Jean*0378              ELSE
                0379                WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
                0380      &           'unknown Processing method for diag="',cdiag(ndId),'"'
                0381                CALL PRINT_ERROR( msgBuf , myThid )
                0382                STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
                0383              ENDIF
                0384             ENDIF
4b158a6b20 Jean*0385
                0386 C--     End of empty diag / not-empty diag block
666b944083 Jean*0387           ENDIF
82453b0e18 Andr*0388
4b158a6b20 Jean*0389 C--     Ready to write field "md", element "lm" in averageCycle(listId)
a4ea38958a Jean*0390
                0391 C-        write to binary file, using MDSIO pkg:
f4a78de860 Jean*0392           IF ( diag_mdsio ) THEN
06752a6f1f Jean*0393 c          nRec = lm + (md-1)*averageCycle(listId)
                0394            nRec = md + (lm-1)*nfields(listId)
                0395 C         default precision for output files
                0396            prec = writeBinaryPrec
                0397 C         fFlag(1)=R(or D): force it to be 32-bit(or 64) precision
                0398            IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
                0399            IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
f4a78de860 Jean*0400 C         a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R
06752a6f1f Jean*0401            IF ( ppFld.LE.1 ) THEN
f4a78de860 Jean*0402             CALL WRITE_REC_LEV_RL(
                0403      I                            fn, prec,
4b158a6b20 Jean*0404      I                            NrMax, 1, nLevOutp,
f4a78de860 Jean*0405      I                            qtmp1, -nRec, myIter, myThid )
06752a6f1f Jean*0406            ELSE
                0407             CALL WRITE_REC_LEV_RL(
                0408      I                            fn, prec,
                0409      I                            NrMax, 1, nLevOutp,
                0410      I                            qtmp2, -nRec, myIter, myThid )
                0411            ENDIF
1549d90dc4 Jean*0412           ENDIF
09ceb40cd6 Jean*0413
                0414 #ifdef ALLOW_MNC
1549d90dc4 Jean*0415           IF (useMNC .AND. diag_mnc) THEN
06752a6f1f Jean*0416            IF ( ppFld.LE.1 ) THEN
380c427652 Jean*0417             CALL DIAGNOSTICS_MNC_OUT(
a22b7a769d Jean*0418      I                       NrMax, nLevOutp, listId, ndId, mate,
9473248f34 Jean*0419      I                       diag_mnc_bn, qtmp1,
                0420      I                       undefRL, myTime, myIter, myThid )
06752a6f1f Jean*0421            ELSE
                0422             CALL DIAGNOSTICS_MNC_OUT(
                0423      I                       NrMax, nLevOutp, listId, ndId, mate,
                0424      I                       diag_mnc_bn, qtmp2,
                0425      I                       undefRL, myTime, myIter, myThid )
                0426            ENDIF
1549d90dc4 Jean*0427           ENDIF
09ceb40cd6 Jean*0428 #endif /*  ALLOW_MNC  */
                0429
3ae5f90260 Jean*0430 C--     end of Processing Fld # md
1549d90dc4 Jean*0431         ENDIF
b3aac8af38 Jean*0432        ENDDO
                0433
10a11947ff Jean*0434 C--   end loop on lm counter (= averagePeriod)
1549d90dc4 Jean*0435       ENDDO
09ceb40cd6 Jean*0436
a4ea38958a Jean*0437 #ifdef ALLOW_MDSIO
                0438       IF (diag_mdsio) THEN
c3cd6c250f Jean*0439 C-    Note: temporary: since it is a pain to add more arguments to
a4ea38958a Jean*0440 C     all MDSIO S/R, uses instead this specific S/R to write only
                0441 C     meta files but with more informations in it.
f4a78de860 Jean*0442             glf = globalFiles
10a11947ff Jean*0443             nRec = averageCycle(listId)*nfields(listId)
a4ea38958a Jean*0444             CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
4b158a6b20 Jean*0445      &              0, 0, nLevOutp, ' ',
ba68d2f969 Jean*0446      &              nfields(listId), flds(1,listId),
                0447      &              nTimRec, timeRec, undefRL,
a4ea38958a Jean*0448      &              nRec, myIter, myThid)
                0449       ENDIF
                0450 #endif /*  ALLOW_MDSIO  */
                0451
3ae5f90260 Jean*0452       RETURN
1549d90dc4 Jean*0453       END
3ae5f90260 Jean*0454
09ceb40cd6 Jean*0455 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|