/[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.27 by edhill, Mon Feb 6 21:20:23 2006 UTC revision 1.33 by jmc, Wed Jan 31 21:47:55 2007 UTC
# Line 26  C     !USES: Line 26  C     !USES:
26  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
27  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
28    
29  #ifdef ALLOW_FIZHI        INTEGER NrMax
30  #include "fizhi_SIZE.h"        PARAMETER( NrMax = numLevels )
 #else  
       INTEGER Nrphys  
       PARAMETER (Nrphys=0)  
 #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 45  CEOP Line 40  CEOP
40    
41  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
42  C     i,j,k :: loop indices  C     i,j,k :: loop indices
43    C     lm    :: loop index (averageCycle)
44  C     md    :: field number in the list "listId".  C     md    :: field number in the list "listId".
45  C     ndId  :: diagnostics  Id number (in available diagnostics list)  C     ndId  :: diagnostics  Id number (in available diagnostics list)
46  C     mate  :: counter mate Id number (in available diagnostics list)  C     mate  :: counter mate Id number (in available diagnostics list)
47  C     ip    :: diagnostics  pointer to storage array  C     ip    :: diagnostics  pointer to storage array
48  C     im    :: counter-mate pointer to storage array  C     im    :: counter-mate pointer to storage array
49        INTEGER i, j, k  C
50    C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)
51    C     qtmp1 :: thread-shared temporary array (needs to be in common block):
52    C              to write a diagnostic field to file, copy it first from (big)
53    C              diagnostic storage qdiag into it.
54          COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1
55          _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
56    
57          INTEGER i, j, k, lm
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*8 parms1
       CHARACTER*3 mate_index  
       _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)  
62        _RL undef, getcon        _RL undef, getcon
63          _RL tmpLev
64        EXTERNAL getcon        EXTERNAL getcon
65        INTEGER ILNBLNK        INTEGER ILNBLNK
66        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
67        INTEGER ilen        INTEGER ilen
       INTEGER nlevsout  
68    
69        INTEGER ioUnit        INTEGER ioUnit
70        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
71        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
72        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
73    #ifdef ALLOW_MDSIO
74        LOGICAL glf        LOGICAL glf
75          INTEGER nRec
76          INTEGER prec
77    #endif
78  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
79        INTEGER ii        INTEGER ii
80        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
# Line 81  C     im    :: counter-mate pointer to s Line 87  C     im    :: counter-mate pointer to s
87        CHARACTER*(NLEN) dn_blnk        CHARACTER*(NLEN) dn_blnk
88  #ifdef DIAG_MNC_COORD_NEEDSWORK  #ifdef DIAG_MNC_COORD_NEEDSWORK
89        CHARACTER*(5) ctmp        CHARACTER*(5) ctmp
90        _RS ztmp(Nr+Nrphys)        _RS ztmp(NrMax)
91  #endif  #endif
92  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
93    
# Line 89  C---+----1----+----2----+----3----+----4 Line 95  C---+----1----+----2----+----3----+----4
95    
96        ioUnit= standardMessageUnit        ioUnit= standardMessageUnit
97        undef = getcon('UNDEF')        undef = getcon('UNDEF')
       glf = globalFiles  
98        WRITE(suff,'(I10.10)') myIter        WRITE(suff,'(I10.10)') myIter
99        ilen = ILNBLNK(fnames(listId))        ilen = ILNBLNK(fnames(listId))
100        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 120  C       beginning and ending times for e Line 125  C       beginning and ending times for e
125          ib(1)  = 1          ib(1)  = 1
126          ie(1)  = nlevels(listId)          ie(1)  = nlevels(listId)
127    
128          CALL MNC_CW_ADD_GNAME('diag_levels', 1,          CALL MNC_CW_ADD_GNAME('diag_levels', 1,
129       &       dim, dn, ib, ie, myThid)       &       dim, dn, ib, ie, myThid)
130          CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',          CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',
131       &       0,0, myThid)       &       0,0, myThid)
132          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',
133       &       'Idicies of vertical levels within the source arrays',       &       'Idicies of vertical levels within the source arrays',
134       &       myThid)       &       myThid)
135            
136          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
137       &       'diag_levels', levs(1,listId), myThid)       &       'diag_levels', levs(1,listId), myThid)
138    
# Line 158  C       Now define:  Zmdxxxxxx, Zudxxxxx Line 163  C       Now define:  Zmdxxxxxx, Zudxxxxx
163  C         The following three ztmp() loops should eventually be modified  C         The following three ztmp() loops should eventually be modified
164  C         to reflect the fractional nature of levs(j,l) -- they should  C         to reflect the fractional nature of levs(j,l) -- they should
165  C         do something like:  C         do something like:
166  C            ztmp(j) = rC(INT(FLOOR(levs(j,l))))  C            ztmp(j) = rC(INT(FLOOR(levs(j,l))))
167  C                      + ( rC(INT(FLOOR(levs(j,l))))  C                      + ( rC(INT(FLOOR(levs(j,l))))
168  C                          + rC(INT(CEIL(levs(j,l)))) )  C                          + rC(INT(CEIL(levs(j,l)))) )
169  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )
170  C         for averaged levels.  C         for averaged levels.
# Line 194  C         for averaged levels. Line 199  C         for averaged levels.
199        ENDIF        ENDIF
200  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
201    
202    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
203    
204        DO md = 1,nfields(listId)        DO md = 1,nfields(listId)
205          ndId = jdiag(md,listId)          ndId = jdiag(md,listId)
206          parms1 = gdiag(ndId)(1:8)          parms1 = gdiag(ndId)(1:8)
207            mate = 0
208            mVec = 0
209            IF ( parms1(5:5).EQ.'C' ) THEN
210    C-      Check for Mate of a Counter Diagnostic
211               READ(parms1,'(5X,I3)') mate
212            ELSEIF ( parms1(1:1).EQ.'U' .OR. parms1(1:1).EQ.'V' ) THEN
213    C-      Check for Mate of a Vector Diagnostic
214               READ(parms1,'(5X,I3)') mVec
215            ENDIF
216          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
217  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
218             DO lm=1,averageCycle(listId)
219    
220            ip = ABS(idiag(md,listId))            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)
221            im = mdiag(md,listId)            im = mdiag(md,listId)
222              IF (mate.GT.0) im = im + kdiag(mate)*(lm-1)
223              IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)
224    
225            IF ( ndiag(ip,1,1).EQ.0 ) THEN            IF ( ndiag(ip,1,1).EQ.0 ) THEN
226  C-        Empty diagnostics case :  C-        Empty diagnostics case :
227    
# Line 215  C-        Empty diagnostics case : Line 235  C-        Empty diagnostics case :
235       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)
236              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
237       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
238              WRITE(msgBuf,'(A,I2,A)')              IF ( averageCycle(listId).GT.1 ) THEN
239       &       '- WARNING -   has not been filled (ndiag=',               WRITE(msgBuf,'(A,2(I2,A))')
240       &       ndiag(ip,1,1), ' )'       &        '- WARNING -   has not been filled (ndiag(lm=',lm,')=',
241         &                                            ndiag(ip,1,1), ' )'
242                ELSE
243                 WRITE(msgBuf,'(A,2(I2,A))')
244         &        '- WARNING -   has not been filled (ndiag=',
245         &                                            ndiag(ip,1,1), ' )'
246                ENDIF
247              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
248       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
249              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
# Line 240  C-        Empty diagnostics case : Line 266  C-        Empty diagnostics case :
266            ELSE            ELSE
267  C-        diagnostics is not empty :  C-        diagnostics is not empty :
268    
269              IF ( myThid.EQ.1 ) WRITE(ioUnit,'(A,I3,3A,I8,2A)')              IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN
270                  WRITE(ioUnit,'(A,I3,3A,I8,2A)')
271       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
272       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
273                  IF ( mate.GT.0 ) THEN
274              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)')  
275       &         '       use Counter Mate for  ', cdiag(ndId),       &         '       use Counter Mate for  ', cdiag(ndId),
276       &         '     Diagnostic # ',mate, '  ', cdiag(mate)       &         '     Diagnostic # ',mate, '  ', cdiag(mate)
277                  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  
278                  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
279                   IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I3,3A)')
280       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
281       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
282       &             ' exists '       &             ' exists '
283                  ELSE                  ELSE
284                   IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,3A)')                   WRITE(ioUnit,'(3A,I3,3A)')
285       &             '           Vector  Mate for  ', cdiag(ndId),       &             '           Vector  Mate for  ', cdiag(ndId),
286       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),       &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
287       &             ' not enabled'       &             ' not enabled'
# Line 275  C             -------------------------- Line 289  C             --------------------------
289                ENDIF                ENDIF
290              ENDIF              ENDIF
291    
292              DO bj = myByLo(myThid), myByHi(myThid)              IF ( fflags(listId)(2:2).EQ.'P' ) THEN
293               DO bi = myBxLo(myThid), myBxHi(myThid)  C-       get all the levels (for vertical interpolation)
294                DO k = 1,nlevels(listId)                DO bj = myByLo(myThid), myByHi(myThid)
295                  CALL GETDIAG(                 DO bi = myBxLo(myThid), myBxHi(myThid)
296       I                       levs(k,listId),undef,                  DO k = 1,kdiag(ndId)
297       O                       qtmp1(1-OLx,1-OLy,k,bi,bj),                    tmpLev = k
298       I                       ndId,mate,ip,im,bi,bj,myThid)                    CALL GETDIAG(
299         I                         tmpLev,undef,
300         O                         qtmp1(1-OLx,1-OLy,k,bi,bj),
301         I                         ndId,mate,ip,im,bi,bj,myThid)
302                    ENDDO
303                   ENDDO
304                ENDDO                ENDDO
305               ENDDO              ELSE
306              ENDDO  C-       get only selected levels:
307                  DO bj = myByLo(myThid), myByHi(myThid)
308                   DO bi = myBxLo(myThid), myBxHi(myThid)
309                    DO k = 1,nlevels(listId)
310                      CALL GETDIAG(
311         I                         levs(k,listId),undef,
312         O                         qtmp1(1-OLx,1-OLy,k,bi,bj),
313         I                         ndId,mate,ip,im,bi,bj,myThid)
314                    ENDDO
315                   ENDDO
316                  ENDDO
317                ENDIF
318    
319  C-        end of empty diag / not empty block  C-        end of empty diag / not empty block
320            ENDIF            ENDIF
321    
           nlevsout = nlevels(listId)  
   
322  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
323  C         Check to see if we need to interpolate before output  C         Check to see if we need to interpolate before output
324  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
325           IF ( fflags(listId)(2:2).EQ.'P' ) THEN            IF ( fflags(listId)(2:2).EQ.'P' ) THEN
326  C-        Do vertical interpolation:  C-        Do vertical interpolation:
327            CALL DIAGNOSTICS_INTERP_VERT(             IF ( fluidIsAir ) THEN
328       I                     listId, md, ndId, ip, im,  C jmc: for now, this can only work in an atmospheric set-up (fluidIsAir);
329       U                     nlevsout,              CALL DIAGNOSTICS_INTERP_VERT(
330         I                     listId, md, ndId, ip, im, lm,
331       U                     qtmp1,       U                     qtmp1,
332       I                     undef,       I                     undef, myTime, myIter, myThid )
333       I                     myTime, myIter, myThid )             ELSE
334           ENDIF               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
335         &         'INTERP_VERT not allowed in this config'
336                 CALL PRINT_ERROR( msgBuf , myThid )
337                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
338               ENDIF
339              ENDIF
340    
341    C--    Ready to write field "md", element "lm" in averageCycle(listId)
342    
343  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
344  C         Prepare for mdsio optionality  C-        write to binary file, using MDSIO pkg:
345            IF (diag_mdsio) THEN            IF (diag_mdsio) THEN
346              IF (fflags(listId)(1:1) .EQ. 'R') THEN              glf = globalFiles
347  C             Force it to be 32-bit precision              nRec = lm + (md-1)*averageCycle(listId)
348                CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,.FALSE.,  C           default precision for output files
349       &             'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)              prec = writeBinaryPrec
350              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN  C           fFlag(1)=R(or D): force it to be 32-bit(or 64) precision
351  C             Force it to be 64-bit precision              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
352                CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,.FALSE.,              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
353       &             'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)  c           CALL MDS_WRITE_FIELD(fn,prec,glf,.FALSE.,'RL',
354              ELSE  c    &              NrMax,nlevels(listId),qtmp1,nRec,myIter,myThid)
355  C             This is the old default behavior  C         a hack not to write meta files now:
356                CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,.FALSE.,              CALL MDS_WRITE_FIELD(fn,prec,glf,.FALSE.,'RL',
357       &             'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)       &              NrMax,nlevels(listId),qtmp1,-nRec,myIter,myThid)
             ENDIF  
358            ENDIF            ENDIF
359  #endif /*  ALLOW_MDSIO  */  #endif /*  ALLOW_MDSIO  */
360    
# Line 347  C           XY dimensions Line 382  C           XY dimensions
382              dim(2)       = sNy + 2*OLy              dim(2)       = sNy + 2*OLy
383              ib(1)        = OLx + 1              ib(1)        = OLx + 1
384              ib(2)        = OLy + 1              ib(2)        = OLy + 1
385              IF (gdiag(ndId)(2:2) .EQ. 'M') THEN              IF (gdiag(ndId)(2:2) .EQ. 'M') THEN
386                dn(1)(1:2) = 'X'                dn(1)(1:2) = 'X'
387                ie(1)      = OLx + sNx                ie(1)      = OLx + sNx
388                dn(2)(1:2) = 'Y'                dn(2)(1:2) = 'Y'
# Line 368  C           XY dimensions Line 403  C           XY dimensions
403                dn(2)(1:3) = 'Yp1'                dn(2)(1:3) = 'Yp1'
404                ie(2)      = OLy + sNy + 1                ie(2)      = OLy + sNy + 1
405              ENDIF              ENDIF
406                
407  C           Z is special since it varies  C           Z is special since it varies
408              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevsout              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listId)
409              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
410       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
411                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevsout                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listId)
412              ENDIF              ENDIF
413              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
414       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
415                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevsout                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listId)
416              ENDIF              ENDIF
417              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
418       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
419                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevsout                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listId)
420              ENDIF              ENDIF
421              dim(3) = Nr+Nrphys              dim(3) = NrMax
422              ib(3)  = 1              ib(3)  = 1
423              ie(3)  = nlevsout              ie(3)  = nlevels(listId)
424    
425  C           Time dimension  C           Time dimension
426              dn(4)(1:1) = 'T'              dn(4)(1:1) = 'T'
# Line 393  C           Time dimension Line 428  C           Time dimension
428              ib(4)  = 1              ib(4)  = 1
429              ie(4)  = 1              ie(4)  = 1
430    
431              CALL MNC_CW_ADD_GNAME(d_cw_name, 4,              CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
432       &             dim, dn, ib, ie, myThid)       &             dim, dn, ib, ie, myThid)
433              CALL MNC_CW_ADD_VNAME(cdiag(ndId), d_cw_name,              CALL MNC_CW_ADD_VNAME(cdiag(ndId), d_cw_name,
434       &             4,5, myThid)       &             4,5, myThid)
435              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'description',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'description',
436       &             tdiag(ndId),myThid)       &             tdiag(ndId),myThid)
437              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
438       &             udiag(ndId),myThid)       &             udiag(ndId),myThid)
439              CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value',  
440       &             0.0 _d 0,myThid)  C           Per the observations of Baylor, this has been commented out
441    C           until we have code that can write missing_value attributes
442    C           in a way thats compatible with most of the more popular
443    C           netCDF tools including ferret.  Using all-zeros completely
444    C           breaks ferret.
445    
446    C           CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value',
447    C           &             0.0 _d 0,myThid)
448    
449              IF ( ( (writeBinaryPrec .EQ. precFloat32)              IF ( ( (writeBinaryPrec .EQ. precFloat32)
450       &           .AND. (fflags(listId)(1:1) .NE. 'D')       &           .AND. (fflags(listId)(1:1) .NE. 'D')
# Line 410  C           Time dimension Line 452  C           Time dimension
452       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
453                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
454       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
455              ELSEIF ( (writeBinaryPrec .EQ. precFloat64)              ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
456       &             .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN       &             .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN
457                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
458       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
459              ENDIF              ENDIF
460                
461              CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid)              CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid)
462              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
463    
# Line 424  C           Time dimension Line 466  C           Time dimension
466            ENDIF            ENDIF
467  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
468    
469             ENDDO
470  C--     end of Processing Fld # md  C--     end of Processing Fld # md
471          ENDIF          ENDIF
472        ENDDO        ENDDO
473    
474    #ifdef ALLOW_MDSIO
475          IF (diag_mdsio) THEN
476    C-    Note: temporary: since it's a pain to add more arguments to
477    C     all MDSIO S/R, uses instead this specific S/R to write only
478    C     meta files but with more informations in it.
479                nRec = nfields(listId)*averageCycle(listId)
480                CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
481         &              0, 0, nlevels(listId), ' ',
482         &              nfields(listId), flds(1,listId), 1, myTime,
483         &              nRec, myIter, myThid)
484          ENDIF
485    #endif /*  ALLOW_MDSIO  */
486    
487        RETURN        RETURN
488        END        END
489    
Legend:
Removed from v.1.27  
changed lines
  Added in v.1.33
  ViewVC Help
Powered by ViewVC 1.1.22