/[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.2 by edhill, Wed Jul 6 14:58:11 2005 UTC revision 1.6 by jmc, Thu Aug 25 21:55:54 2005 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 186  C         for averaged levels. Line 188  C         for averaged levels.
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', nlevels(listId)          WRITE(dn(1),'(a,i6.6)') 'Zd', kdiag(ndId)
192          IF ( (gdiag(ndId)(10:10) .EQ. 'R')          IF ( (gdiag(ndId)(10:10) .EQ. 'R')
193       &       .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN       &       .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
194            WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)            WRITE(dn(1),'(a,i6.6)') 'Zmd', kdiag(ndId)
195          ENDIF          ENDIF
196          IF ( (gdiag(ndId)(10:10) .EQ. 'R')          IF ( (gdiag(ndId)(10:10) .EQ. 'R')
197       &       .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN       &       .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
198            WRITE(dn(1),'(a,i6.6)') 'Zld', nlevels(listId)            WRITE(dn(1),'(a,i6.6)') 'Zld', kdiag(ndId)
199          ENDIF          ENDIF
200          IF ( (gdiag(ndId)(10:10) .EQ. 'R')          IF ( (gdiag(ndId)(10:10) .EQ. 'R')
201       &       .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN       &       .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
202            WRITE(dn(1),'(a,i6.6)') 'Zud', nlevels(listId)            WRITE(dn(1),'(a,i6.6)') 'Zud', kdiag(ndId)
203          ENDIF          ENDIF
204          dim(1) = Nr+Nrphys+1          dim(1) = Nr+Nrphys+1
205          ib(1)  = 1          ib(1)  = 1
# Line 238  C       guarantee uniqueness within each Line 240  C       guarantee uniqueness within each
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
             
           IF ( kdiag(ndId) .GT. 1 ) THEN  
245                            
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)
# Line 292  C           Copy the data into a tempora Line 262  C           Copy the data into a tempora
262              IF ((fflags(listId)(1:1) .EQ. ' ')              IF ((fflags(listId)(1:1) .EQ. ' ')
263       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
264                                
265                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('R',diag_mnc_bn,1,1,
266       &             tnam, stmp, myThid)       &             tnam, stmp, myThid)
267                                
268              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
269                                
270                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('D',diag_mnc_bn,1,1,
271       &             tnam, stmp, myThid)       &             tnam, stmp, myThid)
272                            
273              ENDIF              ENDIF
274                            
275              CALL MNC_CW_DEL_VNAME(tnam, myThid)              CALL MNC_CW_DEL_VNAME(tnam, myThid)
276                            
277            ENDIF  c         ENDIF
278                    
279              IF ( kdiag(ndId) .GT. 1 ) THEN
280    
281                ilen = ILNBLNK(cdiag(ndId))
282                WRITE(tnam,'(a,a4,a3)')
283         &           cdiag(ndId)(1:ilen),'_lv_',stat_typ(ist+1)
284              
285                CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname,
286         &           0,0, myThid)
287                CALL MNC_CW_ADD_VATTR_TEXT(tnam,'description',
288         &           tdiag(ndId),myThid)
289                CALL MNC_CW_ADD_VATTR_TEXT(tnam,'units',
290         &         udiag(ndId),myThid)
291              
292    C           Copy the data into a temporary with the necessary shape
293                DO j = 0,nRegions
294                  DO k = 1,kdiag(ndId)
295                    stmp(k,j+1) = statGlob(ist,k,j)
296                  ENDDO
297                ENDDO
298              
299                IF ((fflags(listId)(1:1) .EQ. ' ')
300         &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
301                
302                  CALL MNC_CW_RL_W('R',diag_mnc_bn,1,1,
303         &             tnam, stmp, myThid)
304                
305                ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
306                
307                  CALL MNC_CW_RL_W('D',diag_mnc_bn,1,1,
308         &             tnam, stmp, myThid)
309                
310                ENDIF
311    
312                CALL MNC_CW_DEL_VNAME(tnam, myThid)
313              
314              ENDIF
315    
316          ENDDO          ENDDO
317                    
318          CALL MNC_CW_DEL_GNAME(d_cw_gname, myThid)          CALL MNC_CW_DEL_GNAME(d_cw_gname, myThid)
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22