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

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

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


Revision 1.49 - (hide annotations) (download)
Mon Dec 12 15:50:51 2005 UTC (18 years, 5 months ago) by jmc
Branch: MAIN
Changes since 1.48: +86 -22 lines
transfert surface NH pressure to eta field (if exactConserv).

1 jmc 1.49 C $Header: /u/gcmpack/MITgcm/model/src/solve_for_pressure.F,v 1.48 2005/11/08 02:14:10 jmc Exp $
2 heimbach 1.21 C $Name: $
3 cnh 1.1
4 edhill 1.39 #include "PACKAGES_CONFIG.h"
5 adcroft 1.5 #include "CPP_OPTIONS.h"
6 cnh 1.1
7 cnh 1.27 CBOP
8     C !ROUTINE: SOLVE_FOR_PRESSURE
9     C !INTERFACE:
10 jmc 1.29 SUBROUTINE SOLVE_FOR_PRESSURE(myTime, myIter, myThid)
11 cnh 1.27
12     C !DESCRIPTION: \bv
13     C *==========================================================*
14     C | SUBROUTINE SOLVE_FOR_PRESSURE
15     C | o Controls inversion of two and/or three-dimensional
16     C | elliptic problems for the pressure field.
17     C *==========================================================*
18     C \ev
19    
20     C !USES:
21 adcroft 1.8 IMPLICIT NONE
22 cnh 1.4 C == Global variables
23     #include "SIZE.h"
24     #include "EEPARAMS.h"
25     #include "PARAMS.h"
26 adcroft 1.12 #include "GRID.h"
27 jmc 1.17 #include "SURFACE.h"
28 jmc 1.28 #include "FFIELDS.h"
29 jmc 1.48 #include "DYNVARS.h"
30     #include "SOLVE_FOR_PRESSURE.h"
31 adcroft 1.9 #ifdef ALLOW_NONHYDROSTATIC
32 adcroft 1.25 #include "SOLVE_FOR_PRESSURE3D.h"
33 jmc 1.48 #include "NH_VARS.h"
34     #endif
35     #ifdef ALLOW_CD_CODE
36     #include "CD_CODE_VARS.h"
37 adcroft 1.12 #endif
38 adcroft 1.11 #ifdef ALLOW_OBCS
39 adcroft 1.9 #include "OBCS.h"
40 adcroft 1.11 #endif
41 cnh 1.4
42 jmc 1.32 C === Functions ====
43 jmc 1.46 LOGICAL DIFFERENT_MULTIPLE
44     EXTERNAL DIFFERENT_MULTIPLE
45 jmc 1.32
46 cnh 1.27 C !INPUT/OUTPUT PARAMETERS:
47 cnh 1.1 C == Routine arguments ==
48 jmc 1.28 C myTime - Current time in simulation
49     C myIter - Current iteration number in simulation
50     C myThid - Thread number for this instance of SOLVE_FOR_PRESSURE
51     _RL myTime
52     INTEGER myIter
53 jmc 1.29 INTEGER myThid
54 cnh 1.4
55 cnh 1.27 C !LOCAL VARIABLES:
56 adcroft 1.22 C == Local variables ==
57 cnh 1.6 INTEGER i,j,k,bi,bj
58 adcroft 1.9 _RS uf(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
59     _RS vf(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
60 adcroft 1.22 _RL firstResidual,lastResidual
61 jmc 1.36 _RL tmpFac
62 jmc 1.47 _RL sumEmP, tileEmP
63     LOGICAL putPmEinXvector
64 adcroft 1.19 INTEGER numIters
65 adcroft 1.25 CHARACTER*(MAX_LEN_MBUF) msgBuf
66 jmc 1.49 #ifdef ALLOW_NONHYDROSTATIC
67     INTEGER ks
68     LOGICAL zeroPsNH
69     #endif
70 cnh 1.27 CEOP
71 jmc 1.17
72 ce107 1.44 #ifdef TIME_PER_TIMESTEP
73     CCE107 common block for per timestep timing
74     C !TIMING VARIABLES
75     C == Timing variables ==
76     REAL*8 utnew, utold, stnew, stold, wtnew, wtold
77     COMMON /timevars/ utnew, utold, stnew, stold, wtnew, wtold
78     #endif
79    
80 jmc 1.49 #ifdef ALLOW_NONHYDROSTATIC
81     c zeroPsNH = .FALSE.
82     zeroPsNH = exactConserv
83     #endif
84    
85 jmc 1.47 C-- Initialise the Vector solution with etaN + deltaT*Global_mean_PmE
86     C instead of simply etaN ; This can speed-up the solver convergence in
87     C the case where |Global_mean_PmE| is large.
88     putPmEinXvector = .FALSE.
89     c putPmEinXvector = useRealFreshWaterFlux
90    
91 jmc 1.17 C-- Save previous solution & Initialise Vector solution and source term :
92 jmc 1.47 sumEmP = 0.
93 jmc 1.17 DO bj=myByLo(myThid),myByHi(myThid)
94     DO bi=myBxLo(myThid),myBxHi(myThid)
95     DO j=1-OLy,sNy+OLy
96     DO i=1-OLx,sNx+OLx
97 edhill 1.40 #ifdef ALLOW_CD_CODE
98 jmc 1.17 etaNm1(i,j,bi,bj) = etaN(i,j,bi,bj)
99 jmc 1.26 #endif
100 jmc 1.18 cg2d_x(i,j,bi,bj) = Bo_surf(i,j,bi,bj)*etaN(i,j,bi,bj)
101 jmc 1.17 cg2d_b(i,j,bi,bj) = 0.
102     ENDDO
103     ENDDO
104 jmc 1.29 IF (useRealFreshWaterFlux) THEN
105 jmc 1.36 tmpFac = freeSurfFac*convertEmP2rUnit
106 mlosch 1.35 IF (exactConserv)
107 jmc 1.36 & tmpFac = freeSurfFac*convertEmP2rUnit*implicDiv2DFlow
108 jmc 1.29 DO j=1,sNy
109     DO i=1,sNx
110     cg2d_b(i,j,bi,bj) =
111     & tmpFac*_rA(i,j,bi,bj)*EmPmR(i,j,bi,bj)/deltaTMom
112     ENDDO
113     ENDDO
114     ENDIF
115 jmc 1.47 IF ( putPmEinXvector ) THEN
116     tileEmP = 0.
117     DO j=1,sNy
118     DO i=1,sNx
119     tileEmP = tileEmP + rA(i,j,bi,bj)*EmPmR(i,j,bi,bj)
120     & *maskH(i,j,bi,bj)
121     ENDDO
122     ENDDO
123     sumEmP = sumEmP + tileEmP
124     ENDIF
125 jmc 1.17 ENDDO
126     ENDDO
127 jmc 1.47 IF ( putPmEinXvector ) THEN
128     _GLOBAL_SUM_R8( sumEmP, myThid )
129     ENDIF
130 adcroft 1.12
131     DO bj=myByLo(myThid),myByHi(myThid)
132     DO bi=myBxLo(myThid),myBxHi(myThid)
133 jmc 1.47 IF ( putPmEinXvector ) THEN
134     tmpFac = 0.
135     IF (globalArea.GT.0.) tmpFac = freeSurfFac*deltaTfreesurf
136     & *convertEmP2rUnit*sumEmP/globalArea
137     DO j=1,sNy
138     DO i=1,sNx
139     cg2d_x(i,j,bi,bj) = cg2d_x(i,j,bi,bj)
140     & - tmpFac*Bo_surf(i,j,bi,bj)
141     ENDDO
142     ENDDO
143     ENDIF
144 adcroft 1.12 DO K=Nr,1,-1
145     DO j=1,sNy+1
146     DO i=1,sNx+1
147     uf(i,j) = _dyG(i,j,bi,bj)
148     & *drF(k)*_hFacW(i,j,k,bi,bj)
149     vf(i,j) = _dxG(i,j,bi,bj)
150     & *drF(k)*_hFacS(i,j,k,bi,bj)
151     ENDDO
152     ENDDO
153     CALL CALC_DIV_GHAT(
154     I bi,bj,1,sNx,1,sNy,K,
155     I uf,vf,
156 jmc 1.17 U cg2d_b,
157 adcroft 1.12 I myThid)
158     ENDDO
159     ENDDO
160     ENDDO
161 cnh 1.4
162 adcroft 1.12 C-- Add source term arising from w=d/dt (p_s + p_nh)
163     DO bj=myByLo(myThid),myByHi(myThid)
164     DO bi=myBxLo(myThid),myBxHi(myThid)
165 adcroft 1.13 #ifdef ALLOW_NONHYDROSTATIC
166 jmc 1.49 IF ( nonHydrostatic .AND. zeroPsNH ) THEN
167     DO j=1,sNy
168     DO i=1,sNx
169     cg2d_b(i,j,bi,bj) = cg2d_b(i,j,bi,bj)
170     & -freeSurfFac*_rA(i,j,bi,bj)/deltaTMom/deltaTfreesurf
171     & * etaH(i,j,bi,bj)
172     cg3d_b(i,j,1,bi,bj) = cg3d_b(i,j,1,bi,bj)
173     & -freeSurfFac*_rA(i,j,bi,bj)/deltaTMom/deltaTfreesurf
174     & * etaH(i,j,bi,bj)
175     ENDDO
176     ENDDO
177     ELSEIF ( nonHydrostatic ) THEN
178 jmc 1.28 DO j=1,sNy
179     DO i=1,sNx
180     cg2d_b(i,j,bi,bj) = cg2d_b(i,j,bi,bj)
181 adcroft 1.33 & -freeSurfFac*_rA(i,j,bi,bj)/deltaTMom/deltaTfreesurf
182 jmc 1.28 & *( etaN(i,j,bi,bj)
183     & +phi_nh(i,j,1,bi,bj)*horiVertRatio/gravity )
184     cg3d_b(i,j,1,bi,bj) = cg3d_b(i,j,1,bi,bj)
185 adcroft 1.33 & -freeSurfFac*_rA(i,j,bi,bj)/deltaTMom/deltaTfreesurf
186 jmc 1.28 & *( etaN(i,j,bi,bj)
187     & +phi_nh(i,j,1,bi,bj)*horiVertRatio/gravity )
188     ENDDO
189 adcroft 1.12 ENDDO
190 jmc 1.28 ELSEIF ( exactConserv ) THEN
191 adcroft 1.13 #else
192 jmc 1.26 IF ( exactConserv ) THEN
193 edhill 1.39 #endif /* ALLOW_NONHYDROSTATIC */
194 jmc 1.26 DO j=1,sNy
195     DO i=1,sNx
196     cg2d_b(i,j,bi,bj) = cg2d_b(i,j,bi,bj)
197 adcroft 1.33 & -freeSurfFac*_rA(i,j,bi,bj)/deltaTMom/deltaTfreesurf
198 jmc 1.26 & * etaH(i,j,bi,bj)
199     ENDDO
200     ENDDO
201     ELSE
202     DO j=1,sNy
203     DO i=1,sNx
204     cg2d_b(i,j,bi,bj) = cg2d_b(i,j,bi,bj)
205 adcroft 1.33 & -freeSurfFac*_rA(i,j,bi,bj)/deltaTMom/deltaTfreesurf
206 jmc 1.26 & * etaN(i,j,bi,bj)
207     ENDDO
208 adcroft 1.12 ENDDO
209 jmc 1.26 ENDIF
210 adcroft 1.12
211     #ifdef ALLOW_OBCS
212 adcroft 1.14 IF (useOBCS) THEN
213 adcroft 1.12 DO i=1,sNx
214     C Northern boundary
215     IF (OB_Jn(I,bi,bj).NE.0) THEN
216     cg2d_b(I,OB_Jn(I,bi,bj),bi,bj)=0.
217 jmc 1.31 cg2d_x(I,OB_Jn(I,bi,bj),bi,bj)=0.
218 adcroft 1.12 ENDIF
219     C Southern boundary
220     IF (OB_Js(I,bi,bj).NE.0) THEN
221     cg2d_b(I,OB_Js(I,bi,bj),bi,bj)=0.
222 jmc 1.31 cg2d_x(I,OB_Js(I,bi,bj),bi,bj)=0.
223 adcroft 1.12 ENDIF
224     ENDDO
225     DO j=1,sNy
226     C Eastern boundary
227     IF (OB_Ie(J,bi,bj).NE.0) THEN
228     cg2d_b(OB_Ie(J,bi,bj),J,bi,bj)=0.
229 jmc 1.31 cg2d_x(OB_Ie(J,bi,bj),J,bi,bj)=0.
230 adcroft 1.12 ENDIF
231     C Western boundary
232     IF (OB_Iw(J,bi,bj).NE.0) THEN
233     cg2d_b(OB_Iw(J,bi,bj),J,bi,bj)=0.
234 jmc 1.31 cg2d_x(OB_Iw(J,bi,bj),J,bi,bj)=0.
235 adcroft 1.12 ENDIF
236     ENDDO
237     ENDIF
238 jmc 1.49 #endif /* ALLOW_OBCS */
239     C- end bi,bj loops
240 adcroft 1.12 ENDDO
241     ENDDO
242    
243 edhill 1.42 #ifdef ALLOW_DEBUG
244 heimbach 1.38 IF ( debugLevel .GE. debLevB ) THEN
245 adcroft 1.23 CALL DEBUG_STATS_RL(1,cg2d_b,'cg2d_b (SOLVE_FOR_PRESSURE)',
246     & myThid)
247 adcroft 1.24 ENDIF
248 adcroft 1.23 #endif
249 adcroft 1.12
250 cnh 1.1 C-- Find the surface pressure using a two-dimensional conjugate
251     C-- gradient solver.
252 adcroft 1.22 C see CG2D.h for the interface to this routine.
253     firstResidual=0.
254     lastResidual=0.
255 adcroft 1.19 numIters=cg2dMaxIters
256 cnh 1.1 CALL CG2D(
257 adcroft 1.22 U cg2d_b,
258 cnh 1.6 U cg2d_x,
259 adcroft 1.22 O firstResidual,
260     O lastResidual,
261 adcroft 1.19 U numIters,
262 cnh 1.1 I myThid )
263 adcroft 1.19 _EXCH_XY_R8(cg2d_x, myThid )
264 adcroft 1.23
265 edhill 1.42 #ifdef ALLOW_DEBUG
266 heimbach 1.38 IF ( debugLevel .GE. debLevB ) THEN
267 adcroft 1.23 CALL DEBUG_STATS_RL(1,cg2d_x,'cg2d_x (SOLVE_FOR_PRESSURE)',
268     & myThid)
269 adcroft 1.24 ENDIF
270 adcroft 1.23 #endif
271 cnh 1.1
272 jmc 1.32 C- dump CG2D output at monitorFreq (to reduce size of STD-OUTPUT files) :
273 jmc 1.46 IF ( DIFFERENT_MULTIPLE(monitorFreq,myTime,deltaTClock)
274 jmc 1.45 & ) THEN
275 heimbach 1.38 IF ( debugLevel .GE. debLevA ) THEN
276     _BEGIN_MASTER( myThid )
277     WRITE(msgBuf,'(A34,1PE24.14)') 'cg2d_init_res =',firstResidual
278     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
279     WRITE(msgBuf,'(A34,I6)') 'cg2d_iters =',numIters
280     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
281     WRITE(msgBuf,'(A34,1PE24.14)') 'cg2d_res =',lastResidual
282     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
283 edhill 1.43 _END_MASTER( myThid )
284 heimbach 1.38 ENDIF
285 jmc 1.32 ENDIF
286 jmc 1.17
287     C-- Transfert the 2D-solution to "etaN" :
288     DO bj=myByLo(myThid),myByHi(myThid)
289     DO bi=myBxLo(myThid),myBxHi(myThid)
290     DO j=1-OLy,sNy+OLy
291     DO i=1-OLx,sNx+OLx
292 jmc 1.18 etaN(i,j,bi,bj) = recip_Bo(i,j,bi,bj)*cg2d_x(i,j,bi,bj)
293 jmc 1.17 ENDDO
294     ENDDO
295     ENDDO
296     ENDDO
297 adcroft 1.10
298 adcroft 1.9 #ifdef ALLOW_NONHYDROSTATIC
299     IF ( nonHydrostatic ) THEN
300    
301     C-- Solve for a three-dimensional pressure term (NH or IGW or both ).
302     C see CG3D.h for the interface to this routine.
303     DO bj=myByLo(myThid),myByHi(myThid)
304     DO bi=myBxLo(myThid),myBxHi(myThid)
305     DO j=1,sNy+1
306     DO i=1,sNx+1
307 jmc 1.18 uf(i,j)=-_recip_dxC(i,j,bi,bj)*
308 adcroft 1.9 & (cg2d_x(i,j,bi,bj)-cg2d_x(i-1,j,bi,bj))
309 jmc 1.18 vf(i,j)=-_recip_dyC(i,j,bi,bj)*
310 adcroft 1.9 & (cg2d_x(i,j,bi,bj)-cg2d_x(i,j-1,bi,bj))
311     ENDDO
312     ENDDO
313    
314 adcroft 1.12 #ifdef ALLOW_OBCS
315 adcroft 1.14 IF (useOBCS) THEN
316 adcroft 1.9 DO i=1,sNx+1
317     C Northern boundary
318     IF (OB_Jn(I,bi,bj).NE.0) THEN
319     vf(I,OB_Jn(I,bi,bj))=0.
320     ENDIF
321     C Southern boundary
322     IF (OB_Js(I,bi,bj).NE.0) THEN
323     vf(I,OB_Js(I,bi,bj)+1)=0.
324     ENDIF
325     ENDDO
326     DO j=1,sNy+1
327     C Eastern boundary
328     IF (OB_Ie(J,bi,bj).NE.0) THEN
329     uf(OB_Ie(J,bi,bj),J)=0.
330     ENDIF
331     C Western boundary
332     IF (OB_Iw(J,bi,bj).NE.0) THEN
333     uf(OB_Iw(J,bi,bj)+1,J)=0.
334     ENDIF
335     ENDDO
336     ENDIF
337 jmc 1.49 #endif /* ALLOW_OBCS */
338 adcroft 1.9
339 adcroft 1.12 K=1
340     DO j=1,sNy
341     DO i=1,sNx
342     cg3d_b(i,j,k,bi,bj) = cg3d_b(i,j,k,bi,bj)
343 jmc 1.49 & +drF(K)*dYG(i+1,j,bi,bj)*hFacW(i+1,j,k,bi,bj)*uf(i+1,j)
344     & -drF(K)*dYG( i ,j,bi,bj)*hFacW( i ,j,k,bi,bj)*uf( i ,j)
345     & +drF(K)*dXG(i,j+1,bi,bj)*hFacS(i,j+1,k,bi,bj)*vf(i,j+1)
346     & -drF(K)*dXG(i, j ,bi,bj)*hFacS(i, j ,k,bi,bj)*vf(i, j )
347 jmc 1.18 & +( freeSurfFac*etaN(i,j,bi,bj)/deltaTMom
348     & -wVel(i,j,k+1,bi,bj)
349 adcroft 1.12 & )*_rA(i,j,bi,bj)/deltaTmom
350     ENDDO
351     ENDDO
352     DO K=2,Nr-1
353 adcroft 1.9 DO j=1,sNy
354     DO i=1,sNx
355     cg3d_b(i,j,k,bi,bj) = cg3d_b(i,j,k,bi,bj)
356 jmc 1.49 & +drF(K)*dYG(i+1,j,bi,bj)*hFacW(i+1,j,k,bi,bj)*uf(i+1,j)
357     & -drF(K)*dYG( i ,j,bi,bj)*hFacW( i ,j,k,bi,bj)*uf( i ,j)
358     & +drF(K)*dXG(i,j+1,bi,bj)*hFacS(i,j+1,k,bi,bj)*vf(i,j+1)
359     & -drF(K)*dXG(i, j ,bi,bj)*hFacS(i, j ,k,bi,bj)*vf(i, j )
360 adcroft 1.12 & +( wVel(i,j,k ,bi,bj)
361     & -wVel(i,j,k+1,bi,bj)
362     & )*_rA(i,j,bi,bj)/deltaTmom
363    
364 adcroft 1.9 ENDDO
365     ENDDO
366     ENDDO
367 adcroft 1.12 K=Nr
368     DO j=1,sNy
369     DO i=1,sNx
370     cg3d_b(i,j,k,bi,bj) = cg3d_b(i,j,k,bi,bj)
371 jmc 1.49 & +drF(K)*dYG(i+1,j,bi,bj)*hFacW(i+1,j,k,bi,bj)*uf(i+1,j)
372     & -drF(K)*dYG( i ,j,bi,bj)*hFacW( i ,j,k,bi,bj)*uf( i ,j)
373     & +drF(K)*dXG(i,j+1,bi,bj)*hFacS(i,j+1,k,bi,bj)*vf(i,j+1)
374     & -drF(K)*dXG(i, j ,bi,bj)*hFacS(i, j ,k,bi,bj)*vf(i, j )
375 adcroft 1.12 & +( wVel(i,j,k ,bi,bj)
376     & )*_rA(i,j,bi,bj)/deltaTmom
377    
378     ENDDO
379     ENDDO
380    
381     #ifdef ALLOW_OBCS
382 adcroft 1.14 IF (useOBCS) THEN
383 adcroft 1.12 DO K=1,Nr
384     DO i=1,sNx
385     C Northern boundary
386     IF (OB_Jn(I,bi,bj).NE.0) THEN
387     cg3d_b(I,OB_Jn(I,bi,bj),K,bi,bj)=0.
388     ENDIF
389     C Southern boundary
390     IF (OB_Js(I,bi,bj).NE.0) THEN
391     cg3d_b(I,OB_Js(I,bi,bj),K,bi,bj)=0.
392     ENDIF
393     ENDDO
394     DO j=1,sNy
395     C Eastern boundary
396     IF (OB_Ie(J,bi,bj).NE.0) THEN
397     cg3d_b(OB_Ie(J,bi,bj),J,K,bi,bj)=0.
398     ENDIF
399     C Western boundary
400     IF (OB_Iw(J,bi,bj).NE.0) THEN
401     cg3d_b(OB_Iw(J,bi,bj),J,K,bi,bj)=0.
402     ENDIF
403     ENDDO
404     ENDDO
405     ENDIF
406 jmc 1.49 #endif /* ALLOW_OBCS */
407     C- end bi,bj loops
408     ENDDO
409     ENDDO
410 adcroft 1.9
411 adcroft 1.25 firstResidual=0.
412     lastResidual=0.
413 jmc 1.49 numIters=cg3dMaxIters
414 adcroft 1.25 CALL CG3D(
415     U cg3d_b,
416     U phi_nh,
417     O firstResidual,
418     O lastResidual,
419     U numIters,
420     I myThid )
421     _EXCH_XYZ_R8(phi_nh, myThid )
422    
423 jmc 1.46 IF ( DIFFERENT_MULTIPLE(monitorFreq,myTime,deltaTClock)
424 jmc 1.45 & ) THEN
425 heimbach 1.38 IF ( debugLevel .GE. debLevA ) THEN
426     _BEGIN_MASTER( myThid )
427     WRITE(msgBuf,'(A34,1PE24.14)') 'cg3d_init_res =',firstResidual
428     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
429     WRITE(msgBuf,'(A34,I6)') 'cg3d_iters =',numIters
430     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
431     WRITE(msgBuf,'(A34,1PE24.14)') 'cg3d_res =',lastResidual
432     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
433 edhill 1.43 _END_MASTER( myThid )
434 heimbach 1.38 ENDIF
435 mlosch 1.37 ENDIF
436 adcroft 1.9
437 jmc 1.49 C-- Update surface pressure (account for NH-p @ surface level) and NH pressure:
438     IF ( zeroPsNH ) THEN
439     DO bj=myByLo(myThid),myByHi(myThid)
440     DO bi=myBxLo(myThid),myBxHi(myThid)
441    
442     IF ( usingZCoords ) THEN
443     C- Z coordinate: assume surface @ level k=1
444     DO k=2,Nr
445     DO j=1-OLy,sNy+OLy
446     DO i=1-OLx,sNx+OLx
447     phi_nh(i,j,k,bi,bj) = phi_nh(i,j,k,bi,bj)
448     & - phi_nh(i,j,1,bi,bj)
449     ENDDO
450     ENDDO
451     ENDDO
452     DO j=1-OLy,sNy+OLy
453     DO i=1-OLx,sNx+OLx
454     etaN(i,j,bi,bj) = recip_Bo(i,j,bi,bj)
455     & *(cg2d_x(i,j,bi,bj) + phi_nh(i,j,1,bi,bj))
456     phi_nh(i,j,1,bi,bj) = 0.
457     ENDDO
458     ENDDO
459     ELSE
460     C- Other than Z coordinate: no assumption on surface level index
461     DO j=1-OLy,sNy+OLy
462     DO i=1-OLx,sNx+OLx
463     ks = ksurfC(i,j,bi,bj)
464     IF ( ks.LE.Nr ) THEN
465     etaN(i,j,bi,bj) = recip_Bo(i,j,bi,bj)
466     & *(cg2d_x(i,j,bi,bj) + phi_nh(i,j,ks,bi,bj))
467     DO k=Nr,1,-1
468     phi_nh(i,j,k,bi,bj) = phi_nh(i,j,k,bi,bj)
469     & - phi_nh(i,j,ks,bi,bj)
470     ENDDO
471     ENDIF
472     ENDDO
473     ENDDO
474     ENDIF
475    
476     ENDDO
477     ENDDO
478 adcroft 1.9 ENDIF
479 jmc 1.49
480     ENDIF
481     #endif /* ALLOW_NONHYDROSTATIC */
482 cnh 1.1
483 ce107 1.44 #ifdef TIME_PER_TIMESTEP
484     CCE107 Time per timestep information
485     _BEGIN_MASTER( myThid )
486     CALL TIMER_GET_TIME( utnew, stnew, wtnew )
487     C Only output timing information after the 1st timestep
488     IF ( wtold .NE. 0.0D0 ) THEN
489     WRITE(msgBuf,'(A34,3F10.6)')
490     $ 'User, system and wallclock time:', utnew - utold,
491     $ stnew - stold, wtnew - wtold
492     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
493     ENDIF
494     utold = utnew
495     stold = stnew
496     wtold = wtnew
497     _END_MASTER( myThid )
498     #endif
499    
500 cnh 1.1 RETURN
501     END
502 ce107 1.44
503     #ifdef TIME_PER_TIMESTEP
504     CCE107 Initialization of common block for per timestep timing
505     BLOCK DATA settimers
506     C !TIMING VARIABLES
507     C == Timing variables ==
508     REAL*8 utnew, utold, stnew, stold, wtnew, wtold
509     COMMON /timevars/ utnew, utold, stnew, stold, wtnew, wtold
510     DATA utnew, utold, stnew, stold, wtnew, wtold /6*0.0D0/
511     END
512     #endif

  ViewVC Help
Powered by ViewVC 1.1.22