New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

trabbl_adv.h90 in trunk/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90 @ 507

Last change on this file since 507 was 503, checked in by opalod, 18 years ago
nemo_v1_update_064 : CT : general trends update including the addition of mean windows analysis possibility in the mixed layer
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 20.1 KB

Line
1	!!----------------------------------------------------------------------
2	!! * trabbl_adv.h90 *
3	!!----------------------------------------------------------------------
4	!! History : 8.5 ! 02-12 (A. de Miranda, G. Madec) Original Code
5	!! 9.0 ! 04-01 (A. de Miranda, G. Madec, J.M. Molines )
6	!!----------------------------------------------------------------------
7
8	!!----------------------------------------------------------------------
9	!! OPA 9.0 , LOCEAN-IPSL (2005)
10	!! $Header$
11	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
12	!!----------------------------------------------------------------------
13
14	SUBROUTINE tra_bbl_adv( kt )
15	!!----------------------------------------------------------------------
16	!! * ROUTINE tra_bbl_adv *
17	!!
18	!! ** Purpose : Compute the before tracer (t & s) trend associated
19	!! with the bottom boundary layer and add it to the general trend
20	!! of tracer equations. The bottom boundary layer is supposed to be
21	!! both an advective and diffusive bottom boundary layer.
22	!!
23	!! ** Method : Computes the bottom boundary horizontal and vertical
24	!! advection terms. Add it to the general trend : ta =ta + adv_bbl.
25	!! When the product grad( rho) * grad(h) < 0 (where grad is a
26	!! along bottom slope gradient) an additional lateral 2nd order
27	!! diffusion along the bottom slope is added to the general
28	!! tracer trend, otherwise the additional trend is set to 0.
29	!! Second order operator (laplacian type) with variable coefficient
30	!! computed as follow for temperature (idem on s):
31	!! difft = 1/(e1te2te3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
32	!! + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
33	!! where ztb is a 2D array: the bottom ocean te;perature and ahtb
34	!! is a time and space varying diffusive coefficient defined by:
35	!! ahbt = zahbp if grad(rho).grad(h) < 0
36	!! = 0. otherwise.
37	!! Note that grad(.) is the along bottom slope gradient. grad(rho)
38	!! is evaluated using the local density (i.e. referenced at the
39	!! local depth). Typical value of ahbt is 2000 m2/s (equivalent to
40	!! a downslope velocity of 20 cm/s if the condition for slope
41	!! convection is satified)
42	!! Add this before trend to the general trend (ta,sa) of the
43	!! botton ocean tracer point:
44	!! ta = ta + difft
45	!!
46	!! ** Action : - update (ta,sa) at the bottom level with the bottom
47	!! boundary layer trend
48	!!
49	!! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
50	!!----------------------------------------------------------------------
51	USE eosbn2 ! equation of state
52	USE oce, ONLY : ztrdt => ua ! use ua as 3D workspace
53	USE oce, ONLY : ztrds => va ! use va as 3D workspace
54	!!
55	INTEGER, INTENT( in ) :: kt ! ocean time-step
56	!!
57	INTEGER :: ji, jj, jk ! dummy loop indices
58	INTEGER :: ik ! temporary integers
59	INTEGER :: iku, iku1, iku2 ! " "
60	INTEGER :: ikv, ikv1, ikv2 ! " "
61	REAL(wp) :: zsign, zh, zalbet ! temporary scalars
62	REAL(wp) :: zgdrho, zbtr ! " "
63	REAL(wp) :: zbt, zsigna ! " "
64	REAL(wp) :: zfui, ze3u, zt, zta ! " "
65	REAL(wp) :: zfvj, ze3v, zs, zsa ! " "
66	REAL(wp), DIMENSION(jpi,jpj) :: zalphax, zwu, zunb ! temporary 2D workspace
67	REAL(wp), DIMENSION(jpi,jpj) :: zalphay, zwv, zvnb ! " "
68	REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zww, zwz ! " "
69	REAL(wp), DIMENSION(jpi,jpj) :: ztbb, zsbb ! " "
70	REAL(wp), DIMENSION(jpi,jpj) :: ztnb, zsnb, zdep ! " "
71	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhdivn ! temporary 3D workspace
72	REAL(wp) :: fsalbt, pft, pfs, pfh ! statement function
73	!!----------------------------------------------------------------------
74	! ratio alpha/beta
75	! ================
76	! fsalbt: ratio of thermal over saline expension coefficients
77	! pft : potential temperature in degrees celcius
78	! pfs : salinity anomaly (s-35) in psu
79	! pfh : depth in meters
80
81	fsalbt( pft, pfs, pfh ) = &
82	( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft &
83	- 0.203814e-03 ) * pft &
84	+ 0.170907e-01 ) * pft &
85	+ 0.665157e-01 &
86	+(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs &
87	+ ( ( - 0.302285e-13 * pfh &
88	- 0.251520e-11 * pfs &
89	+ 0.512857e-12 * pft * pft ) * pfh &
90	- 0.164759e-06 * pfs &
91	+( 0.791325e-08 * pft - 0.933746e-06 ) * pft &
92	+ 0.380374e-04 ) * pfh
93	!!----------------------------------------------------------------------
94
95
96	IF( kt == nit000 ) CALL tra_bbl_init ! initialization at first time-step
97
98	IF( l_trdtra ) THEN ! Save ta and sa trends
99	ztrdt(:,:,:) = ta(:,:,:)
100	ztrds(:,:,:) = sa(:,:,:)
101	ENDIF
102
103	! 1. 2D fields of bottom temperature and salinity, and bottom slope
104	! -----------------------------------------------------------------
105	! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
106
107	#if defined key_vectopt_loop && ! defined key_mpp_omp
108	jj = 1
109	DO ji = 1, jpij ! vector opt. (forced unrolling)
110	#else
111	DO jj = 1, jpj
112	DO ji = 1, jpi
113	#endif
114	ik = mbkt(ji,jj) ! index of the bottom ocean T-level
115	ztnb(ji,jj) = tn(ji,jj,ik)
116	zsnb(ji,jj) = sn(ji,jj,ik)
117	ztbb(ji,jj) = tb(ji,jj,ik)
118	zsbb(ji,jj) = sb(ji,jj,ik)
119	zdep(ji,jj) = fsdept(ji,jj,ik) ! depth of the ocean bottom T-level
120
121	zunb(ji,jj) = un(ji,jj,mbku(ji,jj))
122	zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj))
123	#if ! defined key_vectopt_loop \|\| defined key_mpp_omp
124	END DO
125	#endif
126	END DO
127
128
129	! 2. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
130	! --------------------------------------------
131	! Sign of the local density gradient along the i- and j-slopes
132	! multiplied by the slope of the ocean bottom
133
134	SELECT CASE ( neos )
135	!
136	CASE ( 0 ) ! Jackett and McDougall (1994) formulation
137	!
138	DO jj = 1, jpjm1
139	DO ji = 1, fs_jpim1 ! vector opt.
140	! ... temperature, salinity anomalie and depth
141	zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
142	zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
143	zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
144	! ... masked ratio alpha/beta
145	zalbet = fsalbt( zt, zs, zh ) * umask(ji,jj,1)
146	! ... local density gradient along i-bathymetric slope
147	zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) ) &
148	& - ( zsnb(ji+1,jj) - zsnb(ji,jj) )
149	zgdrho = zgdrho * umask(ji,jj,1)
150	! ... sign of local i-gradient of density multiplied by the i-slope
151	zsign = SIGN( 0.5, -zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
152	zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
153	zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
154	END DO
155	END DO
156	!
157	DO jj = 1, jpjm1
158	DO ji = 1, fs_jpim1 ! vector opt.
159	! ... temperature, salinity anomalie and depth
160	zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
161	zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
162	zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
163	! ... masked ratio alpha/beta
164	zalbet = fsalbt( zt, zs, zh ) * vmask(ji,jj,1)
165	! ... local density gradient along j-bathymetric slope
166	zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) ) &
167	& - ( zsnb(ji,jj+1) - zsnb(ji,jj) )
168	zgdrho = zgdrho*vmask(ji,jj,1)
169	! ... sign of local j-gradient of density multiplied by the j-slope
170	zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
171	zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
172	zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
173	END DO
174	END DO
175	!
176	CASE ( 1 ) ! Linear formulation function of temperature only
177	!
178	DO jj = 1, jpjm1
179	DO ji = 1, fs_jpim1 ! vector opt.
180	! local 'density/temperature' gradient along i-bathymetric slope
181	zgdrho = ( ztnb(ji+1,jj) - ztnb(ji,jj) )
182	! sign of local i-gradient of density multiplied by the i-slope
183	zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
184	zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
185	zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
186
187	! local density gradient along j-bathymetric slope
188	zgdrho = ( ztnb(ji,jj+1) - ztnb(ji,jj) )
189	! sign of local j-gradient of density multiplied by the j-slope
190	zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
191	zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
192	zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
193	END DO
194	END DO
195	!
196	CASE ( 2 ) ! Linear formulation function of temperature and salinity
197	!
198	DO jj = 1, jpjm1
199	DO ji = 1, fs_jpim1 ! vector opt.
200	! local density gradient along i-bathymetric slope
201	zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) ) &
202	& - ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) )
203	! sign of local i-gradient of density multiplied by the i-slope
204	zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
205	zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
206	zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
207
208	! local density gradient along j-bathymetric slope
209	zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) ) &
210	- ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )
211	! sign of local j-gradient of density multiplied by the j-slope
212	zsign = SIGN( 0.5, - zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
213	zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
214	zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
215	END DO
216	END DO
217	!
218	CASE DEFAULT
219	WRITE(ctmp1,*) ' bad flag value for neos = ', neos
220	CALL ctl_stop( ctmp1 )
221	!
222	END SELECT
223
224	! lateral boundary conditions on zalphax and zalphay (unchanged sign)
225	CALL lbc_lnk( zalphax, 'U', 1. ) ; CALL lbc_lnk( zalphay, 'V', 1. )
226
227
228	! 3. Velocities that are exchanged between ajacent bottom boxes.
229	!---------------------------------------------------------------
230
231	! ... is equal to zero but where bbl will work.
232	u_bbl(:,:,:) = 0.e0
233	v_bbl(:,:,:) = 0.e0
234
235	IF( ln_zps ) THEN ! partial steps correction
236
237	# if defined key_vectopt_loop && ! defined key_mpp_omp
238	jj = 1
239	DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)
240	# else
241	DO jj = 1, jpjm1
242	DO ji = 1, jpim1
243	# endif
244	iku = mbku(ji ,jj )
245	ikv = mbkv(ji ,jj )
246	iku1 = mbkt(ji+1,jj )
247	iku2 = mbkt(ji ,jj )
248	ikv1 = mbkt(ji ,jj+1)
249	ikv2 = mbkt(ji ,jj )
250	ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )
251	ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )
252
253	IF( MAX(iku,ikv) > 1 ) THEN
254	u_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * ze3u / fse3u(ji,jj,iku)
255	v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv)
256	ENDIF
257	# if ! defined key_vectopt_loop \|\| defined key_mpp_omp
258	END DO
259	# endif
260	END DO
261
262	! lateral boundary conditions on u_bbl and v_bbl (changed sign)
263	CALL lbc_lnk( u_bbl, 'U', -1. ) ; CALL lbc_lnk( v_bbl, 'V', -1. )
264
265	ELSE ! if not partial step loop over the whole domain no lbc call
266
267	#if defined key_vectopt_loop && ! defined key_mpp_omp
268	jj = 1
269	DO ji = 1, jpij ! vector opt. (forced unrolling)
270	#else
271	DO jj = 1, jpj
272	DO ji = 1, jpi
273	#endif
274	iku = mbku(ji,jj)
275	ikv = mbkv(ji,jj)
276	IF( MAX(iku,ikv) > 1 ) THEN
277	u_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku)
278	v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv)
279	ENDIF
280	#if ! defined key_vectopt_loop \|\| defined key_mpp_omp
281	END DO
282	#endif
283	END DO
284
285	ENDIF
286
287
288	! 5. Along sigma advective trend
289	! -------------------------------
290	! ... Second order centered tracer flux at u and v-points
291
292	# if defined key_vectopt_loop && ! defined key_mpp_omp
293	jj = 1
294	DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)
295	# else
296	DO jj = 1, jpjm1
297	DO ji = 1, jpim1
298	# endif
299	iku = mbku(ji,jj)
300	ikv = mbkv(ji,jj)
301	zfui = e2u(ji,jj) * fse3u(ji,jj,iku) * u_bbl(ji,jj,iku)
302	zfvj = e1v(ji,jj) * fse3v(ji,jj,ikv) * v_bbl(ji,jj,ikv)
303	! centered scheme
304	! zwx(ji,jj) = 0.5* zfui * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
305	! zwy(ji,jj) = 0.5* zfvj * ( ztnb(ji,jj) + ztnb(ji,jj+1) )
306	! zww(ji,jj) = 0.5* zfui * ( zsnb(ji,jj) + zsnb(ji+1,jj) )
307	! zwz(ji,jj) = 0.5* zfvj * ( zsnb(ji,jj) + zsnb(ji,jj+1) )
308	! upstream scheme
309	zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztbb(ji ,jj ) &
310	& +( zfui - ABS( zfui ) ) * ztbb(ji+1,jj ) ) * 0.5
311	zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztbb(ji ,jj ) &
312	& +( zfvj - ABS( zfvj ) ) * ztbb(ji ,jj+1) ) * 0.5
313	zww(ji,jj) = ( ( zfui + ABS( zfui ) ) * zsbb(ji ,jj ) &
314	& +( zfui - ABS( zfui ) ) * zsbb(ji+1,jj ) ) * 0.5
315	zwz(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * zsbb(ji ,jj ) &
316	& +( zfvj - ABS( zfvj ) ) * zsbb(ji ,jj+1) ) * 0.5
317	#if ! defined key_vectopt_loop \|\| defined key_mpp_omp
318	END DO
319	#endif
320	END DO
321	# if defined key_vectopt_loop && ! defined key_mpp_omp
322	jj = 1
323	DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)
324	# else
325	DO jj = 2, jpjm1
326	DO ji = 2, jpim1
327	# endif
328	ik = mbkt(ji,jj)
329	zbtr = 1. / ( e1t(ji,jj)e2t(ji,jj)fse3t(ji,jj,ik) )
330	! horizontal advective trends
331	zta = - zbtr * ( zwx(ji,jj) - zwx(ji-1,jj ) &
332	& + zwy(ji,jj) - zwy(ji ,jj-1) )
333	zsa = - zbtr * ( zww(ji,jj) - zww(ji-1,jj ) &
334	& + zwz(ji,jj) - zwz(ji ,jj-1) )
335
336	! add it to the general tracer trends
337	ta(ji,jj,ik) = ta(ji,jj,ik) + zta
338	sa(ji,jj,ik) = sa(ji,jj,ik) + zsa
339	#if ! defined key_vectopt_loop \|\| defined key_mpp_omp
340	END DO
341	#endif
342	END DO
343
344	! save the trends for diagnostic
345	! BBL lateral advection tracers trends
346	IF( l_trdtra ) THEN
347	ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
348	ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
349	CALL trd_mod(ztrdt, ztrds, jptra_trd_bbl, 'TRA', kt)
350	ENDIF
351
352	IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' bbl - Ta: ', mask1=tmask, &
353	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
354
355	! 6. Vertical advection velocities
356	! --------------------------------
357	! ... computes divergence perturbation (velocties to be removed from upper t boxes :
358	DO jk= 1, jpkm1
359	DO jj=1, jpjm1
360	DO ji = 1, fs_jpim1 ! vector opt.
361	zwu(ji,jj) = -e2u(ji,jj) * u_bbl(ji,jj,jk) * fse3u(ji,jj,jk)
362	zwv(ji,jj) = -e1v(ji,jj) * v_bbl(ji,jj,jk) * fse3v(ji,jj,jk)
363	END DO
364	END DO
365
366	! ... horizontal divergence
367	DO jj = 2, jpjm1
368	DO ji = fs_2, fs_jpim1 ! vector opt.
369	zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
370	zhdivn(ji,jj,jk) = ( zwu(ji,jj) - zwu(ji-1,jj ) &
371	+ zwv(ji,jj) - zwv(ji ,jj-1) ) / zbt
372	END DO
373	END DO
374	END DO
375
376
377	! ... horizontal bottom divergence
378
379	IF( ln_zps ) THEN
380
381	# if defined key_vectopt_loop && ! defined key_mpp_omp
382	jj = 1
383	DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)
384	# else
385	DO jj = 1, jpjm1
386	DO ji = 1, jpim1
387	# endif
388	iku = mbku(ji ,jj )
389	ikv = mbkv(ji ,jj )
390	iku1 = mbkt(ji+1,jj )
391	iku2 = mbkt(ji ,jj )
392	ikv1 = mbkt(ji ,jj+1)
393	ikv2 = mbkt(ji ,jj )
394	ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )
395	ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )
396
397	zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u
398	zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v
399	#if ! defined key_vectopt_loop \|\| defined key_mpp_omp
400	END DO
401	#endif
402	END DO
403
404	ELSE
405
406	# if defined key_vectopt_loop && ! defined key_mpp_omp
407	jj = 1
408	DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)
409	# else
410	DO jj = 1, jpjm1
411	DO ji = 1, jpim1
412	# endif
413	iku = mbku(ji,jj)
414	ikv = mbkv(ji,jj)
415	zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku)
416	zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv)
417	#if ! defined key_vectopt_loop \|\| defined key_mpp_omp
418	END DO
419	#endif
420	END DO
421
422	ENDIF
423
424
425	# if defined key_vectopt_loop && ! defined key_mpp_omp
426	jj = 1
427	DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)
428	# else
429	DO jj = 2, jpjm1
430	DO ji = 2, jpim1
431	# endif
432	ik = mbkt(ji,jj)
433	zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik)
434	zhdivn(ji,jj,ik) = &
435	& ( zwu(ji ,jj ) * ( zunb(ji ,jj ) - un(ji ,jj ,ik) ) &
436	& - zwu(ji-1,jj ) * ( zunb(ji-1,jj ) - un(ji-1,jj ,ik) ) &
437	& + zwv(ji ,jj ) * ( zvnb(ji ,jj ) - vn(ji ,jj ,ik) ) &
438	& - zwv(ji ,jj-1) * ( zvnb(ji ,jj-1) - vn(ji ,jj-1,ik) ) &
439	& ) / zbt
440
441	# if ! defined key_vectopt_loop \|\| defined key_mpp_omp
442	END DO
443	# endif
444	END DO
445
446	! 7. compute additional vertical velocity to be used in t boxes
447	! -------------------------------------------------------------
448	! ... Computation from the bottom
449	! Note that w_bbl(:,:,jpk) has been set to 0 in tra_bbl_init
450	DO jk = jpkm1, 1, -1
451	DO jj= 2, jpjm1
452	DO ji = fs_2, fs_jpim1 ! vector opt.
453	w_bbl(ji,jj,jk) = w_bbl(ji,jj,jk+1) - fse3t(ji,jj,jk)*zhdivn(ji,jj,jk)
454	END DO
455	END DO
456	END DO
457
458	! Boundary condition on w_bbl (unchanged sign)
459	CALL lbc_lnk( w_bbl, 'W', 1. )
460	!
461	END SUBROUTINE tra_bbl_adv

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format