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_ubs.F90 in NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_ubs.F90 @ 13660

Last change on this file since 13660 was 13660, checked in by francesca, 4 years ago
communications cleanup of the TRA modules - ticket #2367
Property svn:keywords set to `Id`
File size: 18.9 KB

Rev	Line
[503]	1	MODULE traadv_ubs
	2	!!==============================================================================
	3	!! * MODULE traadv_ubs *
	4	!! Ocean active tracers: horizontal & vertical advective trend
	5	!!==============================================================================
[2528]	6	!! History : 1.0 ! 2006-08 (L. Debreu, R. Benshila) Original code
	7	!! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport
[503]	8	!!----------------------------------------------------------------------
	9
	10	!!----------------------------------------------------------------------
	11	!! tra_adv_ubs : update the tracer trend with the horizontal
	12	!! advection trends using a third order biaised scheme
	13	!!----------------------------------------------------------------------
[3625]	14	USE oce ! ocean dynamics and active tracers
	15	USE dom_oce ! ocean space and time domain
[4990]	16	USE trc_oce ! share passive tracers/Ocean variables
	17	USE trd_oce ! trends: ocean variables
[5836]	18	USE traadv_fct ! acces to routine interp_4th_cpt
[4990]	19	USE trdtra ! trends manager: tracers
	20	USE diaptr ! poleward transport diagnostics
[7646]	21	USE diaar5 ! AR5 diagnostics
[4990]	22	!
[9019]	23	USE iom ! I/O library
[9124]	24	USE in_out_manager ! I/O manager
[9019]	25	USE lib_mpp ! massively parallel library
[3625]	26	USE lbclnk ! ocean lateral boundary condition (or mpp link)
	27	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
[503]	28
	29	IMPLICIT NONE
	30	PRIVATE
	31
	32	PUBLIC tra_adv_ubs ! routine called by traadv module
	33
[7646]	34	LOGICAL :: l_trd ! flag to compute trends
	35	LOGICAL :: l_ptr ! flag to compute poleward transport
	36	LOGICAL :: l_hst ! flag to compute heat transport
[503]	37
[7646]	38
[503]	39	!! * Substitutions
[12377]	40	# include "do_loop_substitute.h90"
[13237]	41	# include "domzgr_substitute.h90"
[503]	42	!!----------------------------------------------------------------------
[9598]	43	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[1152]	44	!! $Id$
[10068]	45	!! Software governed by the CeCILL license (see ./LICENSE)
[503]	46	!!----------------------------------------------------------------------
	47	CONTAINS
	48
[12377]	49	SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pU, pV, pW, &
	50	& Kbb, Kmm, pt, kjpt, Krhs, kn_ubs_v )
[503]	51	!!----------------------------------------------------------------------
	52	!! * ROUTINE tra_adv_ubs *
	53	!!
	54	!! ** Purpose : Compute the now trend due to the advection of tracers
	55	!! and add it to the general trend of passive tracer equations.
	56	!!
[5836]	57	!! ** Method : The 3rd order Upstream Biased Scheme (UBS) is based on an
[3787]	58	!! upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005)
[519]	59	!! It is only used in the horizontal direction.
	60	!! For example the i-component of the advective fluxes are given by :
[3787]	61	!! ! e2u e3u un ( mi(Tn) - zltu(i ) ) if un(i) >= 0
[4990]	62	!! ztu = ! or
[3787]	63	!! ! e2u e3u un ( mi(Tn) - zltu(i+1) ) if un(i) < 0
[519]	64	!! where zltu is the second derivative of the before temperature field:
	65	!! zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ]
[5836]	66	!! This results in a dissipatively dominant (i.e. hyper-diffusive)
[519]	67	!! truncation error. The overall performance of the advection scheme
	68	!! is similar to that reported in (Farrow and Stevens, 1995).
[5836]	69	!! For stability reasons, the first term of the fluxes which corresponds
[519]	70	!! to a second order centered scheme is evaluated using the now velocity
	71	!! (centered in time) while the second term which is the diffusive part
	72	!! of the scheme, is evaluated using the before velocity (forward in time).
	73	!! Note that UBS is not positive. Do not use it on passive tracers.
[5836]	74	!! On the vertical, the advection is evaluated using a FCT scheme,
	75	!! as the UBS have been found to be too diffusive.
[6140]	76	!! kn_ubs_v argument controles whether the FCT is based on
	77	!! a 2nd order centrered scheme (kn_ubs_v=2) or on a 4th order compact
	78	!! scheme (kn_ubs_v=4).
[503]	79	!!
[12377]	80	!! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends
[6140]	81	!! - send trends to trdtra module for further diagnostcs (l_trdtra=T)
[12377]	82	!! - poleward advective heat and salt transport (ln_diaptr=T)
[519]	83	!!
	84	!! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404.
[13237]	85	!! Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731�1741.
[503]	86	!!----------------------------------------------------------------------
[12377]	87	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	88	INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices
	89	INTEGER , INTENT(in ) :: kit000 ! first time step index
	90	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	91	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	92	INTEGER , INTENT(in ) :: kn_ubs_v ! number of tracers
	93	REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
	94	REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components
	95	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
[2715]	96	!
	97	INTEGER :: ji, jj, jk, jn ! dummy loop indices
[6140]	98	REAL(wp) :: ztra, zbtr, zcoef ! local scalars
[2715]	99	REAL(wp) :: zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk ! - -
	100	REAL(wp) :: zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn ! - -
[9019]	101	REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu, zltv, zti, ztw ! 3D workspace
[503]	102	!!----------------------------------------------------------------------
[3294]	103	!
	104	IF( kt == kit000 ) THEN
[503]	105	IF(lwp) WRITE(numout,*)
[2528]	106	IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme on ', cdtype
[503]	107	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
	108	ENDIF
[2528]	109	!
[4499]	110	l_trd = .FALSE.
[7646]	111	l_hst = .FALSE.
	112	l_ptr = .FALSE.
	113	IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
[12377]	114	IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
[7646]	115	IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
	116	& iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
[4499]	117	!
[6140]	118	ztw (:,:, 1 ) = 0._wp ! surface & bottom value : set to zero for all tracers
	119	zltu(:,:,jpk) = 0._wp ; zltv(:,:,jpk) = 0._wp
[5836]	120	ztw (:,:,jpk) = 0._wp ; zti (:,:,jpk) = 0._wp
[2528]	121	! ! ===========
	122	DO jn = 1, kjpt ! tracer loop
	123	! ! ===========
	124	!
[13497]	125	DO jk = 1, jpkm1 !== horizontal laplacian of before tracer ==!
[13619]	126	DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! First derivative (masked gradient)
[12377]	127	zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk)
	128	zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
	129	ztu(ji,jj,jk) = zeeu * ( pt(ji+1,jj ,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
	130	ztv(ji,jj,jk) = zeev * ( pt(ji ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
	131	END_2D
[13619]	132	DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Second derivative (divergence)
[12377]	133	zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) )
	134	zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef
	135	zltv(ji,jj,jk) = ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zcoef
	136	END_2D
[2528]	137	!
[5836]	138	END DO
[13619]	139	IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn)
[2528]	140	!
[13497]	141	DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== Horizontal advective fluxes ==! (UBS)
	142	zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ! upstream transport (x2)
[12377]	143	zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) )
	144	zfp_vj = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) )
	145	zfm_vj = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) )
	146	! ! 2nd order centered advective fluxes (x2)
	147	zcenut = pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) )
	148	zcenvt = pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) )
	149	! ! UBS advective fluxes
	150	ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) )
	151	ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) )
	152	END_3D
[5836]	153	!
[12377]	154	zltu(:,:,:) = pt(:,:,:,jn,Krhs) ! store the initial trends before its update
[5836]	155	!
	156	DO jk = 1, jpkm1 !== add the horizontal advective trend ==!
[13295]	157	DO_2D( 0, 0, 0, 0 )
[12377]	158	pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) &
	159	& - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk) &
[13237]	160	& + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) &
	161	& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
[12377]	162	END_2D
[2528]	163	!
[5836]	164	END DO
	165	!
[12377]	166	zltu(:,:,:) = pt(:,:,:,jn,Krhs) - zltu(:,:,:) ! Horizontal advective trend used in vertical 2nd order FCT case
[13497]	167	! ! and/or in trend diagnostic (l_trd=T)
[4990]	168	!
	169	IF( l_trd ) THEN ! trend diagnostics
[12377]	170	CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, pt(:,:,:,jn,Kmm) )
	171	CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, pt(:,:,:,jn,Kmm) )
[2528]	172	END IF
[7646]	173	!
	174	! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
	175	IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', ztv(:,:,:) )
	176	! ! heati/salt transport
	177	IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztu(:,:,:), ztv(:,:,:) )
[5836]	178	!
[7646]	179	!
[5836]	180	! !== vertical advective trend ==!
	181	!
	182	SELECT CASE( kn_ubs_v ) ! select the vertical advection scheme
	183	!
	184	CASE( 2 ) ! 2nd order FCT
	185	!
[12377]	186	IF( l_trd ) zltv(:,:,:) = pt(:,:,:,jn,Krhs) ! store pt(:,:,:,:,Krhs) if trend diag.
[5836]	187	!
[13497]	188	! !* upstream advection with initial mass fluxes & intermediate update ==!
[13295]	189	DO_3D( 1, 1, 1, 1, 2, jpkm1 )
[12377]	190	zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
	191	zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
	192	ztw(ji,jj,jk) = 0.5_wp * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk)
	193	END_3D
[13497]	194	IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as ztw has been w-masked)
	195	IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface
[13295]	196	DO_2D( 1, 1, 1, 1 )
[12377]	197	ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface
	198	END_2D
[13497]	199	ELSE ! no cavities: only at the ocean surface
[12377]	200	ztw(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb)
[5836]	201	ENDIF
	202	ENDIF
	203	!
[13497]	204	DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme
[13237]	205	ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) &
	206	& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
[12377]	207	pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztak
	208	zti(ji,jj,jk) = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
	209	END_3D
[5836]	210	!
	211	! !* anti-diffusive flux : high order minus low order
[13295]	212	DO_3D( 1, 1, 1, 1, 2, jpkm1 )
[12377]	213	ztw(ji,jj,jk) = ( 0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) &
	214	& - ztw(ji,jj,jk) ) * wmask(ji,jj,jk)
	215	END_3D
[5836]	216	! ! top ocean value: high order == upstream ==>> zwz=0
[6140]	217	IF( ln_linssh ) ztw(:,:, 1 ) = 0._wp ! only ocean surface as interior zwz values have been w-masked
[5836]	218	!
[12377]	219	CALL nonosc_z( Kmm, pt(:,:,:,jn,Kbb), ztw, zti, p2dt ) ! monotonicity algorithm
[5836]	220	!
	221	CASE( 4 ) ! 4th order COMPACT
[12377]	222	CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! 4th order compact interpolation of T at w-point
[13295]	223	DO_3D( 0, 0, 0, 0, 2, jpkm1 )
[12377]	224	ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
	225	END_3D
	226	IF( ln_linssh ) ztw(:,:, 1 ) = pW(:,:,1) * pt(:,:,1,jn,Kmm) !!gm ISF & 4th COMPACT doesn't work
[5836]	227	!
	228	END SELECT
[2528]	229	!
[13497]	230	DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! final trend with corrected fluxes
[13237]	231	pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) &
	232	& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
[12377]	233	END_3D
[5836]	234	!
[13497]	235	IF( l_trd ) THEN ! vertical advective trend diagnostics
	236	DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
[12377]	237	zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk) &
	238	& + pt(ji,jj,jk,jn,Kmm) * ( pW(ji,jj,jk) - pW(ji,jj,jk+1) ) &
	239	& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
	240	END_3D
	241	CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zltv )
[2528]	242	ENDIF
	243	!
[4990]	244	END DO
[503]	245	!
[2528]	246	END SUBROUTINE tra_adv_ubs
[503]	247
	248
[12377]	249	SUBROUTINE nonosc_z( Kmm, pbef, pcc, paft, p2dt )
[503]	250	!!---------------------------------------------------------------------
	251	!! * ROUTINE nonosc_z *
	252	!!
	253	!! ** Purpose : compute monotonic tracer fluxes from the upstream
	254	!! scheme and the before field by a nonoscillatory algorithm
	255	!!
	256	!! ** Method : ... ???
	257	!! warning : pbef and paft must be masked, but the boundaries
	258	!! conditions on the fluxes are not necessary zalezak (1979)
	259	!! drange (1995) multi-dimensional forward-in-time and upstream-
	260	!! in-space based differencing for fluid
	261	!!----------------------------------------------------------------------
[12377]	262	INTEGER , INTENT(in ) :: Kmm ! time level index
[6140]	263	REAL(wp), INTENT(in ) :: p2dt ! tracer time-step
[2528]	264	REAL(wp), DIMENSION (jpi,jpj,jpk) :: pbef ! before field
[503]	265	REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: paft ! after field
	266	REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: pcc ! monotonic flux in the k direction
[2715]	267	!
	268	INTEGER :: ji, jj, jk ! dummy loop indices
	269	INTEGER :: ikm1 ! local integer
[6140]	270	REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars
[9019]	271	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo ! 3D workspace
[503]	272	!!----------------------------------------------------------------------
[3294]	273	!
[13226]	274	zbig = 1.e+38_wp
[2715]	275	zrtrn = 1.e-15_wp
	276	zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp
[5836]	277	!
[503]	278	! Search local extrema
	279	! --------------------
[5836]	280	! ! large negative value (-zbig) inside land
[503]	281	pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
	282	paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
[5836]	283	!
	284	DO jk = 1, jpkm1 ! search maximum in neighbourhood
[503]	285	ikm1 = MAX(jk-1,1)
[13295]	286	DO_2D( 0, 0, 0, 0 )
[12377]	287	zbetup(ji,jj,jk) = MAX( pbef(ji ,jj ,jk ), paft(ji ,jj ,jk ), &
	288	& pbef(ji ,jj ,ikm1), pbef(ji ,jj ,jk+1), &
	289	& paft(ji ,jj ,ikm1), paft(ji ,jj ,jk+1) )
	290	END_2D
[503]	291	END DO
[5836]	292	! ! large positive value (+zbig) inside land
[503]	293	pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
	294	paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
[5836]	295	!
	296	DO jk = 1, jpkm1 ! search minimum in neighbourhood
[503]	297	ikm1 = MAX(jk-1,1)
[13295]	298	DO_2D( 0, 0, 0, 0 )
[12377]	299	zbetdo(ji,jj,jk) = MIN( pbef(ji ,jj ,jk ), paft(ji ,jj ,jk ), &
	300	& pbef(ji ,jj ,ikm1), pbef(ji ,jj ,jk+1), &
	301	& paft(ji ,jj ,ikm1), paft(ji ,jj ,jk+1) )
	302	END_2D
[503]	303	END DO
[5836]	304	! ! restore masked values to zero
[503]	305	pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
	306	paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
[5836]	307	!
	308	! Positive and negative part of fluxes and beta terms
	309	! ---------------------------------------------------
[13295]	310	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
[12377]	311	! positive & negative part of the flux
	312	zpos = MAX( 0., pcc(ji ,jj ,jk+1) ) - MIN( 0., pcc(ji ,jj ,jk ) )
	313	zneg = MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) )
	314	! up & down beta terms
	315	zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt
	316	zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt
	317	zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
	318	END_3D
[5836]	319	!
[503]	320	! monotonic flux in the k direction, i.e. pcc
	321	! -------------------------------------------
[13295]	322	DO_3D( 0, 0, 0, 0, 2, jpkm1 )
[12377]	323	za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
	324	zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
[13226]	325	zc = 0.5 * ( 1.e0 + SIGN( 1.0_wp, pcc(ji,jj,jk) ) )
[12377]	326	pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
	327	END_3D
[503]	328	!
	329	END SUBROUTINE nonosc_z
	330
	331	!!======================================================================
	332	END MODULE traadv_ubs

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

Download in other formats: