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