/[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.5 - (hide annotations) (download)
Sun Jun 14 21:45:12 2009 UTC (14 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.4: +3 -4 lines
remove unnecessary BARRIER

1 jmc 1.5 C $Header: /u/gcmpack/MITgcm/model/src/read_pickup.F,v 1.4 2008/08/24 21:38:19 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     CALL READ_REC_3D_RL( fn, fp, Nr, gwNm1, 2, myIter,myThid )
244     ENDIF
245     #endif
246 jmc 1.2 ELSE
247     C--- New way to read model fields:
248     nj = 0
249     C--- read State 3-D fields for restart
250     CALL READ_MFLDS_3D_RL( 'Uvel ', uVel,
251     & nj, fp, Nr, myIter, myThid )
252     CALL READ_MFLDS_3D_RL( 'Vvel ', vVel,
253     & nj, fp, Nr, myIter, myThid )
254     CALL READ_MFLDS_3D_RL( 'Theta ', theta,
255     & nj, fp, Nr, myIter, myThid )
256     CALL READ_MFLDS_3D_RL( 'Salt ', salt,
257     & nj, fp, Nr, myIter, myThid )
258     C--- read 3-D fields for AB-restart
259     #ifdef ALLOW_ADAMSBASHFORTH_3
260     m1 = 1 + MOD(myIter+1,2)
261     m2 = 1 + MOD( myIter ,2)
262 jmc 1.3 IF ( momStepping ) THEN
263 jmc 1.2 C-- U velocity:
264     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
265     CALL READ_MFLDS_3D_RL( 'GuNm1 ',guNm(1-Olx,1-Oly,1,1,1,m1),
266     & nj, fp, Nr, myIter, myThid )
267     ENDIF
268     IF ( beta_AB.NE.0. ) THEN
269     CALL READ_MFLDS_3D_RL( 'GuNm2 ',guNm(1-Olx,1-Oly,1,1,1,m2),
270     & nj, fp, Nr, myIter, myThid )
271     ENDIF
272     C-- V velocity:
273     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
274     CALL READ_MFLDS_3D_RL( 'GvNm1 ',gvNm(1-Olx,1-Oly,1,1,1,m1),
275     & nj, fp, Nr, myIter, myThid )
276     ENDIF
277     IF ( beta_AB.NE.0. ) THEN
278     CALL READ_MFLDS_3D_RL( 'GvNm2 ',gvNm(1-Olx,1-Oly,1,1,1,m2),
279     & nj, fp, Nr, myIter, myThid )
280     ENDIF
281 jmc 1.3 ENDIF
282 jmc 1.2 C-- Temperature:
283     IF ( AdamsBashforthGt ) THEN
284     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
285     CALL READ_MFLDS_3D_RL( 'GtNm1 ',gtNm(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( 'GtNm2 ',gtNm(1-Olx,1-Oly,1,1,1,m2),
290     & nj, fp, Nr, myIter, myThid )
291     ENDIF
292     ELSEIF ( AdamsBashforth_T ) THEN
293     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
294     CALL READ_MFLDS_3D_RL( 'TempNm1 ',gtNm(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( 'TempNm2 ',gtNm(1-Olx,1-Oly,1,1,1,m2),
299     & nj, fp, Nr, myIter, myThid )
300     ENDIF
301     ENDIF
302     C-- Salinity:
303     IF ( AdamsBashforthGs ) THEN
304     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
305     CALL READ_MFLDS_3D_RL( 'GsNm1 ',gsNm(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( 'GsNm2 ',gsNm(1-Olx,1-Oly,1,1,1,m2),
310     & nj, fp, Nr, myIter, myThid )
311     ENDIF
312     ELSEIF ( AdamsBashforth_S ) THEN
313     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
314     CALL READ_MFLDS_3D_RL( 'SaltNm1 ',gsNm(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( 'SaltNm2 ',gsNm(1-Olx,1-Oly,1,1,1,m2),
319     & nj, fp, Nr, myIter, myThid )
320     ENDIF
321     ENDIF
322     #else /* ALLOW_ADAMSBASHFORTH_3 */
323 jmc 1.3 IF ( momStepping ) THEN
324 jmc 1.2 C-- U velocity:
325     CALL READ_MFLDS_3D_RL( 'GuNm1 ', guNm1,
326     & nj, fp, Nr, myIter, myThid )
327     C-- V velocity:
328     CALL READ_MFLDS_3D_RL( 'GvNm1 ', gvNm1,
329     & nj, fp, Nr, myIter, myThid )
330 jmc 1.3 ENDIF
331 jmc 1.2 C-- Temperature
332     IF ( AdamsBashforthGt ) THEN
333     CALL READ_MFLDS_3D_RL( 'GtNm1 ', gtNm1,
334     & nj, fp, Nr, myIter, myThid )
335     ENDIF
336     C-- Salinity
337     IF ( AdamsBashforthGs ) THEN
338     CALL READ_MFLDS_3D_RL( 'GsNm1 ', gsNm1,
339     & nj, fp, Nr, myIter, myThid )
340     ENDIF
341     #endif /* ALLOW_ADAMSBASHFORTH_3 */
342    
343     C- read Full Pressure for EOS in pressure:
344     IF ( useDynP_inEos_Zc ) THEN
345     CALL READ_MFLDS_3D_RL( 'PhiHyd ', totPhiHyd,
346     & nj, fp, Nr, myIter, myThid )
347     ENDIF
348     #ifdef ALLOW_NONHYDROSTATIC
349     IF ( use3Dsolver ) THEN
350     CALL READ_MFLDS_3D_RL( 'Phi_NHyd', phi_nh,
351     & nj, fp, Nr, myIter, myThid )
352     ENDIF
353     IF ( nonHydrostatic ) THEN
354     CALL READ_MFLDS_3D_RL( 'GwNm1 ', gwNm1,
355     & nj, fp, Nr, myIter, myThid )
356     ENDIF
357     #endif
358 jmc 1.4 #ifdef ALLOW_ADDFLUID
359     C- read mass source/sink of fluid
360     IF ( selectAddFluid.GE.1 ) THEN
361     CALL READ_MFLDS_3D_RL( 'AddMass ', addMass,
362     & nj, fp, Nr, myIter, myThid )
363     ENDIF
364     #endif /* ALLOW_ADDFLUID */
365 jmc 1.2
366     C--- read 2-D fields, starting with Eta:
367     nj = nj*Nr
368     CALL READ_MFLDS_3D_RL( 'EtaN ', etaN,
369     & nj, fp, 1 , myIter, myThid )
370     #ifdef EXACT_CONSERV
371     IF ( exactConserv ) THEN
372     CALL READ_MFLDS_3D_RL( 'dEtaHdt ', dEtaHdt,
373     & nj, fp, 1 , myIter, myThid )
374     ENDIF
375     IF ( nonlinFreeSurf.GT.0 ) THEN
376     CALL READ_MFLDS_3D_RL( 'EtaH ', etaH,
377     & nj, fp, 1 , myIter, myThid )
378     ENDIF
379     #endif
380     C-- end: new way to read pickup file
381     ENDIF
382    
383     C-- Check for missing fields:
384     nMissing = missFldDim
385     CALL READ_MFLDS_CHECK(
386     O missFldList,
387     U nMissing,
388     I myIter, myThid )
389     IF ( nMissing.GT.missFldDim ) THEN
390     WRITE(msgBuf,'(2A,I4)') 'READ_PICKUP: ',
391     & 'missing fields list has been truncated to', missFldDim
392     CALL PRINT_ERROR( msgBuf, myThid )
393     STOP 'ABNORMAL END: S/R READ_PICKUP (list-size Pb)'
394     ENDIF
395     CALL CHECK_PICKUP(
396     I missFldList,
397     I nMissing, nbFields,
398     I myIter, myThid )
399 jmc 1.1
400 jmc 1.2 C-- end: pickup_read_mdsio
401 jmc 1.1 ENDIF
402    
403     #ifdef ALLOW_MNC
404     IF (useMNC .AND. pickup_read_mnc) THEN
405     WRITE(fn,'(A)') 'pickup'
406     CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
407     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
408     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
409     CALL MNC_CW_RL_R('D',fn,0,0,'U',uVel, myThid)
410     CALL MNC_CW_RL_R('D',fn,0,0,'V',vVel, myThid)
411     CALL MNC_CW_RL_R('D',fn,0,0,'Temp',theta, myThid)
412     CALL MNC_CW_RL_R('D',fn,0,0,'S',salt, myThid)
413     CALL MNC_CW_RL_R('D',fn,0,0,'Eta',etaN, myThid)
414     #ifndef ALLOW_ADAMSBASHFORTH_3
415     CALL MNC_CW_RL_R('D',fn,0,0,'gUnm1',guNm1, myThid)
416     CALL MNC_CW_RL_R('D',fn,0,0,'gVnm1',gvNm1, myThid)
417     CALL MNC_CW_RL_R('D',fn,0,0,'gTnm1',gtNm1, myThid)
418     CALL MNC_CW_RL_R('D',fn,0,0,'gSnm1',gsNm1, myThid)
419     #endif /* ALLOW_ADAMSBASHFORTH_3 */
420     C#ifdef NONLIN_FRSURF
421     C IF ( nonlinFreeSurf.GE.0 .AND. usePickupBeforeC54 )
422     C & CALL MNC_CW_RL_R('D',fn,0,0,'EtaH', etaH, myThid)
423     C#endif
424     #ifdef EXACT_CONSERV
425     IF (exactConserv) THEN
426     CALL MNC_CW_RL_R('D',fn,0,0,'dEtaHdt',dEtaHdt,myThid)
427     ENDIF
428     IF (nonlinFreeSurf .GT. 0) THEN
429     CALL MNC_CW_RL_R('D',fn,0,0,'EtaH', etaH, myThid)
430     ENDIF
431     #endif
432     #ifdef ALLOW_NONHYDROSTATIC
433     IF (use3Dsolver) THEN
434     CALL MNC_CW_RL_R('D',fn,0,0,'phi_nh', phi_nh, myThid)
435     c CALL MNC_CW_RL_R('D',fn,0,0,'gW', gW, myThid)
436     CALL MNC_CW_RL_R('D',fn,0,0,'gWnm1', gwNm1, myThid)
437     ENDIF
438     #endif
439     IF ( useDynP_inEos_Zc ) THEN
440     CALL MNC_CW_RL_R('D',fn,0,0,'phiHyd',totPhiHyd,myThid)
441     ENDIF
442     ENDIF
443     #endif /* ALLOW_MNC */
444    
445     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
446    
447     C Fill in edge regions
448     CALL EXCH_UV_3D_RL( uVel, vVel, .TRUE., Nr, myThid )
449     CALL EXCH_3D_RL( theta, Nr, myThid )
450     CALL EXCH_3D_RL( salt, Nr, myThid )
451     #ifdef ALLOW_ADAMSBASHFORTH_3
452     CALL EXCH_UV_3D_RL( guNm(1-Olx,1-Oly,1,1,1,1),
453     & gvNm(1-Olx,1-Oly,1,1,1,1),.TRUE.,Nr,myThid )
454     CALL EXCH_3D_RL( gtNm(1-Olx,1-Oly,1,1,1,1), Nr, myThid )
455     CALL EXCH_3D_RL( gsNm(1-Olx,1-Oly,1,1,1,1), Nr, myThid )
456     CALL EXCH_UV_3D_RL( guNm(1-Olx,1-Oly,1,1,1,2),
457     & gvNm(1-Olx,1-Oly,1,1,1,2),.TRUE.,Nr,myThid )
458     CALL EXCH_3D_RL( gtNm(1-Olx,1-Oly,1,1,1,2), Nr, myThid )
459     CALL EXCH_3D_RL( gsNm(1-Olx,1-Oly,1,1,1,2), Nr, myThid )
460     #else /* ALLOW_ADAMSBASHFORTH_3 */
461     CALL EXCH_UV_3D_RL( guNm1, gvNm1, .TRUE., Nr, myThid )
462     CALL EXCH_3D_RL( gtNm1, Nr, myThid )
463     CALL EXCH_3D_RL( gsNm1, Nr, myThid )
464     #endif /* ALLOW_ADAMSBASHFORTH_3 */
465     CALL EXCH_XY_RL( etaN, myThid )
466     CALL EXCH_XY_RL( etaH, myThid )
467     #ifdef EXACT_CONSERV
468     CALL EXCH_XY_RL( detaHdt, myThid )
469     #endif
470    
471     IF ( useDynP_inEos_Zc )
472     & CALL EXCH_3D_RL( totPhiHyd, Nr, myThid )
473    
474     #ifdef ALLOW_NONHYDROSTATIC
475     IF ( use3Dsolver ) THEN
476     CALL EXCH_3D_RL( phi_nh, Nr, myThid )
477     CALL EXCH_3D_RL( gwNm1, Nr, myThid )
478     ENDIF
479     #endif
480    
481     RETURN
482     END

  ViewVC Help
Powered by ViewVC 1.1.22