/[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.2 - (hide annotations) (download)
Tue Oct 23 15:22:04 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
Changes since 1.1: +246 -14 lines
first version of "clever pickup" code (but still not very clever)

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

  ViewVC Help
Powered by ViewVC 1.1.22