/[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.16 by edhill, Thu Jul 7 15:32:35 2005 UTC revision 1.21 by edhill, Tue Sep 6 17:45:19 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 275  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  */
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22