/[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.33 by jmc, Wed Jan 31 21:47:55 2007 UTC revision 1.42 by jmc, Tue Aug 4 18:00:29 2009 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*8 parms1        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
75        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
76        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
77        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
78          INTEGER prec, nRec
79  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
80        LOGICAL glf        LOGICAL glf
81        INTEGER nRec        _RL timeRec(1)
       INTEGER prec  
82  #endif  #endif
83  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
84          INTEGER ll, llMx, jj, jjMx
85        INTEGER ii        INTEGER ii
86        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
87        INTEGER CW_DIMS, NLEN        INTEGER CW_DIMS, NLEN
# Line 89  C              diagnostic storage qdiag Line 95  C              diagnostic storage qdiag
95        CHARACTER*(5) ctmp        CHARACTER*(5) ctmp
96        _RS ztmp(NrMax)        _RS ztmp(NrMax)
97  #endif  #endif
98          LOGICAL useMissingValue, useMisValForThisDiag
99          REAL*8 misvalLoc
100          REAL*8 misval_r8(2)
101          REAL*4 misval_r4(2)
102          INTEGER misvalIntLoc, misval_int(2)
103  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
104    
105  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
106    
107        ioUnit= standardMessageUnit        ioUnit= standardMessageUnit
108          undef = UNSET_RL
109    #ifdef ALLOW_FIZHI
110    c     IF ( useFIZHI ) undef = getcon('UNDEF')
111        undef = getcon('UNDEF')        undef = getcon('UNDEF')
112    #endif
113        WRITE(suff,'(I10.10)') myIter        WRITE(suff,'(I10.10)') myIter
114        ilen = ILNBLNK(fnames(listId))        ilen = ILNBLNK(fnames(listId))
115        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)
116    
117  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
118    C-- this is a trick to reverse the order of the loops on md (= field)
119    C   and lm (= averagePeriod): binary output: lm loop inside md loop ;
120    C                                 mnc ouput: md loop inside lm loop.
121        IF (useMNC .AND. diag_mnc) THEN        IF (useMNC .AND. diag_mnc) THEN
122          DO i = 1,MAX_LEN_FNAM          jjMx = averageCycle(listId)
123            diag_mnc_bn(i:i) = ' '          llMx = 1
124          ENDDO        ELSE
125          DO i = 1,NLEN          jjMx = 1
126            dn_blnk(i:i) = ' '          llMx = averageCycle(listId)
127          ENDDO        ENDIF
128          WRITE( diag_mnc_bn, '(A)' ) fnames(listId)(1:ilen)        DO jj=1,jjMx
129    
130           IF (useMNC .AND. diag_mnc) THEN
131    C     Handle missing value attribute (land points)
132             useMissingValue = .FALSE.
133    #ifdef DIAGNOSTICS_MISSING_VALUE
134             useMissingValue = .TRUE.
135    #endif /* DIAGNOSTICS_MISSING_VALUE */
136             IF ( misvalFlt(listId) .NE. UNSET_RL ) THEN
137              misvalLoc = misvalFlt(listId)
138             ELSE
139              misvalLoc = undef
140             ENDIF
141    C     Defaults to UNSET_I
142             misvalIntLoc = misvalInt(listId)
143             DO ii=1,2
144    C         misval_r4(ii)  = UNSET_FLOAT4
145    C         misval_r8(ii)  = UNSET_FLOAT8
146              misval_r4(ii)  = misvalLoc
147              misval_r8(ii)  = misvalLoc
148              misval_int(ii) = UNSET_I
149             ENDDO
150             DO i = 1,MAX_LEN_FNAM
151               diag_mnc_bn(i:i) = ' '
152             ENDDO
153             DO i = 1,NLEN
154               dn_blnk(i:i) = ' '
155             ENDDO
156             WRITE( diag_mnc_bn, '(A)' ) fnames(listId)(1:ilen)
157    
158  C       Update the record dimension by writing the iteration number  C       Update the record dimension by writing the iteration number
159          CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)           klev = myIter + jj - jjMx
160          CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)           tmpLev = myTime + deltaTClock*(jj -jjMx)
161          CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)           CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
162          CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)           CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',tmpLev,myThid)
163             CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
164             CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',klev,myThid)
165    
166  C       NOTE: at some point it would be a good idea to add a time_bounds  C       NOTE: at some point it would be a good idea to add a time_bounds
167  C       variable that has dimension (2,T) and clearly denotes the  C       variable that has dimension (2,T) and clearly denotes the
168  C       beginning and ending times for each diagnostics period  C       beginning and ending times for each diagnostics period
169    
170          dn(1)(1:NLEN) = dn_blnk(1:NLEN)           dn(1)(1:NLEN) = dn_blnk(1:NLEN)
171          WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)           WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)
172          dim(1) = nlevels(listId)           dim(1) = nlevels(listId)
173          ib(1)  = 1           ib(1)  = 1
174          ie(1)  = nlevels(listId)           ie(1)  = nlevels(listId)
175    
176          CALL MNC_CW_ADD_GNAME('diag_levels', 1,           CALL MNC_CW_ADD_GNAME('diag_levels', 1,
177       &       dim, dn, ib, ie, myThid)       &        dim, dn, ib, ie, myThid)
178          CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',           CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',
179       &       0,0, myThid)       &        0,0, myThid)
180          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',           CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',
181       &       'Idicies of vertical levels within the source arrays',       &        'Idicies of vertical levels within the source arrays',
182       &       myThid)       &        myThid)
183    C     suppress the missing value attribute (iflag = 0)
184             IF (useMissingValue)
185         &       CALL MNC_CW_VATTR_MISSING('diag_levels', 0,
186         I       misval_r8, misval_r4, misval_int,
187         I       myThid )
188    
189          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,           CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
190       &       'diag_levels', levs(1,listId), myThid)       &        'diag_levels', levs(1,listId), myThid)
191    
192          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)           CALL MNC_CW_DEL_VNAME('diag_levels', myThid)
193          CALL MNC_CW_DEL_GNAME('diag_levels', myThid)           CALL MNC_CW_DEL_GNAME('diag_levels', myThid)
194    
195  #ifdef DIAG_MNC_COORD_NEEDSWORK  #ifdef DIAG_MNC_COORD_NEEDSWORK
196  C       This part has been placed in an #ifdef because, as its currently  C       This part has been placed in an #ifdef because, as its currently
# Line 153  C       as: Z[uml]td000000 where the 't' Line 206  C       as: Z[uml]td000000 where the 't'
206  C       gdiag(10)  C       gdiag(10)
207    
208  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
209          ctmp(1:5) = 'mul  '           ctmp(1:5) = 'mul  '
210          DO i = 1,3           DO i = 1,3
211            dn(1)(1:NLEN) = dn_blnk(1:NLEN)             dn(1)(1:NLEN) = dn_blnk(1:NLEN)
212            WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listId)             WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listId)
213            CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid)             CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid)
214            CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)             CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)
215    
216  C         The following three ztmp() loops should eventually be modified  C         The following three ztmp() loops should eventually be modified
217  C         to reflect the fractional nature of levs(j,l) -- they should  C         to reflect the fractional nature of levs(j,l) -- they should
# Line 168  C                      + ( rC(INT(FLOOR( Line 221  C                      + ( rC(INT(FLOOR(
221  C                          + rC(INT(CEIL(levs(j,l)))) )  C                          + rC(INT(CEIL(levs(j,l)))) )
222  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )
223  C         for averaged levels.  C         for averaged levels.
224            IF (i .EQ. 1) THEN             IF (i .EQ. 1) THEN
225              DO j = 1,nlevels(listId)               DO j = 1,nlevels(listId)
226                ztmp(j) = rC(NINT(levs(j,listId)))                 ztmp(j) = rC(NINT(levs(j,listId)))
227              ENDDO               ENDDO
228              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',               CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
229       &           'Dimensional coordinate value at the mid point',       &            'Dimensional coordinate value at the mid point',
230       &           myThid)       &            myThid)
231            ELSEIF (i .EQ. 2) THEN             ELSEIF (i .EQ. 2) THEN
232              DO j = 1,nlevels(listId)               DO j = 1,nlevels(listId)
233                ztmp(j) = rF(NINT(levs(j,listId)) + 1)                 ztmp(j) = rF(NINT(levs(j,listId)) + 1)
234              ENDDO               ENDDO
235              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',               CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
236       &           'Dimensional coordinate value at the upper point',       &            'Dimensional coordinate value at the upper point',
237       &           myThid)       &            myThid)
238            ELSEIF (i .EQ. 3) THEN             ELSEIF (i .EQ. 3) THEN
239              DO j = 1,nlevels(listId)               DO j = 1,nlevels(listId)
240                ztmp(j) = rF(NINT(levs(j,listId)))                 ztmp(j) = rF(NINT(levs(j,listId)))
241              ENDDO               ENDDO
242              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',               CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
243       &           'Dimensional coordinate value at the lower point',       &            'Dimensional coordinate value at the lower point',
244       &           myThid)       &            myThid)
245            ENDIF             ENDIF
246            CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)  C     suppress the missing value attribute (iflag = 0)
247            CALL MNC_CW_DEL_VNAME(dn(1), myThid)             IF (useMissingValue)
248            CALL MNC_CW_DEL_GNAME(dn(1), myThid)       &          CALL MNC_CW_VATTR_MISSING(dn(1), 0,
249          ENDDO       I          misval_r8, misval_r4, misval_int,
250         I          myThid )
251               CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)
252               CALL MNC_CW_DEL_VNAME(dn(1), myThid)
253               CALL MNC_CW_DEL_GNAME(dn(1), myThid)
254             ENDDO
255  #endif /*  DIAG_MNC_COORD_NEEDSWORK  */  #endif /*  DIAG_MNC_COORD_NEEDSWORK  */
256    
257        ENDIF         ENDIF
258  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
259    
260  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
261    
262        DO md = 1,nfields(listId)         DO md = 1,nfields(listId)
263          ndId = jdiag(md,listId)          ndId = jdiag(md,listId)
264          parms1 = gdiag(ndId)(1:8)          gcode = gdiag(ndId)(1:10)
265          mate = 0          mate = 0
266          mVec = 0          mVec = 0
267          IF ( parms1(5:5).EQ.'C' ) THEN          IF ( gcode(5:5).EQ.'C' ) THEN
268  C-      Check for Mate of a Counter Diagnostic  C-      Check for Mate of a Counter Diagnostic
269             READ(parms1,'(5X,I3)') mate             mate = hdiag(ndId)
270          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
271  C-      Check for Mate of a Vector Diagnostic  C-      Check for Mate of a Vector Diagnostic
272             READ(parms1,'(5X,I3)') mVec             mVec = hdiag(ndId)
273          ENDIF          ENDIF
274          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
275  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
276    #ifdef ALLOW_MNC
277             DO ll=1,llMx
278              lm = jj+ll-1
279    #else
280           DO lm=1,averageCycle(listId)           DO lm=1,averageCycle(listId)
281    #endif
282    
283            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)
284            im = mdiag(md,listId)            im = mdiag(md,listId)
# Line 230  C-        Empty diagnostics case : Line 293  C-        Empty diagnostics case :
293       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter
294              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
295       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
296              WRITE(msgBuf,'(A,I4,3A,I3,2A)')              WRITE(msgBuf,'(A,I6,3A,I4,2A)')
297       &       '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),       &       '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),
298       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)
299              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
300       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
301              IF ( averageCycle(listId).GT.1 ) THEN              IF ( averageCycle(listId).GT.1 ) THEN
302               WRITE(msgBuf,'(A,2(I2,A))')               WRITE(msgBuf,'(A,2(I3,A))')
303       &        '- WARNING -   has not been filled (ndiag(lm=',lm,')=',       &        '- WARNING -   has not been filled (ndiag(lm=',lm,')=',
304       &                                            ndiag(ip,1,1), ' )'       &                                            ndiag(ip,1,1), ' )'
305              ELSE              ELSE
306               WRITE(msgBuf,'(A,2(I2,A))')               WRITE(msgBuf,'(A,2(I3,A))')
307       &        '- WARNING -   has not been filled (ndiag=',       &        '- WARNING -   has not been filled (ndiag=',
308       &                                            ndiag(ip,1,1), ' )'       &                                            ndiag(ip,1,1), ' )'
309              ENDIF              ENDIF
# Line 267  C-        Empty diagnostics case : Line 330  C-        Empty diagnostics case :
330  C-        diagnostics is not empty :  C-        diagnostics is not empty :
331    
332              IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN              IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN
333                WRITE(ioUnit,'(A,I3,3A,I8,2A)')                WRITE(ioUnit,'(A,I6,3A,I8,2A)')
334       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
335       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
336                IF ( mate.GT.0 ) THEN                IF ( mate.GT.0 ) THEN
337                 WRITE(ioUnit,'(3A,I3,2A)')                 WRITE(ioUnit,'(3A,I6,2A)')
338       &         '       use Counter Mate for  ', cdiag(ndId),       &         '       use Counter Mate for  ', cdiag(ndId),
339       &         '     Diagnostic # ',mate, '  ', cdiag(mate)       &         '     Diagnostic # ',mate, '  ', cdiag(mate)
340                ELSEIF ( mVec.GT.0 ) THEN                ELSEIF ( mVec.GT.0 ) THEN
341                  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
342                   WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I6,3A)')
343       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
344       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
345       &             ' exists '       &             ' exists '
346                  ELSE                  ELSE
347                   WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I6,3A)')
348       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
349       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
350       &             ' not enabled'       &             ' not enabled'
# Line 340  C jmc: for now, this can only work in an Line 403  C jmc: for now, this can only work in an
403    
404  C--    Ready to write field "md", element "lm" in averageCycle(listId)  C--    Ready to write field "md", element "lm" in averageCycle(listId)
405    
 #ifdef ALLOW_MDSIO  
406  C-        write to binary file, using MDSIO pkg:  C-        write to binary file, using MDSIO pkg:
407            IF (diag_mdsio) THEN            IF ( diag_mdsio ) THEN
             glf = globalFiles  
408              nRec = lm + (md-1)*averageCycle(listId)              nRec = lm + (md-1)*averageCycle(listId)
409  C           default precision for output files  C           default precision for output files
410              prec = writeBinaryPrec              prec = writeBinaryPrec
411  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
412              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
413              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
414  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
415  c    &              NrMax,nlevels(listId),qtmp1,nRec,myIter,myThid)              CALL WRITE_REC_LEV_RL(
416  C         a hack not to write meta files now:       I                            fn, prec,
417              CALL MDS_WRITE_FIELD(fn,prec,glf,.FALSE.,'RL',       I                            NrMax, 1, nlevels(listId),
418       &              NrMax,nlevels(listId),qtmp1,-nRec,myIter,myThid)       I                            qtmp1, -nRec, myIter, myThid )
419            ENDIF            ENDIF
 #endif /*  ALLOW_MDSIO  */  
420    
421  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
422            IF (useMNC .AND. diag_mnc) THEN            IF (useMNC .AND. diag_mnc) THEN
# Line 437  C           Time dimension Line 497  C           Time dimension
497              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
498       &             udiag(ndId),myThid)       &             udiag(ndId),myThid)
499    
500  C           Per the observations of Baylor, this has been commented out  C     Missing values only for scalar diagnostics at mass points (so far)
501  C           until we have code that can write missing_value attributes              useMisValForThisDiag = useMissingValue
502  C           in a way thats compatible with most of the more popular       &           .AND.gdiag(ndId)(1:2).EQ.'SM'
503  C           netCDF tools including ferret.  Using all-zeros completely              IF ( useMisValForThisDiag ) THEN
504  C           breaks ferret.  C     assign missing values and set flag for adding the netCDF atttibute
505                 CALL MNC_CW_VATTR_MISSING(cdiag(ndId), 2,
506  C           CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value',       I            misval_r8, misval_r4, misval_int,
507  C           &             0.0 _d 0,myThid)       I            myThid )
508    C     and now use the missing values for masking out the land points
509              IF ( ( (writeBinaryPrec .EQ. precFloat32)               DO bj = myByLo(myThid), myByHi(myThid)
510       &           .AND. (fflags(listId)(1:1) .NE. 'D')                DO bi = myBxLo(myThid), myBxHi(myThid)
511       &           .AND. (fflags(listId)(1:1) .NE. 'R') )                 DO k = 1,nlevels(listId)
512       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN                  klev = NINT(levs(k,listId))
513                    DO j = 1-OLy,sNy+OLy
514                     DO i = 1-OLx,sNx+OLx
515                      IF ( _hFacC(I,J,klev,bi,bj) .EQ. 0. )
516         &                 qtmp1(i,j,k,bi,bj) = misvalLoc
517                     ENDDO
518                    ENDDO
519                   ENDDO
520                  ENDDO
521                 ENDDO
522                ELSE
523    C     suppress the missing value attribute (iflag = 0)
524    C     Note: We have to call the following subroutine for each mnc that has
525    C     been created "on the fly" by mnc_cw_add_vname and will be deleted
526    C     by mnc_cw_del_vname, because all of these variables use the same
527    C     identifier so that mnc_cw_vfmv(indv) needs to be overwritten for
528    C     each of these variables
529                 CALL MNC_CW_VATTR_MISSING(cdiag(ndId), 0,
530         I            misval_r8, misval_r4, misval_int,
531         I            myThid )
532                ENDIF
533    
534                IF (  ((writeBinaryPrec .EQ. precFloat32)
535         &            .AND. (fflags(listId)(1:1) .NE. 'D'))
536         &             .OR. (fflags(listId)(1:1) .EQ. 'R') ) THEN
537                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
538       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
539              ELSEIF ( (writeBinaryPrec .EQ. precFloat64)              ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
# Line 466  C           &             0.0 _d 0,myThi Line 550  C           &             0.0 _d 0,myThi
550            ENDIF            ENDIF
551  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
552    
553    C--      end loop on lm (or ll if ALLOW_MNC) counter
554           ENDDO           ENDDO
555  C--     end of Processing Fld # md  C--     end of Processing Fld # md
556          ENDIF          ENDIF
557           ENDDO
558    
559    #ifdef ALLOW_MNC
560    C--   end loop on jj counter
561        ENDDO        ENDDO
562    #endif
563    
564  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
565        IF (diag_mdsio) THEN        IF (diag_mdsio) THEN
566  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
567  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
568  C     meta files but with more informations in it.  C     meta files but with more informations in it.
569                glf = globalFiles
570              nRec = nfields(listId)*averageCycle(listId)              nRec = nfields(listId)*averageCycle(listId)
571                timeRec(1) = myTime
572              CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,              CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
573       &              0, 0, nlevels(listId), ' ',       &              0, 0, nlevels(listId), ' ',
574       &              nfields(listId), flds(1,listId), 1, myTime,       &              nfields(listId), flds(1,listId), 1, timeRec,
575       &              nRec, myIter, myThid)       &              nRec, myIter, myThid)
576        ENDIF        ENDIF
577  #endif /*  ALLOW_MDSIO  */  #endif /*  ALLOW_MDSIO  */
Legend:
Removed from v.1.33  
changed lines
  Added in v.1.42
  ViewVC Help
Powered by ViewVC 1.1.22