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

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

cla.F90 in branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

Context Navigation

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90 @ 2658

Last change on this file since 2658 was 2658, checked in by trackstand2, 13 years ago
Make jpk a variable rather than parameter
Property svn:keywords set to `Id`
File size: 42.5 KB

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

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

Download in other formats: