/[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.1 by edhill, Wed Jul 6 02:13:52 2005 UTC revision 1.4 by jmc, Thu Jul 14 00:11:13 2005 UTC
# Line 10  C     !ROUTINE: DIAGSTATS_MNC_OUT Line 10  C     !ROUTINE: DIAGSTATS_MNC_OUT
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE DIAGSTATS_MNC_OUT(        SUBROUTINE DIAGSTATS_MNC_OUT(
12       I     statGlob, nLev, ndId,       I     statGlob, nLev, ndId,
13       I     mId, listId, myIter, myTime, myThid )       I     mId, listId, myTime, myIter, myThid )
14    
15  C     !DESCRIPTION:  C     !DESCRIPTION:
16  C     Write Global statistics to a netCDF file  C     Write Global statistics to a netCDF file
# Line 42  C     myIter   :: current Iteration Numb Line 42  C     myIter   :: current Iteration Numb
42  C     myTime   :: current time of simulation (s)  C     myTime   :: current time of simulation (s)
43  C     myThid   :: my thread Id number  C     myThid   :: my thread Id number
44        INTEGER nLev        INTEGER nLev
45        _RL statGlob(0:nStats,0:nLev,0:nRegions)        _RL     statGlob(0:nStats,0:nLev,0:nRegions)
46          _RL     myTime
47        INTEGER ndId, mId, listId        INTEGER ndId, mId, listId
48        INTEGER myIter, myTime, myThid        INTEGER myIter, myThid
49  CEOP  CEOP
50    
51  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
# Line 103  C         Update the record dimension by Line 104  C         Update the record dimension by
104            CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)            CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
105            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)
106            CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)            CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
107              CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)
108          ENDIF          ENDIF
109    
110  #ifdef DIAGST_MNC_NEEDSWORK  #ifdef DIAGST_MNC_NEEDSWORK
# Line 184  C         for averaged levels. Line 186  C         for averaged levels.
186          ENDDO          ENDDO
187                    
188  C       Z is special since it varies  C       Z is special since it varies
189          WRITE(dn(1),'(a,i6.6)') 'Zd', nlevels(listId)          WRITE(dn(1),'(a,i6.6)') 'Zd', kdiag(ndId)
190          IF ( (gdiag(ndId)(10:10) .EQ. 'R')          IF ( (gdiag(ndId)(10:10) .EQ. 'R')
191       &       .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN       &       .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
192            WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)            WRITE(dn(1),'(a,i6.6)') 'Zmd', kdiag(ndId)
193          ENDIF          ENDIF
194          IF ( (gdiag(ndId)(10:10) .EQ. 'R')          IF ( (gdiag(ndId)(10:10) .EQ. 'R')
195       &       .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN       &       .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
196            WRITE(dn(1),'(a,i6.6)') 'Zld', nlevels(listId)            WRITE(dn(1),'(a,i6.6)') 'Zld', kdiag(ndId)
197          ENDIF          ENDIF
198          IF ( (gdiag(ndId)(10:10) .EQ. 'R')          IF ( (gdiag(ndId)(10:10) .EQ. 'R')
199       &       .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN       &       .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
200            WRITE(dn(1),'(a,i6.6)') 'Zud', nlevels(listId)            WRITE(dn(1),'(a,i6.6)') 'Zud', kdiag(ndId)
201          ENDIF          ENDIF
202          dim(1) = Nr+Nrphys+1          dim(1) = Nr+Nrphys+1
203          ib(1)  = 1          ib(1)  = 1
# Line 236  C       guarantee uniqueness within each Line 238  C       guarantee uniqueness within each
238            DO i = 1,MAX_LEN_FNAM            DO i = 1,MAX_LEN_FNAM
239              tnam(i:i) = ' '              tnam(i:i) = ' '
240            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  
241    
242            CALL MNC_CW_DEL_VNAME(tnam, myThid)  c         IF ( kdiag(ndId) .GT. 1 ) THEN
             
           IF ( kdiag(ndId) .GT. 1 ) THEN  
243                            
244              ilen = ILNBLNK(cdiag(ndId))              ilen = ILNBLNK(cdiag(ndId))
245              WRITE(tnam,'(a,a4,a3)')              WRITE(tnam,'(a,a1,a3)')
246       &           cdiag(ndId)(1:ilen),'_vi_',stat_typ(ist+1)       &           cdiag(ndId)(1:ilen),'_',stat_typ(ist+1)
247                            
248              CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname0,              CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname0,
249       &           0,0, myThid)       &           0,0, myThid)
# Line 302  C           Copy the data into a tempora Line 272  C           Copy the data into a tempora
272                            
273              CALL MNC_CW_DEL_VNAME(tnam, myThid)              CALL MNC_CW_DEL_VNAME(tnam, myThid)
274                            
275            ENDIF  c         ENDIF
276                    
277              IF ( kdiag(ndId) .GT. 1 ) THEN
278    
279                ilen = ILNBLNK(cdiag(ndId))
280                WRITE(tnam,'(a,a4,a3)')
281         &           cdiag(ndId)(1:ilen),'_lv_',stat_typ(ist+1)
282              
283                CALL MNC_CW_ADD_VNAME(tnam, d_cw_gname,
284         &           0,0, myThid)
285                CALL MNC_CW_ADD_VATTR_TEXT(tnam,'description',
286         &           tdiag(ndId),myThid)
287                CALL MNC_CW_ADD_VATTR_TEXT(tnam,'units',
288         &         udiag(ndId),myThid)
289              
290    C           Copy the data into a temporary with the necessary shape
291                DO j = 0,nRegions
292                  DO k = 1,kdiag(ndId)
293                    stmp(k,j+1) = statGlob(ist,k,j)
294                  ENDDO
295                ENDDO
296              
297                IF ((fflags(listId)(1:1) .EQ. ' ')
298         &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
299                
300                  CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
301         &             tnam, stmp, myThid)
302                
303                ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
304                
305                  CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
306         &             tnam, stmp, myThid)
307                
308                ENDIF
309    
310                CALL MNC_CW_DEL_VNAME(tnam, myThid)
311              
312              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)
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22