/[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.22 by edhill, Thu Sep 29 16:44:21 2005 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,1,1,'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       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
145          ctmp(1:5) = 'mul  '          ctmp(1:5) = 'mul  '
146          DO i = 1,3          DO i = 1,3
# Line 168  C         for averaged levels. Line 183  C         for averaged levels.
183            CALL MNC_CW_DEL_VNAME(dn(1), myThid)            CALL MNC_CW_DEL_VNAME(dn(1), myThid)
184            CALL MNC_CW_DEL_GNAME(dn(1), myThid)            CALL MNC_CW_DEL_GNAME(dn(1), myThid)
185          ENDDO          ENDDO
186    #endif /*  DIAG_MNC_COORD_NEEDSWORK  */
187    
188        ENDIF        ENDIF
189  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
# Line 267  C             -------------------------- Line 283  C             --------------------------
283  C-        end of empty diag / not empty block  C-        end of empty diag / not empty block
284            ENDIF            ENDIF
285    
286              nlevsout = nlevels(listId)
287    
288    C-----------------------------------------------------------------------
289    C         Check to see if we need to interpolate before output
290    C-----------------------------------------------------------------------
291             IF ( fflags(listId)(2:2).EQ.'P' ) THEN
292    C-        Do vertical interpolation:
293              CALL DIAGNOSTICS_INTERP_VERT(
294         I                     listId, md, ndId, ip, im,
295         U                     nlevsout,
296         U                     qtmp1,
297         I                     undef,
298         I                     myTime, myIter, myThid )
299             ENDIF
300    
301  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
302  C         Prepare for mdsio optionality  C         Prepare for mdsio optionality
303            IF (diag_mdsio) THEN            IF (diag_mdsio) THEN
304              IF (fflags(listId)(1:1) .EQ. ' ') THEN              IF (fflags(listId)(1:1) .EQ. ' ') THEN
305  C             This is the old default behavior  C             This is the old default behavior
306                CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,'RL',
307       &             Nr+Nrphys,nlevels(listId),qtmp1,md,myIter,myThid)       &             Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
308              ELSEIF (fflags(listId)(1:1) .EQ. 'R') THEN              ELSEIF (fflags(listId)(1:1) .EQ. 'R') THEN
309  C             Force it to be 32-bit precision  C             Force it to be 32-bit precision
310                CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,'RL',
311       &             Nr+Nrphys,nlevels(listId),qtmp1,md,myIter,myThid)       &             Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
312              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
313  C             Force it to be 64-bit precision  C             Force it to be 64-bit precision
314                CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,'RL',
315       &             Nr+Nrphys,nlevels(listId),qtmp1,md,myIter,myThid)       &             Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
316              ENDIF              ENDIF
317            ENDIF            ENDIF
318  #endif /*  ALLOW_MDSIO  */  #endif /*  ALLOW_MDSIO  */
# Line 365  C           Time dimension Line 396  C           Time dimension
396              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
397       &             udiag(ndId),myThid)       &             udiag(ndId),myThid)
398    
399              IF ((fflags(listId)(1:1) .EQ. ' ')              IF ( ( (writeBinaryPrec .EQ. precFloat32)
400         &           .AND. (fflags(listId)(1:1) .NE. 'D')
401         &           .AND. (fflags(listId)(1:1) .NE. 'R') )
402       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
403                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
404       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
405              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN              ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
406         &             .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN
407                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
408       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
409              ENDIF              ENDIF
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.22
  ViewVC Help
Powered by ViewVC 1.1.22