/[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.27 by edhill, Mon Feb 6 21:20:23 2006 UTC
# Line 62  C     im    :: counter-mate pointer to s Line 62  C     im    :: counter-mate pointer to s
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
# Line 71  C     im    :: counter-mate pointer to s Line 72  C     im    :: counter-mate pointer to s
72  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
73        INTEGER ii        INTEGER ii
74        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
       CHARACTER*(5) ctmp  
75        INTEGER CW_DIMS, NLEN        INTEGER CW_DIMS, NLEN
76        PARAMETER ( CW_DIMS = 10 )        PARAMETER ( CW_DIMS = 10 )
77        PARAMETER ( NLEN    = 80 )        PARAMETER ( NLEN    = 80 )
# Line 79  C     im    :: counter-mate pointer to s Line 79  C     im    :: counter-mate pointer to s
79        CHARACTER*(NLEN) dn(CW_DIMS)        CHARACTER*(NLEN) dn(CW_DIMS)
80        CHARACTER*(NLEN) d_cw_name        CHARACTER*(NLEN) d_cw_name
81        CHARACTER*(NLEN) dn_blnk        CHARACTER*(NLEN) dn_blnk
82    #ifdef DIAG_MNC_COORD_NEEDSWORK
83          CHARACTER*(5) ctmp
84        _RS ztmp(Nr+Nrphys)        _RS ztmp(Nr+Nrphys)
85    #endif
86  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
87    
88  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 105  C       Update the record dimension by w Line 108  C       Update the record dimension by w
108          CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)          CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
109          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)
110          CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)          CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
111            CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)
112    
113    C       NOTE: at some point it would be a good idea to add a time_bounds
114    C       variable that has dimension (2,T) and clearly denotes the
115    C       beginning and ending times for each diagnostics period
116    
117          dn(1)(1:NLEN) = dn_blnk(1:NLEN)          dn(1)(1:NLEN) = dn_blnk(1:NLEN)
118          WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)          WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)
# Line 126  C       Update the record dimension by w Line 134  C       Update the record dimension by w
134          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)
135          CALL MNC_CW_DEL_GNAME('diag_levels', myThid)          CALL MNC_CW_DEL_GNAME('diag_levels', myThid)
136    
137    #ifdef DIAG_MNC_COORD_NEEDSWORK
138    C       This part has been placed in an #ifdef because, as its currently
139    C       written, it will only work with variables defined on a dynamics
140    C       grid.  As we start using diagnostics for physics grids, ice
141    C       levels, land levels, etc. the different vertical coordinate
142    C       dimensions will have to be taken into account.
143    
144    C       20051021 JMC & EH3 : We need to extend this so that a few
145    C       variables each defined on different grids do not have the same
146    C       vertical dimension names so we should be using a pattern such
147    C       as: Z[uml]td000000 where the 't' is the type as specified by
148    C       gdiag(10)
149    
150  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
151          ctmp(1:5) = 'mul  '          ctmp(1:5) = 'mul  '
152          DO i = 1,3          DO i = 1,3
# Line 168  C         for averaged levels. Line 189  C         for averaged levels.
189            CALL MNC_CW_DEL_VNAME(dn(1), myThid)            CALL MNC_CW_DEL_VNAME(dn(1), myThid)
190            CALL MNC_CW_DEL_GNAME(dn(1), myThid)            CALL MNC_CW_DEL_GNAME(dn(1), myThid)
191          ENDDO          ENDDO
192    #endif /*  DIAG_MNC_COORD_NEEDSWORK  */
193    
194        ENDIF        ENDIF
195  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
# Line 267  C             -------------------------- Line 289  C             --------------------------
289  C-        end of empty diag / not empty block  C-        end of empty diag / not empty block
290            ENDIF            ENDIF
291    
292              nlevsout = nlevels(listId)
293    
294    C-----------------------------------------------------------------------
295    C         Check to see if we need to interpolate before output
296    C-----------------------------------------------------------------------
297             IF ( fflags(listId)(2:2).EQ.'P' ) THEN
298    C-        Do vertical interpolation:
299              CALL DIAGNOSTICS_INTERP_VERT(
300         I                     listId, md, ndId, ip, im,
301         U                     nlevsout,
302         U                     qtmp1,
303         I                     undef,
304         I                     myTime, myIter, myThid )
305             ENDIF
306    
307  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
308  C         Prepare for mdsio optionality  C         Prepare for mdsio optionality
309            IF (diag_mdsio) THEN            IF (diag_mdsio) THEN
310              IF (fflags(listId)(1:1) .EQ. ' ') THEN              IF (fflags(listId)(1:1) .EQ. 'R') THEN
 C             This is the old default behavior  
               CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,'RL',  
      &             Nr+Nrphys,nlevels(listId),qtmp1,md,myIter,myThid)  
             ELSEIF (fflags(listId)(1:1) .EQ. 'R') THEN  
311  C             Force it to be 32-bit precision  C             Force it to be 32-bit precision
312                CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,.FALSE.,
313       &             Nr+Nrphys,nlevels(listId),qtmp1,md,myIter,myThid)       &             'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
314              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
315  C             Force it to be 64-bit precision  C             Force it to be 64-bit precision
316                CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,.FALSE.,
317       &             Nr+Nrphys,nlevels(listId),qtmp1,md,myIter,myThid)       &             'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
318                ELSE
319    C             This is the old default behavior
320                  CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,.FALSE.,
321         &             'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
322              ENDIF              ENDIF
323            ENDIF            ENDIF
324  #endif /*  ALLOW_MDSIO  */  #endif /*  ALLOW_MDSIO  */
# Line 333  C           XY dimensions Line 370  C           XY dimensions
370              ENDIF              ENDIF
371                            
372  C           Z is special since it varies  C           Z is special since it varies
373              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listId)              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevsout
374              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
375       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
376                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listId)                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevsout
377              ENDIF              ENDIF
378              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
379       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
380                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listId)                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevsout
381              ENDIF              ENDIF
382              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
383       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
384                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listId)                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevsout
385              ENDIF              ENDIF
386              dim(3) = Nr+Nrphys              dim(3) = Nr+Nrphys
387              ib(3)  = 1              ib(3)  = 1
388              ie(3)  = nlevels(listId)              ie(3)  = nlevsout
389    
390  C           Time dimension  C           Time dimension
391              dn(4)(1:1) = 'T'              dn(4)(1:1) = 'T'
# Line 364  C           Time dimension Line 401  C           Time dimension
401       &             tdiag(ndId),myThid)       &             tdiag(ndId),myThid)
402              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
403       &             udiag(ndId),myThid)       &             udiag(ndId),myThid)
404                CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value',
405         &             0.0 _d 0,myThid)
406    
407              IF ((fflags(listId)(1:1) .EQ. ' ')              IF ( ( (writeBinaryPrec .EQ. precFloat32)
408         &           .AND. (fflags(listId)(1:1) .NE. 'D')
409         &           .AND. (fflags(listId)(1:1) .NE. 'R') )
410       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
411                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
412       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
413              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN              ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
414         &             .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN
415                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
416       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
417              ENDIF              ENDIF
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22