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

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

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

revision 1.4 by edhill, Mon Feb 21 04:41:52 2005 UTC revision 1.10 by jmc, Thu Aug 27 18:00:01 2009 UTC
# Line 5  C $Name$ Line 5  C $Name$
5    
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7  CBOP  CBOP
8  C     !ROUTINE: DIAGNOSTICS_WRITE_PICKUP  C     !ROUTINE: DIAGNOSTICS_WRITE_PICKUP
9  C     !INTERFACE:  C     !INTERFACE:
10        SUBROUTINE DIAGNOSTICS_WRITE_PICKUP(        SUBROUTINE DIAGNOSTICS_WRITE_PICKUP(
11       I     suff,       I     isPerm,
12         I     suff,
13       I     myTime,       I     myTime,
14       I     myIter,       I     myIter,
15       I     myThid )       I     myThid )
# Line 27  C     == Global variables === Line 28  C     == Global variables ===
28  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
29    
30  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
31    C     isPerm  :: permanent checkpoint flag
32  C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)  C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
33  C     myTime  :: current time  C     myTime  :: current time
34  C     myIter  :: time-step number  C     myIter  :: time-step number
35  C     myThid  :: Number of this instance  C     myThid  :: Number of this instance
36          LOGICAL isPerm
37        CHARACTER*(*) suff        CHARACTER*(*) suff
38        _RL myTime        _RL myTime
39        INTEGER myIter        INTEGER myIter
40        INTEGER myThid        INTEGER myThid
41    
42  #ifdef ALLOW_DIAGNOSTICS  #ifdef DIAGNOSTICS_HAS_PICKUP
43    
44  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
45  C     fn      :: character buffer for creating filename  C     fn      :: character buffer for creating filename
46  C     prec    :: precision of pickup files  C     prec    :: precision of pickup files
47  c     INTEGER prec, iChar, lChar, k  c     INTEGER prec, iChar, lChar, k
48        INTEGER prec, lChar, i, sn        INTEGER prec, lChar, sn
49        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
50    
51        INTEGER  ILNBLNK        INTEGER  ILNBLNK
52        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
53    
54  #ifdef ALLOW_MDSIO        INTEGER dUnit, n, m
       LOGICAL lgf  
       INTEGER dUnit  
 #endif /* ALLOW_MDSIO */  
55    
56  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
57        INTEGER ii        INTEGER i, ii
58        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
59        INTEGER CW_DIMS, NLEN        INTEGER CW_DIMS, NLEN
60        PARAMETER ( CW_DIMS = 10 )        PARAMETER ( CW_DIMS = 10 )
# Line 79  C---+----1----+----2----+----3----+----4 Line 79  C---+----1----+----2----+----3----+----4
79            DO i = 1,MAX_LEN_FNAM            DO i = 1,MAX_LEN_FNAM
80              diag_mnc_bn(i:i) = ' '              diag_mnc_bn(i:i) = ' '
81            ENDDO            ENDDO
82            WRITE(diag_mnc_bn,'(A)') 'pickup_diagnostics'  
83              IF ( isPerm ) THEN
84                WRITE(diag_mnc_bn,'(A)') 'pickup_diagnostics'
85              ELSE
86                ii = ILNBLNK(suff)
87                WRITE(diag_mnc_bn,'(A,A)')
88         &           'pickup_diagnostics.',suff(1:ii)
89              ENDIF
90    
91              CALL MNC_CW_SET_UDIM(fn, 0, myThid)
92              IF ( isPerm ) THEN
93                CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
94              ELSE
95                CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
96              ENDIF
97    C         Then set the actual unlimited dimension
98              CALL MNC_CW_SET_UDIM(fn, 1, myThid)
99    
100  C         Update the record dimension by writing the iteration number  C         Update the record dimension by writing the iteration number
101            CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)            CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)
102            CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'T',myIter,myThid)            CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)
           CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)  
103    
104  C         Write the qdiag() array  C         Write the qdiag() array
105            d_cw_name(1:NLEN) = dn_blnk(1:NLEN)            d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
# Line 101  C         Write the qdiag() array Line 116  C         Write the qdiag() array
116            ib(2)      = OLy + 1            ib(2)      = OLy + 1
117            ie(2)      = OLy + sNy + 1            ie(2)      = OLy + sNy + 1
118            dn(3)(1:2) = 'Nd'            dn(3)(1:2) = 'Nd'
119            dim(3)     = numdiags            dim(3)     = numDiags
120            ib(3)      = 1            ib(3)      = 1
121            ie(3)      = numdiags            ie(3)      = numDiags
122            dn(4)(1:1) = 'T'            dn(4)(1:1) = 'T'
123            dim(4)     = -1            dim(4)     = -1
124            ib(4)      = 1            ib(4)      = 1
125            ie(4)      = 1            ie(4)      = 1
126              
127            CALL MNC_CW_ADD_GNAME(d_cw_name, 4,            CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
128       &         dim, dn, ib, ie, myThid)       &         dim, dn, ib, ie, myThid)
129            CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,            CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
130       &         4,5, myThid)       &         4,5, myThid)
131            CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',            CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',
132       &         'diagnostics state',myThid)       &         'diagnostics state',myThid)
133              
134            CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,            CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
135       &         d_cw_name, qdiag, myThid)       &         d_cw_name, qdiag, myThid)
136              
137            CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)            CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
138            CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)            CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
139    
# Line 129  C         Write the ndiag() array Line 144  C         Write the ndiag() array
144            ENDDO            ENDDO
145            d_cw_name(1:10) = 'diag_count'            d_cw_name(1:10) = 'diag_count'
146            dn(1)(1:2) = 'Nd'            dn(1)(1:2) = 'Nd'
147            dim(1)     = numdiags            dim(1)     = numDiags
148            ib(1)      = 1            ib(1)      = 1
149            ie(1)      = numdiags            ie(1)      = numDiags
150            dn(2)(1:1) = 'T'            dn(2)(1:1) = 'T'
151            dim(2)     = -1            dim(2)     = -1
152            ib(2)      = 1            ib(2)      = 1
153            ie(2)      = 1            ie(2)      = 1
154    
155            CALL MNC_CW_ADD_GNAME(d_cw_name, 2,            CALL MNC_CW_ADD_GNAME(d_cw_name, 2,
156       &         dim, dn, ib, ie, myThid)       &         dim, dn, ib, ie, myThid)
157            CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,            CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
158       &         4,5, myThid)       &         4,5, myThid)
159            CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',            CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',
160       &         'diagnostics state',myThid)       &         'diagnostics state',myThid)
161              
162            CALL MNC_CW_RL_W('I',diag_mnc_bn,0,0,            CALL MNC_CW_I_W('I',diag_mnc_bn,0,0,
163       &         d_cw_name, ndiag, myThid)       &         d_cw_name, ndiag, myThid)
164              
165            CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)            CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
166            CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)            CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
167    
168    
169          ENDIF          ENDIF
170  #endif  #endif
171            
 #ifdef ALLOW_MDSIO  
172          IF (diag_pickup_write_mdsio) THEN          IF (diag_pickup_write_mdsio) THEN
           _BEGIN_MASTER( myThid )  
173    
174            sn = ILNBLNK(suff)            sn = ILNBLNK(suff)
175    
176  C         Write qdiag()  C         Write qdiag()
177            DO i = 1,80            WRITE(fn,'(a,a)') 'pickup_qdiag.', suff(1:sn)
             fn(i:i) = ' '  
           ENDDO  
           write(fn,'(a,a)') 'pickup_qdiag.', suff(1:sn)  
178            prec = precFloat64            prec = precFloat64
179            lgf = globalFiles            CALL WRITE_REC_3D_RL( fn, prec, numDiags, qdiag,
180            CALL MDSWRITEFIELD(fn,prec,lgf,'RL',numdiags,qdiag,       &                          1, myIter, myThid )
      &         1,myIter,myThid)  
181    
182  C         Write ndiag()  C         Write ndiag()
183            DO i = 1,80            _BARRIER
184              fn(i:i) = ' '            _BEGIN_MASTER( myThid )
           ENDDO  
185            WRITE(fn,'(a,a)') 'pickup_ndiag.', suff(1:sn)            WRITE(fn,'(a,a)') 'pickup_ndiag.', suff(1:sn)
186            CALL MDSFINDUNIT( dUnit, mythid )            CALL MDSFINDUNIT( dUnit, mythid )
187            OPEN( dUnit, file=fn )            OPEN( dUnit, file=fn )
188            DO i = 1,numdiags            DO n = 1,nlists
189              WRITE(dUnit,'(I10)') ndiag(i)              DO m = 1,nfields(n)
190                  WRITE(dUnit,'(I10)') ndiag(jdiag(m,n),1,1)
191                ENDDO
192            ENDDO            ENDDO
193            CLOSE( dUnit )            CLOSE( dUnit )
194            _END_MASTER( myThid )            _END_MASTER( myThid )
195              _BARRIER
196          ENDIF          ENDIF
 #endif /* ALLOW_MDSIO */  
197    
198        ENDIF        ENDIF
199    
200  #endif /* ALLOW_DIAGNOSTICS */  #endif /* DIAGNOSTICS_HAS_PICKUP */
201    
202        RETURN        RETURN
203        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22