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_tvd.F90 in branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90 @ 2776

Last change on this file since 2776 was 2775, checked in by rblod, 13 years ago
Add a first solution to find automatically an available working array, see ticket #829 and https://forge.ipsl.jussieu.fr/nemo/wiki/ticket/829
Property svn:keywords set to `Id`
File size: 18.7 KB

Rev	Line
[3]	1	MODULE traadv_tvd
	2	!!==============================================================================
	3	!! * MODULE traadv_tvd *
[2528]	4	!! Ocean tracers: horizontal & vertical advective trend
[3]	5	!!==============================================================================
[2528]	6	!! History : OPA ! 1995-12 (L. Mortier) Original code
	7	!! ! 2000-01 (H. Loukos) adapted to ORCA
	8	!! ! 2000-10 (MA Foujols E.Kestenare) include file not routine
	9	!! ! 2000-12 (E. Kestenare M. Levy) fix bug in trtrd indexes
	10	!! ! 2001-07 (E. Durand G. Madec) adaptation to ORCA config
	11	!! 8.5 ! 2002-06 (G. Madec) F90: Free form and module
	12	!! NEMO 1.0 ! 2004-01 (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
	13	!! 2.0 ! 2008-04 (S. Cravatte) add the i-, j- & k- trends computation
	14	!! - ! 2009-11 (V. Garnier) Surface pressure gradient organization
	15	!! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport
[503]	16	!!----------------------------------------------------------------------
[3]	17
	18	!!----------------------------------------------------------------------
	19	!! tra_adv_tvd : update the tracer trend with the horizontal
	20	!! and vertical advection trends using a TVD scheme
	21	!! nonosc : compute monotonic tracer fluxes by a nonoscillatory
	22	!! algorithm
	23	!!----------------------------------------------------------------------
	24	USE oce ! ocean dynamics and active tracers
	25	USE dom_oce ! ocean space and time domain
[2528]	26	USE trdmod_oce ! tracers trends
[2715]	27	USE trdtra ! tracers trends
[3]	28	USE in_out_manager ! I/O manager
[367]	29	USE dynspg_oce ! choice/control of key cpp for surface pressure gradient
[2715]	30	USE lib_mpp ! MPP library
[74]	31	USE lbclnk ! ocean lateral boundary condition (or mpp link)
[132]	32	USE diaptr ! poleward transport diagnostics
[2528]	33	USE trc_oce ! share passive tracers/Ocean variables
[2771]	34	USE timing ! preformance summary
[2775]	35	USE wrk_nemo_2 ! working arrays
[3]	36
	37	IMPLICIT NONE
	38	PRIVATE
	39
[503]	40	PUBLIC tra_adv_tvd ! routine called by step.F90
[3]	41
[2715]	42	LOGICAL :: l_trd ! flag to compute trends
[2528]	43
[3]	44	!! * Substitutions
	45	# include "domzgr_substitute.h90"
	46	# include "vectopt_loop_substitute.h90"
	47	!!----------------------------------------------------------------------
[2528]	48	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]	49	!! $Id$
[2528]	50	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	51	!!----------------------------------------------------------------------
	52	CONTAINS
	53
[2528]	54	SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn, &
	55	& ptb, ptn, pta, kjpt )
[3]	56	!!----------------------------------------------------------------------
	57	!! * ROUTINE tra_adv_tvd *
	58	!!
	59	!! ** Purpose : Compute the now trend due to total advection of
	60	!! tracers and add it to the general trend of tracer equations
	61	!!
	62	!! ** Method : TVD scheme, i.e. 2nd order centered scheme with
	63	!! corrected flux (monotonic correction)
	64	!! note: - this advection scheme needs a leap-frog time scheme
	65	!!
[2528]	66	!! ** Action : - update (pta) with the now advective tracer trends
	67	!! - save the trends
[503]	68	!!----------------------------------------------------------------------
[2715]	69	USE oce , ONLY: zwx => ua , zwy => va ! (ua,va) used as workspace
	70	!
[2528]	71	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	72	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	73	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	74	REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step
	75	REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components
	76	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields
	77	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend
[2715]	78	!
[2528]	79	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	80	REAL(wp) :: z2dtt, zbtr, ztra ! local scalar
	81	REAL(wp) :: zfp_ui, zfp_vj, zfp_wk ! - -
	82	REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - -
[2775]	83	REAL(wp), DIMENSION (:,:,:), POINTER :: zwi, zwz
[2528]	84	REAL(wp), DIMENSION (:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz
[3]	85	!!----------------------------------------------------------------------
	86
[2771]	87	IF( ln_timing ) CALL timing_start('traadv_tvd')
	88
[2775]	89	! IF( wrk_in_use(3, 12,13) ) THEN
	90	! CALL ctl_stop('tra_adv_tvd: requested workspace arrays unavailable') ; RETURN
	91	! ENDIF
[2715]	92
[2775]	93	CALL nemo_allocate(zwi) ; CALL nemo_allocate(zwz)
	94
[2528]	95	IF( kt == nit000 ) THEN
	96	IF(lwp) WRITE(numout,*)
	97	IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype
	98	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	99	!
	100	l_trd = .FALSE.
	101	IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
[3]	102	ENDIF
[2528]	103	!
	104	IF( l_trd ) THEN
	105	ALLOCATE( ztrdx(jpi,jpj,jpk) ) ; ztrdx(:,:,:) = 0.e0
	106	ALLOCATE( ztrdy(jpi,jpj,jpk) ) ; ztrdy(:,:,:) = 0.e0
	107	ALLOCATE( ztrdz(jpi,jpj,jpk) ) ; ztrdz(:,:,:) = 0.e0
	108	END IF
	109	!
	110	zwi(:,:,:) = 0.e0
	111	!
	112	! ! ===========
	113	DO jn = 1, kjpt ! tracer loop
	114	! ! ===========
	115	! 1. Bottom value : flux set to zero
	116	! ----------------------------------
	117	zwx(:,:,jpk) = 0.e0 ; zwz(:,:,jpk) = 0.e0
	118	zwy(:,:,jpk) = 0.e0 ; zwi(:,:,jpk) = 0.e0
[3]	119
[2528]	120	! 2. upstream advection with initial mass fluxes & intermediate update
	121	! --------------------------------------------------------------------
	122	! upstream tracer flux in the i and j direction
	123	DO jk = 1, jpkm1
	124	DO jj = 1, jpjm1
	125	DO ji = 1, fs_jpim1 ! vector opt.
	126	! upstream scheme
	127	zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
	128	zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
	129	zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
	130	zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
	131	zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj ,jk,jn) )
	132	zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji ,jj+1,jk,jn) )
	133	END DO
[3]	134	END DO
	135	END DO
	136
[2528]	137	! upstream tracer flux in the k direction
	138	! Surface value
	139	IF( lk_vvl ) THEN ; zwz(:,:, 1 ) = 0.e0 ! volume variable
	140	ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface
	141	ENDIF
	142	! Interior value
	143	DO jk = 2, jpkm1
	144	DO jj = 1, jpj
	145	DO ji = 1, jpi
	146	zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
	147	zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
	148	zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) )
	149	END DO
[3]	150	END DO
	151	END DO
	152
[2528]	153	! total advective trend
[216]	154	DO jk = 1, jpkm1
[2528]	155	z2dtt = p2dt(jk)
[216]	156	DO jj = 2, jpjm1
	157	DO ji = fs_2, fs_jpim1 ! vector opt.
[503]	158	zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
[2528]	159	! total intermediate advective trends
	160	ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &
	161	& + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) &
	162	& + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) )
	163	! update and guess with monotonic sheme
	164	pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
	165	zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
[216]	166	END DO
	167	END DO
	168	END DO
[2528]	169	! ! Lateral boundary conditions on zwi (unchanged sign)
	170	CALL lbc_lnk( zwi, 'T', 1. )
	171
	172	! ! trend diagnostics (contribution of upstream fluxes)
	173	IF( l_trd ) THEN
	174	! store intermediate advective trends
	175	ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:)
	176	END IF
	177	! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
	178	IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
	179	IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) )
	180	IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) )
	181	ENDIF
	182
	183	! 3. antidiffusive flux : high order minus low order
	184	! --------------------------------------------------
	185	! antidiffusive flux on i and j
[503]	186	DO jk = 1, jpkm1
[2528]	187	DO jj = 1, jpjm1
	188	DO ji = 1, fs_jpim1 ! vector opt.
	189	zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
	190	zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
[503]	191	END DO
	192	END DO
	193	END DO
[2528]	194
	195	! antidiffusive flux on k
	196	zwz(:,:,1) = 0.e0 ! Surface value
[503]	197	!
[2528]	198	DO jk = 2, jpkm1 ! Interior value
	199	DO jj = 1, jpj
	200	DO ji = 1, jpi
	201	zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
[503]	202	END DO
	203	END DO
	204	END DO
[2528]	205	CALL lbc_lnk( zwx, 'U', -1. ) ; CALL lbc_lnk( zwy, 'V', -1. ) ! Lateral bondary conditions
	206	CALL lbc_lnk( zwz, 'W', 1. )
[216]	207
[2528]	208	! 4. monotonicity algorithm
	209	! -------------------------
	210	CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
[3]	211
	212
[2528]	213	! 5. final trend with corrected fluxes
	214	! ------------------------------------
[216]	215	DO jk = 1, jpkm1
	216	DO jj = 2, jpjm1
[2528]	217	DO ji = fs_2, fs_jpim1 ! vector opt.
[503]	218	zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
[2528]	219	! total advective trends
	220	ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &
	221	& + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) &
	222	& + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) )
	223	! add them to the general tracer trends
	224	pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
[216]	225	END DO
	226	END DO
	227	END DO
[2528]	228
	229	! ! trend diagnostics (contribution of upstream fluxes)
	230	IF( l_trd ) THEN
	231	ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed
	232	ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed
	233	ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed
	234
	235	CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )
	236	CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )
	237	CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) )
	238	END IF
	239	! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
	240	IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
	241	IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:)
	242	IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:)
	243	ENDIF
[503]	244	!
[2715]	245	END DO
[503]	246	!
[2528]	247	IF( l_trd ) THEN
	248	DEALLOCATE( ztrdx ) ; DEALLOCATE( ztrdy ) ; DEALLOCATE( ztrdz )
	249	END IF
	250	!
[2775]	251	! IF( wrk_not_released(3, 12,13) ) CALL ctl_stop('tra_adv_tvd: failed to release workspace arrays')
	252	CALL nemo_deallocate(zwi) ; CALL nemo_deallocate(zwz)
[2715]	253	!
[2771]	254	IF( ln_timing ) CALL timing_stop('traadv_tvd')
	255	!
[3]	256	END SUBROUTINE tra_adv_tvd
	257
	258
[2528]	259	SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )
[3]	260	!!---------------------------------------------------------------------
	261	!! * ROUTINE nonosc *
	262	!!
	263	!! ** Purpose : compute monotonic tracer fluxes from the upstream
	264	!! scheme and the before field by a nonoscillatory algorithm
	265	!!
	266	!! ** Method : ... ???
	267	!! warning : pbef and paft must be masked, but the boundaries
	268	!! conditions on the fluxes are not necessary zalezak (1979)
	269	!! drange (1995) multi-dimensional forward-in-time and upstream-
	270	!! in-space based differencing for fluid
	271	!!----------------------------------------------------------------------
[2775]	272	! USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
	273	! USE wrk_nemo, ONLY: zbetup => wrk_3d_8 , zbetdo => wrk_3d_9 ! 3D workspace
	274	! USE wrk_nemo, ONLY: zbup => wrk_3d_10 , zbdo => wrk_3d_11 ! - -
[2715]	275	!
[2528]	276	REAL(wp), DIMENSION(jpk) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step
	277	REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field
	278	REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions
[2715]	279	!
	280	INTEGER :: ji, jj, jk ! dummy loop indices
	281	INTEGER :: ikm1 ! local integer
	282	REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt ! local scalars
	283	REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - -
[2775]	284	REAL(wp), DIMENSION(:,:,:), POINTER :: zbetup, zbetdo, zbup, zbdo
[3]	285	!!----------------------------------------------------------------------
	286
[2771]	287	IF( ln_timing ) CALL timing_start('nonosc')
	288
[2775]	289	CALL nemo_allocate(zbetup) ; CALL nemo_allocate(zbetdo)
	290	CALL nemo_allocate(zbup ) ; CALL nemo_allocate(zbdo )
[3]	291
[2775]	292	! IF( wrk_in_use(3, 8,9,10,11) ) THEN
	293	! CALL ctl_stop('nonosc: requested workspace array unavailable') ; RETURN
	294	! ENDIF
	295
[2715]	296	zbig = 1.e+40_wp
	297	zrtrn = 1.e-15_wp
	298	zbetup(:,:,jpk) = 0._wp ; zbetdo(:,:,jpk) = 0._wp
[785]	299
[2715]	300
[3]	301	! Search local extrema
	302	! --------------------
[785]	303	! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
	304	zbup = MAX( pbef * tmask - zbig * ( 1.e0 - tmask ), &
	305	& paft * tmask - zbig * ( 1.e0 - tmask ) )
	306	zbdo = MIN( pbef * tmask + zbig * ( 1.e0 - tmask ), &
	307	& paft * tmask + zbig * ( 1.e0 - tmask ) )
	308
[3]	309	DO jk = 1, jpkm1
	310	ikm1 = MAX(jk-1,1)
[2528]	311	z2dtt = p2dt(jk)
[3]	312	DO jj = 2, jpjm1
	313	DO ji = fs_2, fs_jpim1 ! vector opt.
	314
[785]	315	! search maximum in neighbourhood
	316	zup = MAX( zbup(ji ,jj ,jk ), &
	317	& zbup(ji-1,jj ,jk ), zbup(ji+1,jj ,jk ), &
	318	& zbup(ji ,jj-1,jk ), zbup(ji ,jj+1,jk ), &
	319	& zbup(ji ,jj ,ikm1), zbup(ji ,jj ,jk+1) )
[3]	320
[785]	321	! search minimum in neighbourhood
	322	zdo = MIN( zbdo(ji ,jj ,jk ), &
	323	& zbdo(ji-1,jj ,jk ), zbdo(ji+1,jj ,jk ), &
	324	& zbdo(ji ,jj-1,jk ), zbdo(ji ,jj+1,jk ), &
	325	& zbdo(ji ,jj ,ikm1), zbdo(ji ,jj ,jk+1) )
[3]	326
[785]	327	! positive part of the flux
[3]	328	zpos = MAX( 0., paa(ji-1,jj ,jk ) ) - MIN( 0., paa(ji ,jj ,jk ) ) &
	329	& + MAX( 0., pbb(ji ,jj-1,jk ) ) - MIN( 0., pbb(ji ,jj ,jk ) ) &
	330	& + MAX( 0., pcc(ji ,jj ,jk+1) ) - MIN( 0., pcc(ji ,jj ,jk ) )
[785]	331
	332	! negative part of the flux
[3]	333	zneg = MAX( 0., paa(ji ,jj ,jk ) ) - MIN( 0., paa(ji-1,jj ,jk ) ) &
	334	& + MAX( 0., pbb(ji ,jj ,jk ) ) - MIN( 0., pbb(ji ,jj-1,jk ) ) &
	335	& + MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) )
[785]	336
[3]	337	! up & down beta terms
	338	zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
[785]	339	zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
	340	zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt
[3]	341	END DO
	342	END DO
	343	END DO
[2528]	344	CALL lbc_lnk( zbetup, 'T', 1. ) ; CALL lbc_lnk( zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign)
[3]	345
	346
	347
[237]	348	! 3. monotonic flux in the i & j direction (paa & pbb)
	349	! ----------------------------------------
[3]	350	DO jk = 1, jpkm1
	351	DO jj = 2, jpjm1
	352	DO ji = fs_2, fs_jpim1 ! vector opt.
[785]	353	zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
	354	zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
	355	zcu = ( 0.5 + SIGN( 0.5 , paa(ji,jj,jk) ) )
	356	paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1.e0 - zcu) * zbu )
[3]	357
[785]	358	zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
	359	zbv = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
	360	zcv = ( 0.5 + SIGN( 0.5 , pbb(ji,jj,jk) ) )
	361	pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1.e0 - zcv) * zbv )
[3]	362
	363	! monotonic flux in the k direction, i.e. pcc
	364	! -------------------------------------------
[785]	365	za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
	366	zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
	367	zc = ( 0.5 + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
	368	pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1.e0 - zc) * zb )
[3]	369	END DO
	370	END DO
	371	END DO
[2528]	372	CALL lbc_lnk( paa, 'U', -1. ) ; CALL lbc_lnk( pbb, 'V', -1. ) ! lateral boundary condition (changed sign)
[503]	373	!
[2775]	374	!RB IF( wrk_not_released(3, 8,9,10,11) ) CALL ctl_stop('nonosc: failed to release workspace arrays')
[2715]	375	!
[2775]	376	CALL nemo_deallocate(zbetup) ; CALL nemo_deallocate(zbetdo)
	377	CALL nemo_deallocate(zbup ) ; CALL nemo_deallocate(zbdo )
	378	!
[2771]	379	IF( ln_timing ) CALL timing_stop('nonosc')
	380	!
[3]	381	END SUBROUTINE nonosc
	382
	383	!!======================================================================
	384	END MODULE traadv_tvd

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

Download in other formats: