/[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.4 - (hide annotations) (download)
Sun Aug 24 21:38:19 2008 UTC (15 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61c, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61p
Changes since 1.3: +8 -1 lines
add mass source/sink of fluid in continuity eq. ; need to store addMass
 in pickup file for restart.

1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/model/src/read_pickup.F,v 1.3 2007/10/29 18:17: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     _BARRIER
95    
96     IF (pickup_read_mdsio) THEN
97    
98 jmc 1.2 fp = precFloat64
99     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
100    
101     CALL READ_MFLDS_SET(
102     I fn,
103     O nbFields, filePrec,
104     I Nr, myIter, myThid )
105    
106     _BEGIN_MASTER( myThid )
107     c IF ( filePrec.NE.0 .AND. filePrec.NE.fp ) THEN
108     IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
109     WRITE(msgBuf,'(2A,I4)') 'READ_PICKUP: ',
110     & 'pickup-file binary precision do not match !'
111     CALL PRINT_ERROR( msgBuf, myThid )
112     WRITE(msgBuf,'(A,2(A,I4))') 'READ_PICKUP: ',
113     & 'file prec.=', filePrec, ' but expecting prec.=', fp
114     CALL PRINT_ERROR( msgBuf, myThid )
115     STOP 'ABNORMAL END: S/R READ_PICKUP (data-prec Pb)'
116     ENDIF
117     _END_MASTER( myThid )
118    
119     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
120    
121     IF ( nbFields.LE.0 ) THEN
122     C- No meta-file or old meta-file without List of Fields
123     ioUnit = errorMessageUnit
124     IF ( pickupStrictlyMatch ) THEN
125     WRITE(msgBuf,'(4A)') 'READ_PICKUP: ',
126     & 'no field-list found in meta-file',
127     & ' => cannot check for strick-matching'
128     c CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
129     CALL PRINT_ERROR( msgBuf, myThid )
130     WRITE(msgBuf,'(4A)') 'READ_PICKUP: ',
131     & 'try with " pickupStrictlyMatch=.FALSE.,"',
132     & ' in file: "data", NameList: "PARM03"'
133     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
134     STOP 'ABNORMAL END: S/R READ_PICKUP'
135     ELSE
136     WRITE(msgBuf,'(4A)') 'WARNING >> READ_PICKUP: ',
137     & ' no field-list found'
138     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
139     IF ( nbFields.EQ.-1 ) THEN
140     C- No meta-file
141     WRITE(msgBuf,'(4A)') 'WARNING >> ',
142     & ' try to read pickup as currently written'
143     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
144     ELSE
145     C- Old meta-file without List of Fields
146     WRITE(msgBuf,'(4A)') 'WARNING >> ',
147     & ' try to read pickup as it used to be written'
148     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
149     WRITE(msgBuf,'(4A)') 'WARNING >> ',
150     & ' until checkpoint59i (2007 Oct 22)'
151     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
152     ENDIF
153     ENDIF
154     ENDIF
155    
156     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
157 jmc 1.1
158 jmc 1.2 C--- Old way to read model fields:
159     IF ( nbFields.EQ.0 ) THEN
160 jmc 1.1 IF ( usePickupBeforeC54 ) THEN
161     #ifndef ALLOW_ADAMSBASHFORTH_3
162     CALL READ_REC_3D_RL( fn, fp, Nr, uVel, 1, myIter,myThid )
163     CALL READ_REC_3D_RL( fn, fp, Nr, gU, 2, myIter,myThid )
164     CALL READ_REC_3D_RL( fn, fp, Nr, guNm1, 3, myIter,myThid )
165     CALL READ_REC_3D_RL( fn, fp, Nr, vVel, 4, myIter,myThid )
166     CALL READ_REC_3D_RL( fn, fp, Nr, gV, 5, myIter,myThid )
167     CALL READ_REC_3D_RL( fn, fp, Nr, gvNm1, 6, myIter,myThid )
168     CALL READ_REC_3D_RL( fn, fp, Nr, theta, 7, myIter,myThid )
169     CALL READ_REC_3D_RL( fn, fp, Nr, gT, 8, myIter,myThid )
170     CALL READ_REC_3D_RL( fn, fp, Nr, gtNm1, 9, myIter,myThid )
171     CALL READ_REC_3D_RL( fn, fp, Nr, salt, 10, myIter,myThid )
172     CALL READ_REC_3D_RL( fn, fp, Nr, gS, 11, myIter,myThid )
173     CALL READ_REC_3D_RL( fn, fp, Nr, gsNm1,12, myIter,myThid )
174     #endif /* ALLOW_ADAMSBASHFORTH_3 */
175     CALL READ_REC_3D_RL( fn, fp, 1, etaN,
176     & 12*Nr+1, myIter,myThid )
177     #ifdef NONLIN_FRSURF
178     IF (nonlinFreeSurf .GE. 0) THEN
179     CALL READ_REC_3D_RL(fn, fp, 1, etaH,
180     & 12*Nr+2, myIter,myThid )
181     ENDIF
182     #endif
183     ELSE
184     #ifdef ALLOW_ADAMSBASHFORTH_3
185     j = 3
186     IF ( startFromPickupAB2 ) j = 2
187     nj = 0
188     CALL READ_REC_3D_RL( fn, fp, Nr, uVel, nj+1, myIter,myThid )
189     CALL READ_REC_3D_RL( fn, fp, Nr, guNm(1-Olx,1-Oly,1,1,1,1),
190     & nj+2, myIter,myThid )
191     CALL READ_REC_3D_RL( fn, fp, Nr, guNm(1-Olx,1-Oly,1,1,1,2),
192     & nj+j, myIter,myThid )
193     nj = j
194     CALL READ_REC_3D_RL( fn, fp, Nr, vVel, nj+1, myIter,myThid )
195     CALL READ_REC_3D_RL( fn, fp, Nr, gvNm(1-Olx,1-Oly,1,1,1,1),
196     & nj+2, myIter,myThid )
197     CALL READ_REC_3D_RL( fn, fp, Nr, gvNm(1-Olx,1-Oly,1,1,1,2),
198     & nj+j, myIter,myThid )
199     nj = 2*j
200     CALL READ_REC_3D_RL( fn, fp, Nr, theta,nj+1, myIter,myThid )
201     CALL READ_REC_3D_RL( fn, fp, Nr, gtNm(1-Olx,1-Oly,1,1,1,1),
202     & nj+2, myIter,myThid )
203     CALL READ_REC_3D_RL( fn, fp, Nr, gtNm(1-Olx,1-Oly,1,1,1,2),
204     & nj+j, myIter,myThid )
205     nj = 3*j
206     CALL READ_REC_3D_RL( fn, fp, Nr, salt, nj+1, myIter,myThid )
207     CALL READ_REC_3D_RL( fn, fp, Nr, gsNm(1-Olx,1-Oly,1,1,1,1),
208     & nj+2, myIter,myThid )
209     CALL READ_REC_3D_RL( fn, fp, Nr, gsNm(1-Olx,1-Oly,1,1,1,2),
210     & nj+j, myIter,myThid )
211     nj = 4*j
212     #else /* ALLOW_ADAMSBASHFORTH_3 */
213     CALL READ_REC_3D_RL( fn, fp, Nr, uVel, 1, myIter,myThid )
214     CALL READ_REC_3D_RL( fn, fp, Nr, guNm1, 2, myIter,myThid )
215     CALL READ_REC_3D_RL( fn, fp, Nr, vVel, 3, myIter,myThid )
216     CALL READ_REC_3D_RL( fn, fp, Nr, gvNm1, 4, myIter,myThid )
217     CALL READ_REC_3D_RL( fn, fp, Nr, theta, 5, myIter,myThid )
218     CALL READ_REC_3D_RL( fn, fp, Nr, gtNm1, 6, myIter,myThid )
219     CALL READ_REC_3D_RL( fn, fp, Nr, salt, 7, myIter,myThid )
220     CALL READ_REC_3D_RL( fn, fp, Nr, gsNm1, 8, myIter,myThid )
221     nj = 8
222     #endif /* ALLOW_ADAMSBASHFORTH_3 */
223     CALL READ_REC_3D_RL( fn,fp,1, etaN, nj*Nr+1, myIter,myThid )
224     #ifdef EXACT_CONSERV
225 jmc 1.2 IF ( exactConserv ) THEN
226 jmc 1.1 CALL READ_REC_3D_RL(fn,fp,1,dEtaHdt,nj*Nr+2,myIter,myThid )
227     ENDIF
228 jmc 1.2 IF ( nonlinFreeSurf.GT.0 ) THEN
229 jmc 1.1 CALL READ_REC_3D_RL(fn,fp,1, etaH, nj*Nr+3, myIter,myThid )
230     ENDIF
231     #endif
232     ENDIF
233    
234     IF ( useDynP_inEos_Zc ) THEN
235     WRITE(fn,'(A,A10)') 'pickup_ph.',suff
236     CALL READ_REC_3D_RL( fn, fp, Nr, totPhiHyd,1,myIter,myThid )
237 jmc 1.2 ENDIF
238 jmc 1.1 #ifdef ALLOW_NONHYDROSTATIC
239 jmc 1.2 IF ( use3Dsolver ) THEN
240 jmc 1.1 WRITE(fn,'(A,A10)') 'pickup_nh.',suff
241     CALL READ_REC_3D_RL( fn, fp, Nr, phi_nh, 1, myIter,myThid )
242     CALL READ_REC_3D_RL( fn, fp, Nr, gwNm1, 2, myIter,myThid )
243     ENDIF
244     #endif
245 jmc 1.2 ELSE
246     C--- New way to read model fields:
247     nj = 0
248     C--- read State 3-D fields for restart
249     CALL READ_MFLDS_3D_RL( 'Uvel ', uVel,
250     & nj, fp, Nr, myIter, myThid )
251     CALL READ_MFLDS_3D_RL( 'Vvel ', vVel,
252     & nj, fp, Nr, myIter, myThid )
253     CALL READ_MFLDS_3D_RL( 'Theta ', theta,
254     & nj, fp, Nr, myIter, myThid )
255     CALL READ_MFLDS_3D_RL( 'Salt ', salt,
256     & nj, fp, Nr, myIter, myThid )
257     C--- read 3-D fields for AB-restart
258     #ifdef ALLOW_ADAMSBASHFORTH_3
259     m1 = 1 + MOD(myIter+1,2)
260     m2 = 1 + MOD( myIter ,2)
261 jmc 1.3 IF ( momStepping ) THEN
262 jmc 1.2 C-- U velocity:
263     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
264     CALL READ_MFLDS_3D_RL( 'GuNm1 ',guNm(1-Olx,1-Oly,1,1,1,m1),
265     & nj, fp, Nr, myIter, myThid )
266     ENDIF
267     IF ( beta_AB.NE.0. ) THEN
268     CALL READ_MFLDS_3D_RL( 'GuNm2 ',guNm(1-Olx,1-Oly,1,1,1,m2),
269     & nj, fp, Nr, myIter, myThid )
270     ENDIF
271     C-- V velocity:
272     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
273     CALL READ_MFLDS_3D_RL( 'GvNm1 ',gvNm(1-Olx,1-Oly,1,1,1,m1),
274     & nj, fp, Nr, myIter, myThid )
275     ENDIF
276     IF ( beta_AB.NE.0. ) THEN
277     CALL READ_MFLDS_3D_RL( 'GvNm2 ',gvNm(1-Olx,1-Oly,1,1,1,m2),
278     & nj, fp, Nr, myIter, myThid )
279     ENDIF
280 jmc 1.3 ENDIF
281 jmc 1.2 C-- Temperature:
282     IF ( AdamsBashforthGt ) THEN
283     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
284     CALL READ_MFLDS_3D_RL( 'GtNm1 ',gtNm(1-Olx,1-Oly,1,1,1,m1),
285     & nj, fp, Nr, myIter, myThid )
286     ENDIF
287     IF ( beta_AB.NE.0. ) THEN
288     CALL READ_MFLDS_3D_RL( 'GtNm2 ',gtNm(1-Olx,1-Oly,1,1,1,m2),
289     & nj, fp, Nr, myIter, myThid )
290     ENDIF
291     ELSEIF ( AdamsBashforth_T ) THEN
292     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
293     CALL READ_MFLDS_3D_RL( 'TempNm1 ',gtNm(1-Olx,1-Oly,1,1,1,m1),
294     & nj, fp, Nr, myIter, myThid )
295     ENDIF
296     IF ( beta_AB.NE.0. ) THEN
297     CALL READ_MFLDS_3D_RL( 'TempNm2 ',gtNm(1-Olx,1-Oly,1,1,1,m2),
298     & nj, fp, Nr, myIter, myThid )
299     ENDIF
300     ENDIF
301     C-- Salinity:
302     IF ( AdamsBashforthGs ) THEN
303     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
304     CALL READ_MFLDS_3D_RL( 'GsNm1 ',gsNm(1-Olx,1-Oly,1,1,1,m1),
305     & nj, fp, Nr, myIter, myThid )
306     ENDIF
307     IF ( beta_AB.NE.0. ) THEN
308     CALL READ_MFLDS_3D_RL( 'GsNm2 ',gsNm(1-Olx,1-Oly,1,1,1,m2),
309     & nj, fp, Nr, myIter, myThid )
310     ENDIF
311     ELSEIF ( AdamsBashforth_S ) THEN
312     IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
313     CALL READ_MFLDS_3D_RL( 'SaltNm1 ',gsNm(1-Olx,1-Oly,1,1,1,m1),
314     & nj, fp, Nr, myIter, myThid )
315     ENDIF
316     IF ( beta_AB.NE.0. ) THEN
317     CALL READ_MFLDS_3D_RL( 'SaltNm2 ',gsNm(1-Olx,1-Oly,1,1,1,m2),
318     & nj, fp, Nr, myIter, myThid )
319     ENDIF
320     ENDIF
321     #else /* ALLOW_ADAMSBASHFORTH_3 */
322 jmc 1.3 IF ( momStepping ) THEN
323 jmc 1.2 C-- U velocity:
324     CALL READ_MFLDS_3D_RL( 'GuNm1 ', guNm1,
325     & nj, fp, Nr, myIter, myThid )
326     C-- V velocity:
327     CALL READ_MFLDS_3D_RL( 'GvNm1 ', gvNm1,
328     & nj, fp, Nr, myIter, myThid )
329 jmc 1.3 ENDIF
330 jmc 1.2 C-- Temperature
331     IF ( AdamsBashforthGt ) THEN
332     CALL READ_MFLDS_3D_RL( 'GtNm1 ', gtNm1,
333     & nj, fp, Nr, myIter, myThid )
334     ENDIF
335     C-- Salinity
336     IF ( AdamsBashforthGs ) THEN
337     CALL READ_MFLDS_3D_RL( 'GsNm1 ', gsNm1,
338     & nj, fp, Nr, myIter, myThid )
339     ENDIF
340     #endif /* ALLOW_ADAMSBASHFORTH_3 */
341    
342     C- read Full Pressure for EOS in pressure:
343     IF ( useDynP_inEos_Zc ) THEN
344     CALL READ_MFLDS_3D_RL( 'PhiHyd ', totPhiHyd,
345     & nj, fp, Nr, myIter, myThid )
346     ENDIF
347     #ifdef ALLOW_NONHYDROSTATIC
348     IF ( use3Dsolver ) THEN
349     CALL READ_MFLDS_3D_RL( 'Phi_NHyd', phi_nh,
350     & nj, fp, Nr, myIter, myThid )
351     ENDIF
352     IF ( nonHydrostatic ) THEN
353     CALL READ_MFLDS_3D_RL( 'GwNm1 ', gwNm1,
354     & nj, fp, Nr, myIter, myThid )
355     ENDIF
356     #endif
357 jmc 1.4 #ifdef ALLOW_ADDFLUID
358     C- read mass source/sink of fluid
359     IF ( selectAddFluid.GE.1 ) THEN
360     CALL READ_MFLDS_3D_RL( 'AddMass ', addMass,
361     & nj, fp, Nr, myIter, myThid )
362     ENDIF
363     #endif /* ALLOW_ADDFLUID */
364 jmc 1.2
365     C--- read 2-D fields, starting with Eta:
366     nj = nj*Nr
367     CALL READ_MFLDS_3D_RL( 'EtaN ', etaN,
368     & nj, fp, 1 , myIter, myThid )
369     #ifdef EXACT_CONSERV
370     IF ( exactConserv ) THEN
371     CALL READ_MFLDS_3D_RL( 'dEtaHdt ', dEtaHdt,
372     & nj, fp, 1 , myIter, myThid )
373     ENDIF
374     IF ( nonlinFreeSurf.GT.0 ) THEN
375     CALL READ_MFLDS_3D_RL( 'EtaH ', etaH,
376     & nj, fp, 1 , myIter, myThid )
377     ENDIF
378     #endif
379     C-- end: new way to read pickup file
380     ENDIF
381    
382     C-- Check for missing fields:
383     nMissing = missFldDim
384     CALL READ_MFLDS_CHECK(
385     O missFldList,
386     U nMissing,
387     I myIter, myThid )
388     IF ( nMissing.GT.missFldDim ) THEN
389     WRITE(msgBuf,'(2A,I4)') 'READ_PICKUP: ',
390     & 'missing fields list has been truncated to', missFldDim
391     CALL PRINT_ERROR( msgBuf, myThid )
392     STOP 'ABNORMAL END: S/R READ_PICKUP (list-size Pb)'
393     ENDIF
394     CALL CHECK_PICKUP(
395     I missFldList,
396     I nMissing, nbFields,
397     I myIter, myThid )
398 jmc 1.1
399 jmc 1.2 C-- end: pickup_read_mdsio
400 jmc 1.1 ENDIF
401    
402     #ifdef ALLOW_MNC
403     IF (useMNC .AND. pickup_read_mnc) THEN
404     WRITE(fn,'(A)') 'pickup'
405     CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
406     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
407     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
408     CALL MNC_CW_RL_R('D',fn,0,0,'U',uVel, myThid)
409     CALL MNC_CW_RL_R('D',fn,0,0,'V',vVel, myThid)
410     CALL MNC_CW_RL_R('D',fn,0,0,'Temp',theta, myThid)
411     CALL MNC_CW_RL_R('D',fn,0,0,'S',salt, myThid)
412     CALL MNC_CW_RL_R('D',fn,0,0,'Eta',etaN, myThid)
413     #ifndef ALLOW_ADAMSBASHFORTH_3
414     CALL MNC_CW_RL_R('D',fn,0,0,'gUnm1',guNm1, myThid)
415     CALL MNC_CW_RL_R('D',fn,0,0,'gVnm1',gvNm1, myThid)
416     CALL MNC_CW_RL_R('D',fn,0,0,'gTnm1',gtNm1, myThid)
417     CALL MNC_CW_RL_R('D',fn,0,0,'gSnm1',gsNm1, myThid)
418     #endif /* ALLOW_ADAMSBASHFORTH_3 */
419     C#ifdef NONLIN_FRSURF
420     C IF ( nonlinFreeSurf.GE.0 .AND. usePickupBeforeC54 )
421     C & CALL MNC_CW_RL_R('D',fn,0,0,'EtaH', etaH, myThid)
422     C#endif
423     #ifdef EXACT_CONSERV
424     IF (exactConserv) THEN
425     CALL MNC_CW_RL_R('D',fn,0,0,'dEtaHdt',dEtaHdt,myThid)
426     ENDIF
427     IF (nonlinFreeSurf .GT. 0) THEN
428     CALL MNC_CW_RL_R('D',fn,0,0,'EtaH', etaH, myThid)
429     ENDIF
430     #endif
431     #ifdef ALLOW_NONHYDROSTATIC
432     IF (use3Dsolver) THEN
433     CALL MNC_CW_RL_R('D',fn,0,0,'phi_nh', phi_nh, myThid)
434     c CALL MNC_CW_RL_R('D',fn,0,0,'gW', gW, myThid)
435     CALL MNC_CW_RL_R('D',fn,0,0,'gWnm1', gwNm1, myThid)
436     ENDIF
437     #endif
438     IF ( useDynP_inEos_Zc ) THEN
439     CALL MNC_CW_RL_R('D',fn,0,0,'phiHyd',totPhiHyd,myThid)
440     ENDIF
441     ENDIF
442     #endif /* ALLOW_MNC */
443    
444     _BARRIER
445    
446     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
447    
448     C Fill in edge regions
449     CALL EXCH_UV_3D_RL( uVel, vVel, .TRUE., Nr, myThid )
450     CALL EXCH_3D_RL( theta, Nr, myThid )
451     CALL EXCH_3D_RL( salt, Nr, myThid )
452     #ifdef ALLOW_ADAMSBASHFORTH_3
453     CALL EXCH_UV_3D_RL( guNm(1-Olx,1-Oly,1,1,1,1),
454     & gvNm(1-Olx,1-Oly,1,1,1,1),.TRUE.,Nr,myThid )
455     CALL EXCH_3D_RL( gtNm(1-Olx,1-Oly,1,1,1,1), Nr, myThid )
456     CALL EXCH_3D_RL( gsNm(1-Olx,1-Oly,1,1,1,1), Nr, myThid )
457     CALL EXCH_UV_3D_RL( guNm(1-Olx,1-Oly,1,1,1,2),
458     & gvNm(1-Olx,1-Oly,1,1,1,2),.TRUE.,Nr,myThid )
459     CALL EXCH_3D_RL( gtNm(1-Olx,1-Oly,1,1,1,2), Nr, myThid )
460     CALL EXCH_3D_RL( gsNm(1-Olx,1-Oly,1,1,1,2), Nr, myThid )
461     #else /* ALLOW_ADAMSBASHFORTH_3 */
462     CALL EXCH_UV_3D_RL( guNm1, gvNm1, .TRUE., Nr, myThid )
463     CALL EXCH_3D_RL( gtNm1, Nr, myThid )
464     CALL EXCH_3D_RL( gsNm1, Nr, myThid )
465     #endif /* ALLOW_ADAMSBASHFORTH_3 */
466     CALL EXCH_XY_RL( etaN, myThid )
467     CALL EXCH_XY_RL( etaH, myThid )
468     #ifdef EXACT_CONSERV
469     CALL EXCH_XY_RL( detaHdt, myThid )
470     #endif
471    
472     IF ( useDynP_inEos_Zc )
473     & CALL EXCH_3D_RL( totPhiHyd, Nr, myThid )
474    
475     #ifdef ALLOW_NONHYDROSTATIC
476     IF ( use3Dsolver ) THEN
477     CALL EXCH_3D_RL( phi_nh, Nr, myThid )
478     CALL EXCH_3D_RL( gwNm1, Nr, myThid )
479     ENDIF
480     #endif
481    
482     RETURN
483     END

  ViewVC Help
Powered by ViewVC 1.1.22