/[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.34 by jmc, Tue Nov 13 19:43:44 2007 UTC revision 1.39 by mlosch, Tue May 27 08:37:19 2008 UTC
# Line 54  C              diagnostic storage qdiag Line 54  C              diagnostic storage qdiag
54        COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1        COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1
55        _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)        _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, klev
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 88  C              diagnostic storage qdiag Line 88  C              diagnostic storage qdiag
88        CHARACTER*(5) ctmp        CHARACTER*(5) ctmp
89        _RS ztmp(NrMax)        _RS ztmp(NrMax)
90  #endif  #endif
91          LOGICAL useMissingValue, useMisValForThisDiag
92          REAL*8 misvalLoc
93          REAL*8 misval_r8(2)
94          REAL*4 misval_r4(2)
95          INTEGER misvalIntLoc, misval_int(2)
96  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
97    
98  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 100  C---+----1----+----2----+----3----+----4 Line 105  C---+----1----+----2----+----3----+----4
105    
106  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
107        IF (useMNC .AND. diag_mnc) THEN        IF (useMNC .AND. diag_mnc) THEN
108    C     Handle missing value attribute (land points)
109           useMissingValue = .FALSE.
110    #ifdef DIAGNOSTICS_MISSING_VALUE
111           useMissingValue = .TRUE.
112    #endif /* DIAGNOSTICS_MISSING_VALUE */
113           IF ( misvalFlt(listId) .NE. UNSET_RL ) THEN
114            misvalLoc = misvalFlt(listId)
115           ELSE
116            misvalLoc = undef
117           ENDIF
118    C     Defaults to UNSET_I
119           misvalIntLoc = misvalInt(listId)
120           DO ii=1,2
121    C       misval_r4(ii)  = UNSET_FLOAT4
122    C       misval_r8(ii)  = UNSET_FLOAT8
123            misval_r4(ii)  = misvalLoc
124            misval_r8(ii)  = misvalLoc
125            misval_int(ii) = UNSET_I
126           ENDDO
127          DO i = 1,MAX_LEN_FNAM          DO i = 1,MAX_LEN_FNAM
128            diag_mnc_bn(i:i) = ' '            diag_mnc_bn(i:i) = ' '
129          ENDDO          ENDDO
# Line 131  C       beginning and ending times for e Line 155  C       beginning and ending times for e
155          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',
156       &       'Idicies of vertical levels within the source arrays',       &       'Idicies of vertical levels within the source arrays',
157       &       myThid)       &       myThid)
158    C     suppress the missing value attribute (iflag = 0)
159            IF (useMissingValue)
160         &       CALL MNC_CW_VATTR_MISSING('diag_levels', 0,
161         I       misval_r8, misval_r4, misval_int,
162         I       myThid )
163    
164          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
165       &       'diag_levels', levs(1,listId), myThid)       &       'diag_levels', levs(1,listId), myThid)
# Line 189  C         for averaged levels. Line 218  C         for averaged levels.
218       &           'Dimensional coordinate value at the lower point',       &           'Dimensional coordinate value at the lower point',
219       &           myThid)       &           myThid)
220            ENDIF            ENDIF
221    C     suppress the missing value attribute (iflag = 0)
222              IF (useMissingValue)
223         &         CALL MNC_CW_VATTR_MISSING(dn(1), 0,
224         I         misval_r8, misval_r4, misval_int,
225         I         myThid )
226            CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)            CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)
227            CALL MNC_CW_DEL_VNAME(dn(1), myThid)            CALL MNC_CW_DEL_VNAME(dn(1), myThid)
228            CALL MNC_CW_DEL_GNAME(dn(1), myThid)            CALL MNC_CW_DEL_GNAME(dn(1), myThid)
# Line 202  C---+----1----+----2----+----3----+----4 Line 236  C---+----1----+----2----+----3----+----4
236    
237        DO md = 1,nfields(listId)        DO md = 1,nfields(listId)
238          ndId = jdiag(md,listId)          ndId = jdiag(md,listId)
239          parms1 = gdiag(ndId)(1:8)          gcode = gdiag(ndId)(1:10)
240          mate = 0          mate = 0
241          mVec = 0          mVec = 0
242          IF ( parms1(5:5).EQ.'C' ) THEN          IF ( gcode(5:5).EQ.'C' ) THEN
243  C-      Check for Mate of a Counter Diagnostic  C-      Check for Mate of a Counter Diagnostic
244             READ(parms1,'(5X,I3)') mate             mate = hdiag(ndId)
245          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
246  C-      Check for Mate of a Vector Diagnostic  C-      Check for Mate of a Vector Diagnostic
247             READ(parms1,'(5X,I3)') mVec             mVec = hdiag(ndId)
248          ENDIF          ENDIF
249          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
250  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
251           DO lm=1,averageCycle(listId)           DO lm=1,averageCycle(listId)
252    
# Line 229  C-        Empty diagnostics case : Line 263  C-        Empty diagnostics case :
263       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter
264              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
265       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
266              WRITE(msgBuf,'(A,I4,3A,I3,2A)')              WRITE(msgBuf,'(A,I6,3A,I4,2A)')
267       &       '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),       &       '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),
268       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)
269              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
270       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
271              IF ( averageCycle(listId).GT.1 ) THEN              IF ( averageCycle(listId).GT.1 ) THEN
272               WRITE(msgBuf,'(A,2(I2,A))')               WRITE(msgBuf,'(A,2(I3,A))')
273       &        '- WARNING -   has not been filled (ndiag(lm=',lm,')=',       &        '- WARNING -   has not been filled (ndiag(lm=',lm,')=',
274       &                                            ndiag(ip,1,1), ' )'       &                                            ndiag(ip,1,1), ' )'
275              ELSE              ELSE
276               WRITE(msgBuf,'(A,2(I2,A))')               WRITE(msgBuf,'(A,2(I3,A))')
277       &        '- WARNING -   has not been filled (ndiag=',       &        '- WARNING -   has not been filled (ndiag=',
278       &                                            ndiag(ip,1,1), ' )'       &                                            ndiag(ip,1,1), ' )'
279              ENDIF              ENDIF
# Line 266  C-        Empty diagnostics case : Line 300  C-        Empty diagnostics case :
300  C-        diagnostics is not empty :  C-        diagnostics is not empty :
301    
302              IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN              IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN
303                WRITE(ioUnit,'(A,I3,3A,I8,2A)')                WRITE(ioUnit,'(A,I6,3A,I8,2A)')
304       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
305       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
306                IF ( mate.GT.0 ) THEN                IF ( mate.GT.0 ) THEN
307                 WRITE(ioUnit,'(3A,I3,2A)')                 WRITE(ioUnit,'(3A,I6,2A)')
308       &         '       use Counter Mate for  ', cdiag(ndId),       &         '       use Counter Mate for  ', cdiag(ndId),
309       &         '     Diagnostic # ',mate, '  ', cdiag(mate)       &         '     Diagnostic # ',mate, '  ', cdiag(mate)
310                ELSEIF ( mVec.GT.0 ) THEN                ELSEIF ( mVec.GT.0 ) THEN
311                  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
312                   WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I6,3A)')
313       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
314       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
315       &             ' exists '       &             ' exists '
316                  ELSE                  ELSE
317                   WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I6,3A)')
318       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
319       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
320       &             ' not enabled'       &             ' not enabled'
# Line 433  C           Time dimension Line 467  C           Time dimension
467              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
468       &             udiag(ndId),myThid)       &             udiag(ndId),myThid)
469    
470  C           Per the observations of Baylor, this has been commented out  C     Missing values only for scalar diagnostics at mass points (so far)
471  C           until we have code that can write missing_value attributes              useMisValForThisDiag = useMissingValue
472  C           in a way thats compatible with most of the more popular       &           .AND.gdiag(ndId)(1:2).EQ.'SM'
473  C           netCDF tools including ferret.  Using all-zeros completely              IF ( useMisValForThisDiag ) THEN
474  C           breaks ferret.  C     assign missing values and set flag for adding the netCDF atttibute
475                 CALL MNC_CW_VATTR_MISSING(cdiag(ndId), 2,
476  C           CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value',       I            misval_r8, misval_r4, misval_int,
477  C           &             0.0 _d 0,myThid)       I            myThid )
478    C     and now use the missing values for masking out the land points
479                 DO bj = myByLo(myThid), myByHi(myThid)
480                  DO bi = myBxLo(myThid), myBxHi(myThid)
481                   DO k = 1,nlevels(listId)
482                    klev = NINT(levs(k,listId))
483                    DO j = 1-OLy,sNy+OLy
484                     DO i = 1-OLx,sNx+OLx
485                      IF ( _hFacC(I,J,klev,bi,bj) .EQ. 0. )
486         &                 qtmp1(i,j,k,bi,bj) = misvalLoc
487                     ENDDO
488                    ENDDO
489                   ENDDO
490                  ENDDO
491                 ENDDO
492                ELSE
493    C     suppress the missing value attribute (iflag = 0)
494    C     Note: We have to call the following subroutine for each mnc that has
495    C     been created "on the fly" by mnc_cw_add_vname and will be deleted
496    C     by mnc_cw_del_vname, because all of these variables use the same
497    C     identifier so that mnc_cw_vfmv(indv) needs to be overwritten for
498    C     each of these variables
499                 CALL MNC_CW_VATTR_MISSING(cdiag(ndId), 0,
500         I            misval_r8, misval_r4, misval_int,
501         I            myThid )
502                ENDIF
503    
504              IF ( ( (writeBinaryPrec .EQ. precFloat32)              IF ( ( (writeBinaryPrec .EQ. precFloat32)
505       &           .AND. (fflags(listId)(1:1) .NE. 'D')       &           .AND. (fflags(listId)(1:1) .NE. 'D')
Legend:
Removed from v.1.34  
changed lines
  Added in v.1.39
  ViewVC Help
Powered by ViewVC 1.1.22