/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_out.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagnostics_out.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.57 by jmc, Mon Jun 27 22:27:23 2011 UTC revision 1.58 by jmc, Fri Jul 1 18:49:35 2011 UTC
# Line 52  C     bi,bj :: tile indices Line 52  C     bi,bj :: tile indices
52  C     lm    :: loop index (averageCycle)  C     lm    :: loop index (averageCycle)
53  C     md    :: field number in the list "listId".  C     md    :: field number in the list "listId".
54  C     ndId  :: diagnostics  Id number (in available diagnostics list)  C     ndId  :: diagnostics  Id number (in available diagnostics list)
 C     mate  :: counter mate Id number (in available diagnostics list)  
55  C     ip    :: diagnostics  pointer to storage array  C     ip    :: diagnostics  pointer to storage array
56  C     im    :: counter-mate pointer to storage array  C     im    :: counter-mate pointer to storage array
57    C     mate  :: counter mate Id number (in available diagnostics list)
58    C     mDbl  :: processing mate Id number (in case processing requires 2 diags)
59    C     mVec  :: vector mate Id number
60    C     ppFld :: post-processed diag or not (=0): =1 stored in qtmp1 ; =2 in qtmp2
61    C   isComputed :: previous post-processed diag (still available in qtmp)
62  C     nLevOutp :: number of levels to write in output file  C     nLevOutp :: number of levels to write in output file
63  C  C
64  C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)  C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)
# Line 69  c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtm Line 73  c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtm
73        INTEGER bi, bj        INTEGER bi, bj
74        INTEGER md, ndId, nn, ip, im        INTEGER md, ndId, nn, ip, im
75        INTEGER mate, mDbl, mVec        INTEGER mate, mDbl, mVec
76          INTEGER ppFld, isComputed
77        CHARACTER*10 gcode        CHARACTER*10 gcode
78        _RL undefRL        _RL undefRL
79        INTEGER nLevOutp, kLev        INTEGER nLevOutp, kLev
# Line 161  C--   Place the loop on lm (= averagePer Line 166  C--   Place the loop on lm (= averagePer
166    
167  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
168    
169           isComputed = 0
170         DO md = 1,nfields(listId)         DO md = 1,nfields(listId)
171          ndId = jdiag(md,listId)          ndId = jdiag(md,listId)
172          gcode = gdiag(ndId)(1:10)          gcode = gdiag(ndId)(1:10)
173          mate = 0          mate = 0
174          mVec = 0          mVec = 0
175          mDbl = 0          mDbl = 0
176            ppFld = 0
177          IF ( gcode(5:5).EQ.'C' ) THEN          IF ( gcode(5:5).EQ.'C' ) THEN
178  C-      Check for Mate of a Counter Diagnostic  C-      Check for Mate of a Counter Diagnostic
179             mate = hdiag(ndId)             mate = hdiag(ndId)
180          ELSEIF ( gcode(5:5).EQ.'P' ) THEN          ELSEIF ( gcode(5:5).EQ.'P' ) THEN
181               ppFld = 1
182               IF ( gdiag(hdiag(ndId))(5:5).EQ.'P' ) ppFld = 2
183  C-      Also load the mate (if stored) for Post-Processing  C-      Also load the mate (if stored) for Post-Processing
184             nn = ndId             nn = ndId
185             DO WHILE ( gdiag(nn)(5:5).EQ.'P' )             DO WHILE ( gdiag(nn)(5:5).EQ.'P' )
186               nn = hdiag(nn)               nn = hdiag(nn)
187             ENDDO             ENDDO
188             IF ( mdiag(md,listId).NE.0 ) mDbl = hdiag(nn)             IF ( mdiag(md,listId).NE.0 ) mDbl = hdiag(nn)
189    c          write(0,*) ppFld,' ndId=', ndId, nn, mDbl, isComputed
190          ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN          ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN
191  C-      Check for Mate of a Vector Diagnostic  C-      Check for Mate of a Vector Diagnostic
192             mVec = hdiag(ndId)             mVec = hdiag(ndId)
# Line 190  C--     Start processing 1 Fld : Line 200  C--     Start processing 1 Fld :
200            IF (mDbl.GT.0) im = im + kdiag(mDbl)*(lm-1)            IF (mDbl.GT.0) im = im + kdiag(mDbl)*(lm-1)
201            IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)            IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)
202    
203            IF ( ndiag(ip,1,1).EQ.0 ) THEN            IF ( ppFld.EQ.2 .AND. isComputed.EQ.hdiag(ndId) ) THEN
204    C-        Post-Processed diag from an other Post-Processed diag -and-
205    C         both of them have just been calculated and are still stored in qtmp:
206    C         => skip computation and just write qtmp2
207                IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN
208                   WRITE(ioUnit,'(A,I6,3A,I6)')
209         &         '  get Post-Proc. Diag # ', ndId, '  ', cdiag(ndId),
210         &         ' from previous computation of Diag # ', isComputed
211                ENDIF
212                isComputed = 0
213              ELSEIF ( ndiag(ip,1,1).EQ.0 ) THEN
214  C-        Empty diagnostics case :  C-        Empty diagnostics case :
215                isComputed = 0
216    
217              _BEGIN_MASTER( myThid )              _BEGIN_MASTER( myThid )
218              WRITE(msgBuf,'(A,I10)')              WRITE(msgBuf,'(A,I10)')
# Line 233  C-        Empty diagnostics case : Line 254  C-        Empty diagnostics case :
254    
255            ELSE            ELSE
256  C-        diagnostics is not empty :  C-        diagnostics is not empty :
257                isComputed = 0
258    
259              IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN              IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN
260                IF ( gcode(5:5).EQ.'P' ) THEN                IF ( ppFld.GE.1 ) THEN
261                 WRITE(ioUnit,'(A,I6,7A,I8,2A)')                 WRITE(ioUnit,'(A,I6,7A,I8,2A)')
262       &         ' Post-Processing Diag # ', ndId, '  ', cdiag(ndId),       &         ' Post-Processing Diag # ', ndId, '  ', cdiag(ndId),
263       &         '   Parms: ',gdiag(ndId)       &         '   Parms: ',gdiag(ndId)
# Line 347  C-          Integrate vertically: for no Line 369  C-          Integrate vertically: for no
369       U                         qtmp1,       U                         qtmp1,
370       I                         undefRL, myTime, myIter, myThid )       I                         undefRL, myTime, myIter, myThid )
371              ENDIF              ENDIF
372              IF ( gcode(5:5).EQ.'P' ) THEN              IF ( ppFld.GE.1 ) THEN
373  C-          Do Post-Processing:  C-          Do Post-Processing:
374               IF ( flds(md,listId).EQ.'PhiVEL  '               IF ( flds(md,listId).EQ.'PhiVEL  '
375  c    &       .OR. flds(md,listId).EQ.'PsiVEL  '       &       .OR. flds(md,listId).EQ.'PsiVEL  '
376       &          ) THEN       &          ) THEN
377                CALL DIAGNOSTICS_CALC_PHIVEL(                CALL DIAGNOSTICS_CALC_PHIVEL(
378       I                         listId, md, ndId, ip, im, lm,       I                         listId, md, ndId, ip, im, lm,
379         I                         NrMax,
380       U                         qtmp1, qtmp2,       U                         qtmp1, qtmp2,
381       I                         myTime, myIter, myThid )       I                         myTime, myIter, myThid )
382                  isComputed = ndId
383               ELSE               ELSE
384                 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',                 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
385       &           'unknown Processing method for diag="',cdiag(ndId),'"'       &           'unknown Processing method for diag="',cdiag(ndId),'"'
# Line 371  C--     Ready to write field "md", eleme Line 395  C--     Ready to write field "md", eleme
395    
396  C-        write to binary file, using MDSIO pkg:  C-        write to binary file, using MDSIO pkg:
397            IF ( diag_mdsio ) THEN            IF ( diag_mdsio ) THEN
398  c           nRec = lm + (md-1)*averageCycle(listId)  c          nRec = lm + (md-1)*averageCycle(listId)
399              nRec = md + (lm-1)*nfields(listId)             nRec = md + (lm-1)*nfields(listId)
400  C           default precision for output files  C         default precision for output files
401              prec = writeBinaryPrec             prec = writeBinaryPrec
402  C           fFlag(1)=R(or D): force it to be 32-bit(or 64) precision  C         fFlag(1)=R(or D): force it to be 32-bit(or 64) precision
403              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32             IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
404              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64             IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
405  C         a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R  C         a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R
406               IF ( ppFld.LE.1 ) THEN
407              CALL WRITE_REC_LEV_RL(              CALL WRITE_REC_LEV_RL(
408       I                            fn, prec,       I                            fn, prec,
409       I                            NrMax, 1, nLevOutp,       I                            NrMax, 1, nLevOutp,
410       I                            qtmp1, -nRec, myIter, myThid )       I                            qtmp1, -nRec, myIter, myThid )
411               ELSE
412                CALL WRITE_REC_LEV_RL(
413         I                            fn, prec,
414         I                            NrMax, 1, nLevOutp,
415         I                            qtmp2, -nRec, myIter, myThid )
416               ENDIF
417            ENDIF            ENDIF
418    
419  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
420            IF (useMNC .AND. diag_mnc) THEN            IF (useMNC .AND. diag_mnc) THEN
421               IF ( ppFld.LE.1 ) THEN
422              CALL DIAGNOSTICS_MNC_OUT(              CALL DIAGNOSTICS_MNC_OUT(
423       I                       NrMax, nLevOutp, listId, ndId, mate,       I                       NrMax, nLevOutp, listId, ndId, mate,
424       I                       diag_mnc_bn, qtmp1,       I                       diag_mnc_bn, qtmp1,
425       I                       undefRL, myTime, myIter, myThid )       I                       undefRL, myTime, myIter, myThid )
426               ELSE
427                CALL DIAGNOSTICS_MNC_OUT(
428         I                       NrMax, nLevOutp, listId, ndId, mate,
429         I                       diag_mnc_bn, qtmp2,
430         I                       undefRL, myTime, myIter, myThid )
431               ENDIF
432            ENDIF            ENDIF
433  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
434    
Legend:
Removed from v.1.57  
changed lines
  Added in v.1.58
  ViewVC Help
Powered by ViewVC 1.1.22