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 branches/dev_001_SBC/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: branches/dev_001_SBC/NEMO/OPA_SRC/TRA/traadv_cen2.F90 @ 881

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

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

Download in other formats: