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 @ 1806

Last change on this file since 1806 was 1559, checked in by ctlod, 15 years ago
only cosmetic changes
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 22.1 KB

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

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

Download in other formats: