Context Navigation

tranxt.F90 @ 7099

Last change on this file since 7099 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

Property svn:keywords set to Id

File size: 16.5 KB

Rev	Line
[3]	1	MODULE tranxt
	2	!!======================================================================
	3	!! * MODULE tranxt *
	4	!! Ocean active tracers: time stepping on temperature and salinity
	5	!!======================================================================
[1110]	6	!! History : OPA ! 1991-11 (G. Madec) Original code
	7	!! 7.0 ! 1993-03 (M. Guyon) symetrical conditions
	8	!! 8.0 ! 1996-02 (G. Madec & M. Imbard) opa release 8.0
	9	!! - ! 1996-04 (A. Weaver) Euler forward step
	10	!! 8.2 ! 1999-02 (G. Madec, N. Grima) semi-implicit pressure grad.
	11	!! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module
	12	!! - ! 2002-11 (C. Talandier, A-M Treguier) Open boundaries
	13	!! - ! 2005-04 (C. Deltel) Add Asselin trend in the ML budget
	14	!! 2.0 ! 2006-02 (L. Debreu, C. Mazauric) Agrif implementation
	15	!! 3.0 ! 2008-06 (G. Madec) time stepping always done in trazdf
[1438]	16	!! 3.1 ! 2009-02 (G. Madec, R. Benshila) re-introduce the vvl option
[2528]	17	!! 3.3 ! 2010-04 (M. Leclair, G. Madec) semi-implicit hpg with asselin filter + modified LF-RA
	18	!! - ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA
[3]	19	!!----------------------------------------------------------------------
[503]	20
	21	!!----------------------------------------------------------------------
[2528]	22	!! tra_nxt : time stepping on tracers
	23	!! tra_nxt_fix : time stepping on tracers : fixed volume case
	24	!! tra_nxt_vvl : time stepping on tracers : variable volume case
[3]	25	!!----------------------------------------------------------------------
	26	USE oce ! ocean dynamics and tracers variables
	27	USE dom_oce ! ocean space and time domain variables
[2528]	28	USE sbc_oce ! surface boundary condition: ocean
[5467]	29	USE sbcrnf ! river runoffs
[6140]	30	USE sbcisf ! ice shelf melting
[4990]	31	USE zdf_oce ! ocean vertical mixing
[1438]	32	USE domvvl ! variable volume
[4990]	33	USE trd_oce ! trends: ocean variables
	34	USE trdtra ! trends manager: tracers
	35	USE traqsr ! penetrative solar radiation (needed for nksr)
	36	USE phycst ! physical constant
[5836]	37	USE ldftra ! lateral physics on tracers
	38	USE ldfslp
[4990]	39	USE bdy_oce ! BDY open boundary condition variables
[3294]	40	USE bdytra ! open boundary condition (bdy_tra routine)
[4990]	41	!
[3]	42	USE in_out_manager ! I/O manager
	43	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[258]	44	USE prtctl ! Print control
[4990]	45	USE wrk_nemo ! Memory allocation
	46	USE timing ! Timing
[2528]	47	#if defined key_agrif
[389]	48	USE agrif_opa_interp
[2528]	49	#endif
[3]	50
	51	IMPLICIT NONE
	52	PRIVATE
	53
[2528]	54	PUBLIC tra_nxt ! routine called by step.F90
	55	PUBLIC tra_nxt_fix ! to be used in trcnxt
	56	PUBLIC tra_nxt_vvl ! to be used in trcnxt
[592]	57
	58	!! * Substitutions
[6140]	59	# include "vectopt_loop_substitute.h90"
[3]	60	!!----------------------------------------------------------------------
[2528]	61	!! NEMO/OPA 3.3 , NEMO-Consortium (2010)
[2715]	62	!! $Id$
	63	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	64	!!----------------------------------------------------------------------
	65	CONTAINS
	66
	67	SUBROUTINE tra_nxt( kt )
	68	!!----------------------------------------------------------------------
	69	!! * ROUTINE tranxt *
	70	!!
[1110]	71	!! ** Purpose : Apply the boundary condition on the after temperature
	72	!! and salinity fields, achieved the time stepping by adding
	73	!! the Asselin filter on now fields and swapping the fields.
[3]	74	!!
[1110]	75	!! ** Method : At this stage of the computation, ta and sa are the
	76	!! after temperature and salinity as the time stepping has
	77	!! been performed in trazdf_imp or trazdf_exp module.
[3]	78	!!
[1110]	79	!! - Apply lateral boundary conditions on (ta,sa)
	80	!! at the local domain boundaries through lbc_lnk call,
[4328]	81	!! at the one-way open boundaries (lk_bdy=T),
[4990]	82	!! at the AGRIF zoom boundaries (lk_agrif=T)
[1110]	83	!!
[1438]	84	!! - Update lateral boundary conditions on AGRIF children
	85	!! domains (lk_agrif=T)
[1110]	86	!!
[6140]	87	!! ** Action : - tsb & tsn ready for the next time step
[503]	88	!!----------------------------------------------------------------------
	89	INTEGER, INTENT(in) :: kt ! ocean time-step index
	90	!!
[6140]	91	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	92	REAL(wp) :: zfact ! local scalars
[3294]	93	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds
[3]	94	!!----------------------------------------------------------------------
[3294]	95	!
	96	IF( nn_timing == 1 ) CALL timing_start( 'tra_nxt')
	97	!
[1110]	98	IF( kt == nit000 ) THEN
	99	IF(lwp) WRITE(numout,*)
	100	IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
	101	IF(lwp) WRITE(numout,*) '~~~~~~~'
[592]	102	ENDIF
	103
[1110]	104	! Update after tracer on domain lateral boundaries
	105	!
[5656]	106	#if defined key_agrif
	107	CALL Agrif_tra ! AGRIF zoom boundaries
	108	#endif
	109	!
[4230]	110	CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp ) ! local domain boundaries (T-point, unchanged sign)
	111	CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
[1110]	112	!
[2528]	113	#if defined key_bdy
[3294]	114	IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries
[1110]	115	#endif
[1438]	116
	117	! set time step size (Euler/Leapfrog)
[6140]	118	IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! at nit000 (Euler)
	119	ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2._wp* rdt ! at nit000 or nit000+1 (Leapfrog)
[1438]	120	ENDIF
[3]	121
[1110]	122	! trends computation initialisation
[2528]	123	IF( l_trdtra ) THEN ! store now fields before applying the Asselin filter
[3294]	124	CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
	125	ztrdt(:,:,:) = tsn(:,:,:,jp_tem)
	126	ztrds(:,:,:) = tsn(:,:,:,jp_sal)
[4990]	127	IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend
	128	CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
	129	CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
	130	ENDIF
[1110]	131	ENDIF
	132
[2528]	133	IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap)
	134	DO jn = 1, jpts
	135	DO jk = 1, jpkm1
	136	tsn(:,:,jk,jn) = tsa(:,:,jk,jn)
	137	END DO
	138	END DO
[6140]	139	!
[2528]	140	ELSE ! Leap-Frog + Asselin filter time stepping
	141	!
[6140]	142	IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! linear free surface
	143	ELSE ; CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa, &
	144	& sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface
[2528]	145	ENDIF
[6140]	146	!
	147	DO jn = 1, jpts
	148	CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp )
	149	CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp )
	150	CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp )
	151	END DO
[5656]	152	ENDIF
[2715]	153	!
[2528]	154	IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt
[1110]	155	DO jk = 1, jpkm1
[6140]	156	zfact = 1._wp / r2dt
[2528]	157	ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
	158	ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
[1110]	159	END DO
[4990]	160	CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
	161	CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
[3294]	162	CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
[1438]	163	END IF
[2715]	164	!
[1438]	165	! ! control print
[2528]	166	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt - Tn: ', mask1=tmask, &
	167	& tab3d_2=tsn(:,:,:,jp_sal), clinfo2= ' Sn: ', mask2=tmask )
[1438]	168	!
[4990]	169	IF( nn_timing == 1 ) CALL timing_stop('tra_nxt')
[3294]	170	!
[1438]	171	END SUBROUTINE tra_nxt
	172
	173
[3294]	174	SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
[1438]	175	!!----------------------------------------------------------------------
	176	!! * ROUTINE tra_nxt_fix *
	177	!!
	178	!! ** Purpose : fixed volume: apply the Asselin time filter and
	179	!! swap the tracer fields.
	180	!!
	181	!! ** Method : - Apply a Asselin time filter on now fields.
	182	!! - swap tracer fields to prepare the next time_step.
	183	!!
[6140]	184	!! ** Action : - tsb & tsn ready for the next time step
[1438]	185	!!----------------------------------------------------------------------
[6140]	186	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	187	INTEGER , INTENT(in ) :: kit000 ! first time step index
	188	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	189	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	190	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptb ! before tracer fields
	191	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptn ! now tracer fields
	192	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend
[2715]	193	!
[2528]	194	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	195	REAL(wp) :: ztn, ztd ! local scalars
[1438]	196	!!----------------------------------------------------------------------
[6140]	197	!
[3294]	198	IF( kt == kit000 ) THEN
[1438]	199	IF(lwp) WRITE(numout,*)
[3294]	200	IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
[1438]	201	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	202	ENDIF
	203	!
[2528]	204	DO jn = 1, kjpt
[1438]	205	!
[2528]	206	DO jk = 1, jpkm1
[6140]	207	DO jj = 2, jpjm1
	208	DO ji = fs_2, fs_jpim1
[2528]	209	ztn = ptn(ji,jj,jk,jn)
[6140]	210	ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers
[2528]	211	!
[6140]	212	ptb(ji,jj,jk,jn) = ztn + atfp * ztd ! ptb <-- filtered ptn
	213	ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
[3]	214	END DO
[2528]	215	END DO
	216	END DO
[1110]	217	!
[2528]	218	END DO
[1438]	219	!
	220	END SUBROUTINE tra_nxt_fix
[3]	221
[1110]	222
[5385]	223	SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
[1438]	224	!!----------------------------------------------------------------------
	225	!! * ROUTINE tra_nxt_vvl *
	226	!!
	227	!! ** Purpose : Time varying volume: apply the Asselin time filter
	228	!! and swap the tracer fields.
	229	!!
	230	!! ** Method : - Apply a thickness weighted Asselin time filter on now fields.
	231	!! - swap tracer fields to prepare the next time_step.
[6140]	232	!! tb = ( e3t_ntn + atfp[ e3t_btb - 2 e3t_ntn + e3t_a*ta ] )
	233	!! /( e3t_n + atfp*[ e3t_b - 2 e3t_n + e3t_a ] )
	234	!! tn = ta
[1438]	235	!!
[6140]	236	!! ** Action : - tsb & tsn ready for the next time step
[1438]	237	!!----------------------------------------------------------------------
[6140]	238	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	239	INTEGER , INTENT(in ) :: kit000 ! first time step index
	240	REAL(wp) , INTENT(in ) :: p2dt ! time-step
	241	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	242	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	243	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptb ! before tracer fields
	244	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptn ! now tracer fields
	245	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend
	246	REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: psbc_tc ! surface tracer content
	247	REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: psbc_tc_b ! before surface tracer content
	248	!
[5930]	249	LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical
[2528]	250	INTEGER :: ji, jj, jk, jn ! dummy loop indices
[2715]	251	REAL(wp) :: zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar
	252	REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - -
[1438]	253	!!----------------------------------------------------------------------
[3294]	254	!
	255	IF( kt == kit000 ) THEN
[1438]	256	IF(lwp) WRITE(numout,*)
[3294]	257	IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
[1438]	258	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
	259	ENDIF
[2528]	260	!
	261	IF( cdtype == 'TRA' ) THEN
	262	ll_traqsr = ln_traqsr ! active tracers case and solar penetration
[5467]	263	ll_rnf = ln_rnf ! active tracers case and river runoffs
[6140]	264	ll_isf = ln_isf ! active tracers case and ice shelf melting
	265	ELSE ! passive tracers case
	266	ll_traqsr = .FALSE. ! NO solar penetration
	267	ll_rnf = .FALSE. ! NO river runoffs ???? !!gm BUG ?
	268	ll_isf = .FALSE. ! NO ice shelf melting/freezing !!gm BUG ??
[2528]	269	ENDIF
	270	!
	271	DO jn = 1, kjpt
	272	DO jk = 1, jpkm1
[6140]	273	zfact1 = atfp * p2dt
	274	zfact2 = zfact1 * r1_rau0
	275	DO jj = 2, jpjm1
	276	DO ji = fs_2, fs_jpim1
	277	ze3t_b = e3t_b(ji,jj,jk)
	278	ze3t_n = e3t_n(ji,jj,jk)
	279	ze3t_a = e3t_a(ji,jj,jk)
[2528]	280	! ! tracer content at Before, now and after
	281	ztc_b = ptb(ji,jj,jk,jn) * ze3t_b
	282	ztc_n = ptn(ji,jj,jk,jn) * ze3t_n
	283	ztc_a = pta(ji,jj,jk,jn) * ze3t_a
	284	!
	285	ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
	286	ztc_d = ztc_a - 2. * ztc_n + ztc_b
	287	!
	288	ze3t_f = ze3t_n + atfp * ze3t_d
	289	ztc_f = ztc_n + atfp * ztc_d
	290	!
[5643]	291	IF( jk == mikt(ji,jj) ) THEN ! first level
	292	ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj) - emp(ji,jj) ) &
	293	& - (rnf_b(ji,jj) - rnf(ji,jj) ) &
	294	& + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) )
[5385]	295	ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
[2528]	296	ENDIF
[6140]	297	!
[5643]	298	! solar penetration (temperature only)
	299	IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) &
[2528]	300	& ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
[6140]	301	!
[5643]	302	! river runoff
	303	IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) &
[5467]	304	& ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
[6140]	305	& * e3t_n(ji,jj,jk) / h_rnf(ji,jj)
	306	!
[5643]	307	! ice shelf
	308	IF( ll_isf ) THEN
	309	! level fully include in the Losch_2008 ice shelf boundary layer
	310	IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) &
	311	ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) &
[6140]	312	& * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
[5643]	313	! level partially include in Losch_2008 ice shelf boundary layer
	314	IF ( jk == misfkb(ji,jj) ) &
	315	ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) &
[6140]	316	& * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
[5643]	317	END IF
[6140]	318	!
[5467]	319	ze3t_f = 1.e0 / ze3t_f
	320	ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered
	321	ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
	322	!
[1438]	323	END DO
	324	END DO
[2528]	325	END DO
	326	!
	327	END DO
[503]	328	!
[1438]	329	END SUBROUTINE tra_nxt_vvl
[3]	330
	331	!!======================================================================
	332	END MODULE tranxt

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 7099

Download in other formats: