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

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

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

Revision 1.9 - (hide annotations) (download)
Tue Feb 5 15:31:19 2008 UTC (16 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59o, checkpoint59n, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q
Changes since 1.8: +20 -20 lines 
minor modifications for many diagnostics:
- modify "available_diagnostics.log" and diagnostics summary (write mate number)
- use wider (integer) format (generally, use I6) to write diagnostics number
- rename numdiags --> numDiags (to differentiate from mdiag)
1 jmc 1.9 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_write_pickup.F,v 1.8 2005/09/17 03:17:06 edhill Exp $
2 edhill 1.1 C $Name: $
3    
4     #include "DIAG_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP
8 jmc 1.9 C !ROUTINE: DIAGNOSTICS_WRITE_PICKUP
9 edhill 1.1 C !INTERFACE:
10     SUBROUTINE DIAGNOSTICS_WRITE_PICKUP(
11 jmc 1.9 I isPerm,
12     I suff,
13 edhill 1.1 I myTime,
14     I myIter,
15     I myThid )
16    
17     C !DESCRIPTION:
18     C Writes current state of the diagnostics package.
19    
20     C !USES:
21     IMPLICIT NONE
22    
23     C == Global variables ===
24     #include "SIZE.h"
25     #include "EEPARAMS.h"
26     #include "PARAMS.h"
27     #include "DIAGNOSTICS_SIZE.h"
28     #include "DIAGNOSTICS.h"
29    
30     C !INPUT/OUTPUT PARAMETERS:
31 edhill 1.8 C isPerm :: permanent checkpoint flag
32 edhill 1.1 C suff :: suffix for pickup file (eg. ckptA or 0000000010)
33     C myTime :: current time
34     C myIter :: time-step number
35     C myThid :: Number of this instance
36 edhill 1.8 LOGICAL isPerm
37 edhill 1.1 CHARACTER*(*) suff
38     _RL myTime
39     INTEGER myIter
40     INTEGER myThid
41    
42     #ifdef ALLOW_DIAGNOSTICS
43 edhill 1.5 #ifdef DIAGNOSTICS_HAS_PICKUP
44 edhill 1.1
45     C !LOCAL VARIABLES:
46     C fn :: character buffer for creating filename
47     C prec :: precision of pickup files
48     c INTEGER prec, iChar, lChar, k
49 edhill 1.4 INTEGER prec, lChar, i, sn
50 edhill 1.1 CHARACTER*(MAX_LEN_FNAM) fn
51    
52     INTEGER ILNBLNK
53     EXTERNAL ILNBLNK
54    
55 edhill 1.4 #ifdef ALLOW_MDSIO
56     LOGICAL lgf
57 edhill 1.6 INTEGER dUnit, n, m
58 edhill 1.4 #endif /* ALLOW_MDSIO */
59    
60 edhill 1.2 #ifdef ALLOW_MNC
61     INTEGER ii
62     CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
63     INTEGER CW_DIMS, NLEN
64     PARAMETER ( CW_DIMS = 10 )
65     PARAMETER ( NLEN = 80 )
66     INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)
67     CHARACTER*(NLEN) dn(CW_DIMS)
68     CHARACTER*(NLEN) d_cw_name
69     CHARACTER*(NLEN) dn_blnk
70     #endif /* ALLOW_MNC */
71    
72 edhill 1.1 CEOP
73    
74     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
75    
76     IF (diag_pickup_write) THEN
77    
78 edhill 1.2 #ifdef ALLOW_MNC
79     IF (diag_pickup_write_mnc) THEN
80     DO i = 1,NLEN
81     dn_blnk(i:i) = ' '
82     ENDDO
83     DO i = 1,MAX_LEN_FNAM
84     diag_mnc_bn(i:i) = ' '
85     ENDDO
86 jmc 1.9
87 edhill 1.8 IF ( isPerm ) THEN
88     WRITE(diag_mnc_bn,'(A)') 'pickup_diagnostics'
89     ELSE
90     ii = ILNBLNK(suff)
91     WRITE(diag_mnc_bn,'(A,A)')
92     & 'pickup_diagnostics.',suff(1:ii)
93     ENDIF
94    
95     CALL MNC_CW_SET_UDIM(fn, 0, myThid)
96     IF ( isPerm ) THEN
97     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
98     ELSE
99     CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
100     ENDIF
101     C Then set the actual unlimited dimension
102     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
103 edhill 1.2
104     C Update the record dimension by writing the iteration number
105 edhill 1.7 CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)
106     CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)
107 edhill 1.4
108     C Write the qdiag() array
109 edhill 1.2 d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
110     DO ii = 1,CW_DIMS
111     dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
112     ENDDO
113     d_cw_name(1:10) = 'diag_state'
114     dn(1)(1:3) = 'Xp1'
115     dim(1) = sNx + 2*OLx
116     ib(1) = OLx + 1
117     ie(1) = OLx + sNx + 1
118     dn(2)(1:3) = 'Yp1'
119     dim(2) = sNy + 2*OLy
120     ib(2) = OLy + 1
121     ie(2) = OLy + sNy + 1
122 edhill 1.4 dn(3)(1:2) = 'Nd'
123 jmc 1.9 dim(3) = numDiags
124 edhill 1.2 ib(3) = 1
125 jmc 1.9 ie(3) = numDiags
126 edhill 1.2 dn(4)(1:1) = 'T'
127     dim(4) = -1
128     ib(4) = 1
129     ie(4) = 1
130 jmc 1.9
131     CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
132 edhill 1.2 & dim, dn, ib, ie, myThid)
133 jmc 1.9 CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
134 edhill 1.2 & 4,5, myThid)
135     CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',
136     & 'diagnostics state',myThid)
137 jmc 1.9
138 edhill 1.2 CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
139     & d_cw_name, qdiag, myThid)
140 jmc 1.9
141 edhill 1.2 CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
142     CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
143 edhill 1.4
144     C Write the ndiag() array
145     d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
146     DO ii = 1,CW_DIMS
147     dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
148     ENDDO
149     d_cw_name(1:10) = 'diag_count'
150     dn(1)(1:2) = 'Nd'
151 jmc 1.9 dim(1) = numDiags
152 edhill 1.4 ib(1) = 1
153 jmc 1.9 ie(1) = numDiags
154 edhill 1.4 dn(2)(1:1) = 'T'
155     dim(2) = -1
156     ib(2) = 1
157     ie(2) = 1
158    
159 jmc 1.9 CALL MNC_CW_ADD_GNAME(d_cw_name, 2,
160 edhill 1.4 & dim, dn, ib, ie, myThid)
161 jmc 1.9 CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
162 edhill 1.4 & 4,5, myThid)
163     CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',
164     & 'diagnostics state',myThid)
165 jmc 1.9
166 edhill 1.6 CALL MNC_CW_I_W('I',diag_mnc_bn,0,0,
167 edhill 1.4 & d_cw_name, ndiag, myThid)
168 jmc 1.9
169 edhill 1.4 CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
170     CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
171    
172    
173 edhill 1.2 ENDIF
174     #endif
175 jmc 1.9
176 edhill 1.4 #ifdef ALLOW_MDSIO
177 edhill 1.1 IF (diag_pickup_write_mdsio) THEN
178 edhill 1.4 _BEGIN_MASTER( myThid )
179    
180     sn = ILNBLNK(suff)
181    
182     C Write qdiag()
183     DO i = 1,80
184     fn(i:i) = ' '
185     ENDDO
186     write(fn,'(a,a)') 'pickup_qdiag.', suff(1:sn)
187     prec = precFloat64
188     lgf = globalFiles
189 jmc 1.9 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',numDiags,qdiag,
190 edhill 1.1 & 1,myIter,myThid)
191 edhill 1.4
192     C Write ndiag()
193     DO i = 1,80
194     fn(i:i) = ' '
195     ENDDO
196     WRITE(fn,'(a,a)') 'pickup_ndiag.', suff(1:sn)
197     CALL MDSFINDUNIT( dUnit, mythid )
198     OPEN( dUnit, file=fn )
199 edhill 1.6 DO n = 1,nlists
200     DO m = 1,nfields(n)
201     WRITE(dUnit,'(I10)') ndiag(jdiag(m,n))
202     ENDDO
203 edhill 1.4 ENDDO
204     CLOSE( dUnit )
205     _END_MASTER( myThid )
206 edhill 1.1 ENDIF
207 edhill 1.4 #endif /* ALLOW_MDSIO */
208 edhill 1.1
209     ENDIF
210    
211     #endif /* ALLOW_DIAGNOSTICS */
212 edhill 1.5 #endif /* DIAGNOSTICS_HAS_PICKUP */
213 edhill 1.1
214     RETURN
215     END
  ViewVC Help
Powered by ViewVC 1.1.22