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))
df5a9764ba Jean*0098       WRITE( fn, '(A,A,A)' ) fnames(listId)(1:iLen),'.',suff
1f837e63b3 Gael*0099       IF ( diag_mdsio.AND.(diagMdsDir.NE.' ') ) THEN
                0100         jLen = ILNBLNK(diagMdsDir)
                0101         WRITE( fn, '(5A)' ) diagMdsDir(1:jLen),'/',
df5a9764ba Jean*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
06752a6f1f Jean*0204                WRITE(ioUnit,'(A,I6,3A,I6)')
                0205      &         '  get Post-Proc. Diag # ', ndId, '  ', cdiag(ndId),
                0206      &         ' from previous computation of Diag # ', isComputed
                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,
1549d90dc4 Jean*0217      &                          SQUEEZE_RIGHT, myThid)
931cda44c0 Jean*0218             WRITE(msgBuf,'(A,I6,3A,I4,2A)')
3ae5f90260 Jean*0219      &       '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),
                0220      &       ' (#',md,' ) in outp.Stream: ',fnames(listId)
                0221             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
1549d90dc4 Jean*0222      &                          SQUEEZE_RIGHT, myThid)
666b944083 Jean*0223             IF ( averageCycle(listId).GT.1 ) THEN
931cda44c0 Jean*0224              WRITE(msgBuf,'(A,2(I3,A))')
666b944083 Jean*0225      &        '- WARNING -   has not been filled (ndiag(lm=',lm,')=',
                0226      &                                            ndiag(ip,1,1), ' )'
                0227             ELSE
931cda44c0 Jean*0228              WRITE(msgBuf,'(A,2(I3,A))')
666b944083 Jean*0229      &        '- WARNING -   has not been filled (ndiag=',
                0230      &                                            ndiag(ip,1,1), ' )'
                0231             ENDIF
3ae5f90260 Jean*0232             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
1549d90dc4 Jean*0233      &                          SQUEEZE_RIGHT, myThid)
                0234             WRITE(msgBuf,'(A)')
                0235      &       'WARNING DIAGNOSTICS_OUT  => write ZEROS instead'
3ae5f90260 Jean*0236             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
1549d90dc4 Jean*0237      &                          SQUEEZE_RIGHT, myThid)
                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
48a533dac6 Jean*0257                WRITE(ioUnit,'(A,I6,7A,I8,2A)')
                0258      &         ' Post-Processing Diag # ', ndId, '  ', cdiag(ndId),
                0259      &         '   Parms: ',gdiag(ndId)
                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),
                0266      &          ' and diag: ',
                0267      &            cdiag(mDbl),' (#',mDbl,') Cnt=',ndiag(im,1,1)
                0268                ENDIF
                0269               ELSE
                0270                WRITE(ioUnit,'(A,I6,3A,I8,2A)')
3ae5f90260 Jean*0271      &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
                0272      &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
48a533dac6 Jean*0273               ENDIF
666b944083 Jean*0274               IF ( mate.GT.0 ) THEN
931cda44c0 Jean*0275                WRITE(ioUnit,'(3A,I6,2A)')
3ae5f90260 Jean*0276      &         '       use Counter Mate for  ', cdiag(ndId),
                0277      &         '     Diagnostic # ',mate, '  ', cdiag(mate)
666b944083 Jean*0278               ELSEIF ( mVec.GT.0 ) THEN
3ae5f90260 Jean*0279                 IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN
931cda44c0 Jean*0280                  WRITE(ioUnit,'(3A,I6,3A)')
3ae5f90260 Jean*0281      &             '           Vector  Mate for  ', cdiag(ndId),
                0282      &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
                0283      &             ' exists '
1549d90dc4 Jean*0284                 ELSE
931cda44c0 Jean*0285                  WRITE(ioUnit,'(3A,I6,3A)')
3ae5f90260 Jean*0286      &             '           Vector  Mate for  ', cdiag(ndId),
                0287      &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
                0288      &             ' not enabled'
1549d90dc4 Jean*0289                 ENDIF
                0290               ENDIF
7341edc359 Jean*0291             ENDIF
1549d90dc4 Jean*0292
21170727e9 Jean*0293             IF ( fflags(listId)(2:2).EQ.' ' ) THEN
                0294 C-       get only selected levels:
861a196fd3 Jean*0295               DO bj = myByLo(myThid), myByHi(myThid)
                0296                DO bi = myBxLo(myThid), myBxHi(myThid)
21170727e9 Jean*0297                 DO k = 1,nlevels(listId)
                0298                   kLev = NINT(levs(k,listId))
                0299                   CALL DIAGNOSTICS_GET_DIAG(
                0300      I                         kLev, undefRL,
861a196fd3 Jean*0301      O                         qtmp1(1-OLx,1-OLy,k,bi,bj),
48a533dac6 Jean*0302      I                         ndId, mate, ip, im, bi, bj, myThid )
861a196fd3 Jean*0303                 ENDDO
                0304                ENDDO
1549d90dc4 Jean*0305               ENDDO
48a533dac6 Jean*0306               IF ( mDbl.GT.0 ) THEN
                0307                DO bj = myByLo(myThid), myByHi(myThid)
                0308                 DO bi = myBxLo(myThid), myBxHi(myThid)
                0309                  DO k = 1,nlevels(listId)
                0310                   kLev = NINT(levs(k,listId))
                0311                   CALL DIAGNOSTICS_GET_DIAG(
                0312      I                         kLev, undefRL,
                0313      O                         qtmp2(1-OLx,1-OLy,k,bi,bj),
                0314      I                         mDbl, 0, im, 0, bi, bj, myThid )
                0315                  ENDDO
                0316                 ENDDO
                0317                ENDDO
                0318               ENDIF
861a196fd3 Jean*0319             ELSE
21170727e9 Jean*0320 C-       get all the levels (for vertical post-processing)
861a196fd3 Jean*0321               DO bj = myByLo(myThid), myByHi(myThid)
                0322                DO bi = myBxLo(myThid), myBxHi(myThid)
21170727e9 Jean*0323                   CALL DIAGNOSTICS_GET_DIAG(
                0324      I                         0, undefRL,
                0325      O                         qtmp1(1-OLx,1-OLy,1,bi,bj),
48a533dac6 Jean*0326      I                         ndId, mate, ip, im, bi, bj, myThid )
861a196fd3 Jean*0327                ENDDO
                0328               ENDDO
48a533dac6 Jean*0329               IF ( mDbl.GT.0 ) THEN
                0330                DO bj = myByLo(myThid), myByHi(myThid)
                0331                 DO bi = myBxLo(myThid), myBxHi(myThid)
                0332                   CALL DIAGNOSTICS_GET_DIAG(
                0333      I                         0, undefRL,
d103f91726 Jean*0334      O                         qtmp2(1-OLx,1-OLy,1,bi,bj),
48a533dac6 Jean*0335      I                         mDbl, 0, im, 0, bi, bj, myThid )
                0336                 ENDDO
                0337                ENDDO
                0338               ENDIF
861a196fd3 Jean*0339             ENDIF
1549d90dc4 Jean*0340
82453b0e18 Andr*0341 C-----------------------------------------------------------------------
4b158a6b20 Jean*0342 C--     Apply specific post-processing (e.g., interpolate) before output
82453b0e18 Andr*0343 C-----------------------------------------------------------------------
4b158a6b20 Jean*0344             IF ( fflags(listId)(2:2).EQ.'P' ) THEN
                0345 C-          Do vertical interpolation:
                0346              IF ( fluidIsAir ) THEN
666b944083 Jean*0347 C jmc: for now, this can only work in an atmospheric set-up (fluidIsAir);
4b158a6b20 Jean*0348               CALL DIAGNOSTICS_INTERP_VERT(
                0349      I                         listId, md, ndId, ip, im, lm,
21170727e9 Jean*0350      U                         qtmp1, qtmp2,
                0351      I                         undefRL, myTime, myIter, myThid )
4b158a6b20 Jean*0352              ELSE
                0353                WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
                0354      &           'INTERP_VERT not allowed in this config'
                0355                CALL PRINT_ERROR( msgBuf , myThid )
                0356                STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
                0357              ENDIF
                0358             ENDIF
                0359             IF ( fflags(listId)(2:2).EQ.'I' ) THEN
                0360 C-          Integrate vertically: for now, output field has just 1 level:
                0361               CALL DIAGNOSTICS_SUM_LEVELS(
                0362      I                         listId, md, ndId, ip, im, lm,
                0363      U                         qtmp1,
21170727e9 Jean*0364      I                         undefRL, myTime, myIter, myThid )
4b158a6b20 Jean*0365             ENDIF
06752a6f1f Jean*0366             IF ( ppFld.GE.1 ) THEN
48a533dac6 Jean*0367 C-          Do Post-Processing:
                0368              IF ( flds(md,listId).EQ.'PhiVEL  '
06752a6f1f Jean*0369      &       .OR. flds(md,listId).EQ.'PsiVEL  '
48a533dac6 Jean*0370      &          ) THEN
                0371               CALL DIAGNOSTICS_CALC_PHIVEL(
                0372      I                         listId, md, ndId, ip, im, lm,
06752a6f1f Jean*0373      I                         NrMax,
48a533dac6 Jean*0374      U                         qtmp1, qtmp2,
                0375      I                         myTime, myIter, myThid )
06752a6f1f Jean*0376               isComputed = ndId
48a533dac6 Jean*0377              ELSE
                0378                WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
                0379      &           'unknown Processing method for diag="',cdiag(ndId),'"'
                0380                CALL PRINT_ERROR( msgBuf , myThid )
                0381                STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
                0382              ENDIF
                0383             ENDIF
4b158a6b20 Jean*0384
                0385 C--     End of empty diag / not-empty diag block
666b944083 Jean*0386           ENDIF
82453b0e18 Andr*0387
4b158a6b20 Jean*0388 C--     Ready to write field "md", element "lm" in averageCycle(listId)
a4ea38958a Jean*0389
                0390 C-        write to binary file, using MDSIO pkg:
f4a78de860 Jean*0391           IF ( diag_mdsio ) THEN
06752a6f1f Jean*0392 c          nRec = lm + (md-1)*averageCycle(listId)
                0393            nRec = md + (lm-1)*nfields(listId)
                0394 C         default precision for output files
                0395            prec = writeBinaryPrec
                0396 C         fFlag(1)=R(or D): force it to be 32-bit(or 64) precision
                0397            IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
                0398            IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
f4a78de860 Jean*0399 C         a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R
06752a6f1f Jean*0400            IF ( ppFld.LE.1 ) THEN
f4a78de860 Jean*0401             CALL WRITE_REC_LEV_RL(
                0402      I                            fn, prec,
4b158a6b20 Jean*0403      I                            NrMax, 1, nLevOutp,
f4a78de860 Jean*0404      I                            qtmp1, -nRec, myIter, myThid )
06752a6f1f Jean*0405            ELSE
                0406             CALL WRITE_REC_LEV_RL(
                0407      I                            fn, prec,
                0408      I                            NrMax, 1, nLevOutp,
                0409      I                            qtmp2, -nRec, myIter, myThid )
                0410            ENDIF
1549d90dc4 Jean*0411           ENDIF
09ceb40cd6 Jean*0412
                0413 #ifdef ALLOW_MNC
1549d90dc4 Jean*0414           IF (useMNC .AND. diag_mnc) THEN
06752a6f1f Jean*0415            IF ( ppFld.LE.1 ) THEN
380c427652 Jean*0416             CALL DIAGNOSTICS_MNC_OUT(
a22b7a769d Jean*0417      I                       NrMax, nLevOutp, listId, ndId, mate,
9473248f34 Jean*0418      I                       diag_mnc_bn, qtmp1,
                0419      I                       undefRL, myTime, myIter, myThid )
06752a6f1f Jean*0420            ELSE
                0421             CALL DIAGNOSTICS_MNC_OUT(
                0422      I                       NrMax, nLevOutp, listId, ndId, mate,
                0423      I                       diag_mnc_bn, qtmp2,
                0424      I                       undefRL, myTime, myIter, myThid )
                0425            ENDIF
1549d90dc4 Jean*0426           ENDIF
09ceb40cd6 Jean*0427 #endif /*  ALLOW_MNC  */
                0428
3ae5f90260 Jean*0429 C--     end of Processing Fld # md
1549d90dc4 Jean*0430         ENDIF
b3aac8af38 Jean*0431        ENDDO
                0432
10a11947ff Jean*0433 C--   end loop on lm counter (= averagePeriod)
1549d90dc4 Jean*0434       ENDDO
09ceb40cd6 Jean*0435
a4ea38958a Jean*0436 #ifdef ALLOW_MDSIO
                0437       IF (diag_mdsio) THEN
c3cd6c250f Jean*0438 C-    Note: temporary: since it is a pain to add more arguments to
a4ea38958a Jean*0439 C     all MDSIO S/R, uses instead this specific S/R to write only
                0440 C     meta files but with more informations in it.
f4a78de860 Jean*0441             glf = globalFiles
10a11947ff Jean*0442             nRec = averageCycle(listId)*nfields(listId)
a4ea38958a Jean*0443             CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
4b158a6b20 Jean*0444      &              0, 0, nLevOutp, ' ',
ba68d2f969 Jean*0445      &              nfields(listId), flds(1,listId),
                0446      &              nTimRec, timeRec, undefRL,
a4ea38958a Jean*0447      &              nRec, myIter, myThid)
                0448       ENDIF
                0449 #endif /*  ALLOW_MDSIO  */
                0450
3ae5f90260 Jean*0451       RETURN
1549d90dc4 Jean*0452       END
3ae5f90260 Jean*0453
09ceb40cd6 Jean*0454 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|