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

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

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


Revision 1.6 - (hide annotations) (download)
Fri Dec 11 13:53:07 2009 UTC (14 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint62, checkpoint63, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x
Changes since 1.5: +51 -11 lines
Implement AB-3 for non-hydrostatic vertical momentum ;
add 2-D field to store Hydrostatic Surface Pressure adjusment (from cg3d).

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

  ViewVC Help
Powered by ViewVC 1.1.22