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.

traadv_cen2.F90 in trunk/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/TRA/traadv_cen2.F90 @ 718

Last change on this file since 718 was 717, checked in by smasson, 17 years ago
finalize the first set of modifications related to ticket:3
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 23.0 KB

Rev	Line
[3]	1	MODULE traadv_cen2
[717]	2	!!======================================================================
	3	!! * MODULE traadv_cen2 *
[3]	4	!! Ocean active tracers: horizontal & vertical advective trend
[717]	5	!!======================================================================
	6	!! History : 8.2 ! 01-08 (G. Madec, E. Durand) trahad+trazad=traadv
	7	!! 8.5 ! 02-06 (G. Madec) F90: Free form and module
	8	!! 9.0 ! 04-08 (C. Talandier) New trends organization
	9	!! " " ! 05-11 (V. Garnier) Surface pressure gradient organization
	10	!! " " ! 06-04 (R. Benshila, G. Madec) Step reorganization
	11	!! " " ! 06-07 (G. madec) add ups_orca_set routine
[3]	12	!!----------------------------------------------------------------------
[503]	13
	14	!!----------------------------------------------------------------------
[457]	15	!! tra_adv_cen2 : update the tracer trend with the horizontal and
	16	!! vertical advection trends using a seconder order
	17	!! centered scheme. (k-j-i loops)
[717]	18	!! ups_orca_set : allow mixed upstream/centered scheme in specific
	19	!! area (set for orca 2 and 4 only)
[3]	20	!!----------------------------------------------------------------------
	21	USE oce ! ocean dynamics and active tracers
	22	USE dom_oce ! ocean space and time domain
[708]	23	USE sbc_oce ! surface boundary condition: ocean
	24	USE dynspg_oce ! choice/control of key cpp for surface pressure gradient
	25	USE trdmod_oce ! ocean variables trends
[216]	26	USE trdmod ! ocean active tracers trends
[717]	27	USE closea ! closed sea
[3]	28	USE trabbl ! advective term in the BBL
[74]	29	USE ocfzpt !
[717]	30	USE sbcrnf ! river runoffs
[708]	31	USE in_out_manager ! I/O manager
[3]	32	USE lib_mpp
[74]	33	USE lbclnk ! ocean lateral boundary condition (or mpp link)
[132]	34	USE diaptr ! poleward transport diagnostics
[258]	35	USE prtctl ! Print control
[3]	36
	37	IMPLICIT NONE
	38	PRIVATE
	39
[717]	40	PUBLIC tra_adv_cen2 ! routine called by step.F90
	41	PUBLIC ups_orca_set ! routine used by traadv_cen2_jki.F90
[3]	42
[717]	43	REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: upsmsk !: mixed upstream/centered scheme near some straits
	44	! ! and in closed seas (orca 2 and 4 configurations)
	45
[503]	46	REAL(wp), DIMENSION(jpi,jpj) :: btr2 ! inverse of T-point surface [1/(e1t*e2t)]
	47
[3]	48	!! * Substitutions
	49	# include "domzgr_substitute.h90"
	50	# include "vectopt_loop_substitute.h90"
	51	!!----------------------------------------------------------------------
[717]	52	!! OPA 9.0 , LOCEAN-IPSL (2006)
[699]	53	!! $Id$
[503]	54	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
[3]	55	!!----------------------------------------------------------------------
	56
	57	CONTAINS
	58
[457]	59	SUBROUTINE tra_adv_cen2( kt, pun, pvn, pwn )
[3]	60	!!----------------------------------------------------------------------
	61	!! * ROUTINE tra_adv_cen2 *
	62	!!
	63	!! ** Purpose : Compute the now trend due to the advection of tracers
	64	!! and add it to the general trend of passive tracer equations.
	65	!!
	66	!! ** Method : The advection is evaluated by a second order centered
	67	!! scheme using now fields (leap-frog scheme). In specific areas
	68	!! (vicinity of major river mouths, some straits, or where tn is
[457]	69	!! approaching the freezing point) it is mixed with an upstream
[3]	70	!! scheme for stability reasons.
[457]	71	!! Part 0 : compute the upstream / centered flag
	72	!! (3D array, zind, defined at T-point (0<zind<1))
	73	!! Part I : horizontal advection
	74	!! * centered flux:
[3]	75	!! zcenu = e2u*e3u un mi(tn)
	76	!! zcenv = e1v*e3v vn mj(tn)
[457]	77	!! * upstream flux:
[3]	78	!! zupsu = e2u*e3u un (tb(i) or tb(i-1) ) [un>0 or <0]
	79	!! zupsv = e1v*e3v vn (tb(j) or tb(j-1) ) [vn>0 or <0]
[457]	80	!! * mixed upstream / centered horizontal advection scheme
[3]	81	!! zcofi = max(zind(i+1), zind(i))
	82	!! zcofj = max(zind(j+1), zind(j))
	83	!! zwx = zcofi * zupsu + (1-zcofi) * zcenu
	84	!! zwy = zcofj * zupsv + (1-zcofj) * zcenv
[457]	85	!! * horizontal advective trend (divergence of the fluxes)
[3]	86	!! zta = 1/(e1te2te3t) { di-1[zwx] + dj-1[zwy] }
[457]	87	!! * Add this trend now to the general trend of tracer (ta,sa):
[3]	88	!! (ta,sa) = (ta,sa) + ( zta , zsa )
[457]	89	!! * trend diagnostic ('key_trdtra' defined): the trend is
	90	!! saved for diagnostics. The trends saved is expressed as
	91	!! Uh.gradh(T), i.e.
	92	!! save trend = zta + tn divn
[3]	93	!! In addition, the advective trend in the two horizontal direc-
	94	!! tion is also re-computed as Uh gradh(T). Indeed hadt+tn divn is
	95	!! equal to (in s-coordinates, and similarly in z-coord.):
	96	!! zta+tndivn=1/(e1te2te3t) { mi-1( e2ue3u un di[tn] )
	97	!! +mj-1( e1v*e3v vn mj[tn] ) }
[457]	98	!! NB:in z-coordinate - full step (ln_zco=T) e3u=e3v=e3t, so
	99	!! they vanish from the expression of the flux and divergence.
[3]	100	!!
	101	!! Part II : vertical advection
	102	!! For temperature (idem for salinity) the advective trend is com-
	103	!! puted as follows :
	104	!! zta = 1/e3t dk+1[ zwz ]
	105	!! where the vertical advective flux, zwz, is given by :
	106	!! zwz = zcofk * zupst + (1-zcofk) * zcent
[457]	107	!! with
[3]	108	!! zupsv = upstream flux = wn * (tb(k) or tb(k-1) ) [wn>0 or <0]
	109	!! zcenu = centered flux = wn * mk(tn)
[457]	110	!! The surface boundary condition is :
	111	!! rigid-lid (lk_dynspg_frd = T) : zero advective flux
	112	!! free-surf (lk_dynspg_fsc = T) : wn(:,:,1) * tn(:,:,1)
[3]	113	!! Add this trend now to the general trend of tracer (ta,sa):
	114	!! (ta,sa) = (ta,sa) + ( zta , zsa )
[457]	115	!! Trend diagnostic ('key_trdtra' defined): the trend is
	116	!! saved for diagnostics. The trends saved is expressed as :
[3]	117	!! save trend = w.gradz(T) = zta - tn divn.
	118	!!
[457]	119	!! ** Action : - update (ta,sa) with the now advective tracer trends
[503]	120	!! - save trends in (ztrdt,ztrds) ('key_trdtra')
	121	!!----------------------------------------------------------------------
	122	USE oce, ONLY : zwx => ua ! use ua as workspace
	123	USE oce, ONLY : zwy => va ! use va as workspace
[3]	124	!!
[503]	125	INTEGER , INTENT(in) :: kt ! ocean time-step index
	126	REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pun ! ocean velocity u-component
	127	REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pvn ! ocean velocity v-component
	128	REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pwn ! ocean velocity w-component
	129	!!
	130	INTEGER :: ji, jj, jk ! dummy loop indices
[717]	131	REAL(wp) :: zta, zsa, zbtr, zhw, ze3tr, & ! temporary scalars
	132	& zfp_ui, zfp_vj, zfp_w , zfui , & ! " "
	133	& zfm_ui, zfm_vj, zfm_w , zfvj , & ! " "
	134	& zcofi , zcofj , zcofk , & ! " "
	135	& zupsut, zupsus, zcenut, zcenus, & ! " "
	136	& zupsvt, zupsvs, zcenvt, zcenvs, & ! " "
	137	& zupst , zupss , zcent , zcens , & ! " "
	138	& z_hdivn_x, z_hdivn_y, z_hdivn
	139	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz, ztrdt, zind ! 3D workspace
[503]	140	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zww, ztrds ! " "
[3]	141	!!----------------------------------------------------------------------
	142
	143	IF( kt == nit000 ) THEN
	144	IF(lwp) WRITE(numout,*)
	145	IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme'
	146	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ Vector optimization case'
	147	IF(lwp) WRITE(numout,*)
[717]	148	!
	149	upsmsk(:,:) = 0.e0 ! not upstream by default
	150	IF( cp_cfg == "orca" ) CALL ups_orca_set ! set mixed Upstream/centered scheme near some straits
	151	! ! and in closed seas (orca2 and orca4 only)
	152	!
	153	btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) ! inverse of T-point surface
[3]	154	ENDIF
	155
	156	! Upstream / centered scheme indicator
	157	! ------------------------------------
	158	DO jk = 1, jpk
	159	DO jj = 1, jpj
	160	DO ji = 1, jpi
[717]	161	zind(ji,jj,jk) = MAX ( &
	162	rnfmsk(ji,jj) * rnfmsk_z(jk), & ! near runoff mouths (& closed sea outflows)
	163	upsmsk(ji,jj) & ! some of some straits
[3]	164	#if defined key_ice_lim
[717]	165	! ! below ice covered area (if tn < "freezing"+0.1 )
	166	, MAX( 0., SIGN( 1., fzptn(ji,jj) + 0.1 - tn(ji,jj,jk) ) ) * tmask(ji,jj,jk) &
[3]	167	#endif
	168	& )
	169	END DO
	170	END DO
	171	END DO
	172
[717]	173	! I. Horizontal advective fluxes
	174	! ------------------------------
	175	! Second order centered tracer flux at u and v-points
	176	! -----------------------------------------------------
[3]	177	! ! ===============
	178	DO jk = 1, jpkm1 ! Horizontal slab
	179	! ! ===============
	180	DO jj = 1, jpjm1
	181	DO ji = 1, fs_jpim1 ! vector opt.
	182	! upstream indicator
	183	zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
	184	zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
	185	! volume fluxes * 1/2
[457]	186	#if defined key_zco
	187	zfui = 0.5 * e2u(ji,jj) * pun(ji,jj,jk)
	188	zfvj = 0.5 * e1v(ji,jj) * pvn(ji,jj,jk)
[3]	189	#else
[457]	190	zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
	191	zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
[3]	192	#endif
	193	! upstream scheme
	194	zfp_ui = zfui + ABS( zfui )
	195	zfp_vj = zfvj + ABS( zfvj )
	196	zfm_ui = zfui - ABS( zfui )
	197	zfm_vj = zfvj - ABS( zfvj )
	198	zupsut = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj ,jk)
	199	zupsvt = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji ,jj+1,jk)
	200	zupsus = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj ,jk)
	201	zupsvs = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji ,jj+1,jk)
	202	! centered scheme
	203	zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj ,jk) )
	204	zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji ,jj+1,jk) )
	205	zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj ,jk) )
	206	zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji ,jj+1,jk) )
	207	! mixed centered / upstream scheme
	208	zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut
	209	zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt
	210	zww(ji,jj,jk) = zcofi * zupsus + (1.-zcofi) * zcenus
	211	zwz(ji,jj,jk) = zcofj * zupsvs + (1.-zcofj) * zcenvs
	212	END DO
	213	END DO
	214
[503]	215	! Tracer flux divergence at t-point added to the general trend
	216	! --------------------------------------------------------------
[3]	217	DO jj = 2, jpjm1
	218	DO ji = fs_2, fs_jpim1 ! vector opt.
[457]	219	#if defined key_zco
[503]	220	zbtr = btr2(ji,jj)
[457]	221	#else
[503]	222	zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
[3]	223	#endif
[717]	224	zta = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk) & ! horizontal advective trends
[3]	225	& + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk) )
	226	zsa = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj ,jk) &
	227	& + zwz(ji,jj,jk) - zwz(ji ,jj-1,jk) )
[717]	228	ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add it to the general tracer trends
[3]	229	sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
	230	END DO
	231	END DO
	232	! ! ===============
	233	END DO ! End of slab
	234	! ! ===============
	235
[503]	236	! Save the horizontal advective trends for diagnostic
	237	! -----------------------------------------------------
	238	IF( l_trdtra ) THEN
	239	! T/S ZONAL advection trends
	240	ztrdt(:,:,:) = 0.e0 ; ztrds(:,:,:) = 0.e0
	241	!
	242	DO jk = 1, jpkm1
	243	DO jj = 2, jpjm1
	244	DO ji = fs_2, fs_jpim1 ! vector opt.
	245	!-- Compute zonal divergence by splitting hdivn (see divcur.F90)
	246	! N.B. This computation is not valid along OBCs (if any)
	247	#if defined key_zco
	248	zbtr = btr2(ji,jj)
	249	z_hdivn_x = ( e2u(ji ,jj) * pun(ji ,jj,jk) &
	250	& - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
	251	#else
	252	zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
	253	z_hdivn_x = ( e2u(ji ,jj) * fse3u(ji ,jj,jk) * pun(ji ,jj,jk) &
	254	& - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
	255	#endif
	256	ztrdt(ji,jj,jk) = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x
	257	ztrds(ji,jj,jk) = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x
	258	END DO
	259	END DO
	260	END DO
	261	CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
	262	!
	263	! T/S MERIDIONAL advection trends
	264	DO jk = 1, jpkm1
	265	DO jj = 2, jpjm1
	266	DO ji = fs_2, fs_jpim1 ! vector opt.
	267	!-- Compute merid. divergence by splitting hdivn (see divcur.F90)
	268	! N.B. This computation is not valid along OBCs (if any)
	269	#if defined key_zco
	270	zbtr = btr2(ji,jj)
	271	z_hdivn_y = ( e1v(ji,jj ) * pvn(ji,jj ,jk) &
	272	& - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
	273	#else
	274	zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
	275	z_hdivn_y = ( e1v(ji, jj) * fse3v(ji,jj ,jk) * pvn(ji,jj ,jk) &
	276	& - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
	277	#endif
	278	ztrdt(ji,jj,jk) = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y
	279	ztrds(ji,jj,jk) = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y
	280	END DO
	281	END DO
	282	END DO
	283	CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
	284	!
	285	! Save the horizontal up-to-date ta/sa trends
	286	ztrdt(:,:,:) = ta(:,:,:)
	287	ztrds(:,:,:) = sa(:,:,:)
[216]	288	ENDIF
	289
[457]	290	IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 had - Ta: ', mask1=tmask, &
	291	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3]	292
[717]	293	! "zonal" mean advective heat and salt transport
[132]	294	IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
[457]	295	IF( lk_zco ) THEN
	296	DO jk = 1, jpkm1
	297	DO jj = 2, jpjm1
	298	DO ji = fs_2, fs_jpim1 ! vector opt.
	299	zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)
	300	zwz(ji,jj,jk) = zwz(ji,jj,jk) * fse3v(ji,jj,jk)
	301	END DO
[3]	302	END DO
	303	END DO
[457]	304	ENDIF
[132]	305	pht_adv(:) = ptr_vj( zwy(:,:,:) )
	306	pst_adv(:) = ptr_vj( zwz(:,:,:) )
[3]	307	ENDIF
	308
	309	! II. Vertical advection
	310	! ----------------------
	311
	312	! Bottom value : flux set to zero
	313	zwx(:,:,jpk) = 0.e0 ; zwy(:,:,jpk) = 0.e0
	314
	315	! Surface value
[592]	316	IF( lk_dynspg_rl .OR. lk_vvl ) THEN
	317	! rigid lid or variable volume: flux set to zero
[359]	318	zwx(:,:, 1 ) = 0.e0 ; zwy(:,:, 1 ) = 0.e0
	319	ELSE
	320	! free surface
[457]	321	zwx(:,:, 1 ) = pwn(:,:,1) * tn(:,:,1)
	322	zwy(:,:, 1 ) = pwn(:,:,1) * sn(:,:,1)
[200]	323	ENDIF
[3]	324
[717]	325	! 1. Vertical advective fluxes (Second order centered tracer flux at w-point)
[3]	326	! ----------------------------
	327	DO jk = 2, jpk
	328	DO jj = 2, jpjm1
	329	DO ji = fs_2, fs_jpim1 ! vector opt.
[717]	330	zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) ! upstream indicator
	331	zhw = 0.5 * pwn(ji,jj,jk) ! velocity * 1/2
	332	zfp_w = zhw + ABS( zhw ) ! upstream scheme
[3]	333	zfm_w = zhw - ABS( zhw )
	334	zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1)
	335	zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1)
[717]	336	zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) ! centered scheme
[3]	337	zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) )
[717]	338	zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent ! mixed centered / upstream scheme
[3]	339	zwy(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens
	340	END DO
	341	END DO
	342	END DO
	343
	344	! 2. Tracer flux divergence at t-point added to the general trend
	345	! -------------------------
	346	DO jk = 1, jpkm1
	347	DO jj = 2, jpjm1
	348	DO ji = fs_2, fs_jpim1 ! vector opt.
	349	ze3tr = 1. / fse3t(ji,jj,jk)
[717]	350	zta = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) ! vertical advective trends
[3]	351	zsa = - ze3tr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) )
[717]	352	ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add it to the general tracer trends
[3]	353	sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
	354	END DO
	355	END DO
	356	END DO
	357
[216]	358	! 3. Save the vertical advective trends for diagnostic
	359	! ----------------------------------------------------
	360	IF( l_trdtra ) THEN
	361	! Recompute the vertical advection zta & zsa trends computed
	362	! at the step 2. above in making the difference between the new
[503]	363	! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract
[216]	364	! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends
	365
[503]	366	DO jk = 1, jpkm1
	367	DO jj = 2, jpjm1
	368	DO ji = fs_2, fs_jpim1 ! vector opt.
	369	#if defined key_zco
	370	zbtr = btr2(ji,jj)
	371	z_hdivn_x = e2u(ji,jj)pun(ji,jj,jk) - e2u(ji-1,jj)pun(ji-1,jj,jk)
	372	z_hdivn_y = e1v(ji,jj)pvn(ji,jj,jk) - e1v(ji,jj-1)pvn(ji,jj-1,jk)
	373	#else
	374	zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
	375	z_hdivn_x = e2u(ji,jj)fse3u(ji,jj,jk)pun(ji,jj,jk) - e2u(ji-1,jj)fse3u(ji-1,jj,jk)pun(ji-1,jj,jk)
	376	z_hdivn_y = e1v(ji,jj)fse3v(ji,jj,jk)pvn(ji,jj,jk) - e1v(ji,jj-1)fse3v(ji,jj-1,jk)pvn(ji,jj-1,jk)
	377	#endif
	378	z_hdivn = (z_hdivn_x + z_hdivn_y) * zbtr
	379	ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn
	380	ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
	381	END DO
	382	END DO
	383	END DO
	384	CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
[216]	385	ENDIF
	386
[457]	387	IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 zad - Ta: ', mask1=tmask, &
	388	& tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	389	!
[3]	390	END SUBROUTINE tra_adv_cen2
[717]	391
	392
	393	SUBROUTINE ups_orca_set
	394	!!----------------------------------------------------------------------
	395	!! * ROUTINE ups_orca_set *
	396	!!
	397	!! ** Purpose : add a portion of upstream scheme in area where the
	398	!! centered scheme generates too strong overshoot
	399	!!
	400	!! ** Method : orca (R4 and R2) confiiguration setting. Set upsmsk
	401	!! array to nozero value in some straith.
	402	!!
	403	!! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca
	404	!!----------------------------------------------------------------------
	405	INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers
	406	!!----------------------------------------------------------------------
	407
	408	! mixed upstream/centered scheme near river mouths
	409	! ------------------------------------------------
	410	SELECT CASE ( jp_cfg )
	411	! ! =======================
	412	CASE ( 4 ) ! ORCA_R4 configuration
	413	! ! =======================
	414	! ! Gibraltar Strait
	415	ii0 = 70 ; ii1 = 71
	416	ij0 = 52 ; ij1 = 53 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
	417	!
	418	! ! =======================
	419	CASE ( 2 ) ! ORCA_R2 configuration
	420	! ! =======================
	421	! ! Gibraltar Strait
	422	ij0 = 102 ; ij1 = 102
	423	ii0 = 138 ; ii1 = 138 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20
	424	ii0 = 139 ; ii1 = 139 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
	425	ii0 = 140 ; ii1 = 140 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
	426	ij0 = 101 ; ij1 = 102
	427	ii0 = 141 ; ii1 = 141 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
	428	! ! Bab el Mandeb Strait
	429	ij0 = 87 ; ij1 = 88
	430	ii0 = 164 ; ii1 = 164 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10
	431	ij0 = 88 ; ij1 = 88
	432	ii0 = 163 ; ii1 = 163 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
	433	ii0 = 162 ; ii1 = 162 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
	434	ii0 = 160 ; ii1 = 161 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
	435	ij0 = 89 ; ij1 = 89
	436	ii0 = 158 ; ii1 = 160 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
	437	ij0 = 90 ; ij1 = 90
	438	ii0 = 160 ; ii1 = 160 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
	439	! ! Sound Strait
	440	ij0 = 116 ; ij1 = 116
	441	ii0 = 144 ; ii1 = 144 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
	442	ii0 = 145 ; ii1 = 147 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
	443	ii0 = 148 ; ii1 = 148 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
	444	!
	445	END SELECT
	446
	447	! mixed upstream/centered scheme over closed seas
	448	! -----------------------------------------------
	449	CALL clo_ups( upsmsk(:,:) )
	450	!
	451	END SUBROUTINE ups_orca_set
[3]	452
	453	!!======================================================================
	454	END MODULE traadv_cen2

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

Download in other formats: