Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

cla_tam.F90 @ 1885

Last change on this file since 1885 was 1885, checked in by rblod, 14 years ago
add TAM sources
File size: 88.5 KB

Line
1	MODULE cla_tam
2	#ifdef key_tam
3	!!==============================================================================
4	!! * MODULE cla_tam *
5	!! Cross Land Advection : parameterize ocean exchanges through straits by a
6	!! specified advection across land.
7	!! Tangent and Adjoint module
8	!!==============================================================================
9	# if defined key_orca_r2
10	!!----------------------------------------------------------------------
11	!! 'key_orca_r2' : ORCA R2 configuration
12	!!----------------------------------------------------------------------
13	!! tra_cla : update the tracer trend with the horizontal
14	!! and vertical advection trends at straits
15	!! tra_bab_el_mandeb :
16	!! tra_gibraltar :
17	!! tra_hormuz :
18	!! tra_cla_init :
19	!!----------------------------------------------------------------------
20	!! * Modules used
21	USE par_kind, ONLY: & ! Precision variables
22	& wp
23	USE par_oce, ONLY: & ! Ocean space and time domain variables
24	& jpi, &
25	& jpj, &
26	& jpk, &
27	& jpiglo
28	USE oce, ONLY: & ! ocean dynamics and tracers variables
29	& tn, &
30	& sn
31	USE sbc_oce_tam, ONLY: & ! surface variables
32	& emp_tl, &
33	& emp_ad
34	USE oce_tam, ONLY: & ! ocean dynamics and tracers variables
35	& tn_tl, &
36	& sn_tl, &
37	& ta_tl, &
38	& sa_tl, &
39	& tn_ad, &
40	& sn_ad, &
41	& ta_ad, &
42	& sa_ad
43	USE sbc_oce, ONLY: & ! ocean surface boundary condition (fluxes)
44	& emp
45	USE phycst, ONLY: & ! Physical constants
46	& rauw
47	USE dom_oce, ONLY: & ! ocean space and time domain
48	& mi0, &
49	& mi1, &
50	& mj0, &
51	& mj1, &
52	& nldi, &
53	& nldj, &
54	& nlei, &
55	& nlej, &
56	& rdt, &
57	& tmask, &
58	& mig, &
59	& mjg, &
60	& e2u, &
61	& e1v, &
62	& e1t, &
63	& e2t, &
64	# if defined key_vvl
65	& e3t_1, &
66	# else
67	# if defined key_zco
68	& e3t_0, &
69	# else
70	& e3t, &
71	# endif
72	# endif
73	# if ! defined key_zco
74	& e3u, &
75	& e3v
76	# endif
77	USE in_out_manager, ONLY: & ! I/O manager
78	& nit000, &
79	& nitend, &
80	& numout, &
81	& lwp
82	USE lib_mpp, ONLY: & ! distributed memory computing library
83	& lk_mpp, &
84	& mpp_sum
85	USE paresp, ONLY: &
86	& wesp_t, &
87	& wesp_s
88	USE gridrandom, ONLY: & ! Random Gaussian noise on grids
89	& grid_random
90	USE dotprodfld, ONLY : & ! Computes dot product for 3D and 2D fields
91	& dot_product
92	USE tstool_tam, ONLY: &
93	& prntst_adj, & !
94	& stdemp, & ! stdev for evaporation minus precip
95	& stdt, & ! temperature
96	& stds ! salinity
97
98	IMPLICIT NONE
99	PRIVATE
100
101	!! * Routine accessibility
102	PUBLIC tra_cla_tan ! routine called by step_tam.F90
103	PUBLIC tra_cla_adj ! routine called by step_tam.F90
104	PUBLIC tra_cla_adj_tst ! routine called by tst.F90
105
106	!! * Modules variables
107	REAL(wp) :: zempmed, zempred
108	REAL(wp) :: zempmed_tl, zempred_tl
109	REAL(wp) :: zempmed_ad, zempred_ad
110
111	REAL(wp) :: zisw_rs, zurw_rs, zbrw_rs ! Imposed transport Red Sea
112	REAL(wp) :: zisw_ms, zmrw_ms, zurw_ms, zbrw_ms ! Imposed transport Med Sea
113	REAL(wp), DIMENSION(jpk) :: &
114	zu1_rs_i, zu2_rs_i, zu3_rs_i, & ! Red Sea velocities
115	zu1_ms_i, zu2_ms_i, zu3_ms_i ! Mediterranean Sea velocities
116	LOGICAL :: lfirst = .TRUE. ! initialisation flag
117	!! * Substitutions
118	# include "domzgr_substitute.h90"
119	# include "vectopt_loop_substitute.h90"
120
121	CONTAINS
122
123	SUBROUTINE tra_cla_tan( kt )
124	!!----------------------------------------------------------------------
125	!! * ROUTINE tra_cla_tan *
126	!!
127	!! ** Purpose of the direct reoutine:
128	!! Update the now trend due to the advection of tracers
129	!! and add it to the general trend of passive tracer equations
130	!! at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
131	!!
132	!! ** Method : ...
133	!! Add this trend now to the general trend of tracer (ta,sa):
134	!! (ta,sa) = (ta,sa) + ( zta , zsa )
135	!!
136	!! ** Action : update (ta,sa) with the now advective tracer trends
137	!!
138	!! History of the direct method:
139	!! ! (A. Bozec) original code
140	!! 8.5 ! 02-11 (A. Bozec) F90: Free form and module
141	!! History of the TAM:
142	!! ! 08-08 (A. Vidard) tangent of the 02-11 vesrsion
143	!!----------------------------------------------------------------------
144	!! * Arguments
145	INTEGER, INTENT( in ) :: kt ! ocean time-step index
146	!!----------------------------------------------------------------------
147
148	! cross land advection for straits
149
150	! Initialization
151	IF( kt == nit000 ) CALL tra_cla_init_tam
152
153
154	! Bab el Mandeb strait horizontal advection
155
156	CALL tra_bab_el_mandeb_tan
157
158	! Gibraltar strait horizontal advection
159
160	CALL tra_gibraltar_tan
161
162	! Hormuz Strait ( persian Gulf) horizontal advection
163
164	CALL tra_hormuz_tan
165
166
167
168	END SUBROUTINE tra_cla_tan
169	SUBROUTINE tra_cla_adj( kt )
170	!!----------------------------------------------------------------------
171	!! * ROUTINE tra_cla_adj *
172	!!
173	!! ** Purpose of the direct reoutine:
174	!! Update the now trend due to the advection of tracers
175	!! and add it to the general trend of passive tracer equations
176	!! at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
177	!!
178	!! ** Method : ...
179	!! Add this trend now to the general trend of tracer (ta,sa):
180	!! (ta,sa) = (ta,sa) + ( zta , zsa )
181	!!
182	!! ** Action : update (ta,sa) with the now advective tracer trends
183	!!
184	!! History of the direct method:
185	!! ! (A. Bozec) original code
186	!! 8.5 ! 02-11 (A. Bozec) F90: Free form and module
187	!! History:
188	!! ! 08-06 (A. Vidard) adjoint of the 02-11 vesrsion
189	!!----------------------------------------------------------------------
190	!! * Arguments
191	INTEGER, INTENT( in ) :: kt ! ocean time-step index
192	!!----------------------------------------------------------------------
193
194	! cross land advection for straits
195
196	! Initialization
197	IF( kt == nitend ) CALL tra_cla_init_tam
198
199
200	! Hormuz Strait ( persian Gulf) horizontal advection
201	CALL tra_hormuz_adj
202	! Gibraltar strait horizontal advection
203
204	CALL tra_gibraltar_adj
205	! Bab el Mandeb strait horizontal advection
206
207	CALL tra_bab_el_mandeb_adj
208
209	END SUBROUTINE tra_cla_adj
210
211	SUBROUTINE tra_bab_el_mandeb_tan
212	!!---------------------------------------------------------------------
213	!! * ROUTINE tra_bab_el_mandeb_tan *
214	!!
215	!! ** Purpose of the direct routine:
216	!! Update the horizontal advective trend of tracers
217	!! correction in Bab el Mandeb strait and
218	!! add it to the general trend of tracer equations.
219	!!
220	!! ** Method of the direct routine:
221	!! We impose transport at Bab el Mandeb and knowing T and S in
222	!! surface and depth at each side of the strait, we deduce T and S
223	!! of the deep outflow of the Red Sea in the Indian ocean .
224	!! \|
225	!! \|/ \\| N \|\ /\|
226	!! \|_\|_\|______ \| \|___\|______
227	!! 88 \| \|<- W - - E 88 \| \|<-
228	!! 87 \|___\|______ \| 87 \|___\|->____
229	!! 160 161 S 160 161
230	!! horizontal view horizontal view
231	!! surface depth
232	!!
233	!! The horizontal advection is evaluated by a second order cen-
234	!! tered scheme using now fields (leap-frog scheme). In specific
235	!! areas (vicinity of major river mouths, some straits, or tn
236	!! approaching the freezing point) it is mixed with an upstream
237	!! scheme for stability reasons.
238	!!
239	!! C A U T I O N : the trend saved is the centered trend only.
240	!! It doesn't take into account the upstream part of the scheme.
241	!!
242	!! ** history of the direct routine:
243	!! ! 02-11 (A. Bozec) Original code
244	!! 8.5 ! 02-11 (A. Bozec) F90: Free form and module
245	!! ** history of the tangent routine:
246	!! ! 08-08 (A. Vidard)
247	!!---------------------------------------------------------------------
248	!! * Local declarations
249	INTEGER :: ji, jj, jk ! dummy loop indices
250	REAL(wp) :: zsu, zvt
251	REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4
252	REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4
253	REAL(wp) :: zsumttl, zsumt1tl, zsumt2tl, zsumt3tl, zsumt4tl
254	REAL(wp) :: zsumstl, zsums1tl, zsums2tl, zsums3tl, zsums4tl
255	REAL(wp) :: zt, zs
256	REAL(wp) :: zttl, zstl
257	REAL(wp) :: zwei
258	REAL(wp), DIMENSION (jpk) :: zu1_rs, zu2_rs, zu3_rs
259	REAL(wp), DIMENSION (jpk) :: zu1_rs_tl, zu2_rs_tl, zu3_rs_tl
260	!!---------------------------------------------------------------------
261
262	! Initialization of vertical sum for T and S transport
263	! ----------------------------------------------------
264
265	zsumt = 0.e0 ! East Bab el Mandeb surface north point (T)
266	zsums = 0.e0 ! East Bab el Mandeb surface north point (S)
267	zsumt1 = 0.e0 ! East Bab el Mandeb depth south point (T)
268	zsums1 = 0.e0 ! East Bab el Mandeb depth south point (S)
269	zsumt2 = 0.e0 ! West Bab el Mandeb surface (T)
270	zsums2 = 0.e0 ! West Bab el Mandeb surface (S)
271	zsumt3 = 0.e0 ! West Bab el Mandeb depth (T)
272	zsums3 = 0.e0 ! West Bab el Mandeb depth (S)
273	zsumt4 = 0.e0 ! East Bab el Mandeb depth north point (T)
274	zsums4 = 0.e0 ! East Bab el Mandeb depth north point (S)
275	zsumttl = 0.e0 ! East Bab el Mandeb surface north point (T)
276	zsumstl = 0.e0 ! East Bab el Mandeb surface north point (S)
277	zsumt1tl = 0.e0 ! East Bab el Mandeb depth south point (T)
278	zsums1tl = 0.e0 ! East Bab el Mandeb depth south point (S)
279	zsumt2tl = 0.e0 ! West Bab el Mandeb surface (T)
280	zsums2tl = 0.e0 ! West Bab el Mandeb surface (S)
281	zsumt3tl = 0.e0 ! West Bab el Mandeb depth (T)
282	zsums3tl = 0.e0 ! West Bab el Mandeb depth (S)
283	zsumt4tl = 0.e0 ! East Bab el Mandeb depth north point (T)
284	zsums4tl = 0.e0 ! East Bab el Mandeb depth north point (S)
285
286	! EMP of the Red Sea
287	! ------------------
288
289	zempred_tl = 0.e0
290	zempred = 0.e0
291	zwei = 0.e0
292	DO jj = mj0(87), mj1(96)
293	DO ji = mi0(148), mi1(160)
294	zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
295	zempred = zempred + emp(ji,jj) * zwei
296	zempred_tl = zempred_tl + emp_tl(ji,jj) * zwei
297	END DO
298	END DO
299	IF( lk_mpp ) CALL mpp_sum( zempred ) ! sum with other processors value
300	IF( lk_mpp ) CALL mpp_sum( zempred_tl ) ! sum with other processors value
301
302	! convert in m3
303	zempred_tl = zempred_tl * 1.e-3
304	zempred = zempred * 1.e-3
305
306	! Velocity profile at each point
307	! ------------------------------
308
309	zu1_rs(:) = zu1_rs_i(:)
310	zu2_rs(:) = zu2_rs_i(:)
311	zu3_rs(:) = zu3_rs_i(:)
312	zu1_rs_tl(:) = 0.0_wp
313	zu2_rs_tl(:) = 0.0_wp
314	zu3_rs_tl(:) = 0.0_wp
315
316	! velocity profile at 161,88 East Bab el Mandeb North point
317	! we imposed zisw_rs + EMP above the Red Sea
318	DO jk = 1, 8
319	DO jj = mj0(88), mj1(88)
320	DO ji = mi0(160), mi1(160)
321	zu1_rs(jk) = zu1_rs(jk) &
322	& - ( zempred / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
323	zu1_rs_tl(jk) = zu1_rs_tl(jk) &
324	& - ( zempred_tl / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
325	END DO
326	END DO
327	END DO
328
329	! velocity profile at 161, 88 West Bab el Mandeb
330	! we imposed zisw_rs + EMP above the Red Sea
331	DO jk = 1, 10
332	DO jj = mj0(88), mj1(88)
333	DO ji = mi0(160), mi1(160)
334	zu3_rs(jk) = zu3_rs(jk) &
335	& + ( zempred / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
336	zu3_rs_tl(jk) = zu3_rs_tl(jk) &
337	& + ( zempred_tl / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
338	END DO
339	END DO
340	END DO
341
342	! Balance of temperature and salinity
343	! -----------------------------------
344
345	! east Bab el Mandeb surface vertical sum of transport* S,T
346	DO jk = 1, 19
347	DO jj = mj0(88), mj1(88)
348	DO ji = mi0(161), mi1(161)
349	zsumt = zsumt &
350	& + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
351	zsums = zsums &
352	& + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
353	zsumttl = zsumttl &
354	& + tn_tl(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) &
355	& + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs_tl(jk)
356	zsumstl = zsumstl &
357	& + sn_tl(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) &
358	& + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs_tl(jk)
359	END DO
360	END DO
361	END DO
362
363	! west Bab el Mandeb surface vertical sum of transport* S,T
364	DO jk = 1, 10
365	DO jj = mj0(88), mj1(88)
366	DO ji = mi0(161), mi1(161)
367	zsumt2 = zsumt2 &
368	& + tn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
369	zsums2 = zsums2 &
370	& + sn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
371	zsumt2tl = zsumt2tl &
372	& + tn_tl(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk) &
373	& + tn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs_tl(jk)
374	zsums2tl = zsums2tl &
375	& + sn_tl(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk) &
376	& + sn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs_tl(jk)
377	END DO
378	END DO
379	END DO
380
381	! west Bab el Mandeb deeper
382	DO jj = mj0(89), mj1(89)
383	DO ji = mi0(160), mi1(160)
384	zsumt3 = tn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
385	zsums3 = sn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
386	zsumt3tl = tn_tl(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16) &
387	& + tn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs_tl(16)
388	zsums3tl = sn_tl(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16) &
389	& + sn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs_tl(16)
390	END DO
391	END DO
392
393	! east Bab el Mandeb deeper
394	DO jk = 20, 21
395	DO jj = mj0(88), mj1(88)
396	DO ji = mi0(161), mi1(161)
397	zsumt4 = zsumt4 &
398	& + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
399	zsums4 = zsums4 &
400	& + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
401	zsumt4tl = zsumt4tl &
402	& + tn_tl(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) &
403	& + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs_tl(jk)
404	zsums4tl = zsums4tl &
405	& + sn_tl(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) &
406	& + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs_tl(jk)
407	END DO
408	END DO
409	END DO
410
411	! Total transport
412	zsumt1 = -( zsumt3 + zsumt2 + zsumt + zsumt4 )
413	zsums1 = -( zsums3 + zsums2 + zsums + zsums4 )
414	zsumt1tl = -( zsumt3tl + zsumt2tl + zsumttl + zsumt4tl )
415	zsums1tl = -( zsums3tl + zsums2tl + zsumstl + zsums4tl )
416
417	! Temperature and Salinity at East Bab el Mandeb, Level 21
418	DO jj = mj0(88), mj1(88)
419	DO ji = mi0(160), mi1(160)
420	zt = zsumt1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
421	zs = zsums1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
422	zttl = zsumt1tl / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) ) &
423	& - zsumt1 / ( 2 * zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) ) * zu2_rs_tl(21)
424	zstl = zsums1tl / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) ) &
425	& - zsums1 / ( 2 * zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) ) * zu2_rs_tl(21)
426	END DO
427	END DO
428
429	! New Temperature and Salinity at East Bab el Mandeb
430	! --------------------------------------------------
431
432	! north point
433	DO jk = 1, jpk
434	DO jj = mj0(88), mj1(88)
435	DO ji = mi0(161), mi1(161)
436	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
437	zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
438	ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) &
439	& + ( 1. / zvt ) * zsu * zu1_rs_tl(jk) * tn(ji,jj,jk) &
440	& + ( 1. / zvt ) * zsu * zu1_rs(jk) * tn_tl(ji,jj,jk)
441	sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) &
442	& + ( 1. / zvt ) * zsu * zu1_rs_tl(jk) * sn(ji,jj,jk) &
443	& + ( 1. / zvt ) * zsu * zu1_rs(jk) * sn_tl(ji,jj,jk)
444	END DO
445	END DO
446	END DO
447
448	! south point
449	jk = 21
450	DO jj = mj0(87), mj1(87)
451	DO ji = mi0(161), mi1(161)
452	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
453	zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
454	ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) &
455	& + ( 1. / zvt ) * zsu * zu2_rs_tl(jk) * zt &
456	& + ( 1. / zvt ) * zsu * zu2_rs(jk) * zttl
457	sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) &
458	& + ( 1. / zvt ) * zsu * zu2_rs_tl(jk) * zs &
459	& + ( 1. / zvt ) * zsu * zu2_rs(jk) * zstl
460	END DO
461	END DO
462
463
464	! New Temperature and Salinity at West Bab el Mandeb
465	! --------------------------------------------------
466
467	! surface
468	DO jk = 1, 10
469	DO jj = mj0(89), mj1(89)
470	DO ji = mi0(160), mi1(160)
471	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
472	zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk)
473	ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) &
474	& + ( 1. / zvt ) * zsu * zu3_rs_tl(jk) * tn(ji+1,jj-1,jk) &
475	& + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn_tl(ji+1,jj-1,jk)
476	sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) &
477	& + ( 1. / zvt ) * zsu * zu3_rs_tl(jk) * sn(ji+1,jj-1,jk) &
478	& + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn_tl(ji+1,jj-1,jk)
479	END DO
480	END DO
481	END DO
482	! deeper
483	jk = 16
484	DO jj = mj0(89), mj1(89)
485	DO ji = mi0(160), mi1(160)
486	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
487	zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk)
488	ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) &
489	& + ( 1. / zvt ) * zsu * zu3_rs_tl(jk) * tn(ji,jj,jk) &
490	& + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn_tl(ji,jj,jk)
491	sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) &
492	& + ( 1. / zvt ) * zsu * zu3_rs_tl(jk) * sn(ji,jj,jk) &
493	& + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn_tl(ji,jj,jk)
494	END DO
495	END DO
496
497	END SUBROUTINE tra_bab_el_mandeb_tan
498	SUBROUTINE tra_bab_el_mandeb_adj
499	!!---------------------------------------------------------------------
500	!! * ROUTINE tra_bab_el_mandeb_adj *
501	!!
502	!! ** Purpose of the direct routine:
503	!! Update the horizontal advective trend of tracers
504	!! correction in Bab el Mandeb strait and
505	!! add it to the general trend of tracer equations.
506	!!
507	!! ** Method of the direct routine:
508	!! We impose transport at Bab el Mandeb and knowing T and S in
509	!! surface and depth at each side of the strait, we deduce T and S
510	!! of the deep outflow of the Red Sea in the Indian ocean .
511	!! \|
512	!! \|/ \\| N \|\ /\|
513	!! \|_\|_\|______ \| \|___\|______
514	!! 88 \| \|<- W - - E 88 \| \|<-
515	!! 87 \|___\|______ \| 87 \|___\|->____
516	!! 160 161 S 160 161
517	!! horizontal view horizontal view
518	!! surface depth
519	!!
520	!! The horizontal advection is evaluated by a second order cen-
521	!! tered scheme using now fields (leap-frog scheme). In specific
522	!! areas (vicinity of major river mouths, some straits, or tn
523	!! approaching the freezing point) it is mixed with an upstream
524	!! scheme for stability reasons.
525	!!
526	!! C A U T I O N : the trend saved is the centered trend only.
527	!! It doesn't take into account the upstream part of the scheme.
528	!!
529	!! ** history of the direct routine:
530	!! ! 02-11 (A. Bozec) Original code
531	!! 8.5 ! 02-11 (A. Bozec) F90: Free form and module
532	!! ** history of the adjoint routine:
533	!! ! 08-08 (A. Vidard)
534	!!---------------------------------------------------------------------
535	!! * Local declarations
536	INTEGER :: ji, jj, jk ! dummy loop indices
537	REAL(wp) :: zsu, zvt
538	REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4
539	REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4
540	REAL(wp) :: zsumtad, zsumt1ad, zsumt2ad, zsumt3ad, zsumt4ad
541	REAL(wp) :: zsumsad, zsums1ad, zsums2ad, zsums3ad, zsums4ad
542	REAL(wp) :: zt, zs
543	REAL(wp) :: ztad, zsad
544	REAL(wp) :: zwei
545	REAL(wp), DIMENSION (jpk) :: zu1_rs, zu2_rs, zu3_rs
546	REAL(wp), DIMENSION (jpk) :: zu1_rs_ad, zu2_rs_ad, zu3_rs_ad
547	!!---------------------------------------------------------------------
548
549	! Initialization of vertical sum for T and S transport
550	! ----------------------------------------------------
551
552	zsumt = 0.e0 ! East Bab el Mandeb surface north point (T)
553	zsums = 0.e0 ! East Bab el Mandeb surface north point (S)
554	zsumt1 = 0.e0 ! East Bab el Mandeb depth south point (T)
555	zsums1 = 0.e0 ! East Bab el Mandeb depth south point (S)
556	zsumt2 = 0.e0 ! West Bab el Mandeb surface (T)
557	zsums2 = 0.e0 ! West Bab el Mandeb surface (S)
558	zsumt3 = 0.e0 ! West Bab el Mandeb depth (T)
559	zsums3 = 0.e0 ! West Bab el Mandeb depth (S)
560	zsumt4 = 0.e0 ! East Bab el Mandeb depth north point (T)
561	zsums4 = 0.e0 ! East Bab el Mandeb depth north point (S)
562	zsumtad = 0.e0 ! East Bab el Mandeb surface north point (T)
563	zsumsad = 0.e0 ! East Bab el Mandeb surface north point (S)
564	zsumt1ad = 0.e0 ! East Bab el Mandeb depth south point (T)
565	zsums1ad = 0.e0 ! East Bab el Mandeb depth south point (S)
566	zsumt2ad = 0.e0 ! West Bab el Mandeb surface (T)
567	zsums2ad = 0.e0 ! West Bab el Mandeb surface (S)
568	zsumt3ad = 0.e0 ! West Bab el Mandeb depth (T)
569	zsums3ad = 0.e0 ! West Bab el Mandeb depth (S)
570	zsumt4ad = 0.e0 ! East Bab el Mandeb depth north point (T)
571	zsums4ad = 0.e0 ! East Bab el Mandeb depth north point (S)
572	ztad = 0.e0
573	zsad = 0.e0
574	zu1_rs_ad (:) = 0.e0
575	zu2_rs_ad (:) = 0.e0
576	zu3_rs_ad (:) = 0.e0
577	zempred_ad = 0.e0
578	!===========================
579	! Direct model recomputation
580	!===========================
581	! EMP of the Red Sea
582	! ------------------
583
584	zempred = 0.e0
585	zwei = 0.e0
586	DO jj = mj0(87), mj1(96)
587	DO ji = mi0(148), mi1(160)
588	zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
589	zempred = zempred + emp(ji,jj) * zwei
590	END DO
591	END DO
592	IF( lk_mpp ) CALL mpp_sum( zempred ) ! sum with other processors value
593
594	! convert in m3
595	zempred = zempred * 1.e-3
596
597	! Velocity profile at each point
598	! ------------------------------
599
600	zu1_rs(:) = zu1_rs_i(:)
601	zu2_rs(:) = zu2_rs_i(:)
602	zu3_rs(:) = zu3_rs_i(:)
603
604	! velocity profile at 161,88 East Bab el Mandeb North point
605	! we imposed zisw_rs + EMP above the Red Sea
606	DO jk = 1, 8
607	DO jj = mj0(88), mj1(88)
608	DO ji = mi0(160), mi1(160)
609	zu1_rs(jk) = zu1_rs(jk) - ( zempred / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
610	END DO
611	END DO
612	END DO
613
614	! velocity profile at 161, 88 West Bab el Mandeb
615	! we imposed zisw_rs + EMP above the Red Sea
616	DO jk = 1, 10
617	DO jj = mj0(88), mj1(88)
618	DO ji = mi0(160), mi1(160)
619	zu3_rs(jk) = zu3_rs(jk) + ( zempred / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
620	END DO
621	END DO
622	END DO
623
624	! Balance of temperature and salinity
625	! -----------------------------------
626
627	! east Bab el Mandeb surface vertical sum of transport* S,T
628	DO jk = 1, 19
629	DO jj = mj0(88), mj1(88)
630	DO ji = mi0(161), mi1(161)
631	zsumt = zsumt + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
632	zsums = zsums + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
633	END DO
634	END DO
635	END DO
636
637	! west Bab el Mandeb surface vertical sum of transport* S,T
638	DO jk = 1, 10
639	DO jj = mj0(88), mj1(88)
640	DO ji = mi0(161), mi1(161)
641	zsumt2 = zsumt2 + tn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
642	zsums2 = zsums2 + sn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
643	END DO
644	END DO
645	END DO
646
647	! west Bab el Mandeb deeper
648	DO jj = mj0(89), mj1(89)
649	DO ji = mi0(160), mi1(160)
650	zsumt3 = tn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
651	zsums3 = sn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
652	END DO
653	END DO
654
655	! east Bab el Mandeb deeper
656	DO jk = 20, 21
657	DO jj = mj0(88), mj1(88)
658	DO ji = mi0(161), mi1(161)
659	zsumt4 = zsumt4 + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
660	zsums4 = zsums4 + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
661	END DO
662	END DO
663	END DO
664
665	! Total transport
666	zsumt1 = -( zsumt3 + zsumt2 + zsumt + zsumt4 )
667	zsums1 = -( zsums3 + zsums2 + zsums + zsums4 )
668
669	! Temperature and Salinity at East Bab el Mandeb, Level 21
670	DO jj = mj0(88), mj1(88)
671	DO ji = mi0(160), mi1(160)
672	zt = zsumt1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
673	zs = zsums1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
674	END DO
675	END DO
676
677	!=============
678	! Adjoint part
679	!=============
680
681	! New Temperature and Salinity at West Bab el Mandeb
682	! --------------------------------------------------
683
684	! deeper
685	jk = 16
686	DO jj = mj1(89), mj0(89), -1
687	DO ji = mi1(160), mi0(160), -1
688	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
689	zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk)
690	zu3_rs_ad(jk) = zu3_rs_ad(jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * tn(ji,jj,jk)
691	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu3_rs(jk)
692	zu3_rs_ad(jk) = zu3_rs_ad(jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * sn(ji,jj,jk)
693	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu3_rs(jk)
694	END DO
695	END DO
696	! surface
697	DO jk = 10, 1, -1
698	DO jj = mj1(89), mj0(89), -1
699	DO ji = mi1(160), mi0(160), -1
700	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
701	zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk)
702	zu3_rs_ad(jk) = zu3_rs_ad(jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * tn(ji+1,jj-1,jk)
703	tn_ad(ji+1,jj-1,jk) = tn_ad(ji+1,jj-1,jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu3_rs(jk)
704	zu3_rs_ad(jk) = zu3_rs_ad(jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * sn(ji+1,jj-1,jk)
705	sn_ad(ji+1,jj-1,jk) = sn_ad(ji+1,jj-1,jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu3_rs(jk)
706	END DO
707	END DO
708	END DO
709	! New Temperature and Salinity at East Bab el Mandeb
710	! --------------------------------------------------
711
712	! south point
713	jk = 21
714	DO jj = mj1(87), mj0(87), -1
715	DO ji = mi1(161), mi0(161), -1
716	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
717	zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
718	zu2_rs_ad(jk) = zu2_rs_ad(jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zt
719	ztad = ztad + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu2_rs(jk)
720	zu2_rs_ad(jk) = zu2_rs_ad(jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zs
721	zsad = zsad + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu2_rs(jk)
722	END DO
723	END DO
724
725	! north point
726	DO jk = jpk, 1, -1
727	DO jj = mj1(88), mj0(88), -1
728	DO ji = mi1(161), mi0(161), -1
729	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
730	zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
731	zu1_rs_ad(jk) = zu1_rs_ad(jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * tn(ji,jj,jk)
732	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu1_rs(jk)
733	zu1_rs_ad(jk) = zu1_rs_ad(jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * sn(ji,jj,jk)
734	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu1_rs(jk)
735	END DO
736	END DO
737	END DO
738
739	! Balance of temperature and salinity
740	! -----------------------------------
741
742	! Temperature and Salinity at East Bab el Mandeb, Level 21
743	DO jj = mj1(88), mj0(88), -1
744	DO ji = mi1(160), mi0(160), -1
745	zsumt1ad = zsumt1ad + ztad / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
746	zu2_rs_ad(21) = zu2_rs_ad(21) - ztad * zsumt1 / ( 2 * zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
747	ztad = 0.0_wp
748	zsums1ad = zsums1ad + zsad / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
749	zu2_rs_ad(21) = zu2_rs_ad(21) - zsad * zsums1 / ( 2 * zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
750	zsad = 0.0_wp
751	END DO
752	END DO
753	! Total transport
754	zsumt3ad = zsumt3ad - zsumt1ad
755	zsumt2ad = zsumt2ad - zsumt1ad
756	zsumtad = zsumtad - zsumt1ad
757	zsumt4ad = zsumt4ad - zsumt1ad
758	zsumt1ad = 0.0_wp
759	zsums3ad = zsums3ad - zsums1ad
760	zsums2ad = zsums2ad - zsums1ad
761	zsumsad = zsumsad - zsums1ad
762	zsums4ad = zsums4ad - zsums1ad
763	zsums1ad = 0.0_wp
764
765	! east Bab el Mandeb deeper
766	DO jk = 21, 20, -1
767	DO jj = mj1(88), mj0(88), -1
768	DO ji = mi1(161), mi0(161), -1
769	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) + zsumt4ad * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
770	zu1_rs_ad(jk) = zu1_rs_ad(jk) + zsumt4ad * tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
771	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) + zsums4ad * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
772	zu1_rs_ad(jk) = zu1_rs_ad(jk) + zsums4ad * sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
773	END DO
774	END DO
775	END DO
776
777	! west Bab el Mandeb deeper
778	DO jj = mj1(89), mj0(89), -1
779	DO ji = mi1(160), mi0(160), -1
780	tn_ad(ji,jj,16) = tn_ad(ji,jj,16) + zsumt3ad * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
781	zu3_rs_ad(16) = zu3_rs_ad(16) + zsumt3ad * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * tn(ji,jj,16)
782	sn_ad(ji,jj,16) = sn_ad(ji,jj,16) + zsums3ad * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
783	zu3_rs_ad(16) = zu3_rs_ad(16) + zsums3ad * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * sn(ji,jj,16)
784	zsumt3ad = 0.0_wp
785	zsums3ad = 0.0_wp
786	END DO
787	END DO
788
789	! west Bab el Mandeb surface vertical sum of transport* S,T
790	DO jk = 10, 1, -1
791	DO jj = mj1(88), mj0(88), -1
792	DO ji = mi1(161), mi0(161), -1
793	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) + zsumt2ad * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
794	zu3_rs_ad(jk) = zu3_rs_ad(jk) + zsumt2ad * tn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk)
795	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) + zsums2ad * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
796	zu3_rs_ad(jk) = zu3_rs_ad(jk) + zsums2ad * sn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk)
797	END DO
798	END DO
799	END DO
800
801	! east Bab el Mandeb surface vertical sum of transport* S,T
802	DO jk = 19, 1, -1
803	DO jj = mj1(88), mj0(88), -1
804	DO ji = mi1(161), mi0(161), -1
805	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) + zsumtad * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
806	zu1_rs_ad(jk) = zu1_rs_ad(jk) + zsumtad * tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
807	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) + zsumsad * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
808	zu1_rs_ad(jk) = zu1_rs_ad(jk) + zsumsad * sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
809	END DO
810	END DO
811	END DO
812
813	! Velocity profile at each point
814	! ------------------------------
815	! velocity profile at 161, 88 West Bab el Mandeb
816	! we imposed zisw_rs + EMP above the Red Sea
817	DO jk = 10, 1, -1
818	DO jj = mj0(88), mj1(88)
819	DO ji = mi0(160), mi1(160)
820	zempred_ad = zempred_ad + zu3_rs_ad(jk) / ( 10. * e1v(ji,jj) * fse3v(ji,jj,jk) )
821	END DO
822	END DO
823	END DO
824
825	! velocity profile at 161,88 East Bab el Mandeb North point
826	! we imposed zisw_rs + EMP above the Red Sea
827	DO jk = 8, 1, -1
828	DO jj = mj0(88), mj1(88)
829	DO ji = mi0(160), mi1(160)
830	zempred_ad = zempred_ad - zu1_rs_ad(jk) / ( 8. * e2u(ji,jj) * fse3u(ji,jj,jk) )
831	END DO
832	END DO
833	END DO
834
835	zu1_rs(:) = zu1_rs_i(:)
836	zu2_rs(:) = zu2_rs_i(:)
837	zu3_rs(:) = zu3_rs_i(:)
838	zu1_rs_ad(:) = 0.0_wp
839	zu2_rs_ad(:) = 0.0_wp
840	zu3_rs_ad(:) = 0.0_wp
841
842	! EMP of the Red Sea
843	! ------------------
844
845	! convert in m3
846	zempred_ad = zempred_ad * 1.e-3
847
848	IF( lk_mpp ) CALL mpp_sum( zempred_ad ) ! sum with other processors value
849	DO jj = mj0(87), mj1(96)
850	DO ji = mi0(148), mi1(160)
851	zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
852	emp_ad(ji,jj) = emp_ad(ji,jj) + zempred_ad * zwei
853	END DO
854	END DO
855
856	zempred_ad = 0.e0
857	zwei = 0.e0
858
859	END SUBROUTINE tra_bab_el_mandeb_adj
860	SUBROUTINE tra_gibraltar_tan
861	!!---------------------------------------------------------------------
862	!! * ROUTINE tra_gibraltar_tan *
863	!!
864	!! ** Purpose :
865	!! Update the horizontal advective trend of tracers (t & s)
866	!! correction in Gibraltar and
867	!! add it to the general trend of tracer equations.
868	!!
869	!! ** Method :
870	!! We impose transport at Gibraltar and knowing T and S in
871	!! surface and deeper at each side of the strait, we deduce T and S
872	!! of the outflow of the Mediterranean Sea in the Atlantic ocean .
873	!!
874	!! ________________ N ________________
875	!! 102 \| \|-> \| <-\| \|<-
876	!! 101 ___->\|____\|_____ W - - E ___->\|____\|_____
877	!! 139 140 141 \| 139 140 141
878	!! horizontal view S horizontal view
879	!! surface depth
880	!! C A U T I O N : the trend saved is the centered trend only.
881	!! It doesn't take into account the upstream part of the scheme.
882	!!
883	!! ** history :
884	!! ! 02-06 (A. Bozec) Original code
885	!! 8.5 ! 02-11 (A. Bozec) F90: Free form and module
886	!! ** history of the tangent routine:
887	!! ! 08-08 (A. Vidard) tangent of the 02-11 version
888	!!---------------------------------------------------------------------
889	!! * Local declarations
890	INTEGER :: ji, jj, jk ! dummy loop indices
891	REAL(wp) :: zsu, zvt
892	REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4
893	REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4
894	REAL(wp) :: zsumttl, zsumt1tl, zsumt2tl, zsumt3tl, zsumt4tl
895	REAL(wp) :: zsumstl, zsums1tl, zsums2tl, zsums3tl, zsums4tl
896	REAL(wp) :: zt, zs
897	REAL(wp) :: zttl, zstl
898	REAL(wp) :: zwei
899	REAL(wp), DIMENSION (jpk) :: zu1_ms, zu2_ms, zu3_ms
900	REAL(wp), DIMENSION (jpk) :: zu1_ms_tl, zu2_ms_tl, zu3_ms_tl
901	!!---------------------------------------------------------------------
902
903	! Initialization of vertical sum for T and S transport
904	! ----------------------------------------------------
905
906	zsumt = 0.e0 ! West Gib. surface south point ( T )
907	zsums = 0.e0 ! West Gib. surface south point ( S )
908	zsumt1 = 0.e0 ! East Gib. surface north point ( T )
909	zsums1 = 0.e0 ! East Gib. surface north point ( S )
910	zsumt2 = 0.e0 ! East Gib. depth north point ( T )
911	zsums2 = 0.e0 ! East Gib. depth north point ( S )
912	zsumt3 = 0.e0 ! West Gib. depth south point ( T )
913	zsums3 = 0.e0 ! West Gib. depth south point ( S )
914	zsumt4 = 0.e0 ! West Gib. depth north point ( T )
915	zsums4 = 0.e0 ! West Gib. depth north point ( S )
916	zsumttl = 0.e0 ! West Gib. surface south point ( T )
917	zsumstl = 0.e0 ! West Gib. surface south point ( S )
918	zsumt1tl = 0.e0 ! East Gib. surface north point ( T )
919	zsums1tl = 0.e0 ! East Gib. surface north point ( S )
920	zsumt2tl = 0.e0 ! East Gib. depth north point ( T )
921	zsums2tl = 0.e0 ! East Gib. depth north point ( S )
922	zsumt3tl = 0.e0 ! West Gib. depth south point ( T )
923	zsums3tl = 0.e0 ! West Gib. depth south point ( S )
924	zsumt4tl = 0.e0 ! West Gib. depth north point ( T )
925	zsums4tl = 0.e0 ! West Gib. depth north point ( S )
926
927	! EMP of Mediterranean Sea
928	! ------------------------
929
930	zempmed_tl = 0.e0
931	zempmed = 0.e0
932	zwei = 0.e0
933	DO jj = mj0(96), mj1(110)
934	DO ji = mi0(141), mi1(181)
935	zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
936	zempmed = zempmed + emp (ji,jj) * zwei
937	zempmed_tl = zempmed_tl + emp_tl(ji,jj) * zwei
938	END DO
939	END DO
940	IF( lk_mpp ) CALL mpp_sum( zempmed ) ! sum with other processors value
941	IF( lk_mpp ) CALL mpp_sum( zempmed_tl ) ! sum with other processors value
942
943	! minus 2 points in Red Sea and 3 in Atlantic ocean
944	DO jj = mj0(96),mj1(96)
945	DO ji = mi0(148),mi1(148)
946	zempmed_tl = zempmed_tl &
947	& - emp_tl(ji ,jj) * tmask(ji ,jj,1) * e1t(ji ,jj) * e2t(ji ,jj) &
948	& - emp_tl(ji+1,jj) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)
949	zempmed = zempmed &
950	& - emp(ji ,jj) * tmask(ji ,jj,1) * e1t(ji ,jj) * e2t(ji ,jj) &
951	& - emp(ji+1,jj) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)
952	END DO
953	END DO
954
955	! convert in m3
956	zempmed = zempmed * 1.e-3
957	zempmed_tl = zempmed_tl * 1.e-3
958
959	! Velocity profile at each point
960	! ------------------------------
961
962	zu1_ms(:) = zu1_ms_i(:)
963	zu2_ms(:) = zu2_ms_i(:)
964	zu3_ms(:) = zu3_ms_i(:)
965	zu1_ms_tl(:) = 0.0_wp
966	zu2_ms_tl(:) = 0.0_wp
967	zu3_ms_tl(:) = 0.0_wp
968
969	! velocity profile at 139,101 South point + emp on surface
970	DO jk = 1, 14
971	DO jj = mj0(102), mj1(102)
972	DO ji = mi0(140), mi1(140)
973	zu1_ms(jk) = zu1_ms(jk) &
974	& + ( zempmed / 14. ) / ( e2u(ji-1,jj-1) * fse3u(ji-1,jj-1,jk) )
975	zu1_ms_tl(jk) = zu1_ms_tl(jk) &
976	& + ( zempmed_tl / 14. ) / ( e2u(ji-1,jj-1) * fse3u(ji-1,jj-1,jk) )
977	END DO
978	END DO
979	END DO
980
981	! profile at East Gibraltar
982	! velocity profile at 141,102 + emp on surface
983	DO jk = 1, 14
984	DO jj = mj0(102), mj1(102)
985	DO ji = mi0(140), mi1(140)
986	zu3_ms(jk) = zu3_ms(jk) &
987	& + ( zempmed / 14. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
988	zu3_ms_tl(jk) = zu3_ms_tl(jk) &
989	& + ( zempmed_tl / 14. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
990	END DO
991	END DO
992	END DO
993
994	! Balance of temperature and salinity
995	! -----------------------------------
996
997	! west gibraltar surface vertical sum of transport* S,T
998	DO jk = 1, 14
999	DO jj = mj0(101), mj1(101)
1000	DO ji = mi0(139), mi1(139)
1001	zsumt = zsumt + tn(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk)
1002	zsums = zsums + sn(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk)
1003	zsumttl = zsumttl &
1004	& + tn_tl(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk) &
1005	& + tn(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms_tl(jk)
1006	zsumstl = zsumstl &
1007	& + sn_tl(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk) &
1008	& + sn(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms_tl(jk)
1009	END DO
1010	END DO
1011	END DO
1012
1013	! east Gibraltar surface vertical sum of transport* S,T
1014	DO jk = 1, 14
1015	DO jj = mj0(101), mj1(101)
1016	DO ji = mi0(139), mi1(139)
1017	zsumt1 = zsumt1 &
1018	& + tn(ji,jj,jk) * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * zu3_ms(jk)
1019	zsums1 = zsums1 &
1020	& + sn(ji,jj,jk) * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * zu3_ms(jk)
1021	zsumt1tl = zsumt1tl &
1022	& + tn_tl(ji,jj,jk) * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * zu3_ms(jk) &
1023	& + tn(ji,jj,jk) * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * zu3_ms_tl(jk)
1024	zsums1tl = zsums1tl &
1025	& + sn_tl(ji,jj,jk) * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * zu3_ms(jk) &
1026	& + sn(ji,jj,jk) * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * zu3_ms_tl(jk)
1027	END DO
1028	END DO
1029	END DO
1030
1031	! east Gibraltar deeper vertical sum of transport* S,T
1032	DO jj = mj0(102), mj1(102)
1033	DO ji = mi0(141), mi1(141)
1034	zsumt2 = tn( ji,jj,21) * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * zu3_ms( 21)
1035	zsums2 = sn( ji,jj,21) * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * zu3_ms( 21)
1036	zsumt2tl = tn_tl(ji,jj,21) * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * zu3_ms( 21) &
1037	& + tn( ji,jj,21) * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * zu3_ms_tl(21)
1038	zsums2tl = sn_tl(ji,jj,21) * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * zu3_ms( 21) &
1039	& + sn( ji,jj,21) * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * zu3_ms_tl(21)
1040	END DO
1041	END DO
1042
1043	! west Gibraltar deeper vertical sum of transport* S,T
1044	DO jk = 21, 22
1045	DO jj = mj0(101), mj1(101)
1046	DO ji = mi0(139), mi1(139)
1047	zsumt3 = zsumt3 &
1048	& + tn( ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk)
1049	zsums3 = zsums3 &
1050	& + sn( ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk)
1051	zsumt3tl = zsumt3tl &
1052	& + tn_tl(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk) &
1053	& + tn( ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms_tl(jk)
1054	zsums3tl = zsums3tl &
1055	& + sn_tl(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk) &
1056	& + sn( ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms_tl(jk)
1057	END DO
1058	END DO
1059	END DO
1060
1061	! Total transport = 0.
1062	zsumt4 = zsumt2 + zsumt1 - zsumt - zsumt3
1063	zsums4 = zsums2 + zsums1 - zsums - zsums3
1064	zsumt4tl = zsumt2tl + zsumt1tl - zsumttl - zsumt3tl
1065	zsums4tl = zsums2tl + zsums1tl - zsumstl - zsums3tl
1066
1067	! Temperature and Salinity at West gibraltar , Level 22
1068	DO jj = mj0(102), mj1(102)
1069	DO ji = mi0(140), mi1(140)
1070	zt = zsumt4 / ( zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) )
1071	zs = zsums4 / ( zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) )
1072	zttl = zsumt4tl / ( zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) ) &
1073	& - zsumt4 / ( 2 * zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) ) * zu2_ms_tl(22)
1074	zstl = zsums4tl / ( zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) ) &
1075	& - zsums4 / ( 2 * zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) ) * zu2_ms_tl(22)
1076	END DO
1077	END DO
1078
1079	! New Temperature and Salinity trend at West Gibraltar
1080	! ----------------------------------------------------
1081
1082	! south point
1083	DO jk = 1, 22
1084	DO jj = mj0(101), mj1(101)
1085	DO ji = mi0(139), mi1(139)
1086	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
1087	zsu = e2u(ji,jj) * fse3u(ji,jj,jk)
1088	ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) &
1089	& - ( 1. / zvt ) * zsu * zu1_ms_tl(jk) * tn(ji,jj,jk) &
1090	& - ( 1. / zvt ) * zsu * zu1_ms(jk) * tn_tl(ji,jj,jk)
1091	sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) &
1092	& - ( 1. / zvt ) * zsu * zu1_ms_tl(jk) * sn(ji,jj,jk) &
1093	& - ( 1. / zvt ) * zsu * zu1_ms(jk) * sn_tl(ji,jj,jk)
1094	END DO
1095	END DO
1096	END DO
1097
1098	! north point
1099	DO jk = 15, 20
1100	DO jj = mj0(102), mj1(102)
1101	DO ji = mi0(139), mi1(139)
1102	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
1103	zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
1104	ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) &
1105	& - ( 1. / zvt ) * zsu * zu2_ms_tl(jk) * tn(ji, jj-1,jk) &
1106	& - ( 1. / zvt ) * zsu * zu2_ms(jk) * tn_tl(ji, jj-1,jk)
1107	sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) &
1108	& - ( 1. / zvt ) * zsu * zu2_ms_tl(jk) * sn(ji, jj-1,jk) &
1109	& - ( 1. / zvt ) * zsu * zu2_ms(jk) * sn_tl(ji, jj-1,jk)
1110	END DO
1111	END DO
1112	END DO
1113
1114	! Gibraltar outflow, north point deeper
1115	jk = 22
1116	DO jj = mj0(102), mj1(102)
1117	DO ji = mi0(139), mi1(139)
1118	zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
1119	zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
1120	ta_tl(ji, jj,jk) = ta_tl(ji, jj,jk) &
1121	& - ( 1. / zvt ) * zsu * zu2_ms_tl(jk) * zt &
1122	& - ( 1. / zvt ) * zsu * zu2_ms(jk) * zttl
1123	sa_tl(ji, jj,jk) = sa_tl(ji, jj,jk) &
1124	& - ( 1. / zvt ) * zsu * zu2_ms_tl(jk) * zs &
1125	& - ( 1. / zvt ) * zsu * zu2_ms(jk) * zstl
1126	END DO
1127	END DO
1128
1129
1130	! New Temperature and Salinity at East Gibraltar
1131	! ----------------------------------------------
1132
1133	! surface
1134	DO jk = 1, 14
1135	DO jj = mj0(102), mj1(102)
1136	DO ji = mi0(141), mi1(141)
1137	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
1138	zsu = e2u(ji-1,jj) * fse3u(ji-2,jj,jk)
1139	ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) &
1140	& + ( 1. / zvt ) * zsu * zu3_ms_tl(jk) * tn(ji-2,jj-1,jk) &
1141	& + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn_tl(ji-2,jj-1,jk)
1142	sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) &
1143	& + ( 1. / zvt ) * zsu * zu3_ms_tl(jk) * sn(ji-2,jj-1,jk) &
1144	& + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn_tl(ji-2,jj-1,jk)
1145	END DO
1146	END DO
1147	END DO
1148	! deeper
1149	jk = 21
1150	DO jj = mj0(102), mj1(102)
1151	DO ji = mi0(141), mi1(141)
1152	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
1153	zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
1154	ta_tl(ji,jj,jk) = ta_tl(ji,jj,jk) &
1155	& + ( 1. / zvt ) * zsu * zu3_ms_tl(jk) * tn(ji,jj,jk) &
1156	& + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn_tl(ji,jj,jk)
1157	sa_tl(ji,jj,jk) = sa_tl(ji,jj,jk) &
1158	& + ( 1. / zvt ) * zsu * zu3_ms_tl(jk) * sn(ji,jj,jk) &
1159	& + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn_tl(ji,jj,jk)
1160	END DO
1161	END DO
1162
1163	END SUBROUTINE tra_gibraltar_tan
1164	SUBROUTINE tra_gibraltar_adj
1165	!!---------------------------------------------------------------------
1166	!! * ROUTINE tra_gibraltar_adj *
1167	!!
1168	!! ** Purpose :
1169	!! Update the horizontal advective trend of tracers (t & s)
1170	!! correction in Gibraltar and
1171	!! add it to the general trend of tracer equations.
1172	!!
1173	!! ** Method :
1174	!! We impose transport at Gibraltar and knowing T and S in
1175	!! surface and deeper at each side of the strait, we deduce T and S
1176	!! of the outflow of the Mediterranean Sea in the Atlantic ocean .
1177	!!
1178	!! ________________ N ________________
1179	!! 102 \| \|-> \| <-\| \|<-
1180	!! 101 ___->\|____\|_____ W - - E ___->\|____\|_____
1181	!! 139 140 141 \| 139 140 141
1182	!! horizontal view S horizontal view
1183	!! surface depth
1184	!! C A U T I O N : the trend saved is the centered trend only.
1185	!! It doesn't take into account the upstream part of the scheme.
1186	!!
1187	!! ** history :
1188	!! ! 02-06 (A. Bozec) Original code
1189	!! 8.5 ! 02-11 (A. Bozec) F90: Free form and module
1190	!! ** history of the adjoint routine:
1191	!! ! 08-08 (A. Vidard) tangent of the 02-11 version
1192	!!---------------------------------------------------------------------
1193	!! * Local declarations
1194	INTEGER :: ji, jj, jk ! dummy loop indices
1195	REAL(wp) :: zsu, zvt
1196	REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4
1197	REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4
1198	REAL(wp) :: zsumtad, zsumt1ad, zsumt2ad, zsumt3ad, zsumt4ad
1199	REAL(wp) :: zsumsad, zsums1ad, zsums2ad, zsums3ad, zsums4ad
1200	REAL(wp) :: zt, zs
1201	REAL(wp) :: ztad, zsad
1202	REAL(wp) :: zwei
1203	REAL(wp), DIMENSION (jpk) :: zu1_ms, zu2_ms, zu3_ms
1204	REAL(wp), DIMENSION (jpk) :: zu1_ms_ad, zu2_ms_ad, zu3_ms_ad
1205	!!---------------------------------------------------------------------
1206
1207	! Initialization of vertical sum for T and S transport
1208	! ----------------------------------------------------
1209
1210	zsumt = 0.e0 ! West Gib. surface south point ( T )
1211	zsums = 0.e0 ! West Gib. surface south point ( S )
1212	zsumt1 = 0.e0 ! East Gib. surface north point ( T )
1213	zsums1 = 0.e0 ! East Gib. surface north point ( S )
1214	zsumt2 = 0.e0 ! East Gib. depth north point ( T )
1215	zsums2 = 0.e0 ! East Gib. depth north point ( S )
1216	zsumt3 = 0.e0 ! West Gib. depth south point ( T )
1217	zsums3 = 0.e0 ! West Gib. depth south point ( S )
1218	zsumt4 = 0.e0 ! West Gib. depth north point ( T )
1219	zsums4 = 0.e0 ! West Gib. depth north point ( S )
1220	zsumtad = 0.e0 ! West Gib. surface south point ( T )
1221	zsumsad = 0.e0 ! West Gib. surface south point ( S )
1222	zsumt1ad = 0.e0 ! East Gib. surface north point ( T )
1223	zsums1ad = 0.e0 ! East Gib. surface north point ( S )
1224	zsumt2ad = 0.e0 ! East Gib. depth north point ( T )
1225	zsums2ad = 0.e0 ! East Gib. depth north point ( S )
1226	zsumt3ad = 0.e0 ! West Gib. depth south point ( T )
1227	zsums3ad = 0.e0 ! West Gib. depth south point ( S )
1228	zsumt4ad = 0.e0 ! West Gib. depth north point ( T )
1229	zsums4ad = 0.e0 ! West Gib. depth north point ( S )
1230	ztad = 0.e0
1231	zsad = 0.e0
1232	zu1_ms_ad(:) = 0.0_wp
1233	zu2_ms_ad(:) = 0.0_wp
1234	zu3_ms_ad(:) = 0.0_wp
1235	zempmed_ad = 0.e0
1236
1237	!=====================
1238	! Direct recomputation
1239	!=====================
1240
1241	! EMP of Mediterranean Sea
1242	! ------------------------
1243
1244	zempmed = 0.e0
1245	zwei = 0.e0
1246	DO jj = mj0(96),mj1(110)
1247	DO ji = mi0(141),mi1(181)
1248	zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
1249	zempmed = zempmed + emp(ji,jj) * zwei
1250	END DO
1251	END DO
1252	IF( lk_mpp ) CALL mpp_sum( zempmed ) ! sum with other processors value
1253
1254
1255	! minus 2 points in Red Sea and 3 in Atlantic ocean
1256	DO jj = mj0(96),mj1(96)
1257	DO ji = mi0(148),mi1(148)
1258	zempmed = zempmed - emp(ji ,jj) * tmask(ji ,jj,1) * e1t(ji ,jj) * e2t(ji ,jj) &
1259	- emp(ji+1,jj) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)
1260	END DO
1261	END DO
1262
1263	! convert in m3
1264	zempmed = zempmed * 1.e-3
1265
1266	! Velocity profile at each point
1267	! ------------------------------
1268
1269	zu1_ms(:) = zu1_ms_i(:)
1270	zu2_ms(:) = zu2_ms_i(:)
1271	zu3_ms(:) = zu3_ms_i(:)
1272
1273	! velocity profile at 139,101 South point + emp on surface
1274	DO jk = 1, 14
1275	DO jj = mj0(102), mj1(102)
1276	DO ji = mi0(140), mi1(140)
1277	zu1_ms(jk) = zu1_ms(jk) + ( zempmed / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) )
1278	END DO
1279	END DO
1280	END DO
1281
1282	! profile at East Gibraltar
1283	! velocity profile at 141,102 + emp on surface
1284	DO jk = 1, 14
1285	DO jj = mj0(102), mj1(102)
1286	DO ji = mi0(140), mi1(140)
1287	zu3_ms(jk) = zu3_ms(jk) + ( zempmed / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
1288	END DO
1289	END DO
1290	END DO
1291
1292	! Balance of temperature and salinity
1293	! -----------------------------------
1294
1295	! west gibraltar surface vertical sum of transport* S,T
1296	DO jk = 1, 14
1297	DO jj = mj0(101), mj1(101)
1298	DO ji = mi0(139), mi1(139)
1299	zsumt = zsumt + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)
1300	zsums = zsums + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)
1301	END DO
1302	END DO
1303	END DO
1304
1305	! east Gibraltar surface vertical sum of transport* S,T
1306	DO jk = 1, 14
1307	DO jj = mj0(101), mj1(101)
1308	DO ji = mi0(139), mi1(139)
1309	zsumt1 = zsumt1 + tn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk)
1310	zsums1 = zsums1 + sn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk)
1311	END DO
1312	END DO
1313	END DO
1314
1315	! east Gibraltar deeper vertical sum of transport* S,T
1316	DO jj = mj0(102), mj1(102)
1317	DO ji = mi0(141), mi1(141)
1318	zsumt2 = tn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21)
1319	zsums2 = sn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21)
1320	END DO
1321	END DO
1322
1323	! west Gibraltar deeper vertical sum of transport* S,T
1324	DO jk = 21, 22
1325	DO jj = mj0(101), mj1(101)
1326	DO ji = mi0(139), mi1(139)
1327	zsumt3 = zsumt3 + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)
1328	zsums3 = zsums3 + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)
1329	END DO
1330	END DO
1331	END DO
1332
1333	! Total transport = 0.
1334	zsumt4 = zsumt2 + zsumt1 - zsumt - zsumt3
1335	zsums4 = zsums2 + zsums1 - zsums - zsums3
1336
1337	! Temperature and Salinity at West gibraltar , Level 22
1338	DO jj = mj0(102), mj1(102)
1339	DO ji = mi0(140), mi1(140)
1340	zt = zsumt4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) )
1341	zs = zsums4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) )
1342	END DO
1343	END DO
1344
1345	!=============
1346	! Adjoint part
1347	!=============
1348
1349	! New Temperature and Salinity at East Gibraltar
1350	! ----------------------------------------------
1351
1352	! deeper
1353	jk = 21
1354	DO jj = mj0(102), mj1(102)
1355	DO ji = mi1(141), mi0(141), -1
1356	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
1357	zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
1358	zu3_ms_ad(jk) = zu3_ms_ad(jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * sn(ji,jj,jk)
1359	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu3_ms(jk)
1360	zu3_ms_ad(jk) = zu3_ms_ad(jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * tn(ji,jj,jk)
1361	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu3_ms(jk)
1362	END DO
1363	END DO
1364
1365	! surface
1366	DO jk = 14, 1, -1
1367	DO jj = mj1(102), mj0(102), -1
1368	DO ji = mi1(141), mi0(141), -1
1369	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
1370	zsu = e2u(ji-1,jj) * fse3u(ji-2,jj,jk)
1371	zu3_ms_ad(jk) = zu3_ms_ad(jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * sn(ji-2,jj-1,jk)
1372	sn_ad(ji-2,jj-1,jk) = sn_ad(ji-2,jj-1,jk) + sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu3_ms(jk)
1373	zu3_ms_ad(jk) = zu3_ms_ad(jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * tn(ji-2,jj-1,jk)
1374	tn_ad(ji-2,jj-1,jk) = tn_ad(ji-2,jj-1,jk) + ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu3_ms(jk)
1375	END DO
1376	END DO
1377	END DO
1378
1379	! New Temperature and Salinity trend at West Gibraltar
1380	! ----------------------------------------------------
1381	! Gibraltar outflow, north point deeper
1382	jk = 22
1383	DO jj = mj0(102), mj1(102)
1384	DO ji = mi0(139), mi1(139)
1385	zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
1386	zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
1387	zu2_ms_ad(jk) = zu2_ms_ad(jk) - sa_ad(ji, jj,jk) * ( 1. / zvt ) * zsu * zs
1388	zsad = zsad - sa_ad(ji, jj,jk) * ( 1. / zvt ) * zsu * zu2_ms(jk)
1389	zu2_ms_ad(jk) = zu2_ms_ad(jk) - ta_ad(ji, jj,jk) * ( 1. / zvt ) * zsu * zt
1390	ztad = ztad - ta_ad(ji, jj,jk) * ( 1. / zvt ) * zsu * zu2_ms(jk)
1391	END DO
1392	END DO
1393	! north point
1394	DO jk = 20, 15, -1
1395	DO jj = mj1(102), mj0(102), -1
1396	DO ji = mi1(139), mi0(139), -1
1397	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
1398	zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
1399	zu2_ms_ad(jk) = zu2_ms_ad(jk) - sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * sn(ji, jj-1,jk)
1400	sn_ad(ji, jj-1,jk) = sn_ad(ji, jj-1,jk) - sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu2_ms(jk)
1401	zu2_ms_ad(jk) = zu2_ms_ad(jk) - ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * tn(ji, jj-1,jk)
1402	tn_ad(ji, jj-1,jk) = tn_ad(ji, jj-1,jk) - ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu2_ms(jk)
1403	END DO
1404	END DO
1405	END DO
1406	! south point
1407	DO jk = 22, 1, -1
1408	DO jj = mj0(101), mj1(101)
1409	DO ji = mi0(139), mi1(139)
1410	zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
1411	zsu = e2u(ji,jj) * fse3u(ji,jj,jk)
1412	zu1_ms_ad(jk) = zu1_ms_ad(jk) - sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * sn(ji,jj,jk)
1413	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) - sa_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu1_ms(jk)
1414	zu1_ms_ad(jk) = zu1_ms_ad(jk) - ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * tn(ji,jj,jk)
1415	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) - ta_ad(ji,jj,jk) * ( 1. / zvt ) * zsu * zu1_ms(jk)
1416	END DO
1417	END DO
1418	END DO
1419
1420
1421	! Balance of temperature and salinity
1422	! -----------------------------------
1423
1424	! Temperature and Salinity at West gibraltar , Level 22
1425	DO jj = mj0(102), mj1(102)
1426	DO ji = mi1(140), mi0(140), -1
1427	zsums4ad = zsums4ad &
1428	& + zsad / ( zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) )
1429	zu2_ms_ad(22) = zu2_ms_ad(22) &
1430	& - zsad * zsums4 / ( 2 * zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) )
1431	zsumt4ad = zsumt4ad &
1432	& + ztad / ( zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) )
1433	zu2_ms_ad(22) = zu2_ms_ad(22) &
1434	& - ztad * zsumt4 / ( 2 * zu2_ms(22) * e2u(ji-1,jj) * fse3u(ji-1,jj,22) )
1435	ztad = 0.0_wp
1436	zsad = 0.0_wp
1437	END DO
1438	END DO
1439
1440	! Total transport = 0.
1441	zsums2ad = zsums2ad + zsums4ad
1442	zsums1ad = zsums1ad + zsums4ad
1443	zsumsad = zsumsad - zsums4ad
1444	zsums3ad = zsums3ad - zsums4ad
1445	zsumt2ad = zsumt2ad + zsumt4ad
1446	zsumt1ad = zsumt1ad + zsumt4ad
1447	zsumtad = zsumtad - zsumt4ad
1448	zsumt3ad = zsumt3ad - zsumt4ad
1449	zsumt4ad = 0.0
1450	zsums4ad = 0.0
1451
1452	! west Gibraltar deeper vertical sum of transport* S,T
1453	DO jk = 22, 21, -1
1454	DO jj = mj0(101), mj1(101)
1455	DO ji = mi0(139), mi1(139)
1456	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) + zsums3ad * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk)
1457	zu1_ms_ad(jk) = zu1_ms_ad(jk) + zsums3ad * e2u(ji,jj) * fse3u(ji,jj,jk) * sn(ji,jj,jk)
1458	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) + zsumt3ad * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk)
1459	zu1_ms_ad(jk) = zu1_ms_ad(jk) + zsumt3ad * e2u(ji,jj) * fse3u(ji,jj,jk) * tn(ji,jj,jk)
1460	END DO
1461	END DO
1462	END DO
1463
1464	! east Gibraltar deeper vertical sum of transport* S,T
1465	DO jj = mj0(102), mj1(102)
1466	DO ji = mi1(141), mi0(141), -1
1467	sn_ad(ji,jj,21) = sn_ad(ji,jj,21) + zsums2ad * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * zu3_ms(21)
1468	zu3_ms_ad(21) = zu3_ms_ad(21) + zsums2ad * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * sn(ji,jj,21)
1469	tn_ad(ji,jj,21) = tn_ad(ji,jj,21) + zsumt2ad * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * zu3_ms(21)
1470	zu3_ms_ad(21) = zu3_ms_ad(21) + zsumt2ad * e2u(ji-1,jj) * fse3u(ji-1,jj,21) * tn(ji,jj,21)
1471	zsumt2ad = 0.0_wp
1472	zsums2ad = 0.0_wp
1473	END DO
1474	END DO
1475
1476	! east Gibraltar surface vertical sum of transport* S,T
1477	DO jk = 14, 1, -1
1478	DO jj = mj1(101), mj0(101), -1
1479	DO ji = mi1(139), mi0(139), - 1
1480	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) + zsums1ad * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * zu3_ms(jk)
1481	zu3_ms_ad(jk) = zu3_ms_ad(jk) + zsums1ad * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * sn(ji,jj,jk)
1482	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) + zsumt1ad * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * zu3_ms(jk)
1483	zu3_ms_ad(jk) = zu3_ms_ad(jk) + zsumt1ad * e2u(ji+1,jj+1) * fse3u(ji+1,jj+1,jk) * tn(ji,jj,jk)
1484	END DO
1485	END DO
1486	END DO
1487
1488	! west gibraltar surface vertical sum of transport* S,T
1489	DO jk = 14, 1, -1
1490	DO jj = mj0(101), mj1(101)
1491	DO ji = mi0(139), mi1(139)
1492	sn_ad(ji,jj,jk) = sn_ad(ji,jj,jk) + zsumsad * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk)
1493	zu1_ms_ad(jk) = zu1_ms_ad(jk) + zsumsad * e2u(ji,jj) * fse3u(ji,jj,jk) * sn(ji,jj,jk)
1494	tn_ad(ji,jj,jk) = tn_ad(ji,jj,jk) + zsumtad * e2u(ji,jj) * fse3u(ji,jj,jk) * zu1_ms(jk)
1495	zu1_ms_ad(jk) = zu1_ms_ad(jk) + zsumtad * e2u(ji,jj) * fse3u(ji,jj,jk) * tn(ji,jj,jk)
1496	END DO
1497	END DO
1498	END DO
1499	! Velocity profile at each point
1500	! ------------------------------
1501	! profile at East Gibraltar
1502	! velocity profile at 141,102 + emp on surface
1503	DO jk = 14, 1, -1
1504	DO jj = mj0(102), mj1(102)
1505	DO ji = mi0(140), mi1(140)
1506	zempmed_ad = zempmed_ad + zu3_ms_ad(jk) / ( 14. * e2u(ji,jj) * fse3u(ji,jj,jk) )
1507	END DO
1508	END DO
1509	END DO
1510
1511	! velocity profile at 139,101 South point + emp on surface
1512	DO jk = 14, 1, -1
1513	DO jj = mj1(102), mj0(102), -1
1514	DO ji = mi1(140), mi0(140), -1
1515	zempmed_ad = zempmed_ad + zu1_ms_ad(jk) / ( 14. * e2u(ji-1,jj-1) * fse3u(ji-1,jj-1,jk) )
1516	END DO
1517	END DO
1518	END DO
1519
1520	zu1_ms_ad(:) = 0.0_wp
1521	zu2_ms_ad(:) = 0.0_wp
1522	zu3_ms_ad(:) = 0.0_wp
1523
1524	! EMP of Mediterranean Sea
1525	! ------------------------
1526
1527	! convert in m3
1528	zempmed_ad = zempmed_ad * 1.e-3
1529
1530	! minus 2 points in Red Sea and 3 in Atlantic ocean
1531	DO jj = mj1(96), mj0(96), -1
1532	DO ji = mi1(148), mi0(148), -1
1533	emp_ad(ji ,jj) = emp_ad(ji ,jj) - zempmed_ad * tmask(ji ,jj,1) * e1t(ji ,jj) * e2t(ji ,jj)
1534	emp_ad(ji+1,jj) = emp_ad(ji+1,jj) - zempmed_ad * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)
1535	END DO
1536	END DO
1537
1538	IF( lk_mpp ) CALL mpp_sum( zempmed_ad ) ! sum with other processors value
1539
1540	DO jj = mj0(96), mj1(110)
1541	DO ji = mi0(141), mi1(181)
1542	zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
1543	emp_ad(ji,jj) = emp_ad(ji,jj) + zempmed_ad * zwei
1544	END DO
1545	END DO
1546	zempmed_ad = 0.e0
1547
1548
1549	END SUBROUTINE tra_gibraltar_adj
1550	SUBROUTINE tra_hormuz_tan
1551	!!---------------------------------------------------------------------
1552	!! * ROUTINE tra_hormuz_tan *
1553	!!
1554	!! ** Purpose of the direct routine:
1555	!! Update the horizontal advective trend of tracers
1556	!! correction in Hormuz.
1557	!!
1558	!! ** Method of the direct routine: We impose transport at Hormuz .
1559	!!
1560	!! ** history of the direct routine:
1561	!! ! 02-11 (A. Bozec) Original code
1562	!! 8.5 ! 02-11 (A. Bozec) F90: Free form and module
1563	!! ** history of the tangent routine:
1564	!! ! 08-08 (A. Vidard) tangent of the 02-11 version
1565	!!---------------------------------------------------------------------
1566	!! * Local declarations
1567	!!---------------------------------------------------------------------
1568
1569	!! ... nothing
1570
1571	END SUBROUTINE tra_hormuz_tan
1572	SUBROUTINE tra_hormuz_adj
1573	!!---------------------------------------------------------------------
1574	!! * ROUTINE tra_hormuz_adj *
1575	!!
1576	!! ** Purpose of the direct routine:
1577	!! Update the horizontal advective trend of tracers
1578	!! correction in Hormuz.
1579	!!
1580	!! ** Method of the direct routine: We impose transport at Hormuz .
1581	!!
1582	!! ** history of the direct routine:
1583	!! ! 02-11 (A. Bozec) Original code
1584	!! 8.5 ! 02-11 (A. Bozec) F90: Free form and module
1585	!! ** history of the tangent routine:
1586	!! ! 08-08 (A. Vidard) adjoint of the 02-11 version
1587	!!---------------------------------------------------------------------
1588	!! * Local declarations
1589	!!---------------------------------------------------------------------
1590
1591	!! ... nothing
1592
1593	END SUBROUTINE tra_hormuz_adj
1594	SUBROUTINE tra_cla_init_tam
1595	!!---------------------------------------------------------------------
1596	!! * ROUTINE tra_cla_init_tam *
1597	!!
1598	!! ** Purpose : Initialization of variables
1599	!!
1600	!! ** history :
1601	!! ! 02-11 (A. Bozec) Original code
1602	!! 8.5 ! 02-11 (A. Bozec) F90: Free form and module
1603	!! ** history of the tam version:
1604	!! 9.0 ! 08-08 (A. Vidard) Original code
1605	!!---------------------------------------------------------------------
1606	!! * Local declarations
1607	INTEGER :: ji, jj, jk ! dummy loop indices
1608	!!---------------------------------------------------------------------
1609
1610	! Control print
1611	! -------------
1612	IF (lfirst) THEN
1613	IF(lwp) WRITE(numout,*)
1614	IF(lwp) WRITE(numout,*) 'tra_cla_init_tam : cross land advection on tracer '
1615	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
1616
1617	! Initialization at Bab el Mandeb
1618	! -------------------------------
1619
1620	! imposed transport
1621	zisw_rs = 0.4e6 ! inflow surface water
1622	zurw_rs = 0.2e6 ! upper recirculation water
1623	!!Alex zbrw_rs = 1.2e6 ! bottom recirculation water
1624	zbrw_rs = 0.5e6 ! bottom recirculation water
1625
1626	! initialization of the velocity at Bab el Mandeb
1627	zu1_rs_i(:) = 0.e0 ! velocity profile at 161,88 South point
1628	zu2_rs_i(:) = 0.e0 ! velocity profile at 161,87 North point
1629	zu3_rs_i(:) = 0.e0 ! velocity profile at 160,88 East point
1630
1631	! velocity profile at 161,88 East Bab el Mandeb North point
1632	! we imposed zisw_rs + EMP above the Red Sea
1633	DO jk = 1, 8
1634	DO jj = mj0(88), mj1(88)
1635	DO ji = mi0(160), mi1(160)
1636	zu1_rs_i(jk) = -( zisw_rs / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
1637	END DO
1638	END DO
1639	END DO
1640
1641	! recirculation water
1642	DO jj = mj0(88), mj1(88)
1643	DO ji = mi0(160), mi1(160)
1644	zu1_rs_i(20) = -( zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,20) )
1645	zu1_rs_i(21) = -( zbrw_rs - zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) )
1646	END DO
1647	END DO
1648
1649	! velocity profile at 161,87 East Bab el Mandeb South point
1650	DO jj = mj0(87), mj1(87)
1651	DO ji = mi0(160), mi1(160)
1652	zu2_rs_i(21) = ( zbrw_rs + zisw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) )
1653	END DO
1654	END DO
1655
1656	! velocity profile at 161, 88 West Bab el Mandeb
1657	! we imposed zisw_rs + EMP above the Red Sea
1658	DO jk = 1, 10
1659	DO jj = mj0(88), mj1(88)
1660	DO ji = mi0(160), mi1(160)
1661	zu3_rs_i(jk) = ( zisw_rs / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
1662	END DO
1663	END DO
1664	END DO
1665
1666	! deeper
1667	DO jj = mj0(88), mj1(88)
1668	DO ji = mi0(160), mi1(160)
1669	zu3_rs_i(16) = - zisw_rs /( e1v(ji,jj) * fse3v(ji,jj,16) )
1670	END DO
1671	END DO
1672
1673
1674	! Initialization at Gibraltar
1675	! ---------------------------
1676
1677	! imposed transport
1678	zisw_ms = 0.8e6 ! atlantic-mediterranean water
1679	zmrw_ms = 0.7e6 ! middle recirculation water
1680	zurw_ms = 2.5e6 ! upper recirculation water
1681	zbrw_ms = 3.5e6 ! bottom recirculation water
1682
1683	! initialization of the velocity
1684	zu1_ms_i(:) = 0.e0 ! velocity profile at 139,101 South point
1685	zu2_ms_i(:) = 0.e0 ! velocity profile at 139,102 North point
1686	zu3_ms_i(:) = 0.e0 ! velocity profile at 141,102 East point
1687
1688	! velocity profile at 139,101 South point
1689	DO jk = 1, 14
1690	DO jj = mj0(102), mj1(102)
1691	DO ji = mi0(140), mi1(140)
1692	zu1_ms_i(jk) = ( zisw_ms / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk))
1693	END DO
1694	END DO
1695	END DO
1696
1697	! middle recirculation ( uncounting in the balance )
1698	DO jk = 15, 20
1699	DO jj = mj0(102), mj1(102)
1700	DO ji = mi0(140), mi1(140)
1701	zu1_ms_i(jk) = ( zmrw_ms / 6. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) )
1702	END DO
1703	END DO
1704	END DO
1705
1706	DO jj = mj0(102), mj1(102)
1707	DO ji = mi0(140), mi1(140)
1708	zu1_ms_i(21) = ( zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,21) )
1709	zu1_ms_i(22) = ( zbrw_ms - zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,22) )
1710	END DO
1711	END DO
1712
1713	! velocity profile at 139,102 North point
1714	! middle recirculation ( uncounting in the balance )
1715	DO jk = 15, 20
1716	DO jj = mj0(102), mj1(102)
1717	DO ji = mi0(140), mi1(140)
1718	zu2_ms_i(jk) = -( zmrw_ms / 6. ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,jk) )
1719	END DO
1720	END DO
1721	END DO
1722
1723	DO jj = mj0(102), mj1(102)
1724	DO ji = mi0(140), mi1(140)
1725	zu2_ms_i(22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,22) )
1726	END DO
1727	END DO
1728
1729	! profile at East Gibraltar
1730	! velocity profile at 141,102
1731	DO jk = 1, 14
1732	DO jj = mj0(102), mj1(102)
1733	DO ji = mi0(140), mi1(140)
1734	zu3_ms_i(jk) = ( zisw_ms / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
1735	END DO
1736	END DO
1737	END DO
1738
1739	! deeper
1740	DO jj = mj0(102), mj1(102)
1741	DO ji = mi0(140), mi1(140)
1742	zu3_ms_i(21) = -zisw_ms / ( e2u(ji, jj) * fse3u(ji, jj,21) )
1743	END DO
1744	END DO
1745	lfirst = .FALSE.
1746	END IF
1747
1748
1749	END SUBROUTINE tra_cla_init_tam
1750	SUBROUTINE tra_cla_adj_tst( kumadt )
1751	!!-----------------------------------------------------------------------
1752	!!
1753	!! * ROUTINE dyn_adv_adj_tst *
1754	!!
1755	!! ** Purpose : Test the adjoint routine.
1756	!!
1757	!! ** Method : Verify the scalar product
1758	!!
1759	!! ( L dx )^T W dy = dx^T L^T W dy
1760	!!
1761	!! where L = tangent routine
1762	!! L^T = adjoint routine
1763	!! W = diagonal matrix of scale factors
1764	!! dx = input perturbation (random field)
1765	!! dy = L dx
1766	!!
1767	!!
1768	!! History :
1769	!! ! 08-08 (A. Vidard)
1770	!!-----------------------------------------------------------------------
1771	!! * Modules used
1772
1773	!! * Arguments
1774	INTEGER, INTENT(IN) :: &
1775	& kumadt ! Output unit
1776
1777	INTEGER :: & ! dummy loop indices
1778	& ji, &
1779	& jj, &
1780	& jk, &
1781	& jt, &
1782	& jii, &
1783	& jis, &
1784	& jji, &
1785	& jjs, &
1786	& jpert
1787	INTEGER, DIMENSION(jpi,jpj) :: &
1788	& iseed_2d ! 2D seed for the random number generator
1789
1790	!! * Local declarations
1791	REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: &
1792	& ztn_tlin, & ! potential temperature
1793	& zsn_tlin, & ! salinity
1794	& zta_tlin, & ! potential temperature
1795	& zsa_tlin, & ! salinity
1796	& zta_tlout, & ! potential temperature
1797	& zsa_tlout, & ! salinity
1798	& ztn_adout, & ! potential temperature
1799	& zsn_adout, & ! salinity
1800	& zta_adout, & ! potential temperature
1801	& zsa_adout, & ! salinity
1802	& zta_adin, & ! potential temperature
1803	& zsa_adin, & ! salinity
1804	& z3r ! 3D random field
1805	REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
1806	& zemp_tlin, & ! evaporation minus precipitation
1807	& zemp_adout, & ! evaporation minus precipitation
1808	& z2r ! 2D random field
1809
1810	REAL(KIND=wp) :: &
1811	& zsp1, & ! scalar product involving the tangent routine
1812	& zsp1_1, & ! scalar product involving the tangent routine
1813	& zsp1_2, & ! scalar product involving the tangent routine
1814	& zsp2, & ! scalar product involving the adjoint routine
1815	& zsp2_1, & ! scalar product involving the adjoint routine
1816	& zsp2_2, & ! scalar product involving the adjoint routine
1817	& zsp2_3, & ! scalar product involving the adjoint routine
1818	& zsp2_4, & ! scalar product involving the adjoint routine
1819	& zsp2_5, & ! scalar product involving the adjoint routine
1820	& z2dt, & ! temporary scalars
1821	& zraur
1822	CHARACTER(LEN=14) :: cl_name
1823
1824	ALLOCATE( &
1825	& ztn_tlin( jpi, jpj, jpk ), &
1826	& zsn_tlin( jpi, jpj, jpk ), &
1827	& zta_tlin( jpi, jpj, jpk ), &
1828	& zsa_tlin( jpi, jpj, jpk ), &
1829	& zta_tlout( jpi, jpj, jpk ), &
1830	& zsa_tlout( jpi, jpj, jpk ), &
1831	& ztn_adout( jpi, jpj, jpk ), &
1832	& zsn_adout( jpi, jpj, jpk ), &
1833	& zta_adout( jpi, jpj, jpk ), &
1834	& zsa_adout( jpi, jpj, jpk ), &
1835	& zta_adin( jpi, jpj, jpk ), &
1836	& zsa_adin( jpi, jpj, jpk ), &
1837	& z3r( jpi, jpj, jpk ), &
1838	& zemp_tlin( jpi, jpj ), &
1839	& zemp_adout( jpi, jpj ), &
1840	& z2r( jpi, jpj ) &
1841	& )
1842
1843	! Initialize constants
1844
1845	z2dt = 2.0_wp * rdt ! time step: leap-frog
1846	zraur = 1.0_wp / rauw ! inverse density of pure water (m3/kg)
1847
1848	!=============================================================
1849	! 1) dx = ( T ) and dy = ( T )
1850	!=============================================================
1851
1852	DO jt = 2, 1, -1
1853	!--------------------------------------------------------------------
1854	! Reset the tangent and adjoint variables
1855	!--------------------------------------------------------------------
1856	ztn_tlin( :,:,:) = 0.0_wp
1857	zsn_tlin( :,:,:) = 0.0_wp
1858	zta_tlin( :,:,:) = 0.0_wp
1859	zsa_tlin( :,:,:) = 0.0_wp
1860	zta_tlout( :,:,:) = 0.0_wp
1861	zsa_tlout( :,:,:) = 0.0_wp
1862	ztn_adout( :,:,:) = 0.0_wp
1863	zsn_adout( :,:,:) = 0.0_wp
1864	zta_adout( :,:,:) = 0.0_wp
1865	zsa_adout( :,:,:) = 0.0_wp
1866	zta_adin( :,:,:) = 0.0_wp
1867	zsa_adin( :,:,:) = 0.0_wp
1868	zemp_tlin( :,: ) = 0.0_wp
1869	zemp_adout(:,: ) = 0.0_wp
1870
1871	SELECT CASE (jt)
1872	CASE(1) ! Bab el Madeb
1873	jji = mj0(86)
1874	jjs = mj1(97)
1875	jii = mi0(147)
1876	jis = mi1(162)
1877	CASE(2) ! Gibraltar
1878	jji = mj0(95)
1879	jjs = mj1(111)
1880	jii = mi0(138)
1881	jis = mi1(182)
1882	END SELECT
1883	!--------------------------------------------------------------------
1884	! Initialize the tangent input with random noise: dx
1885	!--------------------------------------------------------------------
1886	DO jj = 1, jpj
1887	DO ji = 1, jpi
1888	iseed_2d(ji,jj) = - ( 456953 + &
1889	& mig(ji) + ( mjg(jj) - 1 ) * jpiglo )
1890	END DO
1891	END DO
1892	CALL grid_random( iseed_2d, z3r, 'T', 0.0_wp, stdt )
1893	DO jk = 1, jpk
1894	DO jj = nldj, nlej
1895	DO ji = nldi, nlei
1896	ztn_tlin(ji,jj,jk) = z3r(ji,jj,jk)
1897	END DO
1898	END DO
1899	END DO
1900	DO jj = 1, jpj
1901	DO ji = 1, jpi
1902	iseed_2d(ji,jj) = - ( 395703 + &
1903	& mig(ji) + ( mjg(jj) - 1 ) * jpiglo )
1904	END DO
1905	END DO
1906	CALL grid_random( iseed_2d, z3r, 'T', 0.0_wp, stds )
1907	DO jk = 1, jpk
1908	DO jj = nldj, nlej
1909	DO ji = nldi, nlei
1910	zsn_tlin(ji,jj,jk) = z3r(ji,jj,jk)
1911	END DO
1912	END DO
1913	END DO
1914
1915	DO jj = 1, jpj
1916	DO ji = 1, jpi
1917	iseed_2d(ji,jj) = - ( 536782 + &
1918	& mig(ji) + ( mjg(jj) - 1 ) * jpiglo )
1919	END DO
1920	END DO
1921	CALL grid_random( iseed_2d, z3r, 'T', 0.0_wp, stdt )
1922	DO jk = 1, jpk
1923	DO jj = nldj, nlej
1924	DO ji = nldi, nlei
1925	zta_tlin(ji,jj,jk) = z3r(ji,jj,jk)
1926	END DO
1927	END DO
1928	END DO
1929
1930	DO jj = 1, jpj
1931	DO ji = 1, jpi
1932	iseed_2d(ji,jj) = - ( 613925 + &
1933	& mig(ji) + ( mjg(jj) - 1 ) * jpiglo )
1934	END DO
1935	END DO
1936	CALL grid_random( iseed_2d, z3r, 'T', 0.0_wp, stds )
1937	DO jk = 1, jpk
1938	DO jj = nldj, nlej
1939	DO ji = nldi, nlei
1940	zsa_tlin(ji,jj,jk) = z3r(ji,jj,jk)
1941	END DO
1942	END DO
1943	END DO
1944
1945	DO jj = 1, jpj
1946	DO ji = 1, jpi
1947	iseed_2d(ji,jj) = - ( 228401 + &
1948	& mig(ji) + ( mjg(jj) - 1 ) * jpiglo )
1949	END DO
1950	END DO
1951	CALL grid_random( iseed_2d, z2r, 'T', 0.0_wp, stdemp )
1952	DO jj = nldj, nlej
1953	DO ji = nldi, nlei
1954	zemp_tlin(ji,jj) = z2r(ji,jj)
1955	END DO
1956	END DO
1957
1958	zemp_tlin(:,:) = zemp_tlin(:,:) / ( z2dt * zraur )
1959
1960	tn_ad(:,:,:) = 0.0_wp
1961	sn_ad(:,:,:) = 0.0_wp
1962	ta_ad(:,:,:) = 0.0_wp
1963	sa_ad(:,:,:) = 0.0_wp
1964	emp_ad(:,:) = 0.0_wp
1965	tn_tl(:,:,:) = 0.0_wp
1966	sn_tl(:,:,:) = 0.0_wp
1967	ta_tl(:,:,:) = 0.0_wp
1968	sa_tl(:,:,:) = 0.0_wp
1969	emp_tl(:,:) = 0.0_wp
1970
1971
1972	DO jk = 1, jpk
1973	DO jj = jji, jjs
1974	DO ji = jii, jis
1975	tn_tl(ji,jj,jk) = ztn_tlin(ji,jj,jk)
1976	sn_tl(ji,jj,jk) = zsn_tlin(ji,jj,jk)
1977	ta_tl(ji,jj,jk) = zta_tlin(ji,jj,jk)
1978	sa_tl(ji,jj,jk) = zsa_tlin(ji,jj,jk)
1979	emp_tl(ji,jj) = zemp_tlin(ji,jj)
1980	END DO
1981	END DO
1982	END DO
1983	CALL tra_cla_tan ( nit000 )
1984
1985	DO jk = 1, jpk
1986	DO jj = nldj, nlej
1987	DO ji = nldi, nlei
1988	zta_tlout(ji,jj,jk) = ta_tl(ji,jj,jk)
1989	zsa_tlout(ji,jj,jk) = sa_tl(ji,jj,jk)
1990	zta_adin(ji,jj,jk) = zta_tlout(ji,jj,jk) &
1991	& * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)&
1992	& * tmask(ji,jj,jk) * wesp_t(jk)
1993	zsa_adin(ji,jj,jk) = zsa_tlout(ji,jj,jk) &
1994	& * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)&
1995	& * tmask(ji,jj,jk) * wesp_s(jk)
1996	END DO
1997	END DO
1998	END DO
1999
2000	!--------------------------------------------------------------------
2001	! Compute the scalar product: ( L dx )^T W dy
2002	!--------------------------------------------------------------------
2003
2004	zsp1_1 = DOT_PRODUCT( zta_tlout, zta_adin )
2005	zsp1_2 = DOT_PRODUCT( zsa_tlout, zsa_adin )
2006	zsp1 = zsp1_1 + zsp1_2
2007
2008	!--------------------------------------------------------------------
2009	! Call the adjoint routine: dx^* = L^T dy^*
2010	!--------------------------------------------------------------------
2011	DO jk = 1, jpk
2012	DO jj = nldj, nlej
2013	DO ji = nldi, nlei
2014	sa_ad(ji,jj,jk) = zsa_adin(ji,jj,jk)
2015	ta_ad(ji,jj,jk) = zta_adin(ji,jj,jk)
2016	END DO
2017	END DO
2018	END DO
2019	CALL tra_cla_adj ( nit000 )
2020	DO jk = 1, jpk
2021	DO jj = jji, jjs ! tlin should be 0 outside these boundaries but is not by construction
2022	DO ji = jii, jis ! here it would insure that the dot product does not account for it
2023	ztn_adout(ji,jj,jk) = tn_ad(ji,jj,jk)
2024	zsn_adout(ji,jj,jk) = sn_ad(ji,jj,jk)
2025	zta_adout(ji,jj,jk) = ta_ad(ji,jj,jk)
2026	zsa_adout(ji,jj,jk) = sa_ad(ji,jj,jk)
2027	zemp_adout(ji,jj) = emp_ad(ji,jj)
2028	END DO
2029	END DO
2030	END DO
2031
2032	zsp2_1 = DOT_PRODUCT( ztn_tlin , ztn_adout )
2033	zsp2_2 = DOT_PRODUCT( zsn_tlin , zsn_adout )
2034	zsp2_3 = DOT_PRODUCT( zta_tlin , zta_adout )
2035	zsp2_4 = DOT_PRODUCT( zsa_tlin , zsa_adout )
2036	zsp2_5 = DOT_PRODUCT( zemp_tlin, zemp_adout )
2037	zsp2 = zsp2_1 + zsp2_2 + zsp2_3 + zsp2_4 + zsp2_5
2038
2039	! Compare the scalar products
2040
2041	! 14 char:'12345678901234'
2042	SELECT CASE (jt)
2043	CASE(1) ! Bab el Madeb
2044	cl_name = 'tra_cla_adj BM'
2045	CASE(2) ! Gibraltar
2046	cl_name = 'tra_cla_adj Gi'
2047	END SELECT
2048	CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
2049
2050	END DO
2051	! Deallocate memory
2052
2053	DEALLOCATE( &
2054	& ztn_tlin , &
2055	& zsn_tlin , &
2056	& zta_tlin , &
2057	& zsa_tlin , &
2058	& zta_tlout , &
2059	& zsa_tlout , &
2060	& ztn_adout , &
2061	& zsn_adout , &
2062	& zta_adout , &
2063	& zsa_adout , &
2064	& zta_adin , &
2065	& zsa_adin , &
2066	& zemp_tlin , &
2067	& zemp_adout &
2068	& )
2069
2070	END SUBROUTINE tra_cla_adj_tst
2071	!!======================================================================
2072	# else
2073	!!----------------------------------------------------------------------
2074	!! Default option NO cross land advection
2075	!!----------------------------------------------------------------------
2076	USE in_out_manager ! I/O manager
2077	CONTAINS
2078	SUBROUTINE tra_cla_tan( kt )
2079	INTEGER, INTENT(in) :: kt ! ocean time-step indice
2080	IF( kt == nit000 .AND. lwp ) THEN
2081	WRITE(numout,*)
2082	WRITE(numout,*) 'tra_cla_tan : No use of cross land advection'
2083	WRITE(numout,*) '~~~~~~~~~~~'
2084	ENDIF
2085	END SUBROUTINE tra_cla_tan
2086	SUBROUTINE tra_cla_adj( kt )
2087	INTEGER, INTENT(in) :: kt ! ocean time-step indice
2088	IF( kt == nit000 .AND. lwp ) THEN
2089	WRITE(numout,*)
2090	WRITE(numout,*) 'tra_cla_adj : No use of cross land advection'
2091	WRITE(numout,*) '~~~~~~~~~~~'
2092	ENDIF
2093	END SUBROUTINE tra_cla_adj
2094	SUBROUTINE tra_cla_adj_tst( kt )
2095	INTEGER, INTENT(in) :: kt ! ocean time-step indice
2096	IF( kt == nit000 .AND. lwp ) THEN
2097	WRITE(numout,*)
2098	WRITE(numout,*) 'tra_cla_adj_tst : No use of cross land advection'
2099	WRITE(numout,*) '~~~~~~~~~~~'
2100	ENDIF
2101	END SUBROUTINE tra_cla_adj_tst
2102	# endif
2103	#endif
2104	END MODULE cla_tam

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

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

Context Navigation

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/cla_tam.F90 @ 1885

Download in other formats: