Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

cla.F90

Last change on this file was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 42.0 KB

Line
1	MODULE cla
2	!!======================================================================
3	!! * MODULE cla *
4	!! Cross Land Advection : specific update of the horizontal divergence,
5	!! tracer trends and after velocity
6	!!
7	!! --- Specific to ORCA_R2 ---
8	!!
9	!!======================================================================
10	!! History : 1.0 ! 2002-11 (A. Bozec) Original code
11	!! 3.2 ! 2009-07 (G. Madec) merge cla, cla_div, tra_cla, cla_dynspg
12	!! ! and correct a mpp bug reported by A.R. Porter
13	!!----------------------------------------------------------------------
14	!! cla_div : update of horizontal divergence at cla straits
15	!! tra_cla : update of tracers at cla straits
16	!! cla_dynspg : update of after horizontal velocities at cla straits
17	!! cla_init : initialisation - control check
18	!! cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait
19	!! cla_gibraltar : cross land advection for Gibraltar strait
20	!! cla_hormuz : cross land advection for Hormuz strait
21	!!----------------------------------------------------------------------
22	USE oce ! ocean dynamics and tracers
23	USE dom_oce ! ocean space and time domain
24	USE sbc_oce ! surface boundary condition: ocean
25	USE dynspg_oce ! ocean dynamics: surface pressure gradient variables
26	USE in_out_manager ! I/O manager
27	USE lib_mpp ! distributed memory computing library
28	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
29	USE lib_mpp ! MPP library
30
31	IMPLICIT NONE
32	PRIVATE
33
34	PUBLIC cla_init ! routine called by opa.F90
35	PUBLIC cla_div ! routine called by divcur.F90
36	PUBLIC cla_traadv ! routine called by traadv.F90
37	PUBLIC cla_dynspg ! routine called by dynspg_flt.F90
38
39	INTEGER :: nbab, ngib, nhor ! presence or not of required grid-point on local domain
40	! ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits
41
42	! ! fixed part ! time evolving !!! profile of hdiv for some straits
43	REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) :: hdiv_139_101, hdiv_139_101_kt ! Gibraltar (i,j)=(172,101)
44	REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) :: hdiv_139_102 ! Gibraltar (i,j)=(139,102)
45	REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) :: hdiv_141_102, hdiv_141_102_kt ! Gibraltar (i,j)=(141,102)
46	REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) :: hdiv_161_88 , hdiv_161_88_kt ! Bab-el-Mandeb (i,j)=(161,88)
47	REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) :: hdiv_161_87 ! Bab-el-Mandeb (i,j)=(161,87)
48	REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) :: hdiv_160_89 , hdiv_160_89_kt ! Bab-el-Mandeb (i,j)=(160,89)
49	REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) :: hdiv_172_94 ! Hormuz (i,j)=(172, 94)
50
51	REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) :: t_171_94_hor, s_171_94_hor ! Temperature, salinity in Hormuz strait
52
53	!! * Substitutions
54	# include "domzgr_substitute.h90"
55	!!----------------------------------------------------------------------
56	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
57	!! $Id$
58	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
59	!!----------------------------------------------------------------------
60	CONTAINS
61
62	SUBROUTINE cla_div( kt )
63	!!----------------------------------------------------------------------
64	!! * ROUTINE div_cla *
65	!!
66	!! ** Purpose : update the horizontal divergence of the velocity field
67	!! at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
68	!!
69	!! ** Method : - first time-step: initialisation of cla
70	!! - all time-step: using imposed transport at each strait,
71	!! the now horizontal divergence is updated
72	!!
73	!! ** Action : phdivn updted now horizontal divergence at cla straits
74	!!----------------------------------------------------------------------
75	INTEGER, INTENT( in ) :: kt ! ocean time-step index
76	!!----------------------------------------------------------------------
77	!
78	IF( kt == nit000 ) THEN
79	!
80	CALL cla_init ! control check
81	!
82	IF(lwp) WRITE(numout,*)
83	IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv '
84	IF(lwp) WRITE(numout,*) '~~~~~~~~'
85	IF(lflush) CALL flush(numout)
86	!
87	IF( nbab == 1 ) CALL cla_bab_el_mandeb('ini') ! Bab el Mandeb ( Red Sea - Indian ocean )
88	IF( ngib == 1 ) CALL cla_gibraltar ('ini') ! Gibraltar strait (Med Sea - Atlantic ocean)
89	IF( nhor == 1 ) CALL cla_hormuz ('ini') ! Hormuz Strait ( Persian Gulf - Indian ocean )
90	!
91	ENDIF
92	!
93	IF( nbab == 1 ) CALL cla_bab_el_mandeb('div') ! Bab el Mandeb ( Red Sea - Indian ocean )
94	IF( ngib == 1 ) CALL cla_gibraltar ('div') ! Gibraltar strait (Med Sea - Atlantic ocean)
95	IF( nhor == 1 ) CALL cla_hormuz ('div') ! Hormuz Strait ( Persian Gulf - Indian ocean )
96	!
97	!!gm lbc useless here, no?
98	!!gm CALL lbc_lnk( hdivn, 'T', 1. ) ! Lateral boundary conditions on hdivn
99	!
100	END SUBROUTINE cla_div
101
102
103	SUBROUTINE cla_traadv( kt )
104	!!----------------------------------------------------------------------
105	!! * ROUTINE tra_cla *
106	!!
107	!! ** Purpose : Update the now trend due to the advection of tracers
108	!! and add it to the general trend of passive tracer equations
109	!! at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
110	!!
111	!! ** Method : using both imposed transport at each strait and T & S
112	!! budget, the now tracer trends is updated
113	!!
114	!! ** Action : (ta,sa) updated now tracer trends at cla straits
115	!!----------------------------------------------------------------------
116	INTEGER, INTENT( in ) :: kt ! ocean time-step index
117	!!----------------------------------------------------------------------
118	!
119	IF( kt == nit000 ) THEN
120	IF(lwp) WRITE(numout,*)
121	IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers '
122	IF(lwp) WRITE(numout,*) '~~~~~~~~'
123	IF(lflush) CALL flush(numout)
124	ENDIF
125	!
126	IF( nbab == 1 ) CALL cla_bab_el_mandeb('tra') ! Bab el Mandeb strait
127	IF( ngib == 1 ) CALL cla_gibraltar ('tra') ! Gibraltar strait
128	IF( nhor == 1 ) CALL cla_hormuz ('tra') ! Hormuz Strait ( Persian Gulf)
129	!
130	END SUBROUTINE cla_traadv
131
132
133	SUBROUTINE cla_dynspg( kt )
134	!!----------------------------------------------------------------------
135	!! * ROUTINE cla_dynspg *
136	!!
137	!! ** Purpose : Update the after velocity at some straits
138	!! (Bab el Mandeb, Gibraltar, Hormuz).
139	!!
140	!! ** Method : required to compute the filtered surface pressure gradient
141	!!
142	!! ** Action : (ua,va) after velocity at the cla straits
143	!!----------------------------------------------------------------------
144	INTEGER, INTENT( in ) :: kt ! ocean time-step index
145	!!----------------------------------------------------------------------
146	!
147	IF( kt == nit000 ) THEN
148	IF(lwp) WRITE(numout,*)
149	IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) '
150	IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
151	IF(lflush) CALL flush(numout)
152	ENDIF
153	!
154	IF( nbab == 1 ) CALL cla_bab_el_mandeb('spg') ! Bab el Mandeb strait
155	IF( ngib == 1 ) CALL cla_gibraltar ('spg') ! Gibraltar strait
156	IF( nhor == 1 ) CALL cla_hormuz ('spg') ! Hormuz Strait ( Persian Gulf)
157	!
158	!!gm lbc is needed here, not?
159	!!gm CALL lbc_lnk( hdivn, 'U', -1. ) ; CALL lbc_lnk( hdivn, 'V', -1. ) ! Lateral boundary conditions
160	!
161	END SUBROUTINE cla_dynspg
162
163
164	SUBROUTINE cla_init
165	!! -------------------------------------------------------------------
166	!! * ROUTINE cla_init *
167	!!
168	!! ** Purpose : control check for mpp computation
169	!!
170	!! ** Method : - All the strait grid-points must be inside one of the
171	!! local domain interior for the cla advection to work
172	!! properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ).
173	!! Define the corresponding indicators (nbab, ngib, nhor)
174	!! - The profiles of cross-land fluxes are currently hard
175	!! coded for L31 levels. Stop if jpk/=31
176	!!
177	!! ** Action : nbab, ngib, nhor strait inside the local domain or not
178	!!---------------------------------------------------------------------
179	REAL(wp) :: ztemp ! local scalar
180	INTEGER :: ierr ! local integer
181	!!---------------------------------------------------------------------
182	!
183	IF(lwp) WRITE(numout,*)
184	IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation '
185	IF(lwp) WRITE(numout,*) '~~~~~~~~~'
186	IF(lwp .AND. lflush) CALL flush(numout)
187	!
188	! ! Allocate arrays for this module
189	ALLOCATE( hdiv_139_101(jpk) , hdiv_139_101_kt(jpk) , & ! Gibraltar
190	& hdiv_139_102(jpk) , &
191	& hdiv_141_102(jpk) , hdiv_141_102_kt(jpk) , &
192	& hdiv_161_88 (jpk) , hdiv_161_88_kt (jpk) , & ! Bab-el-Mandeb
193	& hdiv_161_87 (jpk) , &
194	& hdiv_160_89 (jpk) , hdiv_160_89_kt (jpk) , & ! Hormuz
195	& hdiv_172_94 (jpk) , &
196	& t_171_94_hor(jpk) , s_171_94_hor (jpk) , STAT=ierr )
197	IF( lk_mpp ) CALL mpp_sum( ierr )
198	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'cla_init: unable to allocate arrays' )
199	!
200	IF( .NOT.lk_dynspg_flt ) CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )
201	!
202	IF( lk_vvl ) CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
203	!
204	IF( jpk /= 31 ) CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
205	!
206	! _\|_______\|_______\|_
207	! 89 \| \|///////\|
208	! _\|_______\|_______\|_
209	! ------------------------ ! 88 \|///////\| \|
210	! Bab el Mandeb strait ! _\|_______\|_______\|_
211	! ------------------------ ! 87 \|///////\| \|
212	! _\|_______\|_______\|_
213	! \| 160 \| 161 \|
214	!
215	! The 6 Bab el Mandeb grid-points must be inside one of the interior of the
216	! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
217	nbab = 0
218	IF( ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND. & !* (161,89), (161,88) and (161,88) on the local pocessor
219	& ( 1 <= mi0(160) .AND. mi1(161) <= jpi ) ) nbab = 1
220	!
221	! test if there is no local domain that includes all required grid-points
222	ztemp = REAL( nbab )
223	IF( lk_mpp ) CALL mpp_sum( ztemp ) ! sum with other processors value
224	IF( ztemp == 0 ) THEN ! Only 2 points in each direction, this should never be a problem
225	CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' )
226	ENDIF
227	! ___________________________
228	! ------------------------ ! 102 \| \|///////\| \|
229	! Gibraltar strait ! _\|_______\|_______\|_______\|_
230	! ------------------------ ! 101 \| \|///////\| \|
231	! _\|_______\|_______\|_______\|_
232	! \| 139 \| 140 \| 141 \|
233	!
234	! The 6 Gibraltar grid-points must be inside one of the interior of the
235	! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
236	ngib = 0
237	IF( ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND. & !* (139:141,101:102) on the local pocessor
238	& ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 ) ) ngib = 1
239	!
240	! test if there is no local domain that includes all required grid-points
241	ztemp = REAL( ngib )
242	IF( lk_mpp ) CALL mpp_sum( ztemp ) ! sum with other processors value
243	IF( ztemp == 0 ) THEN ! 3 points in i-direction, this may be a problem with some cutting
244	CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' )
245	ENDIF
246	! _______________
247	! ------------------------ ! 94 \|/////\| \|
248	! Hormuz strait ! _\|_____\|_____\|_
249	! ------------------------ ! 171 172
250	!
251	! The 2 Hormuz grid-points must be inside one of the interior of the
252	! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
253	nhor = 0
254	IF( 2 <= mj0( 94) .AND. mj1( 94) <= jpjm1 .AND. &
255	& 2 <= mi0(171) .AND. mi1(172) <= jpim1 ) nhor = 1
256	!
257	! test if there is no local domain that includes all required grid-points
258	ztemp = REAL( nhor )
259	IF( lk_mpp ) CALL mpp_sum( ztemp ) ! sum with other processors value
260	IF( ztemp == 0 ) THEN ! 3 points in i-direction, this may be a problem with some cutting
261	CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' )
262	ENDIF
263	!
264	END SUBROUTINE cla_init
265
266
267	SUBROUTINE cla_bab_el_mandeb( cd_td )
268	!!----------------------------------------------------------------------
269	!! * ROUTINE cla_bab_el_mandeb *
270	!!
271	!! ** Purpose : update the now horizontal divergence, the tracer tendancy
272	!! and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean).
273	!!
274	!! ** Method : compute the exchanges at each side of the strait :
275	!!
276	!! surf. zio_flow
277	!! (+ balance of emp) /\ \|\\\\\\\\\\\\|
278	!! \|\| \|\\\\\\\\\\\\|
279	!! deep zio_flow \|\| \|\\\\\\\\\\\\|
280	!! \| \|\| \|\| \|\\\\\\\\\\\\|
281	!! 89 \| \|\| \|\| \|\\\\\\\\\\\\|
282	!! \|__\/_v_\|\|__\|____________
283	!! !\\\\\\\\\\\\| surf. zio_flow
284	!! \|\\\\\\\\\\\\|<=== (+ balance of emp)
285	!! \|\\\\\\\\\\\u
286	!! 88 \|\\\\\\\\\\\\|<--- deep zrecirc (upper+deep at 2 different levels)
287	!! \|___________\|__________
288	!! !\\\\\\\\\\\\|
289	!! \|\\\\\\\\\\\\| ---\ deep zrecirc (upper+deep)
290	!! 87 !\\\\\\\\\\\u ===/ + deep zio_flow (all at the same level)
291	!! !\\\\\\\\\\\\|
292	!! !___________\|__________
293	!! 160 161
294	!!
295	!!----------------------------------------------------------------------
296	CHARACTER(len=1), INTENT(in) :: cd_td ! ='div' update the divergence
297	! ! ='tra' update the tracers
298	! ! ='spg' update after velocity
299	INTEGER :: ji, jj, jk ! dummy loop indices
300	REAL(wp) :: zemp_red ! temporary scalar
301	REAL(wp) :: zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
302	!!---------------------------------------------------------------------
303	!
304	SELECT CASE( cd_td )
305	! ! ---------------- !
306	CASE( 'ini' ) ! initialisation !
307	! ! ---------------- !
308	!
309	zio_flow = 0.4e6 ! imposed in/out flow
310	zrecirc_upp = 0.2e6 ! imposed upper recirculation water
311	zrecirc_bot = 0.5e6 ! imposed bottom recirculation water
312
313	hdiv_161_88(:) = 0.e0 ! (161,88) Gulf of Aden side, north point
314	hdiv_161_87(:) = 0.e0 ! (161,87) Gulf of Aden side, south point
315	hdiv_160_89(:) = 0.e0 ! (160,89) Red sea side
316
317	DO jj = mj0(88), mj1(88) !** profile of hdiv at (161,88) (Gulf of Aden side, north point)
318	DO ji = mi0(161), mi1(161) !------------------------------
319	DO jk = 1, 8 ! surface in/out flow (Ind -> Red) (div >0)
320	hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
321	END DO
322	! ! recirculation water (Ind -> Red) (div >0)
323	hdiv_161_88(20) = + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) )
324	hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
325	END DO
326	END DO
327	!
328	DO jj = mj0(87), mj1(87) !** profile of hdiv at (161,88) (Gulf of Aden side, south point)
329	DO ji = mi0(161), mi1(161) !------------------------------
330	! ! deep out flow + recirculation (Red -> Ind) (div <0)
331	hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
332	END DO
333	END DO
334	!
335	DO jj = mj0(89), mj1(89) !** profile of hdiv at (161,88) (Red sea side)
336	DO ji = mi0(160), mi1(160) !------------------------------
337	DO jk = 1, 8 ! surface inflow (Ind -> Red) (div <0)
338	hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
339	END DO
340	! ! deep outflow (Red -> Ind) (div >0)
341	hdiv_160_89(16) = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) )
342	END DO
343	END DO
344	! ! ---------------- !
345	CASE( 'div' ) ! update hdivn ! (call by divcur module)
346	! ! ---------=====-- !
347	! !** emp on the Red Sea (div >0)
348	zemp_red = 0.e0 !---------------------
349	DO jj = mj0(87), mj1(96) ! sum over the Red sea
350	DO ji = mi0(148), mi1(160)
351	zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
352	END DO
353	END DO
354	IF( lk_mpp ) CALL mpp_sum( zemp_red ) ! sum with other processors value
355	zemp_red = zemp_red * 1.e-3 ! convert in m3
356	!
357	! !** Correct hdivn (including emp adjustment)
358	! !-------------------------------------------
359	DO jj = mj0(88), mj1(88) !* profile of hdiv at (161,88) (Gulf of Aden side, north point)
360	DO ji = mi0(161), mi1(161)
361	hdiv_161_88_kt(:) = hdiv_161_88(:)
362	DO jk = 1, 8 ! increase the inflow from the Indian (div >0)
363	hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) )
364	END DO
365	hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:)
366	END DO
367	END DO
368	DO jj = mj0(87), mj1(87) !* profile of divergence at (161,87) (Gulf of Aden side, south point)
369	DO ji = mi0(161), mi1(161)
370	hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:)
371	END DO
372	END DO
373	DO jj = mj0(89), mj1(89) !* profile of divergence at (160,89) (Red sea side)
374	DO ji = mi0(160), mi1(160)
375	hdiv_160_89_kt(:) = hdiv_160_89(:)
376	DO jk = 1, 18 ! increase the inflow from the Indian (div <0)
377	hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) )
378	END DO
379	hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:)
380	END DO
381	END DO
382	! ! ---------------- !
383	CASE( 'tra' ) ! update (ta,sa) ! (call by traadv module)
384	! ! --------=======- !
385	!
386	DO jj = mj0(88), mj1(88) !** (161,88) (Gulf of Aden side, north point)
387	DO ji = mi0(161), mi1(161)
388	DO jk = 1, jpkm1 ! surf inflow + reciculation (from Gulf of Aden)
389	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_tem)
390	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_sal)
391	END DO
392	END DO
393	END DO
394	DO jj = mj0(87), mj1(87) !** (161,87) (Gulf of Aden side, south point)
395	DO ji = mi0(161), mi1(161)
396	jk = 21 ! deep outflow + recirulation (combined flux)
397	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + hdiv_161_88(20) * tsn(ji ,jj+1,20,jp_tem) & ! upper recirculation from Gulf of Aden
398	& + hdiv_161_88(21) * tsn(ji ,jj+1,21,jp_tem) & ! deep recirculation from Gulf of Aden
399	& + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_tem) ! deep inflow from Red sea
400	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + hdiv_161_88(20) * tsn(ji ,jj+1,20,jp_sal) &
401	& + hdiv_161_88(21) * tsn(ji ,jj+1,21,jp_sal) &
402	& + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_sal)
403	END DO
404	END DO
405	DO jj = mj0(89), mj1(89) !** (161,88) (Red sea side)
406	DO ji = mi0(160), mi1(160)
407	DO jk = 1, 14 ! surface inflow (from Gulf of Aden)
408	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_tem)
409	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_sal)
410	END DO
411	! ! deep outflow (from Red sea)
412	tsa(ji,jj,16,jp_tem) = tsa(ji,jj,16,jp_tem) - hdiv_160_89(16) * tsn(ji,jj,16,jp_tem)
413	tsa(ji,jj,16,jp_sal) = tsa(ji,jj,16,jp_sal) - hdiv_160_89(16) * tsn(ji,jj,16,jp_sal)
414	END DO
415	END DO
416	!
417	! ! ---------------- !
418	CASE( 'spg' ) ! update (ua,va) ! (call by dynspg module)
419	! ! --------=======- !
420	! at this stage, (ua,va) are the after velocity, not the tendancy
421	! compute the velocity from the divergence at T-point
422	!
423	DO jj = mj0(88), mj1(88) !** (160,88) (Gulf of Aden side, north point)
424	DO ji = mi0(160), mi1(160) ! 160, not 161 as it is a U-point)
425	ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) &
426	& * e2u(ji,jj) * fse3u(ji,jj,:)
427	END DO
428	END DO
429	DO jj = mj0(87), mj1(87) !** (160,87) (Gulf of Aden side, south point)
430	DO ji = mi0(160), mi1(160) ! 160, not 161 as it is a U-point)
431	ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) &
432	& * e2u(ji,jj) * fse3u(ji,jj,:)
433	END DO
434	END DO
435	DO jj = mj0(88), mj1(88) !** profile of divergence at (160,89) (Red sea side)
436	DO ji = mi0(160), mi1(160) ! 88, not 89 as it is a V-point)
437	va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) ) &
438	& * e1v(ji,jj) * fse3v(ji,jj,:)
439	END DO
440	END DO
441	END SELECT
442	!
443	END SUBROUTINE cla_bab_el_mandeb
444
445
446	SUBROUTINE cla_gibraltar( cd_td )
447	!! -------------------------------------------------------------------
448	!! * ROUTINE cla_gibraltar *
449	!!
450	!! ** Purpose : update the now horizontal divergence, the tracer
451	!! tendancyand the after velocity in vicinity of Gibraltar
452	!! strait ( Persian Gulf - Indian ocean ).
453	!!
454	!! ** Method :
455	!! _______________________
456	!! deep zio_flow /====\|///////\|====> surf. zio_flow
457	!! + deep zrecirc \----\|///////\| (+balance of emp)
458	!! 102 u///////u
459	!! mid. recicul <--\|///////\|<==== deep zio_flow
460	!! _____\|_______\|_____
461	!! surf. zio_flow ====>\|///////\|
462	!! (+balance of emp) \|///////\|
463	!! 101 u///////\|
464	!! mid. recicul -->\|///////\| Caution: zrecirc split into
465	!! deep zrecirc ---->\|///////\| upper & bottom recirculation
466	!! _______\|_______\|_______
467	!! 139 140 141
468	!!
469	!!---------------------------------------------------------------------
470	CHARACTER(len=1), INTENT(in) :: cd_td ! ='div' update the divergence
471	! ! ='tra' update the tracers
472	! ! ='spg' update after velocity
473	INTEGER :: ji, jj, jk ! dummy loop indices
474	REAL(wp) :: zemp_med ! temporary scalar
475	REAL(wp) :: zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
476	!!---------------------------------------------------------------------
477	!
478	SELECT CASE( cd_td )
479	! ! ---------------- !
480	CASE( 'ini' ) ! initialisation !
481	! ! ---------------- !
482	! !** initialization of the velocity
483	hdiv_139_101(:) = 0.e0 ! 139,101 (Atlantic side, south point)
484	hdiv_139_102(:) = 0.e0 ! 139,102 (Atlantic side, north point)
485	hdiv_141_102(:) = 0.e0 ! 141,102 (Med sea side)
486
487	! !** imposed transport
488	zio_flow = 0.8e6 ! inflow surface water
489	zrecirc_mid = 0.7e6 ! middle recirculation water
490	zrecirc_upp = 2.5e6 ! upper recirculation water
491	zrecirc_bot = 3.5e6 ! bottom recirculation water
492	!
493	DO jj = mj0(101), mj1(101) !** profile of hdiv at 139,101 (Atlantic side, south point)
494	DO ji = mi0(139), mi1(139) !-----------------------------
495	DO jk = 1, 14 ! surface in/out flow (Atl -> Med) (div >0)
496	hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
497	END DO
498	DO jk = 15, 20 ! middle reciculation (Atl 101 -> Atl 102) (div >0)
499	hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
500	END DO
501	! ! upper reciculation (Atl 101 -> Atl 101) (div >0)
502	hdiv_139_101(21) = + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
503	!
504	! ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102) (div >0)
505	hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
506	END DO
507	END DO
508	DO jj = mj0(102), mj1(102) !** profile of hdiv at 139,102 (Atlantic side, north point)
509	DO ji = mi0(139), mi1(139) !-----------------------------
510	DO jk = 15, 20 ! middle reciculation (Atl 101 -> Atl 102) (div <0)
511	hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
512	END DO
513	! ! outflow of Mediterranean sea + deep recirculation (div <0)
514	hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
515	END DO
516	END DO
517	DO jj = mj0(102), mj1(102) !** velocity profile at 141,102 (Med sea side)
518	DO ji = mi0(141), mi1(141) !------------------------------
519	DO jk = 1, 14 ! surface inflow in the Med (div <0)
520	hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
521	END DO
522	! ! deep outflow toward the Atlantic (div >0)
523	hdiv_141_102(21) = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
524	END DO
525	END DO
526	! ! ---------------- !
527	CASE( 'div' ) ! update hdivn ! (call by divcur module)
528	! ! ---------=====-- !
529	! !** emp on the Mediterranean Sea (div >0)
530	zemp_med = 0.e0 !-------------------------------
531	DO jj = mj0(96), mj1(110) ! sum over the Med sea
532	DO ji = mi0(141),mi1(181)
533	zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
534	END DO
535	END DO
536	DO jj = mj0(96), mj1(96) ! minus 2 points in Red Sea
537	DO ji = mi0(148),mi1(148)
538	zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
539	END DO
540	DO ji = mi0(149),mi1(149)
541	zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
542	END DO
543	END DO
544	IF( lk_mpp ) CALL mpp_sum( zemp_med ) ! sum with other processors value
545	zemp_med = zemp_med * 1.e-3 ! convert in m3
546	!
547	! !** Correct hdivn (including emp adjustment)
548	! !-------------------------------------------
549	DO jj = mj0(101), mj1(101) !* 139,101 (Atlantic side, south point)
550	DO ji = mi0(139), mi1(139)
551	hdiv_139_101_kt(:) = hdiv_139_101(:)
552	DO jk = 1, 14 ! increase the inflow from the Atlantic (div >0)
553	hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
554	END DO
555	hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:)
556	END DO
557	END DO
558	DO jj = mj0(102), mj1(102) !* 139,102 (Atlantic side, north point)
559	DO ji = mi0(139), mi1(139)
560	hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:)
561	END DO
562	END DO
563	DO jj = mj0(102), mj1(102) !* 141,102 (Med side)
564	DO ji = mi0(141), mi1(141)
565	hdiv_141_102(:) = hdiv_141_102(:)
566	DO jk = 1, 14 ! increase the inflow from the Atlantic (div <0)
567	hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
568	END DO
569	hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:)
570	END DO
571	END DO
572	! ! ---------------- !
573	CASE( 'tra' ) ! update (ta,sa) ! (call by traadv module)
574	! ! --------=======- !
575	!
576	DO jj = mj0(101), mj1(101) !** 139,101 (Atlantic side, south point) (div >0)
577	DO ji = mi0(139), mi1(139)
578	DO jk = 1, jpkm1 ! surf inflow + mid. & bottom reciculation (from Atlantic)
579	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_tem)
580	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_sal)
581	END DO
582	END DO
583	END DO
584	!
585	DO jj = mj0(102), mj1(102) !** 139,102 (Atlantic side, north point) (div <0)
586	DO ji = mi0(139), mi1(139)
587	DO jk = 15, 20 ! middle reciculation (Atl 101 -> Atl 102) (div <0)
588	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_tem) ! middle Atlantic recirculation
589	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_sal)
590	END DO
591	! ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0)
592	! ! deep Med flow (Med 102 -> Atl 102) - (div <0)
593	tsa(ji,jj,22,jp_tem) = tsa(ji,jj,22,jp_tem) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_tem) & ! deep Med flow
594	& + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_tem) & ! upper Atlantic recirculation
595	& + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_tem) ! bottom Atlantic recirculation
596	tsa(ji,jj,22,jp_sal) = tsa(ji,jj,22,jp_sal) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_sal) &
597	& + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_sal) &
598	& + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_sal)
599	END DO
600	END DO
601	DO jj = mj0(102), mj1(102) !* 141,102 (Med side) (div <0)
602	DO ji = mi0(141), mi1(141)
603	DO jk = 1, 14 ! surface flow from Atlantic to Med sea
604	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_tem)
605	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_sal)
606	END DO
607	! ! deeper flow from Med sea to Atlantic
608	tsa(ji,jj,21,jp_tem) = tsa(ji,jj,21,jp_tem) - hdiv_141_102(21) * tsn(ji,jj,21,jp_tem)
609	tsa(ji,jj,21,jp_sal) = tsa(ji,jj,21,jp_sal) - hdiv_141_102(21) * tsn(ji,jj,21,jp_sal)
610	END DO
611	END DO
612	! ! ---------------- !
613	CASE( 'spg' ) ! update (ua,va) ! (call by dynspg module)
614	! ! --------=======- !
615	! at this stage, (ua,va) are the after velocity, not the tendancy
616	! compute the velocity from the divergence at T-point
617	!
618	DO jj = mj0(101), mj1(101) !** 139,101 (Atlantic side, south point)
619	DO ji = mi0(139), mi1(139) ! div >0 => ua >0, same sign
620	ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) ) &
621	& * e2u(ji,jj) * fse3u(ji,jj,:)
622	END DO
623	END DO
624	DO jj = mj0(102), mj1(102) !** 139,102 (Atlantic side, north point)
625	DO ji = mi0(139), mi1(139) ! div <0 => ua <0, same sign
626	ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) ) &
627	& * e2u(ji,jj) * fse3u(ji,jj,:)
628	END DO
629	END DO
630	DO jj = mj0(102), mj1(102) !** 140,102 (Med side) (140 not 141 as it is a U-point)
631	DO ji = mi0(140), mi1(140) ! div >0 => ua <0, opposite sign
632	ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) &
633	& * e2u(ji,jj) * fse3u(ji,jj,:)
634	END DO
635	END DO
636	!
637	END SELECT
638	!
639	END SUBROUTINE cla_gibraltar
640
641
642	SUBROUTINE cla_hormuz( cd_td )
643	!! -------------------------------------------------------------------
644	!! * ROUTINE div_hormuz *
645	!!
646	!! ** Purpose : update the now horizontal divergence, the tracer
647	!! tendancyand the after velocity in vicinity of Hormuz
648	!! strait ( Persian Gulf - Indian ocean ).
649	!!
650	!! ** Method : Hormuz strait
651	!! ______________
652	!! \|/////\|<== surface inflow
653	!! 94 \|/////\|
654	!! \|/////\|==> deep outflow
655	!! \|_____\|_______
656	!! 171 172
657	!!---------------------------------------------------------------------
658	CHARACTER(len=1), INTENT(in) :: cd_td ! ='ini' initialisation
659	!! ! ='div' update the divergence
660	!! ! ='tra' update the tracers
661	!! ! ='spg' update after velocity
662	!!
663	INTEGER :: ji, jj, jk ! dummy loop indices
664	REAL(wp) :: zio_flow ! temporary scalar
665	!!---------------------------------------------------------------------
666	!
667	SELECT CASE( cd_td )
668	! ! ---------------- !
669	CASE( 'ini' ) ! initialisation !
670	! ! ---------------- !
671	! !** profile of horizontal divergence due to cross-land advection
672	zio_flow = 1.e6 ! imposed in/out flow
673	!
674	hdiv_172_94(:) = 0.e0
675	!
676	DO jj = mj0(94), mj1(94) ! in/out flow at (i,j) = (172,94)
677	DO ji = mi0(172), mi1(172)
678	DO jk = 1, 8 ! surface inflow (Indian ocean to Persian Gulf) (div<0)
679	hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
680	END DO
681	DO jk = 16, 18 ! deep outflow (Persian Gulf to Indian ocean) (div>0)
682	hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
683	END DO
684	END DO
685	END DO
686	! !** T & S profile in the Hormuz strait (use in deep outflow)
687	! Temperature and Salinity
688	t_171_94_hor(:) = 0.e0 ; s_171_94_hor(:) = 0.e0
689	t_171_94_hor(16) = 18.4 ; s_171_94_hor(16) = 36.27
690	t_171_94_hor(17) = 17.8 ; s_171_94_hor(17) = 36.4
691	t_171_94_hor(18) = 16. ; s_171_94_hor(18) = 36.27
692	!
693	! ! ---------------- !
694	CASE( 'div' ) ! update hdivn ! (call by divcur module)
695	! ! ---------=====-- !
696	!
697	DO jj = mj0(94), mj1(94) !** 172,94 (Indian ocean side)
698	DO ji = mi0(172), mi1(172)
699	hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:)
700	END DO
701	END DO
702	! ! ---------------- !
703	CASE( 'tra' ) ! update (ta,sa) ! (call by traadv module)
704	! ! --------=======- !
705	!
706	DO jj = mj0(94), mj1(94) !** 172,94 (Indian ocean side)
707	DO ji = mi0(172), mi1(172)
708	DO jk = 1, 8 ! surface inflow (Indian ocean to Persian Gulf) (div<0)
709	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_tem)
710	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_sal)
711	END DO
712	DO jk = 16, 18 ! deep outflow (Persian Gulf to Indian ocean) (div>0)
713	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * t_171_94_hor(jk)
714	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * s_171_94_hor(jk)
715	END DO
716	END DO
717	END DO
718	! ! ---------------- !
719	CASE( 'spg' ) ! update (ua,va) ! (call by dynspg module)
720	! ! --------=======- !
721	! No barotropic flow through Hormuz strait
722	! at this stage, (ua,va) are the after velocity, not the tendancy
723	! compute the velocity from the divergence at T-point
724	DO jj = mj0(94), mj1(94) !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point)
725	DO ji = mi0(171), mi1(171) ! div >0 => ua >0, opposite sign
726	ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) &
727	& * e2u(ji,jj) * fse3u(ji,jj,:)
728	END DO
729	END DO
730	!
731	END SELECT
732	!
733	END SUBROUTINE cla_hormuz
734
735	!!======================================================================
736	END MODULE cla

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90

Download in other formats: