/[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.31 by jmc, Fri Dec 29 05:43:56 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 52  C     ndId  :: diagnostics  Id number (i Line 46  C     ndId  :: diagnostics  Id number (i
46  C     mate  :: counter mate Id number (in available diagnostics list)  C     mate  :: counter mate Id number (in available diagnostics list)
47  C     ip    :: diagnostics  pointer to storage array  C     ip    :: diagnostics  pointer to storage array
48  C     im    :: counter-mate pointer to storage array  C     im    :: counter-mate pointer to storage array
49    C
50    C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)
51    C     qtmp1 :: thread-shared temporary array (needs to be in common block):
52    C              to write a diagnostic field to file, copy it first from (big)
53    C              diagnostic storage qdiag into it.
54          COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1
55          _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
56    
57        INTEGER i, j, k, lm        INTEGER i, j, k, lm
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
       _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)  
62        _RL undef, getcon        _RL undef, getcon
63        _RL tmpLev        _RL tmpLev
64        EXTERNAL getcon        EXTERNAL getcon
# Line 69  C     im    :: counter-mate pointer to s Line 70  C     im    :: counter-mate pointer to s
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 202  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 229  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 266  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 339  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
Legend:
Removed from v.1.31  
changed lines
  Added in v.1.35
  ViewVC Help
Powered by ViewVC 1.1.22