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

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

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


Revision 1.14 - (show annotations) (download)
Fri Mar 24 23:26:36 2017 UTC (7 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, HEAD
Changes since 1.13: +6 -5 lines
use new S/R to get file suffix (according to "rwSuffixType")

1 C $Header: /u/gcmpack/MITgcm/model/src/read_pickup.F,v 1.13 2016/02/15 18:00:26 jmc 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: READ_PICKUP
10 C !INTERFACE:
11 SUBROUTINE READ_PICKUP(
12 I myIter, myThid )
13
14 C !DESCRIPTION:
15 C This is the controlling routine for IO to read restart (or
16 C "pickup" or "checkpoint" ) files. It calls routines from other
17 C packages (\textit{eg.} rw and mnc) to do the per-variable
18 C reads.
19
20 C !USES:
21 IMPLICIT NONE
22 #include "SIZE.h"
23 #include "EEPARAMS.h"
24 #include "PARAMS.h"
25 #include "RESTART.h"
26 #include "DYNVARS.h"
27 #include "SURFACE.h"
28 #include "FFIELDS.h"
29 #ifdef ALLOW_GENERIC_ADVDIFF
30 # include "GAD.h"
31 #endif
32 #ifdef ALLOW_NONHYDROSTATIC
33 # include "NH_VARS.h"
34 #endif
35 #ifdef ALLOW_MNC
36 # include "MNC_PARAMS.h"
37 #endif
38 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
39 # include "GMREDI.h"
40 #endif
41
42 C !INPUT/OUTPUT PARAMETERS:
43 C myIter :: Iteration number
44 C myThid :: my Thread Id. number
45 INTEGER myIter
46 INTEGER myThid
47 CEOP
48
49 C !LOCAL VARIABLES:
50 C fp :: pickup-file precision
51 C fn :: Temp. for building file name.
52 C suff :: suffix of pickup file to read
53 C filePrec :: pickup-file precision (read from meta file)
54 C nbFields :: number of fields in pickup file (read from meta file)
55 C missFldList :: List of missing fields (attempted to read but not found)
56 C missFldDim :: Dimension of missing fields list array: missFldList
57 C nMissing :: Number of missing fields (attempted to read but not found)
58 C m1,m2 :: 6.th dim index (AB-3) corresponding to time-step N-1 & N-2
59 C j :: loop index
60 C nj :: record number
61 C ioUnit :: temp for writing msg unit
62 C msgBuf :: Informational/error message buffer
63 INTEGER fp
64 CHARACTER*(MAX_LEN_FNAM) fn
65 CHARACTER*(10) suff
66 INTEGER filePrec, nbFields
67 INTEGER missFldDim, nMissing
68 PARAMETER( missFldDim = 20 )
69 CHARACTER*(8) missFldList(missFldDim)
70 #ifdef ALLOW_ADAMSBASHFORTH_3
71 INTEGER m1, m2
72 #endif
73 INTEGER j, nj, ioUnit
74 CHARACTER*(MAX_LEN_MBUF) msgBuf
75 #ifndef ALLOW_GENERIC_ADVDIFF
76 LOGICAL AdamsBashforthGt
77 LOGICAL AdamsBashforthGs
78 LOGICAL AdamsBashforth_T
79 LOGICAL AdamsBashforth_S
80 PARAMETER ( AdamsBashforthGt = .FALSE. ,
81 & AdamsBashforthGs = .FALSE. ,
82 & AdamsBashforth_T = .FALSE. ,
83 & AdamsBashforth_S = .FALSE. )
84 #endif
85
86 C Suffix for pickup files
87 IF (pickupSuff .EQ. ' ') THEN
88 IF ( rwSuffixType.EQ.0 ) THEN
89 WRITE(suff,'(I10.10)') myIter
90 ELSE
91 CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
92 ENDIF
93 ELSE
94 WRITE(suff,'(A10)') pickupSuff
95 ENDIF
96 WRITE(fn,'(A,A10)') 'pickup.',suff
97
98 C Going to really do some IO. Make everyone except master thread wait.
99 C this is done within IO routines => no longer needed
100 c _BARRIER
101
102 IF (pickup_read_mdsio) THEN
103
104 fp = precFloat64
105 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
106
107 CALL READ_MFLDS_SET(
108 I fn,
109 O nbFields, filePrec,
110 I Nr, myIter, myThid )
111
112 _BEGIN_MASTER( myThid )
113 c IF ( filePrec.NE.0 .AND. filePrec.NE.fp ) THEN
114 IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
115 WRITE(msgBuf,'(2A,I4)') 'READ_PICKUP: ',
116 & 'pickup-file binary precision do not match !'
117 CALL PRINT_ERROR( msgBuf, myThid )
118 WRITE(msgBuf,'(A,2(A,I4))') 'READ_PICKUP: ',
119 & 'file prec.=', filePrec, ' but expecting prec.=', fp
120 CALL PRINT_ERROR( msgBuf, myThid )
121 STOP 'ABNORMAL END: S/R READ_PICKUP (data-prec Pb)'
122 ENDIF
123 _END_MASTER( myThid )
124
125 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
126
127 IF ( nbFields.LE.0 ) THEN
128 C- No meta-file or old meta-file without List of Fields
129 ioUnit = errorMessageUnit
130 IF ( pickupStrictlyMatch ) THEN
131 WRITE(msgBuf,'(4A)') 'READ_PICKUP: ',
132 & 'no field-list found in meta-file',
133 & ' => cannot check for strick-matching'
134 c CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
135 CALL PRINT_ERROR( msgBuf, myThid )
136 WRITE(msgBuf,'(4A)') 'READ_PICKUP: ',
137 & 'try with " pickupStrictlyMatch=.FALSE.,"',
138 & ' in file: "data", NameList: "PARM03"'
139 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
140 STOP 'ABNORMAL END: S/R READ_PICKUP'
141 ELSE
142 WRITE(msgBuf,'(4A)') 'WARNING >> READ_PICKUP: ',
143 & ' no field-list found'
144 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
145 IF ( nbFields.EQ.-1 ) THEN
146 C- No meta-file
147 WRITE(msgBuf,'(4A)') 'WARNING >> ',
148 & ' try to read pickup as currently written'
149 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
150 ELSE
151 C- Old meta-file without List of Fields
152 WRITE(msgBuf,'(4A)') 'WARNING >> ',
153 & ' try to read pickup as it used to be written'
154 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
155 WRITE(msgBuf,'(4A)') 'WARNING >> ',
156 & ' until checkpoint59i (2007 Oct 22)'
157 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
158 ENDIF
159 ENDIF
160 ENDIF
161
162 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
163
164 C--- Old way to read model fields:
165 IF ( nbFields.EQ.0 ) THEN
166 IF ( usePickupBeforeC54 ) THEN
167 #ifndef ALLOW_ADAMSBASHFORTH_3
168 CALL READ_REC_3D_RL( fn, fp, Nr, uVel, 1, myIter,myThid )
169 CALL READ_REC_3D_RL( fn, fp, Nr, gU, 2, myIter,myThid )
170 CALL READ_REC_3D_RL( fn, fp, Nr, guNm1, 3, myIter,myThid )
171 CALL READ_REC_3D_RL( fn, fp, Nr, vVel, 4, myIter,myThid )
172 CALL READ_REC_3D_RL( fn, fp, Nr, gV, 5, myIter,myThid )
173 CALL READ_REC_3D_RL( fn, fp, Nr, gvNm1, 6, myIter,myThid )
174 CALL READ_REC_3D_RL( fn, fp, Nr, theta, 7, myIter,myThid )
175 c CALL READ_REC_3D_RL( fn, fp, Nr, gT, 8, myIter,myThid )
176 CALL READ_REC_3D_RL( fn, fp, Nr, gtNm1, 9, myIter,myThid )
177 CALL READ_REC_3D_RL( fn, fp, Nr, salt, 10, myIter,myThid )
178 c CALL READ_REC_3D_RL( fn, fp, Nr, gS, 11, myIter,myThid )
179 CALL READ_REC_3D_RL( fn, fp, Nr, gsNm1,12, myIter,myThid )
180 #endif /* ALLOW_ADAMSBASHFORTH_3 */
181 CALL READ_REC_3D_RL( fn, fp, 1, etaN,
182 & 12*Nr+1, myIter,myThid )
183 #ifdef NONLIN_FRSURF
184 IF (nonlinFreeSurf .GE. 0) THEN
185 CALL READ_REC_3D_RL(fn, fp, 1, etaH,
186 & 12*Nr+2, myIter,myThid )
187 ENDIF
188 #endif
189 ELSE
190 #ifdef ALLOW_ADAMSBASHFORTH_3
191 j = 3
192 IF ( startFromPickupAB2 ) j = 2
193 nj = 0
194 CALL READ_REC_3D_RL( fn, fp, Nr, uVel, nj+1, myIter,myThid )
195 CALL READ_REC_3D_RL( fn, fp, Nr, guNm(1-OLx,1-OLy,1,1,1,1),
196 & nj+2, myIter,myThid )
197 CALL READ_REC_3D_RL( fn, fp, Nr, guNm(1-OLx,1-OLy,1,1,1,2),
198 & nj+j, myIter,myThid )
199 nj = j
200 CALL READ_REC_3D_RL( fn, fp, Nr, vVel, nj+1, myIter,myThid )
201 CALL READ_REC_3D_RL( fn, fp, Nr, gvNm(1-OLx,1-OLy,1,1,1,1),
202 & nj+2, myIter,myThid )
203 CALL READ_REC_3D_RL( fn, fp, Nr, gvNm(1-OLx,1-OLy,1,1,1,2),
204 & nj+j, myIter,myThid )
205 nj = 2*j
206 CALL READ_REC_3D_RL( fn, fp, Nr, theta,nj+1, myIter,myThid )
207 CALL READ_REC_3D_RL( fn, fp, Nr, gtNm(1-OLx,1-OLy,1,1,1,1),
208 & nj+2, myIter,myThid )
209 CALL READ_REC_3D_RL( fn, fp, Nr, gtNm(1-OLx,1-OLy,1,1,1,2),
210 & nj+j, myIter,myThid )
211 nj = 3*j
212 CALL READ_REC_3D_RL( fn, fp, Nr, salt, nj+1, myIter,myThid )
213 CALL READ_REC_3D_RL( fn, fp, Nr, gsNm(1-OLx,1-OLy,1,1,1,1),
214 & nj+2, myIter,myThid )
215 CALL READ_REC_3D_RL( fn, fp, Nr, gsNm(1-OLx,1-OLy,1,1,1,2),
216 & nj+j, myIter,myThid )
217 nj = 4*j
218 #else /* ALLOW_ADAMSBASHFORTH_3 */
219 CALL READ_REC_3D_RL( fn, fp, Nr, uVel, 1, myIter,myThid )
220 CALL READ_REC_3D_RL( fn, fp, Nr, guNm1, 2, myIter,myThid )
221 CALL READ_REC_3D_RL( fn, fp, Nr, vVel, 3, myIter,myThid )
222 CALL READ_REC_3D_RL( fn, fp, Nr, gvNm1, 4, myIter,myThid )
223 CALL READ_REC_3D_RL( fn, fp, Nr, theta, 5, myIter,myThid )
224 CALL READ_REC_3D_RL( fn, fp, Nr, gtNm1, 6, myIter,myThid )
225 CALL READ_REC_3D_RL( fn, fp, Nr, salt, 7, myIter,myThid )
226 CALL READ_REC_3D_RL( fn, fp, Nr, gsNm1, 8, myIter,myThid )
227 nj = 8
228 #endif /* ALLOW_ADAMSBASHFORTH_3 */
229 CALL READ_REC_3D_RL( fn,fp,1, etaN, nj*Nr+1, myIter,myThid )
230 #ifdef EXACT_CONSERV
231 IF ( exactConserv ) THEN
232 CALL READ_REC_3D_RL(fn,fp,1,dEtaHdt,nj*Nr+2,myIter,myThid )
233 ENDIF
234 IF ( nonlinFreeSurf.GT.0 ) THEN
235 CALL READ_REC_3D_RL(fn,fp,1, etaH, nj*Nr+3, myIter,myThid )
236 ENDIF
237 #endif
238 ENDIF
239
240 IF ( storePhiHyd4Phys ) THEN
241 WRITE(fn,'(A,A10)') 'pickup_ph.',suff
242 CALL READ_REC_3D_RL( fn, fp, Nr, totPhiHyd,1,myIter,myThid )
243 ENDIF
244 #ifdef ALLOW_NONHYDROSTATIC
245 IF ( use3Dsolver ) THEN
246 WRITE(fn,'(A,A10)') 'pickup_nh.',suff
247 CALL READ_REC_3D_RL( fn, fp, Nr, phi_nh, 1, myIter,myThid )
248 #ifdef ALLOW_ADAMSBASHFORTH_3
249 CALL READ_REC_3D_RL( fn, fp, Nr, gwNm(1-OLx,1-OLy,1,1,1,1),
250 & 2, myIter,myThid )
251 CALL READ_REC_3D_RL( fn, fp, Nr, gwNm(1-OLx,1-OLy,1,1,1,2),
252 & 2, myIter,myThid )
253 #else /* ALLOW_ADAMSBASHFORTH_3 */
254 CALL READ_REC_3D_RL( fn, fp, Nr, gwNm1, 2, myIter,myThid )
255 #endif /* ALLOW_ADAMSBASHFORTH_3 */
256 ENDIF
257 #endif /* ALLOW_NONHYDROSTATIC */
258 ELSE
259 C--- New way to read model fields:
260 nj = 0
261 C--- read State 3-D fields for restart
262 CALL READ_MFLDS_3D_RL( 'Uvel ', uVel,
263 & nj, fp, Nr, myIter, myThid )
264 CALL READ_MFLDS_3D_RL( 'Vvel ', vVel,
265 & nj, fp, Nr, myIter, myThid )
266 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
267 IF (GM_InMomAsStress) THEN
268 CALL READ_MFLDS_3D_RL( 'UEulerM ', uEulerMean,
269 & nj, fp, Nr, myIter, myThid )
270 CALL READ_MFLDS_3D_RL( 'VEulerM ', vEulerMean,
271 & nj, fp, Nr, myIter, myThid )
272 ENDIF
273 #endif
274 CALL READ_MFLDS_3D_RL( 'Theta ', theta,
275 & nj, fp, Nr, myIter, myThid )
276 CALL READ_MFLDS_3D_RL( 'Salt ', salt,
277 & nj, fp, Nr, myIter, myThid )
278 C--- read 3-D fields for AB-restart
279 #ifdef ALLOW_ADAMSBASHFORTH_3
280 m1 = 1 + MOD(myIter+1,2)
281 m2 = 1 + MOD( myIter ,2)
282 IF ( momStepping ) THEN
283 C-- U velocity:
284 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
285 CALL READ_MFLDS_3D_RL( 'GuNm1 ',guNm(1-OLx,1-OLy,1,1,1,m1),
286 & nj, fp, Nr, myIter, myThid )
287 ENDIF
288 IF ( beta_AB.NE.0. ) THEN
289 CALL READ_MFLDS_3D_RL( 'GuNm2 ',guNm(1-OLx,1-OLy,1,1,1,m2),
290 & nj, fp, Nr, myIter, myThid )
291 ENDIF
292 C-- V velocity:
293 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
294 CALL READ_MFLDS_3D_RL( 'GvNm1 ',gvNm(1-OLx,1-OLy,1,1,1,m1),
295 & nj, fp, Nr, myIter, myThid )
296 ENDIF
297 IF ( beta_AB.NE.0. ) THEN
298 CALL READ_MFLDS_3D_RL( 'GvNm2 ',gvNm(1-OLx,1-OLy,1,1,1,m2),
299 & nj, fp, Nr, myIter, myThid )
300 ENDIF
301 ENDIF
302 C-- Temperature:
303 IF ( AdamsBashforthGt ) THEN
304 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
305 CALL READ_MFLDS_3D_RL( 'GtNm1 ',gtNm(1-OLx,1-OLy,1,1,1,m1),
306 & nj, fp, Nr, myIter, myThid )
307 ENDIF
308 IF ( beta_AB.NE.0. ) THEN
309 CALL READ_MFLDS_3D_RL( 'GtNm2 ',gtNm(1-OLx,1-OLy,1,1,1,m2),
310 & nj, fp, Nr, myIter, myThid )
311 ENDIF
312 ELSEIF ( AdamsBashforth_T ) THEN
313 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
314 CALL READ_MFLDS_3D_RL( 'TempNm1 ',gtNm(1-OLx,1-OLy,1,1,1,m1),
315 & nj, fp, Nr, myIter, myThid )
316 ENDIF
317 IF ( beta_AB.NE.0. ) THEN
318 CALL READ_MFLDS_3D_RL( 'TempNm2 ',gtNm(1-OLx,1-OLy,1,1,1,m2),
319 & nj, fp, Nr, myIter, myThid )
320 ENDIF
321 ENDIF
322 C-- Salinity:
323 IF ( AdamsBashforthGs ) THEN
324 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
325 CALL READ_MFLDS_3D_RL( 'GsNm1 ',gsNm(1-OLx,1-OLy,1,1,1,m1),
326 & nj, fp, Nr, myIter, myThid )
327 ENDIF
328 IF ( beta_AB.NE.0. ) THEN
329 CALL READ_MFLDS_3D_RL( 'GsNm2 ',gsNm(1-OLx,1-OLy,1,1,1,m2),
330 & nj, fp, Nr, myIter, myThid )
331 ENDIF
332 ELSEIF ( AdamsBashforth_S ) THEN
333 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
334 CALL READ_MFLDS_3D_RL( 'SaltNm1 ',gsNm(1-OLx,1-OLy,1,1,1,m1),
335 & nj, fp, Nr, myIter, myThid )
336 ENDIF
337 IF ( beta_AB.NE.0. ) THEN
338 CALL READ_MFLDS_3D_RL( 'SaltNm2 ',gsNm(1-OLx,1-OLy,1,1,1,m2),
339 & nj, fp, Nr, myIter, myThid )
340 ENDIF
341 ENDIF
342 #ifdef ALLOW_NONHYDROSTATIC
343 IF ( nonHydrostatic ) THEN
344 C-- W velocity:
345 IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
346 CALL READ_MFLDS_3D_RL( 'GwNm1 ',gwNm(1-OLx,1-OLy,1,1,1,m1),
347 & nj, fp, Nr, myIter, myThid )
348 ENDIF
349 IF ( beta_AB.NE.0. ) THEN
350 CALL READ_MFLDS_3D_RL( 'GwNm2 ',gwNm(1-OLx,1-OLy,1,1,1,m2),
351 & nj, fp, Nr, myIter, myThid )
352 ENDIF
353 ENDIF
354 #endif /* ALLOW_NONHYDROSTATIC */
355 #else /* ALLOW_ADAMSBASHFORTH_3 */
356 IF ( momStepping ) THEN
357 C-- U velocity:
358 CALL READ_MFLDS_3D_RL( 'GuNm1 ', guNm1,
359 & nj, fp, Nr, myIter, myThid )
360 C-- V velocity:
361 CALL READ_MFLDS_3D_RL( 'GvNm1 ', gvNm1,
362 & nj, fp, Nr, myIter, myThid )
363 ENDIF
364 C-- Temperature
365 IF ( AdamsBashforthGt ) THEN
366 CALL READ_MFLDS_3D_RL( 'GtNm1 ', gtNm1,
367 & nj, fp, Nr, myIter, myThid )
368 ELSEIF ( AdamsBashforth_T ) THEN
369 CALL READ_MFLDS_3D_RL( 'TempNm1 ', gtNm1,
370 & nj, fp, Nr, myIter, myThid )
371 ENDIF
372 C-- Salinity
373 IF ( AdamsBashforthGs ) THEN
374 CALL READ_MFLDS_3D_RL( 'GsNm1 ', gsNm1,
375 & nj, fp, Nr, myIter, myThid )
376 ELSEIF ( AdamsBashforth_S ) THEN
377 CALL READ_MFLDS_3D_RL( 'SaltNm1 ', gsNm1,
378 & nj, fp, Nr, myIter, myThid )
379 ENDIF
380 #ifdef ALLOW_NONHYDROSTATIC
381 IF ( nonHydrostatic ) THEN
382 CALL READ_MFLDS_3D_RL( 'GwNm1 ', gwNm1,
383 & nj, fp, Nr, myIter, myThid )
384 ENDIF
385 #endif /* ALLOW_NONHYDROSTATIC */
386 #endif /* ALLOW_ADAMSBASHFORTH_3 */
387
388 C- read Full Pressure for EOS in pressure:
389 IF ( storePhiHyd4Phys ) THEN
390 CALL READ_MFLDS_3D_RL( 'PhiHyd ', totPhiHyd,
391 & nj, fp, Nr, myIter, myThid )
392 ENDIF
393 #ifdef ALLOW_NONHYDROSTATIC
394 IF ( use3Dsolver ) THEN
395 CALL READ_MFLDS_3D_RL( 'Phi_NHyd', phi_nh,
396 & nj, fp, Nr, myIter, myThid )
397 ENDIF
398 #endif /* ALLOW_NONHYDROSTATIC */
399 #ifdef ALLOW_ADDFLUID
400 C- read mass source/sink of fluid
401 IF ( selectAddFluid.GE.1 ) THEN
402 CALL READ_MFLDS_3D_RL( 'AddMass ', addMass,
403 & nj, fp, Nr, myIter, myThid )
404 ENDIF
405 #endif /* ALLOW_ADDFLUID */
406 #ifdef ALLOW_FRICTION_HEATING
407 C- needs frictional heating when using synchronous time-stepping
408 IF ( addFrictionHeating .AND. .NOT.staggerTimeStep ) THEN
409 CALL READ_MFLDS_LEV_RS( 'FricHeat', frictionHeating,
410 & nj, fp, Nr, 1, Nr, myIter, myThid )
411 ENDIF
412 #endif /* ALLOW_FRICTION_HEATING */
413
414 C--- read 2-D fields, starting with Eta:
415 nj = nj*Nr
416 CALL READ_MFLDS_3D_RL( 'EtaN ', etaN,
417 & nj, fp, 1 , myIter, myThid )
418 #ifdef ALLOW_NONHYDROSTATIC
419 IF ( selectNHfreeSurf.GE.1 ) THEN
420 CALL READ_MFLDS_3D_RL( 'dPhiNH ', dPhiNH,
421 & nj, fp, 1 , myIter, myThid )
422 ENDIF
423 #endif /* ALLOW_NONHYDROSTATIC */
424 #ifdef EXACT_CONSERV
425 IF ( exactConserv ) THEN
426 CALL READ_MFLDS_3D_RL( 'dEtaHdt ', dEtaHdt,
427 & nj, fp, 1 , myIter, myThid )
428 ENDIF
429 IF ( nonlinFreeSurf.GT.0 ) THEN
430 CALL READ_MFLDS_3D_RL( 'EtaH ', etaH,
431 & nj, fp, 1 , myIter, myThid )
432 ENDIF
433 #endif /* EXACT_CONSERV */
434 C-- end: new way to read pickup file
435 ENDIF
436
437 C-- Check for missing fields:
438 nMissing = missFldDim
439 CALL READ_MFLDS_CHECK(
440 O missFldList,
441 U nMissing,
442 I myIter, myThid )
443 IF ( nMissing.GT.missFldDim ) THEN
444 WRITE(msgBuf,'(2A,I4)') 'READ_PICKUP: ',
445 & 'missing fields list has been truncated to', missFldDim
446 CALL PRINT_ERROR( msgBuf, myThid )
447 STOP 'ABNORMAL END: S/R READ_PICKUP (list-size Pb)'
448 ENDIF
449 CALL CHECK_PICKUP(
450 I missFldList,
451 I nMissing, nbFields,
452 I myIter, myThid )
453
454 C-- end: pickup_read_mdsio
455 ENDIF
456
457 #ifdef ALLOW_MNC
458 IF (useMNC .AND. pickup_read_mnc) THEN
459 WRITE(fn,'(A)') 'pickup'
460 CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
461 CALL MNC_CW_SET_UDIM(fn, 1, myThid)
462 CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
463 CALL MNC_CW_RL_R('D',fn,0,0,'U',uVel, myThid)
464 CALL MNC_CW_RL_R('D',fn,0,0,'V',vVel, myThid)
465 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
466 IF (GM_InMomAsStress) THEN
467 CALL MNC_CW_RL_R('D',fn,0,0,'UEulerM',uEulerMean, myThid)
468 CALL MNC_CW_RL_R('D',fn,0,0,'VEulerM',vEulerMean, myThid)
469 ENDIF
470 #endif
471 CALL MNC_CW_RL_R('D',fn,0,0,'Temp',theta, myThid)
472 CALL MNC_CW_RL_R('D',fn,0,0,'S',salt, myThid)
473 CALL MNC_CW_RL_R('D',fn,0,0,'Eta',etaN, myThid)
474 #ifndef ALLOW_ADAMSBASHFORTH_3
475 CALL MNC_CW_RL_R('D',fn,0,0,'gUnm1',guNm1, myThid)
476 CALL MNC_CW_RL_R('D',fn,0,0,'gVnm1',gvNm1, myThid)
477 CALL MNC_CW_RL_R('D',fn,0,0,'gTnm1',gtNm1, myThid)
478 CALL MNC_CW_RL_R('D',fn,0,0,'gSnm1',gsNm1, myThid)
479 #endif /* ALLOW_ADAMSBASHFORTH_3 */
480 C#ifdef NONLIN_FRSURF
481 C IF ( nonlinFreeSurf.GE.0 .AND. usePickupBeforeC54 )
482 C & CALL MNC_CW_RL_R('D',fn,0,0,'EtaH', etaH, myThid)
483 C#endif
484 #ifdef EXACT_CONSERV
485 IF (exactConserv) THEN
486 CALL MNC_CW_RL_R('D',fn,0,0,'dEtaHdt',dEtaHdt,myThid)
487 ENDIF
488 IF (nonlinFreeSurf .GT. 0) THEN
489 CALL MNC_CW_RL_R('D',fn,0,0,'EtaH', etaH, myThid)
490 ENDIF
491 #endif
492 #ifdef ALLOW_NONHYDROSTATIC
493 IF (use3Dsolver) THEN
494 CALL MNC_CW_RL_R('D',fn,0,0,'phi_nh', phi_nh, myThid)
495 c CALL MNC_CW_RL_R('D',fn,0,0,'gW', gW, myThid)
496 #ifndef ALLOW_ADAMSBASHFORTH_3
497 CALL MNC_CW_RL_R('D',fn,0,0,'gWnm1', gwNm1, myThid)
498 #endif
499 ENDIF
500 #endif
501 IF ( storePhiHyd4Phys ) THEN
502 CALL MNC_CW_RL_R('D',fn,0,0,'phiHyd',totPhiHyd,myThid)
503 ENDIF
504 ENDIF
505 #endif /* ALLOW_MNC */
506
507 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
508
509 C Fill in edge regions
510 CALL EXCH_UV_3D_RL( uVel, vVel, .TRUE., Nr, myThid )
511 #if defined(ALLOW_EDDYPSI) && defined(ALLOW_GMREDI)
512 IF (GM_InMomAsStress) THEN
513 CALL EXCH_UV_3D_RL( uEulerMean, vEulerMean, .TRUE., Nr, myThid )
514 ENDIF
515 #endif
516 CALL EXCH_3D_RL( theta, Nr, myThid )
517 CALL EXCH_3D_RL( salt, Nr, myThid )
518 #ifdef ALLOW_ADAMSBASHFORTH_3
519 CALL EXCH_UV_3D_RL( guNm(1-OLx,1-OLy,1,1,1,1),
520 & gvNm(1-OLx,1-OLy,1,1,1,1),.TRUE.,Nr,myThid )
521 CALL EXCH_UV_3D_RL( guNm(1-OLx,1-OLy,1,1,1,2),
522 & gvNm(1-OLx,1-OLy,1,1,1,2),.TRUE.,Nr,myThid )
523 CALL EXCH_3D_RL( gtNm(1-OLx,1-OLy,1,1,1,1), Nr, myThid )
524 CALL EXCH_3D_RL( gtNm(1-OLx,1-OLy,1,1,1,2), Nr, myThid )
525 CALL EXCH_3D_RL( gsNm(1-OLx,1-OLy,1,1,1,1), Nr, myThid )
526 CALL EXCH_3D_RL( gsNm(1-OLx,1-OLy,1,1,1,2), Nr, myThid )
527 #else /* ALLOW_ADAMSBASHFORTH_3 */
528 CALL EXCH_UV_3D_RL( guNm1, gvNm1, .TRUE., Nr, myThid )
529 CALL EXCH_3D_RL( gtNm1, Nr, myThid )
530 CALL EXCH_3D_RL( gsNm1, Nr, myThid )
531 #endif /* ALLOW_ADAMSBASHFORTH_3 */
532 CALL EXCH_XY_RL( etaN, myThid )
533 CALL EXCH_XY_RL( etaH, myThid )
534 #ifdef EXACT_CONSERV
535 CALL EXCH_XY_RL( detaHdt, myThid )
536 #endif
537
538 IF ( storePhiHyd4Phys )
539 & CALL EXCH_3D_RL( totPhiHyd, Nr, myThid )
540
541 #ifdef ALLOW_NONHYDROSTATIC
542 IF ( use3Dsolver ) THEN
543 CALL EXCH_3D_RL( phi_nh, Nr, myThid )
544 ENDIF
545 IF ( nonHydrostatic ) THEN
546 #ifdef ALLOW_ADAMSBASHFORTH_3
547 CALL EXCH_3D_RL( gwNm(1-OLx,1-OLy,1,1,1,1), Nr, myThid )
548 CALL EXCH_3D_RL( gwNm(1-OLx,1-OLy,1,1,1,2), Nr, myThid )
549 #else /* ALLOW_ADAMSBASHFORTH_3 */
550 CALL EXCH_3D_RL( gwNm1, Nr, myThid )
551 #endif /* ALLOW_ADAMSBASHFORTH_3 */
552 ENDIF
553 IF ( selectNHfreeSurf.GE.1 ) THEN
554 CALL EXCH_XY_RL( dPhiNH, myThid )
555 ENDIF
556 #endif /* ALLOW_NONHYDROSTATIC */
557
558 RETURN
559 END

  ViewVC Help
Powered by ViewVC 1.1.22