/[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.3 by edhill, Wed Jul 6 19:51:29 2005 UTC revision 1.8 by jmc, Tue Feb 5 15:31:19 2008 UTC
# Line 49  C     myThid   :: my thread Id number Line 49  C     myThid   :: my thread Id number
49  CEOP  CEOP
50    
51  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
52    #ifdef ALLOW_MNC
53        INTEGER im, ix, iv, ist        INTEGER im, ix, iv, ist
54        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )
55        INTEGER i, j, k        INTEGER i, j, k
# Line 56  C     !LOCAL VARIABLES: Line 57  C     !LOCAL VARIABLES:
57        CHARACTER*(3) stat_typ(5)        CHARACTER*(3) stat_typ(5)
58        INTEGER ILNBLNK        INTEGER ILNBLNK
59        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
 #ifdef ALLOW_MNC  
60        INTEGER ii, ilen        INTEGER ii, ilen
61        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
       CHARACTER*(5) ctmp  
62        INTEGER CW_DIMS, NLEN        INTEGER CW_DIMS, NLEN
63        PARAMETER ( CW_DIMS = 10 )        PARAMETER ( CW_DIMS = 10 )
64        PARAMETER ( NLEN    = 80 )        PARAMETER ( NLEN    = 80 )
# Line 68  C     !LOCAL VARIABLES: Line 67  C     !LOCAL VARIABLES:
67        CHARACTER*(NLEN) d_cw_gname        CHARACTER*(NLEN) d_cw_gname
68        CHARACTER*(NLEN) d_cw_gname0        CHARACTER*(NLEN) d_cw_gname0
69        CHARACTER*(NLEN) dn_blnk        CHARACTER*(NLEN) dn_blnk
70    #ifdef DIAGST_MNC_NEEDSWORK
71          CHARACTER*(5) ctmp
72        _RS ztmp(Nr+Nrphys)        _RS ztmp(Nr+Nrphys)
73    #endif
74        _RL stmp(Nr+Nrphys+1,nRegions+1)        _RL stmp(Nr+Nrphys+1,nRegions+1)
75  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
76    
# Line 102  C---+----1----+----2----+----3----+----4 Line 104  C---+----1----+----2----+----3----+----4
104          IF (mId .EQ. 1) THEN          IF (mId .EQ. 1) THEN
105  C         Update the record dimension by writing the iteration number  C         Update the record dimension by writing the iteration number
106            CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)            CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
107            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,1,1,'T',myTime,myThid)
108            CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)            CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
109            CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)            CALL MNC_CW_I_W_S('I',diag_mnc_bn,1,1,'iter',myIter,myThid)
110          ENDIF          ENDIF
111    
112  #ifdef DIAGST_MNC_NEEDSWORK  #ifdef DIAGST_MNC_NEEDSWORK
# Line 130  C       no specified vertical location. Line 132  C       no specified vertical location.
132       &       'Idicies of vertical levels within the source arrays',       &       'Idicies of vertical levels within the source arrays',
133       &       myThid)       &       myThid)
134    
135          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,          CALL MNC_CW_RL_W('D',diag_mnc_bn,1,1,
136       &       'diag_levels', levs(1,listId), myThid)       &       'diag_levels', levs(1,listId), myThid)
137    
138          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)
# Line 174  C         for averaged levels. Line 176  C         for averaged levels.
176       &           'Dimensional coordinate value at the lower point',       &           'Dimensional coordinate value at the lower point',
177       &           myThid)       &           myThid)
178            ENDIF            ENDIF
179            CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)            CALL MNC_CW_RS_W('D',diag_mnc_bn,1,1, dn(1), ztmp, myThid)
180            CALL MNC_CW_DEL_VNAME(dn(1), myThid)            CALL MNC_CW_DEL_VNAME(dn(1), myThid)
181            CALL MNC_CW_DEL_GNAME(dn(1), myThid)            CALL MNC_CW_DEL_GNAME(dn(1), myThid)
182          ENDDO          ENDDO
# Line 184  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 202  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 232  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
           ilen = ILNBLNK(cdiag(ndId))  
           WRITE(tnam,'(a,a4,a3)')  
      &         cdiag(ndId)(1:ilen),'_lv_',stat_typ(ist+1)  
             
           CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname,  
      &         0,0, myThid)  
           CALL MNC_CW_ADD_VATTR_TEXT(tnam,'description',  
      &         tdiag(ndId),myThid)  
           CALL MNC_CW_ADD_VATTR_TEXT(tnam,'units',  
      &         udiag(ndId),myThid)  
             
 C         Copy the data into a temporary with the necessary shape  
           DO j = 0,nRegions  
             DO k = 1,kdiag(ndId)  
               stmp(k,j+1) = statGlob(ist,k,j)  
             ENDDO  
           ENDDO  
             
           IF ((fflags(listId)(1:1) .EQ. ' ')  
      &         .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN  
               
             CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,  
      &           tnam, stmp, myThid)  
               
           ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN  
               
             CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,  
      &           tnam, stmp, myThid)  
               
           ENDIF  
243    
244            CALL MNC_CW_DEL_VNAME(tnam, myThid)  c         IF ( kdiag(ndId) .GT. 1 ) THEN
245              
           IF ( kdiag(ndId) .GT. 1 ) THEN  
               
246              ilen = ILNBLNK(cdiag(ndId))              ilen = ILNBLNK(cdiag(ndId))
247              WRITE(tnam,'(a,a4,a3)')              WRITE(tnam,'(a,a1,a3)')
248       &           cdiag(ndId)(1:ilen),'_vi_',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              IF ((fflags(listId)(1:1) .EQ. ' ')  C-jmc: fflags is not for Statistics-Diagnostics, can be unset, and since
263       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN  C-     size of the output file will not be an issue here: Always write real*8
264                  c           IF ((fflags(listId)(1:1) .EQ. ' ')
265                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,  c    &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
266    c
267    c             CALL MNC_CW_RL_W('R',diag_mnc_bn,1,1,
268    c    &             tnam, stmp, myThid)
269    c
270    c           ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
271    
272                  CALL MNC_CW_RL_W('D',diag_mnc_bn,1,1,
273       &             tnam, stmp, myThid)       &             tnam, stmp, myThid)
274                  
275              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN  c           else
276                  c             write(0,*) myIter, ndId, listId
277                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,  c             write(0,'(3A)') '>',cdiag(ndId),'<'
278    c             write(0,'(3A)') '>',fflags(listId),'<'
279    c             STOP ' in DIAGSTATS_MNC_OUT'
280    c           ENDIF
281    
282                CALL MNC_CW_DEL_VNAME(tnam, myThid)
283    
284    c         ENDIF
285    
286              IF ( kdiag(ndId) .GT. 1 ) THEN
287    
288                ilen = ILNBLNK(cdiag(ndId))
289                WRITE(tnam,'(a,a4,a3)')
290         &           cdiag(ndId)(1:ilen),'_lv_',stat_typ(ist+1)
291    
292                CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname,
293         &           0,0, myThid)
294                CALL MNC_CW_ADD_VATTR_TEXT(tnam,'description',
295         &           tdiag(ndId),myThid)
296                CALL MNC_CW_ADD_VATTR_TEXT(tnam,'units',
297         &         udiag(ndId),myThid)
298    
299    C           Copy the data into a temporary with the necessary shape
300                DO j = 0,nRegions
301                  DO k = 1,kdiag(ndId)
302                    stmp(k,j+1) = statGlob(ist,k,j)
303                  ENDDO
304                ENDDO
305    
306    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,
308       &             tnam, stmp, myThid)       &             tnam, stmp, myThid)
309                
             ENDIF  
               
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.3  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22