/[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.15 by jmc, Sun Jun 26 16:51:49 2005 UTC revision 1.29 by jmc, Mon Jun 5 18:17:23 2006 UTC
# Line 45  CEOP Line 45  CEOP
45    
46  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
47  C     i,j,k :: loop indices  C     i,j,k :: loop indices
48    C     lm    :: loop index (averageCycle)
49  C     md    :: field number in the list "listId".  C     md    :: field number in the list "listId".
50  C     ndId  :: diagnostics  Id number (in available diagnostics list)  C     ndId  :: diagnostics  Id number (in available diagnostics list)
51  C     mate  :: counter mate Id number (in available diagnostics list)  C     mate  :: counter mate Id number (in available diagnostics list)
52  C     ip    :: diagnostics  pointer to storage array  C     ip    :: diagnostics  pointer to storage array
53  C     im    :: counter-mate pointer to storage array  C     im    :: counter-mate pointer to storage array
54        INTEGER i, j, k        INTEGER i, j, k, lm
55        INTEGER bi, bj        INTEGER bi, bj
56        INTEGER md, ndId, ip, im        INTEGER md, ndId, ip, im
57        INTEGER mate, mVec        INTEGER mate, mVec
58        CHARACTER*8 parms1        CHARACTER*8 parms1
       CHARACTER*3 mate_index  
59        _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)        _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)
60        _RL undef, getcon        _RL undef, getcon
61        EXTERNAL getcon        EXTERNAL getcon
62        INTEGER ILNBLNK        INTEGER ILNBLNK
63        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
64        INTEGER ilen        INTEGER ilen
65          INTEGER nlevsout
66    
67        INTEGER ioUnit        INTEGER ioUnit
68        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
69        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
70        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
71    #ifdef ALLOW_MDSIO
72        LOGICAL glf        LOGICAL glf
73          INTEGER nRec
74    #endif
75  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
76        INTEGER ii        INTEGER ii
77        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
       CHARACTER*(5) ctmp  
78        INTEGER CW_DIMS, NLEN        INTEGER CW_DIMS, NLEN
79        PARAMETER ( CW_DIMS = 10 )        PARAMETER ( CW_DIMS = 10 )
80        PARAMETER ( NLEN    = 80 )        PARAMETER ( NLEN    = 80 )
# Line 79  C     im    :: counter-mate pointer to s Line 82  C     im    :: counter-mate pointer to s
82        CHARACTER*(NLEN) dn(CW_DIMS)        CHARACTER*(NLEN) dn(CW_DIMS)
83        CHARACTER*(NLEN) d_cw_name        CHARACTER*(NLEN) d_cw_name
84        CHARACTER*(NLEN) dn_blnk        CHARACTER*(NLEN) dn_blnk
85    #ifdef DIAG_MNC_COORD_NEEDSWORK
86          CHARACTER*(5) ctmp
87        _RS ztmp(Nr+Nrphys)        _RS ztmp(Nr+Nrphys)
88    #endif
89  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
90    
91  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
92    
93        ioUnit= standardMessageUnit        ioUnit= standardMessageUnit
94        undef = getcon('UNDEF')        undef = getcon('UNDEF')
       glf = globalFiles  
95        WRITE(suff,'(I10.10)') myIter        WRITE(suff,'(I10.10)') myIter
96        ilen = ILNBLNK(fnames(listId))        ilen = ILNBLNK(fnames(listId))
97        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)
# Line 105  C       Update the record dimension by w Line 110  C       Update the record dimension by w
110          CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)          CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
111          CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)          CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)
112          CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)          CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
113            CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)
114    
115    C       NOTE: at some point it would be a good idea to add a time_bounds
116    C       variable that has dimension (2,T) and clearly denotes the
117    C       beginning and ending times for each diagnostics period
118    
119          dn(1)(1:NLEN) = dn_blnk(1:NLEN)          dn(1)(1:NLEN) = dn_blnk(1:NLEN)
120          WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)          WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)
# Line 112  C       Update the record dimension by w Line 122  C       Update the record dimension by w
122          ib(1)  = 1          ib(1)  = 1
123          ie(1)  = nlevels(listId)          ie(1)  = nlevels(listId)
124    
125          CALL MNC_CW_ADD_GNAME('diag_levels', 1,          CALL MNC_CW_ADD_GNAME('diag_levels', 1,
126       &       dim, dn, ib, ie, myThid)       &       dim, dn, ib, ie, myThid)
127          CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',          CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',
128       &       0,0, myThid)       &       0,0, myThid)
129          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',
130       &       'Idicies of vertical levels within the source arrays',       &       'Idicies of vertical levels within the source arrays',
131       &       myThid)       &       myThid)
132            
133          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
134       &       'diag_levels', levs(1,listId), myThid)       &       'diag_levels', levs(1,listId), myThid)
135    
136          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)
137          CALL MNC_CW_DEL_GNAME('diag_levels', myThid)          CALL MNC_CW_DEL_GNAME('diag_levels', myThid)
138    
139    #ifdef DIAG_MNC_COORD_NEEDSWORK
140    C       This part has been placed in an #ifdef because, as its currently
141    C       written, it will only work with variables defined on a dynamics
142    C       grid.  As we start using diagnostics for physics grids, ice
143    C       levels, land levels, etc. the different vertical coordinate
144    C       dimensions will have to be taken into account.
145    
146    C       20051021 JMC & EH3 : We need to extend this so that a few
147    C       variables each defined on different grids do not have the same
148    C       vertical dimension names so we should be using a pattern such
149    C       as: Z[uml]td000000 where the 't' is the type as specified by
150    C       gdiag(10)
151    
152  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
153          ctmp(1:5) = 'mul  '          ctmp(1:5) = 'mul  '
154          DO i = 1,3          DO i = 1,3
# Line 137  C       Now define:  Zmdxxxxxx, Zudxxxxx Line 160  C       Now define:  Zmdxxxxxx, Zudxxxxx
160  C         The following three ztmp() loops should eventually be modified  C         The following three ztmp() loops should eventually be modified
161  C         to reflect the fractional nature of levs(j,l) -- they should  C         to reflect the fractional nature of levs(j,l) -- they should
162  C         do something like:  C         do something like:
163  C            ztmp(j) = rC(INT(FLOOR(levs(j,l))))  C            ztmp(j) = rC(INT(FLOOR(levs(j,l))))
164  C                      + ( rC(INT(FLOOR(levs(j,l))))  C                      + ( rC(INT(FLOOR(levs(j,l))))
165  C                          + rC(INT(CEIL(levs(j,l)))) )  C                          + rC(INT(CEIL(levs(j,l)))) )
166  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )
167  C         for averaged levels.  C         for averaged levels.
# Line 168  C         for averaged levels. Line 191  C         for averaged levels.
191            CALL MNC_CW_DEL_VNAME(dn(1), myThid)            CALL MNC_CW_DEL_VNAME(dn(1), myThid)
192            CALL MNC_CW_DEL_GNAME(dn(1), myThid)            CALL MNC_CW_DEL_GNAME(dn(1), myThid)
193          ENDDO          ENDDO
194    #endif /*  DIAG_MNC_COORD_NEEDSWORK  */
195    
196        ENDIF        ENDIF
197  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
198    
199    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
200    
201        DO md = 1,nfields(listId)        DO md = 1,nfields(listId)
202          ndId = jdiag(md,listId)          ndId = jdiag(md,listId)
203          parms1 = gdiag(ndId)(1:8)          parms1 = gdiag(ndId)(1:8)
204            mate = 0
205            mVec = 0
206            IF ( parms1(5:5).EQ.'C' ) THEN
207    C-      Check for Mate of a Counter Diagnostic
208               READ(parms1,'(5X,I3)') mate
209            ELSEIF ( parms1(1:1).EQ.'U' .OR. parms1(1:1).EQ.'V' ) THEN
210    C-      Check for Mate of a Vector Diagnostic
211               READ(parms1,'(5X,I3)') mVec
212            ENDIF
213          IF ( idiag(md,listId).NE.0 .AND. parms1(5:5).NE.'D' ) THEN          IF ( idiag(md,listId).NE.0 .AND. parms1(5:5).NE.'D' ) THEN
214  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
215             DO lm=1,averageCycle(listId)
216    
217            ip = ABS(idiag(md,listId))            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)
218            im = mdiag(md,listId)            im = mdiag(md,listId)
219              IF (mate.GT.0) im = im + kdiag(mate)*(lm-1)
220              IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)
221    
222            IF ( ndiag(ip,1,1).EQ.0 ) THEN            IF ( ndiag(ip,1,1).EQ.0 ) THEN
223  C-        Empty diagnostics case :  C-        Empty diagnostics case :
224    
# Line 193  C-        Empty diagnostics case : Line 232  C-        Empty diagnostics case :
232       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)
233              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
234       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
235              WRITE(msgBuf,'(A,I2,A)')              IF ( averageCycle(listId).GT.1 ) THEN
236       &       '- WARNING -   has not been filled (ndiag=',               WRITE(msgBuf,'(A,2(I2,A))')
237       &       ndiag(ip,1,1), ' )'       &        '- WARNING -   has not been filled (ndiag(lm=',lm,')=',
238         &                                            ndiag(ip,1,1), ' )'
239                ELSE
240                 WRITE(msgBuf,'(A,2(I2,A))')
241         &        '- WARNING -   has not been filled (ndiag=',
242         &                                            ndiag(ip,1,1), ' )'
243                ENDIF
244              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
245       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
246              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
# Line 218  C-        Empty diagnostics case : Line 263  C-        Empty diagnostics case :
263            ELSE            ELSE
264  C-        diagnostics is not empty :  C-        diagnostics is not empty :
265    
266              IF ( myThid.EQ.1 ) WRITE(ioUnit,'(A,I3,3A,I8,2A)')              IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN
267                  WRITE(ioUnit,'(A,I3,3A,I8,2A)')
268       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
269       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
270                  IF ( mate.GT.0 ) THEN
271              IF ( parms1(5:5).EQ.'C' ) THEN                 WRITE(ioUnit,'(3A,I3,2A)')
 C             Check for Mate of a Counter Diagnostic  
 C             --------------------------------------  
               mate_index = parms1(6:8)  
               READ (mate_index,'(I3)') mate  
               IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,2A)')  
272       &         '       use Counter Mate for  ', cdiag(ndId),       &         '       use Counter Mate for  ', cdiag(ndId),
273       &         '     Diagnostic # ',mate, '  ', cdiag(mate)       &         '     Diagnostic # ',mate, '  ', cdiag(mate)
274                  ELSEIF ( mVec.GT.0 ) THEN
             ELSE  
               mate = 0  
   
 C             Check for Mate of a Vector Diagnostic  
 C             -------------------------------------  
               IF ( parms1(1:1).EQ.'U' .OR. parms1(1:1).EQ.'V' ) THEN  
                 mate_index = parms1(6:8)  
                 READ (mate_index,'(I3)') mVec  
275                  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
276                   IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I3,3A)')
277       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
278       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
279       &             ' exists '       &             ' exists '
280                  ELSE                  ELSE
281                   IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I3,3A)')
282       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
283       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
284       &             ' not enabled'       &             ' not enabled'
# Line 267  C             -------------------------- Line 300  C             --------------------------
300  C-        end of empty diag / not empty block  C-        end of empty diag / not empty block
301            ENDIF            ENDIF
302    
303              nlevsout = nlevels(listId)
304    
305    C-----------------------------------------------------------------------
306    C         Check to see if we need to interpolate before output
307    C-----------------------------------------------------------------------
308              IF ( fflags(listId)(2:2).EQ.'P' ) THEN
309    C-        Do vertical interpolation:
310    c          IF ( fluidIsAir ) THEN
311    C jmc: for now, this can only work in an atmospheric set-up (fluidIsAir);
312    C      find some problems with 5-levels AIM => use it only with FIZHI
313               IF ( useFIZHI ) THEN
314                CALL DIAGNOSTICS_INTERP_VERT(
315         I                     listId, md, ndId, ip, im,
316         U                     nlevsout,
317         U                     qtmp1,
318         I                     undef,
319         I                     myTime, myIter, myThid )
320               ELSE
321                 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
322         &         'INTERP_VERT not safe in this config'
323                 CALL PRINT_ERROR( msgBuf , myThid )
324                 WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_OUT: ',
325         &         ' for list l=', listId, ', filename: ', fnames(listId)
326                 CALL PRINT_ERROR( msgBuf , myThid )
327                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
328               ENDIF
329              ENDIF
330    
331  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
332  C         Prepare for mdsio optionality  C         Prepare for mdsio optionality
333            IF (diag_mdsio) THEN            IF (diag_mdsio) THEN
334              IF (fflags(listId)(1:1) .EQ. ' ') THEN              glf = globalFiles
335  C             This is the old default behavior              nRec = lm + (md-1)*averageCycle(listId)
336                CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,'RL',              IF (fflags(listId)(1:1) .EQ. 'R') THEN
      &             Nr+Nrphys,nlevels(listId),qtmp1,md,myIter,myThid)  
             ELSEIF (fflags(listId)(1:1) .EQ. 'R') THEN  
337  C             Force it to be 32-bit precision  C             Force it to be 32-bit precision
338                CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,.FALSE.,
339       &             Nr+Nrphys,nlevels(listId),qtmp1,md,myIter,myThid)       &             'RL',Nr+Nrphys,nlevsout,qtmp1,nRec,myIter,myThid)
340              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
341  C             Force it to be 64-bit precision  C             Force it to be 64-bit precision
342                CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,.FALSE.,
343       &             Nr+Nrphys,nlevels(listId),qtmp1,md,myIter,myThid)       &             'RL',Nr+Nrphys,nlevsout,qtmp1,nRec,myIter,myThid)
344                ELSE
345    C             This is the old default behavior
346                  CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,.FALSE.,
347         &             'RL',Nr+Nrphys,nlevsout,qtmp1,nRec,myIter,myThid)
348              ENDIF              ENDIF
349            ENDIF            ENDIF
350  #endif /*  ALLOW_MDSIO  */  #endif /*  ALLOW_MDSIO  */
# Line 310  C           XY dimensions Line 373  C           XY dimensions
373              dim(2)       = sNy + 2*OLy              dim(2)       = sNy + 2*OLy
374              ib(1)        = OLx + 1              ib(1)        = OLx + 1
375              ib(2)        = OLy + 1              ib(2)        = OLy + 1
376              IF (gdiag(ndId)(2:2) .EQ. 'M') THEN              IF (gdiag(ndId)(2:2) .EQ. 'M') THEN
377                dn(1)(1:2) = 'X'                dn(1)(1:2) = 'X'
378                ie(1)      = OLx + sNx                ie(1)      = OLx + sNx
379                dn(2)(1:2) = 'Y'                dn(2)(1:2) = 'Y'
# Line 331  C           XY dimensions Line 394  C           XY dimensions
394                dn(2)(1:3) = 'Yp1'                dn(2)(1:3) = 'Yp1'
395                ie(2)      = OLy + sNy + 1                ie(2)      = OLy + sNy + 1
396              ENDIF              ENDIF
397                
398  C           Z is special since it varies  C           Z is special since it varies
399              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listId)              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevsout
400              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
401       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
402                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listId)                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevsout
403              ENDIF              ENDIF
404              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
405       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
406                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listId)                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevsout
407              ENDIF              ENDIF
408              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
409       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
410                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listId)                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevsout
411              ENDIF              ENDIF
412              dim(3) = Nr+Nrphys              dim(3) = Nr+Nrphys
413              ib(3)  = 1              ib(3)  = 1
414              ie(3)  = nlevels(listId)              ie(3)  = nlevsout
415    
416  C           Time dimension  C           Time dimension
417              dn(4)(1:1) = 'T'              dn(4)(1:1) = 'T'
# Line 356  C           Time dimension Line 419  C           Time dimension
419              ib(4)  = 1              ib(4)  = 1
420              ie(4)  = 1              ie(4)  = 1
421    
422              CALL MNC_CW_ADD_GNAME(d_cw_name, 4,              CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
423       &             dim, dn, ib, ie, myThid)       &             dim, dn, ib, ie, myThid)
424              CALL MNC_CW_ADD_VNAME(cdiag(ndId), d_cw_name,              CALL MNC_CW_ADD_VNAME(cdiag(ndId), d_cw_name,
425       &             4,5, myThid)       &             4,5, myThid)
426              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'description',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'description',
427       &             tdiag(ndId),myThid)       &             tdiag(ndId),myThid)
428              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
429       &             udiag(ndId),myThid)       &             udiag(ndId),myThid)
430    
431              IF ((fflags(listId)(1:1) .EQ. ' ')  C           Per the observations of Baylor, this has been commented out
432    C           until we have code that can write missing_value attributes
433    C           in a way thats compatible with most of the more popular
434    C           netCDF tools including ferret.  Using all-zeros completely
435    C           breaks ferret.
436    
437    C           CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value',
438    C           &             0.0 _d 0,myThid)
439    
440                IF ( ( (writeBinaryPrec .EQ. precFloat32)
441         &           .AND. (fflags(listId)(1:1) .NE. 'D')
442         &           .AND. (fflags(listId)(1:1) .NE. 'R') )
443       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
444                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
445       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
446              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN              ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
447         &             .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN
448                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
449       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
450              ENDIF              ENDIF
451                
452              CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid)              CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid)
453              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
454    
# Line 382  C           Time dimension Line 457  C           Time dimension
457            ENDIF            ENDIF
458  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
459    
460             ENDDO
461  C--     end of Processing Fld # md  C--     end of Processing Fld # md
462          ENDIF          ENDIF
463        ENDDO        ENDDO
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.22