/[MITgcm]/MITgcm/model/src/write_pickup.F
ViewVC logotype

Contents of /MITgcm/model/src/write_pickup.F

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


Revision 1.16 - (show annotations) (download)
Mon Aug 18 14:27:11 2014 UTC (9 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65h, checkpoint65c, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e
Changes since 1.15: +11 -5 lines
- allow to apply Adams-Bashforth on Temp & Salt (instead of on gT,gS)
  with AB-2 code (previously only available with AB-3 code).

1 C $Header: /u/gcmpack/MITgcm/model/src/write_pickup.F,v 1.15 2013/09/18 18:08:55 m_bates Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8 CBOP
9 C !ROUTINE: WRITE_PICKUP
10 C !INTERFACE:
11 SUBROUTINE WRITE_PICKUP(
12 I permPickup,
13 I myTime, myIter, myThid )
14
15 C !DESCRIPTION:
16 C Write the main-model pickup-file and do it NOW.
17 C It writes both "rolling-pickup" files (ckptA,ckptB) and
18 C permanent pickup files (with iteration number in the file name).
19 C It calls routines from other packages (\textit{eg.} rw and mnc)
20 C to do the per-variable writes.
21
22 C !USES:
23 IMPLICIT NONE
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26 #include "PARAMS.h"
27 #include "RESTART.h"
28 #include "DYNVARS.h"
29 #include "SURFACE.h"
30 #ifdef ALLOW_GENERIC_ADVDIFF
31 # include "GAD.h"
32 #endif
33 #ifdef ALLOW_NONHYDROSTATIC
34 # include "NH_VARS.h"
35 #endif
36 #ifdef ALLOW_ADDFLUID
37 # include "FFIELDS.h"
38 #endif
39 #ifdef ALLOW_MNC
40 # include "MNC_PARAMS.h"
41 #endif
42 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
43 # include "GMREDI.h"
44 #endif
45
46 C !INPUT PARAMETERS:
47 C permPickup :: Is or is not a permanent pickup.
48 C myTime :: Current time of simulation ( s )
49 C myIter :: Iteration number
50 C myThid :: Thread number for this instance of the routine.
51 LOGICAL permPickup
52 _RL myTime
53 INTEGER myIter
54 INTEGER myThid
55 CEOP
56
57 C !LOCAL VARIABLES:
58 C fp :: pickup-file precision
59 C glf :: local flag for "globalFiles"
60 C fn :: Temp. for building file name.
61 C nWrFlds :: number of fields being written
62 C n3D :: number of 3-D fields being written
63 C listDim :: dimension of "wrFldList" local array
64 C wrFldList :: list of written fields
65 C m1,m2 :: 6.th dim index (AB-3) corresponding to time-step N-1 & N-2
66 C j :: loop index / field number
67 C nj :: record number
68 C msgBuf :: Informational/error message buffer
69 INTEGER fp
70 LOGICAL glf
71 _RL timList(1)
72 CHARACTER*(MAX_LEN_FNAM) fn
73 INTEGER listDim, nWrFlds, n3D
74 PARAMETER( listDim = 20 )
75 CHARACTER*(8) wrFldList(listDim)
76 #ifdef ALLOW_ADAMSBASHFORTH_3
77 INTEGER m1, m2
78 #endif
79 INTEGER j, nj
80 CHARACTER*(MAX_LEN_MBUF) msgBuf
81 #ifndef ALLOW_GENERIC_ADVDIFF
82 LOGICAL AdamsBashforthGt
83 LOGICAL AdamsBashforthGs
84 LOGICAL AdamsBashforth_T
85 LOGICAL AdamsBashforth_S
86 PARAMETER ( AdamsBashforthGt = .FALSE. ,
87 & AdamsBashforthGs = .FALSE. ,
88 & AdamsBashforth_T = .FALSE. ,
89 & AdamsBashforth_S = .FALSE. )
90 #endif
91
92 C- Initialise:
93 DO j=1,listDim
94 wrFldList(j) = ' '
95 ENDDO
96
97 C Write model fields
98 DO j = 1,MAX_LEN_FNAM
99 fn(j:j) = ' '
100 ENDDO
101 IF ( permPickup ) THEN
102 WRITE(fn,'(A,I10.10)') 'pickup.',myIter
103 ELSE
104 WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
105 ENDIF
106
107 C Going to really do some IO. Make everyone except master thread wait.
108 C this is done within IO routines => no longer needed
109 c _BARRIER
110
111 IF (pickup_write_mdsio) THEN
112
113 fp = precFloat64
114 j = 0
115 C record number < 0 : a hack not to write meta files now:
116
117 C--- write State 3-D fields for restart
118 j = j + 1
119 CALL WRITE_REC_3D_RL( fn, fp, Nr, uVel, -j, myIter, myThid )
120 IF (j.LE.listDim) wrFldList(j) = 'Uvel '
121 j = j + 1
122 CALL WRITE_REC_3D_RL( fn, fp, Nr, vVel, -j, myIter, myThid )
123 IF (j.LE.listDim) wrFldList(j) = 'Vvel '
124
125 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
126 IF (GM_InMomAsStress) THEN
127 j = j + 1
128 CALL WRITE_REC_3D_RL( fn, fp, Nr, uMean, -j, myIter, myThid)
129 IF (j.LE.listDim) wrFldList(j) = 'Umean '
130 j = j + 1
131 CALL WRITE_REC_3D_RL( fn, fp, Nr, vMean, -j, myIter, myThid)
132 IF (j.LE.listDim) wrFldList(j) = 'Vmean '
133 ENDIF
134 #endif
135
136 j = j + 1
137 CALL WRITE_REC_3D_RL( fn, fp, Nr, theta, -j, myIter, myThid )
138 IF (j.LE.listDim) wrFldList(j) = 'Theta '
139 j = j + 1
140 CALL WRITE_REC_3D_RL( fn, fp, Nr, salt, -j, myIter, myThid )
141 IF (j.LE.listDim) wrFldList(j) = 'Salt '
142 C--- write 3-D fields for AB-restart
143 #ifdef ALLOW_ADAMSBASHFORTH_3
144 m1 = 1 + MOD(myIter+1,2)
145 m2 = 1 + MOD( myIter ,2)
146 IF ( momStepping ) THEN
147 C-- U velocity:
148 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
149 j = j + 1
150 CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm(1-OLx,1-OLy,1,1,1,m1),
151 & -j, myIter, myThid )
152 IF (j.LE.listDim) wrFldList(j) = 'GuNm1 '
153 ENDIF
154 IF ( beta_AB.NE.0. ) THEN
155 j = j + 1
156 CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm(1-OLx,1-OLy,1,1,1,m2),
157 & -j, myIter, myThid )
158 IF (j.LE.listDim) wrFldList(j) = 'GuNm2 '
159 ENDIF
160 C-- V velocity:
161 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
162 j = j + 1
163 CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm(1-OLx,1-OLy,1,1,1,m1),
164 & -j, myIter, myThid )
165 IF (j.LE.listDim) wrFldList(j) = 'GvNm1 '
166 ENDIF
167 IF ( beta_AB.NE.0. ) THEN
168 j = j + 1
169 CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm(1-OLx,1-OLy,1,1,1,m2),
170 & -j, myIter, myThid )
171 IF (j.LE.listDim) wrFldList(j) = 'GvNm2 '
172 ENDIF
173 ENDIF
174 C-- Temperature:
175 IF ( AdamsBashforthGt.OR.AdamsBashforth_T ) THEN
176 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
177 j = j + 1
178 CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm(1-OLx,1-OLy,1,1,1,m1),
179 & -j, myIter, myThid )
180 IF (j.LE.listDim) THEN
181 IF ( AdamsBashforthGt ) wrFldList(j) = 'GtNm1 '
182 IF ( AdamsBashforth_T ) wrFldList(j) = 'TempNm1 '
183 ENDIF
184 ENDIF
185 IF ( beta_AB.NE.0. ) THEN
186 j = j + 1
187 CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm(1-OLx,1-OLy,1,1,1,m2),
188 & -j, myIter, myThid )
189 IF (j.LE.listDim) THEN
190 IF ( AdamsBashforthGt ) wrFldList(j) = 'GtNm2 '
191 IF ( AdamsBashforth_T ) wrFldList(j) = 'TempNm2 '
192 ENDIF
193 ENDIF
194 ENDIF
195 C-- Salinity:
196 IF ( AdamsBashforthGs.OR.AdamsBashforth_S ) THEN
197 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
198 j = j + 1
199 CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm(1-OLx,1-OLy,1,1,1,m1),
200 & -j, myIter, myThid )
201 IF (j.LE.listDim) THEN
202 IF ( AdamsBashforthGs ) wrFldList(j) = 'GsNm1 '
203 IF ( AdamsBashforth_S ) wrFldList(j) = 'SaltNm1 '
204 ENDIF
205 ENDIF
206 IF ( beta_AB.NE.0. ) THEN
207 j = j + 1
208 CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm(1-OLx,1-OLy,1,1,1,m2),
209 & -j, myIter, myThid )
210 IF (j.LE.listDim) THEN
211 IF ( AdamsBashforthGs ) wrFldList(j) = 'GsNm2 '
212 IF ( AdamsBashforth_S ) wrFldList(j) = 'SaltNm2 '
213 ENDIF
214 ENDIF
215 ENDIF
216 #ifdef ALLOW_NONHYDROSTATIC
217 C-- W velocity:
218 IF ( nonHydrostatic ) THEN
219 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
220 j = j + 1
221 CALL WRITE_REC_3D_RL( fn, fp, Nr, gwNm(1-OLx,1-OLy,1,1,1,m1),
222 & -j, myIter, myThid )
223 IF (j.LE.listDim) wrFldList(j) = 'GwNm1 '
224 ENDIF
225 IF ( beta_AB.NE.0. ) THEN
226 j = j + 1
227 CALL WRITE_REC_3D_RL( fn, fp, Nr, gwNm(1-OLx,1-OLy,1,1,1,m2),
228 & -j, myIter, myThid )
229 IF (j.LE.listDim) wrFldList(j) = 'GwNm2 '
230 ENDIF
231 ENDIF
232 #endif /* ALLOW_NONHYDROSTATIC */
233 #else /* ALLOW_ADAMSBASHFORTH_3 */
234 IF ( momStepping ) THEN
235 j = j + 1
236 CALL WRITE_REC_3D_RL( fn, fp, Nr, guNm1, -j, myIter, myThid )
237 IF (j.LE.listDim) wrFldList(j) = 'GuNm1 '
238 j = j + 1
239 CALL WRITE_REC_3D_RL( fn, fp, Nr, gvNm1, -j, myIter, myThid )
240 IF (j.LE.listDim) wrFldList(j) = 'GvNm1 '
241 ENDIF
242 IF ( AdamsBashforthGt.OR.AdamsBashforth_T ) THEN
243 j = j + 1
244 CALL WRITE_REC_3D_RL( fn, fp, Nr, gtNm1, -j, myIter, myThid )
245 IF (j.LE.listDim) THEN
246 IF ( AdamsBashforthGt ) wrFldList(j) = 'GtNm1 '
247 IF ( AdamsBashforth_T ) wrFldList(j) = 'TempNm1 '
248 ENDIF
249 ENDIF
250 IF ( AdamsBashforthGs.OR.AdamsBashforth_S ) THEN
251 j = j + 1
252 CALL WRITE_REC_3D_RL( fn, fp, Nr, gsNm1, -j, myIter, myThid )
253 IF (j.LE.listDim) THEN
254 IF ( AdamsBashforthGs ) wrFldList(j) = 'GsNm1 '
255 IF ( AdamsBashforth_S ) wrFldList(j) = 'SaltNm1 '
256 ENDIF
257 ENDIF
258 #ifdef ALLOW_NONHYDROSTATIC
259 IF ( nonHydrostatic ) THEN
260 j = j + 1
261 CALL WRITE_REC_3D_RL( fn, fp, Nr, gwNm1, -j, myIter, myThid )
262 IF (j.LE.listDim) wrFldList(j) = 'GwNm1 '
263 ENDIF
264 #endif /* ALLOW_NONHYDROSTATIC */
265 #endif /* ALLOW_ADAMSBASHFORTH_3 */
266
267 C- write Full Pressure for EOS in pressure:
268 IF ( useDynP_inEos_Zc ) THEN
269 j = j + 1
270 CALL WRITE_REC_3D_RL( fn, fp, Nr,totPhiHyd,-j,myIter, myThid )
271 IF (j.LE.listDim) wrFldList(j) = 'PhiHyd '
272 ENDIF
273 #ifdef ALLOW_NONHYDROSTATIC
274 IF ( use3Dsolver ) THEN
275 j = j + 1
276 CALL WRITE_REC_3D_RL( fn, fp, Nr, phi_nh, -j, myIter, myThid )
277 IF (j.LE.listDim) wrFldList(j) = 'Phi_NHyd'
278 ENDIF
279 #endif /* ALLOW_NONHYDROSTATIC */
280 #ifdef ALLOW_ADDFLUID
281 C- write mass source/sink of fluid (but not needed if selectAddFluid=-1)
282 IF ( selectAddFluid.NE.0 ) THEN
283 j = j + 1
284 CALL WRITE_REC_3D_RL( fn, fp, Nr,addMass,-j,myIter, myThid )
285 IF (j.LE.listDim) wrFldList(j) = 'AddMass '
286 ENDIF
287 #endif /* ALLOW_ADDFLUID */
288
289 n3D = j
290 C--- Write 2-D fields, starting with Eta:
291 j = j + 1
292 nj = -( n3D*(Nr-1) + j )
293 CALL WRITE_REC_3D_RL( fn, fp, 1 , etaN, nj, myIter, myThid )
294 IF (j.LE.listDim) wrFldList(j) = 'EtaN '
295 #ifdef ALLOW_NONHYDROSTATIC
296 IF ( selectNHfreeSurf.GE.1 ) THEN
297 j = j + 1
298 nj = -( n3D*(Nr-1) + j )
299 CALL WRITE_REC_3D_RL( fn, fp, 1, dPhiNH, nj, myIter, myThid )
300 IF (j.LE.listDim) wrFldList(j) = 'dPhiNH '
301 ENDIF
302 #endif /* ALLOW_NONHYDROSTATIC */
303 #ifdef EXACT_CONSERV
304 c IF ( exactConserv ) THEN
305 j = j + 1
306 nj = -( n3D*(Nr-1) + j )
307 CALL WRITE_REC_3D_RL( fn, fp, 1, dEtaHdt, nj, myIter, myThid )
308 IF (j.LE.listDim) wrFldList(j) = 'dEtaHdt '
309 c ENDIF
310 C- note: always write dEtaHdt & EtaH but read only if exactConserv & nonlinFreeSurf
311 C this works only because nonlinFreeSurf > 0 => exactConserv=T
312 c IF ( nonlinFreeSurf.GT.0 ) THEN
313 j = j + 1
314 nj = -( n3D*(Nr-1) + j )
315 CALL WRITE_REC_3D_RL( fn, fp, 1, etaHnm1, nj, myIter, myThid )
316 IF (j.LE.listDim) wrFldList(j) = 'EtaH '
317 c ENDIF
318 #endif /* EXACT_CONSERV */
319 C--------------------------
320 nWrFlds = j
321 IF ( nWrFlds.GT.listDim ) THEN
322 WRITE(msgBuf,'(2A,I5,A)') 'WRITE_PICKUP: ',
323 & 'trying to write ',nWrFlds,' fields'
324 CALL PRINT_ERROR( msgBuf, myThid )
325 WRITE(msgBuf,'(2A,I5,A)') 'WRITE_PICKUP: ',
326 & 'field-list dimension (listDim=',listDim,') too small'
327 CALL PRINT_ERROR( msgBuf, myThid )
328 STOP 'ABNORMAL END: S/R WRITE_PICKUP (list-size Pb)'
329 ENDIF
330 #ifdef ALLOW_MDSIO
331 C- Note: temporary: since it is a pain to add more arguments to
332 C all MDSIO S/R, uses instead this specific S/R to write only
333 C meta files but with more informations in it.
334 nj = ABS(nj)
335 glf = globalFiles
336 timList(1) = myTime
337 CALL MDS_WR_METAFILES( fn, fp, glf, .FALSE.,
338 & 0, 0, 1, ' ',
339 & nWrFlds, wrFldList,
340 & 1, timList, oneRL,
341 & nj, myIter, myThid )
342 #endif /* ALLOW_MDSIO */
343 C--------------------------
344 ENDIF
345
346 #ifdef ALLOW_MNC
347 IF (useMNC .AND. pickup_write_mnc) THEN
348 IF ( permPickup ) THEN
349 WRITE(fn,'(A)') 'pickup'
350 ELSE
351 WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
352 ENDIF
353 C First ***define*** the file group name
354 CALL MNC_CW_SET_UDIM(fn, 0, myThid)
355 IF ( permPickup ) THEN
356 CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
357 ELSE
358 CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
359 ENDIF
360 C Then set the actual unlimited dimension
361 CALL MNC_CW_SET_UDIM(fn, 1, myThid)
362 CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
363 CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
364 CALL MNC_CW_RL_W('D',fn,0,0,'U', uVel, myThid)
365 CALL MNC_CW_RL_W('D',fn,0,0,'V', vVel, myThid)
366 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
367 IF (GM_InMomAsStress) THEN
368 CALL MNC_CW_RL_W('D',fn,0,0,'Umean', uMean, myThid)
369 CALL MNC_CW_RL_W('D',fn,0,0,'Vmean', vMean, myThid)
370 ENDIF
371 #endif
372 CALL MNC_CW_RL_W('D',fn,0,0,'Temp', theta, myThid)
373 CALL MNC_CW_RL_W('D',fn,0,0,'S', salt, myThid)
374 CALL MNC_CW_RL_W('D',fn,0,0,'Eta', etaN, myThid)
375 #ifndef ALLOW_ADAMSBASHFORTH_3
376 CALL MNC_CW_RL_W('D',fn,0,0,'gUnm1', guNm1, myThid)
377 CALL MNC_CW_RL_W('D',fn,0,0,'gVnm1', gvNm1, myThid)
378 CALL MNC_CW_RL_W('D',fn,0,0,'gTnm1', gtNm1, myThid)
379 CALL MNC_CW_RL_W('D',fn,0,0,'gSnm1', gsNm1, myThid)
380 #endif /* ALLOW_ADAMSBASHFORTH_3 */
381 #ifdef EXACT_CONSERV
382 CALL MNC_CW_RL_W('D',fn,0,0,'dEtaHdt', dEtaHdt, myThid)
383 CALL MNC_CW_RL_W('D',fn,0,0,'EtaH', etaHnm1, myThid)
384 #endif
385 #ifdef ALLOW_NONHYDROSTATIC
386 IF ( use3Dsolver ) THEN
387 CALL MNC_CW_RL_W('D',fn,0,0,'phi_nh', phi_nh, myThid)
388 c CALL MNC_CW_RL_W('D',fn,0,0,'gW', gW, myThid)
389 #ifndef ALLOW_ADAMSBASHFORTH_3
390 CALL MNC_CW_RL_W('D',fn,0,0,'gWnm1', gwNm1, myThid)
391 #endif
392 ENDIF
393 #endif
394 IF ( useDynP_inEos_Zc ) THEN
395 CALL MNC_CW_RL_W('D',fn,0,0,'phiHyd', totPhiHyd, myThid)
396 ENDIF
397 CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
398 ENDIF
399 #endif /* ALLOW_MNC */
400
401 C-- Every one else must wait until writing is done.
402 C this is done within IO routines => no longer needed
403 c _BARRIER
404
405 RETURN
406 END

  ViewVC Help
Powered by ViewVC 1.1.22