/[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.32 by jmc, Fri Dec 29 23:57:15 2006 UTC revision 1.35 by jmc, Tue Feb 5 15:13:01 2008 UTC
# Line 27  C     !USES: Line 27  C     !USES:
27  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
28    
29        INTEGER NrMax        INTEGER NrMax
30  #ifdef ALLOW_FIZHI        PARAMETER( NrMax = numLevels )
 #include "fizhi_SIZE.h"  
       PARAMETER( NrMax = Nr+Nrphys )  
 #else  
       PARAMETER( NrMax = Nr )  
 #endif  
31    
32  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
33  C     listId  :: Diagnostics list number being written  C     listId  :: Diagnostics list number being written
# Line 63  C              diagnostic storage qdiag Line 58  C              diagnostic storage qdiag
58        INTEGER bi, bj        INTEGER bi, bj
59        INTEGER md, ndId, ip, im        INTEGER md, ndId, ip, im
60        INTEGER mate, mVec        INTEGER mate, mVec
61        CHARACTER*8 parms1        CHARACTER*10 gcode
62        _RL undef, getcon        _RL undef, getcon
63        _RL tmpLev        _RL tmpLev
64        EXTERNAL getcon        EXTERNAL getcon
# Line 75  C              diagnostic storage qdiag Line 70  C              diagnostic storage qdiag
70        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
71        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
72        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
73          INTEGER prec, nRec
74  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
75        LOGICAL glf        LOGICAL glf
       INTEGER nRec  
       INTEGER prec  
76  #endif  #endif
77  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
78        INTEGER ii        INTEGER ii
# Line 208  C---+----1----+----2----+----3----+----4 Line 202  C---+----1----+----2----+----3----+----4
202    
203        DO md = 1,nfields(listId)        DO md = 1,nfields(listId)
204          ndId = jdiag(md,listId)          ndId = jdiag(md,listId)
205          parms1 = gdiag(ndId)(1:8)          gcode = gdiag(ndId)(1:10)
206          mate = 0          mate = 0
207          mVec = 0          mVec = 0
208          IF ( parms1(5:5).EQ.'C' ) THEN          IF ( gcode(5:5).EQ.'C' ) THEN
209  C-      Check for Mate of a Counter Diagnostic  C-      Check for Mate of a Counter Diagnostic
210             READ(parms1,'(5X,I3)') mate             mate = hdiag(ndId)
211          ELSEIF ( parms1(1:1).EQ.'U' .OR. parms1(1:1).EQ.'V' ) THEN          ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN
212  C-      Check for Mate of a Vector Diagnostic  C-      Check for Mate of a Vector Diagnostic
213             READ(parms1,'(5X,I3)') mVec             mate = hdiag(ndId)
214          ENDIF          ENDIF
215          IF ( idiag(md,listId).NE.0 .AND. parms1(5:5).NE.'D' ) THEN          IF ( idiag(md,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN
216  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
217           DO lm=1,averageCycle(listId)           DO lm=1,averageCycle(listId)
218    
# Line 235  C-        Empty diagnostics case : Line 229  C-        Empty diagnostics case :
229       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter
230              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
231       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
232              WRITE(msgBuf,'(A,I4,3A,I3,2A)')              WRITE(msgBuf,'(A,I6,3A,I4,2A)')
233       &       '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),       &       '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),
234       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)
235              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
236       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
237              IF ( averageCycle(listId).GT.1 ) THEN              IF ( averageCycle(listId).GT.1 ) THEN
238               WRITE(msgBuf,'(A,2(I2,A))')               WRITE(msgBuf,'(A,2(I3,A))')
239       &        '- WARNING -   has not been filled (ndiag(lm=',lm,')=',       &        '- WARNING -   has not been filled (ndiag(lm=',lm,')=',
240       &                                            ndiag(ip,1,1), ' )'       &                                            ndiag(ip,1,1), ' )'
241              ELSE              ELSE
242               WRITE(msgBuf,'(A,2(I2,A))')               WRITE(msgBuf,'(A,2(I3,A))')
243       &        '- WARNING -   has not been filled (ndiag=',       &        '- WARNING -   has not been filled (ndiag=',
244       &                                            ndiag(ip,1,1), ' )'       &                                            ndiag(ip,1,1), ' )'
245              ENDIF              ENDIF
# Line 272  C-        Empty diagnostics case : Line 266  C-        Empty diagnostics case :
266  C-        diagnostics is not empty :  C-        diagnostics is not empty :
267    
268              IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN              IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN
269                WRITE(ioUnit,'(A,I3,3A,I8,2A)')                WRITE(ioUnit,'(A,I6,3A,I8,2A)')
270       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
271       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
272                IF ( mate.GT.0 ) THEN                IF ( mate.GT.0 ) THEN
273                 WRITE(ioUnit,'(3A,I3,2A)')                 WRITE(ioUnit,'(3A,I6,2A)')
274       &         '       use Counter Mate for  ', cdiag(ndId),       &         '       use Counter Mate for  ', cdiag(ndId),
275       &         '     Diagnostic # ',mate, '  ', cdiag(mate)       &         '     Diagnostic # ',mate, '  ', cdiag(mate)
276                ELSEIF ( mVec.GT.0 ) THEN                ELSEIF ( mVec.GT.0 ) THEN
277                  IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN                  IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN
278                   WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I6,3A)')
279       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
280       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
281       &             ' exists '       &             ' exists '
282                  ELSE                  ELSE
283                   WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I6,3A)')
284       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
285       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
286       &             ' not enabled'       &             ' not enabled'
# Line 345  C jmc: for now, this can only work in an Line 339  C jmc: for now, this can only work in an
339    
340  C--    Ready to write field "md", element "lm" in averageCycle(listId)  C--    Ready to write field "md", element "lm" in averageCycle(listId)
341    
 #ifdef ALLOW_MDSIO  
342  C-        write to binary file, using MDSIO pkg:  C-        write to binary file, using MDSIO pkg:
343            IF (diag_mdsio) THEN            IF ( diag_mdsio ) THEN
             glf = globalFiles  
344              nRec = lm + (md-1)*averageCycle(listId)              nRec = lm + (md-1)*averageCycle(listId)
345  C           default precision for output files  C           default precision for output files
346              prec = writeBinaryPrec              prec = writeBinaryPrec
347  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
348              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
349              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
350  c           CALL MDS_WRITE_FIELD(fn,prec,glf,.FALSE.,'RL',  C         a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R
351  c    &              NrMax,nlevels(listId),qtmp1,nRec,myIter,myThid)              CALL WRITE_REC_LEV_RL(
352  C         a hack not to write meta files now:       I                            fn, prec,
353              CALL MDS_WRITE_FIELD(fn,prec,glf,.FALSE.,'RL',       I                            NrMax, 1, nlevels(listId),
354       &              NrMax,nlevels(listId),qtmp1,-nRec,myIter,myThid)       I                            qtmp1, -nRec, myIter, myThid )
355            ENDIF            ENDIF
 #endif /*  ALLOW_MDSIO  */  
356    
357  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
358            IF (useMNC .AND. diag_mnc) THEN            IF (useMNC .AND. diag_mnc) THEN
# Line 481  C--     end of Processing Fld # md Line 472  C--     end of Processing Fld # md
472  C-    Note: temporary: since it's a pain to add more arguments to  C-    Note: temporary: since it's a pain to add more arguments to
473  C     all MDSIO S/R, uses instead this specific S/R to write only  C     all MDSIO S/R, uses instead this specific S/R to write only
474  C     meta files but with more informations in it.  C     meta files but with more informations in it.
475                glf = globalFiles
476              nRec = nfields(listId)*averageCycle(listId)              nRec = nfields(listId)*averageCycle(listId)
477              CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,              CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
478       &              0, 0, nlevels(listId), ' ',       &              0, 0, nlevels(listId), ' ',
Legend:
Removed from v.1.32  
changed lines
  Added in v.1.35
  ViewVC Help
Powered by ViewVC 1.1.22