/[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.35 by jmc, Tue Feb 5 15:13:01 2008 UTC revision 1.40 by jmc, Tue Nov 18 21:41:06 2008 UTC
# Line 38  C     myThid  :: my Thread Id number Line 38  C     myThid  :: my Thread Id number
38        INTEGER listId, myIter, myThid        INTEGER listId, myIter, myThid
39  CEOP  CEOP
40    
41    C     !FUNCTIONS:
42          INTEGER ILNBLNK
43          EXTERNAL ILNBLNK
44    #ifdef ALLOW_FIZHI
45          _RL   getcon
46          EXTERNAL getcon
47    #endif
48    
49  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
50  C     i,j,k :: loop indices  C     i,j,k :: loop indices
51  C     lm    :: loop index (averageCycle)  C     lm    :: loop index (averageCycle)
# Line 54  C              diagnostic storage qdiag Line 62  C              diagnostic storage qdiag
62        COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1        COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1
63        _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)
64    
65        INTEGER i, j, k, lm        INTEGER i, j, k, lm, klev
66        INTEGER bi, bj        INTEGER bi, bj
67        INTEGER md, ndId, ip, im        INTEGER md, ndId, ip, im
68        INTEGER mate, mVec        INTEGER mate, mVec
69        CHARACTER*10 gcode        CHARACTER*10 gcode
70        _RL undef, getcon        _RL undef
71        _RL tmpLev        _RL tmpLev
       EXTERNAL getcon  
       INTEGER ILNBLNK  
       EXTERNAL ILNBLNK  
72        INTEGER ilen        INTEGER ilen
73    
74        INTEGER ioUnit        INTEGER ioUnit
# Line 88  C              diagnostic storage qdiag Line 93  C              diagnostic storage qdiag
93        CHARACTER*(5) ctmp        CHARACTER*(5) ctmp
94        _RS ztmp(NrMax)        _RS ztmp(NrMax)
95  #endif  #endif
96          LOGICAL useMissingValue, useMisValForThisDiag
97          REAL*8 misvalLoc
98          REAL*8 misval_r8(2)
99          REAL*4 misval_r4(2)
100          INTEGER misvalIntLoc, misval_int(2)
101  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
102    
103  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
104    
105        ioUnit= standardMessageUnit        ioUnit= standardMessageUnit
106          undef = UNSET_RL
107    #ifdef ALLOW_FIZHI
108    c     IF ( useFIZHI ) undef = getcon('UNDEF')
109        undef = getcon('UNDEF')        undef = getcon('UNDEF')
110    #endif
111        WRITE(suff,'(I10.10)') myIter        WRITE(suff,'(I10.10)') myIter
112        ilen = ILNBLNK(fnames(listId))        ilen = ILNBLNK(fnames(listId))
113        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)
114    
115  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
116        IF (useMNC .AND. diag_mnc) THEN        IF (useMNC .AND. diag_mnc) THEN
117    C     Handle missing value attribute (land points)
118           useMissingValue = .FALSE.
119    #ifdef DIAGNOSTICS_MISSING_VALUE
120           useMissingValue = .TRUE.
121    #endif /* DIAGNOSTICS_MISSING_VALUE */
122           IF ( misvalFlt(listId) .NE. UNSET_RL ) THEN
123            misvalLoc = misvalFlt(listId)
124           ELSE
125            misvalLoc = undef
126           ENDIF
127    C     Defaults to UNSET_I
128           misvalIntLoc = misvalInt(listId)
129           DO ii=1,2
130    C       misval_r4(ii)  = UNSET_FLOAT4
131    C       misval_r8(ii)  = UNSET_FLOAT8
132            misval_r4(ii)  = misvalLoc
133            misval_r8(ii)  = misvalLoc
134            misval_int(ii) = UNSET_I
135           ENDDO
136          DO i = 1,MAX_LEN_FNAM          DO i = 1,MAX_LEN_FNAM
137            diag_mnc_bn(i:i) = ' '            diag_mnc_bn(i:i) = ' '
138          ENDDO          ENDDO
# Line 131  C       beginning and ending times for e Line 164  C       beginning and ending times for e
164          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',
165       &       'Idicies of vertical levels within the source arrays',       &       'Idicies of vertical levels within the source arrays',
166       &       myThid)       &       myThid)
167    C     suppress the missing value attribute (iflag = 0)
168            IF (useMissingValue)
169         &       CALL MNC_CW_VATTR_MISSING('diag_levels', 0,
170         I       misval_r8, misval_r4, misval_int,
171         I       myThid )
172    
173          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
174       &       'diag_levels', levs(1,listId), myThid)       &       'diag_levels', levs(1,listId), myThid)
# Line 189  C         for averaged levels. Line 227  C         for averaged levels.
227       &           'Dimensional coordinate value at the lower point',       &           'Dimensional coordinate value at the lower point',
228       &           myThid)       &           myThid)
229            ENDIF            ENDIF
230    C     suppress the missing value attribute (iflag = 0)
231              IF (useMissingValue)
232         &         CALL MNC_CW_VATTR_MISSING(dn(1), 0,
233         I         misval_r8, misval_r4, misval_int,
234         I         myThid )
235            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)
236            CALL MNC_CW_DEL_VNAME(dn(1), myThid)            CALL MNC_CW_DEL_VNAME(dn(1), myThid)
237            CALL MNC_CW_DEL_GNAME(dn(1), myThid)            CALL MNC_CW_DEL_GNAME(dn(1), myThid)
# Line 210  C-      Check for Mate of a Counter Diag Line 253  C-      Check for Mate of a Counter Diag
253             mate = hdiag(ndId)             mate = hdiag(ndId)
254          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
255  C-      Check for Mate of a Vector Diagnostic  C-      Check for Mate of a Vector Diagnostic
256             mate = hdiag(ndId)             mVec = hdiag(ndId)
257          ENDIF          ENDIF
258          IF ( idiag(md,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN          IF ( idiag(md,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN
259  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
# Line 433  C           Time dimension Line 476  C           Time dimension
476              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
477       &             udiag(ndId),myThid)       &             udiag(ndId),myThid)
478    
479  C           Per the observations of Baylor, this has been commented out  C     Missing values only for scalar diagnostics at mass points (so far)
480  C           until we have code that can write missing_value attributes              useMisValForThisDiag = useMissingValue
481  C           in a way thats compatible with most of the more popular       &           .AND.gdiag(ndId)(1:2).EQ.'SM'
482  C           netCDF tools including ferret.  Using all-zeros completely              IF ( useMisValForThisDiag ) THEN
483  C           breaks ferret.  C     assign missing values and set flag for adding the netCDF atttibute
484                 CALL MNC_CW_VATTR_MISSING(cdiag(ndId), 2,
485  C           CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value',       I            misval_r8, misval_r4, misval_int,
486  C           &             0.0 _d 0,myThid)       I            myThid )
487    C     and now use the missing values for masking out the land points
488                 DO bj = myByLo(myThid), myByHi(myThid)
489                  DO bi = myBxLo(myThid), myBxHi(myThid)
490                   DO k = 1,nlevels(listId)
491                    klev = NINT(levs(k,listId))
492                    DO j = 1-OLy,sNy+OLy
493                     DO i = 1-OLx,sNx+OLx
494                      IF ( _hFacC(I,J,klev,bi,bj) .EQ. 0. )
495         &                 qtmp1(i,j,k,bi,bj) = misvalLoc
496                     ENDDO
497                    ENDDO
498                   ENDDO
499                  ENDDO
500                 ENDDO
501                ELSE
502    C     suppress the missing value attribute (iflag = 0)
503    C     Note: We have to call the following subroutine for each mnc that has
504    C     been created "on the fly" by mnc_cw_add_vname and will be deleted
505    C     by mnc_cw_del_vname, because all of these variables use the same
506    C     identifier so that mnc_cw_vfmv(indv) needs to be overwritten for
507    C     each of these variables
508                 CALL MNC_CW_VATTR_MISSING(cdiag(ndId), 0,
509         I            misval_r8, misval_r4, misval_int,
510         I            myThid )
511                ENDIF
512    
513              IF ( ( (writeBinaryPrec .EQ. precFloat32)              IF ( ( (writeBinaryPrec .EQ. precFloat32)
514       &           .AND. (fflags(listId)(1:1) .NE. 'D')       &           .AND. (fflags(listId)(1:1) .NE. 'D')
Legend:
Removed from v.1.35  
changed lines
  Added in v.1.40
  ViewVC Help
Powered by ViewVC 1.1.22