/[MITgcm]/MITgcm/pkg/diagnostics/diagstats_mnc_out.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagstats_mnc_out.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.7 by jmc, Tue Nov 1 01:53:13 2005 UTC revision 1.8 by jmc, Tue Feb 5 15:31:19 2008 UTC
# Line 186  C         for averaged levels. Line 186  C         for averaged levels.
186            d_cw_gname(1:NLEN) = dn_blnk(1:NLEN)            d_cw_gname(1:NLEN) = dn_blnk(1:NLEN)
187            dn(ii)(1:NLEN) = dn_blnk(1:NLEN)            dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
188          ENDDO          ENDDO
189            
190  C       Z is special since it varies  C       Z is special since it varies
191          WRITE(dn(1),'(a,i6.6)') 'Zd', kdiag(ndId)          WRITE(dn(1),'(a,i6.6)') 'Zd', kdiag(ndId)
192          IF ( (gdiag(ndId)(10:10) .EQ. 'R')          IF ( (gdiag(ndId)(10:10) .EQ. 'R')
# Line 204  C       Z is special since it varies Line 204  C       Z is special since it varies
204          dim(1) = Nr+Nrphys+1          dim(1) = Nr+Nrphys+1
205          ib(1)  = 1          ib(1)  = 1
206          ie(1)  = kdiag(ndId)          ie(1)  = kdiag(ndId)
207            
208  C       "region" dimension  C       "region" dimension
209          dim(2)     = nRegions + 1          dim(2)     = nRegions + 1
210          ib(2)      = 1          ib(2)      = 1
211          dn(2)(1:6) = 'region'          dn(2)(1:6) = 'region'
212          ie(2)      = nRegions + 1          ie(2)      = nRegions + 1
213            
214  C       Time dimension  C       Time dimension
215          dn(3)(1:1) = 'T'          dn(3)(1:1) = 'T'
216          dim(3)     = -1          dim(3)     = -1
217          ib(3)      = 1          ib(3)      = 1
218          ie(3)      = 1          ie(3)      = 1
219            
220  C       Note that the "d_cw_gname" variable is a hack that hides a  C       Note that the "d_cw_gname" variable is a hack that hides a
221  C       subtlety within MNC.  Basically, each MNC-wrapped file is  C       subtlety within MNC.  Basically, each MNC-wrapped file is
222  C       caching its own concept of what each "grid name" (that is, a  C       caching its own concept of what each "grid name" (that is, a
# Line 234  C       guarantee uniqueness within each Line 234  C       guarantee uniqueness within each
234          WRITE(d_cw_gname0,'(a9,i6.6)') 'dst_cw_0_', ndId          WRITE(d_cw_gname0,'(a9,i6.6)') 'dst_cw_0_', ndId
235          CALL MNC_CW_ADD_GNAME(d_cw_gname0, 3,          CALL MNC_CW_ADD_GNAME(d_cw_gname0, 3,
236       &       dim, dn, ib, ie, myThid)       &       dim, dn, ib, ie, myThid)
237            
238          DO ist = 0,nStats          DO ist = 0,nStats
239              
240            DO i = 1,MAX_LEN_FNAM            DO i = 1,MAX_LEN_FNAM
241              tnam(i:i) = ' '              tnam(i:i) = ' '
242            ENDDO            ENDDO
243    
244  c         IF ( kdiag(ndId) .GT. 1 ) THEN  c         IF ( kdiag(ndId) .GT. 1 ) THEN
245                
246              ilen = ILNBLNK(cdiag(ndId))              ilen = ILNBLNK(cdiag(ndId))
247              WRITE(tnam,'(a,a1,a3)')              WRITE(tnam,'(a,a1,a3)')
248       &           cdiag(ndId)(1:ilen),'_',stat_typ(ist+1)       &           cdiag(ndId)(1:ilen),'_',stat_typ(ist+1)
249                
250              CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname0,              CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname0,
251       &           0,0, myThid)       &           0,0, myThid)
252              CALL MNC_CW_ADD_VATTR_TEXT(tnam,'description',              CALL MNC_CW_ADD_VATTR_TEXT(tnam,'description',
253       &           tdiag(ndId),myThid)       &           tdiag(ndId),myThid)
254              CALL MNC_CW_ADD_VATTR_TEXT(tnam,'units',              CALL MNC_CW_ADD_VATTR_TEXT(tnam,'units',
255       &           udiag(ndId),myThid)       &           udiag(ndId),myThid)
256                
257  C           Copy the data into a temporary with the necessary shape  C           Copy the data into a temporary with the necessary shape
258              DO j = 0,nRegions              DO j = 0,nRegions
259                stmp(1,j+1) = statGlob(ist,0,j)                stmp(1,j+1) = statGlob(ist,0,j)
260              ENDDO              ENDDO
261              
262  C-jmc: fflags is not for Statistics-Diagnostics, can be unset, and since  C-jmc: fflags is not for Statistics-Diagnostics, can be unset, and since
263  C-     size of the output file will not be an issue here: Always write real*8  C-     size of the output file will not be an issue here: Always write real*8
264  c           IF ((fflags(listId)(1:1) .EQ. ' ')  c           IF ((fflags(listId)(1:1) .EQ. ' ')
265  c    &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN  c    &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
266  c              c
267  c             CALL MNC_CW_RL_W('R',diag_mnc_bn,1,1,  c             CALL MNC_CW_RL_W('R',diag_mnc_bn,1,1,
268  c    &             tnam, stmp, myThid)  c    &             tnam, stmp, myThid)
269  c              c
270  c           ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN  c           ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
271                  
272                CALL MNC_CW_RL_W('D',diag_mnc_bn,1,1,                CALL MNC_CW_RL_W('D',diag_mnc_bn,1,1,
273       &             tnam, stmp, myThid)       &             tnam, stmp, myThid)
274                
275  c           else  c           else
276  c             write(0,*) myIter, ndId, listId  c             write(0,*) myIter, ndId, listId
277  c             write(0,'(3A)') '>',cdiag(ndId),'<'  c             write(0,'(3A)') '>',cdiag(ndId),'<'
278  c             write(0,'(3A)') '>',fflags(listId),'<'  c             write(0,'(3A)') '>',fflags(listId),'<'
279  c             STOP ' in DIAGSTATS_MNC_OUT'  c             STOP ' in DIAGSTATS_MNC_OUT'
280  c           ENDIF  c           ENDIF
281                
282              CALL MNC_CW_DEL_VNAME(tnam, myThid)              CALL MNC_CW_DEL_VNAME(tnam, myThid)
283                
284  c         ENDIF  c         ENDIF
285            
286            IF ( kdiag(ndId) .GT. 1 ) THEN            IF ( kdiag(ndId) .GT. 1 ) THEN
287    
288              ilen = ILNBLNK(cdiag(ndId))              ilen = ILNBLNK(cdiag(ndId))
289              WRITE(tnam,'(a,a4,a3)')              WRITE(tnam,'(a,a4,a3)')
290       &           cdiag(ndId)(1:ilen),'_lv_',stat_typ(ist+1)       &           cdiag(ndId)(1:ilen),'_lv_',stat_typ(ist+1)
291              
292              CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname,              CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname,
293       &           0,0, myThid)       &           0,0, myThid)
294              CALL MNC_CW_ADD_VATTR_TEXT(tnam,'description',              CALL MNC_CW_ADD_VATTR_TEXT(tnam,'description',
295       &           tdiag(ndId),myThid)       &           tdiag(ndId),myThid)
296              CALL MNC_CW_ADD_VATTR_TEXT(tnam,'units',              CALL MNC_CW_ADD_VATTR_TEXT(tnam,'units',
297       &         udiag(ndId),myThid)       &         udiag(ndId),myThid)
298              
299  C           Copy the data into a temporary with the necessary shape  C           Copy the data into a temporary with the necessary shape
300              DO j = 0,nRegions              DO j = 0,nRegions
301                DO k = 1,kdiag(ndId)                DO k = 1,kdiag(ndId)
302                  stmp(k,j+1) = statGlob(ist,k,j)                  stmp(k,j+1) = statGlob(ist,k,j)
303                ENDDO                ENDDO
304              ENDDO              ENDDO
305              
306  C-jmc: Always write real*8 (size of the output file will not be an issue here)  C-jmc: Always write real*8 (size of the output file will not be an issue here)
307                CALL MNC_CW_RL_W('D',diag_mnc_bn,1,1,                CALL MNC_CW_RL_W('D',diag_mnc_bn,1,1,
308       &             tnam, stmp, myThid)       &             tnam, stmp, myThid)
309                
310              CALL MNC_CW_DEL_VNAME(tnam, myThid)              CALL MNC_CW_DEL_VNAME(tnam, myThid)
311              
312            ENDIF            ENDIF
313    
314          ENDDO          ENDDO
315            
316          CALL MNC_CW_DEL_GNAME(d_cw_gname, myThid)          CALL MNC_CW_DEL_GNAME(d_cw_gname, myThid)
317          CALL MNC_CW_DEL_GNAME(d_cw_gname0, myThid)          CALL MNC_CW_DEL_GNAME(d_cw_gname0, myThid)
318    
319        ENDIF        ENDIF
320            
321        _END_MASTER( myThid )        _END_MASTER( myThid )
322    
323  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22