Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

tranxt.F90 @ 7910

Last change on this file since 7910 was 7910, checked in by timgraham, 7 years ago
All wrk_alloc removed
Property svn:keywords set to `Id`
File size: 16.8 KB

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

Download in other formats: