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.

stprk3_stg.F90 in NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE – NEMO

Context Navigation

source: NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/stprk3_stg.F90 @ 15321

Last change on this file since 15321 was 15321, checked in by techene, 3 years ago
#2605 #2715 some cleanning
File size: 20.4 KB

Line
1	MODULE stprk3_stg
2	!!======================================================================
3	!! * MODULE stprk3_stg *
4	!! Time-stepping : manager of the ocean, tracer and ice time stepping
5	!! using a 3rd order Runge-Kutta with fixed or quasi-eulerian coordinate
6	!!======================================================================
7	!! History : 4.5 ! 2021-01 (S. Techene, G. Madec, N. Ducousso, F. Lemarie) Original code
8	!! NEMO
9	!!----------------------------------------------------------------------
10	#if defined key_qco \|\| defined key_linssh
11	!!----------------------------------------------------------------------
12	!! 'key_qco' Quasi-Eulerian vertical coordinate
13	!! OR
14	!! 'key_linssh Fixed in time vertical coordinate
15	!!----------------------------------------------------------------------
16
17	!!----------------------------------------------------------------------
18	!! stp_RK3_stg : NEMO 3rd order Runge-Kutta stage with qco or linssh
19	!!----------------------------------------------------------------------
20	USE step_oce ! time stepping used modules
21	USE domqco ! quasi-eulerian coordinate (dom_qco_r3c routine)
22	USE dynspg_ts, ONLY: un_adv , vn_adv ! advective transport from N to N+1
23	USE bdydyn ! ocean open boundary conditions (define bdy_dyn)
24	# if defined key_top
25	USE trc ! ocean passive tracers variables
26	USE trcadv ! passive tracers advection (trc_adv routine)
27	USE trcsms ! passive tracers source and sink
28	USE trctrp ! passive tracers transport
29	USE trcbdy ! passive tracers transport open boundary
30	USE trcstp_rk3
31	# endif
32	# if defined key_agrif
33	USE agrif_oce_interp
34	# endif
35
36	!
37	USE prtctl ! print control
38
39	IMPLICIT NONE
40	PRIVATE
41
42	PUBLIC stp_RK3_stg ! called by nemogcm.F90
43
44	REAL(wp) :: r1_2 = 1._wp / 2._wp
45	REAL(wp) :: r1_3 = 1._wp / 3._wp
46	REAL(wp) :: r2_3 = 2._wp / 3._wp
47
48	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssha ! sea-surface height at N+1
49	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_b, va_b ! barotropic velocity at N+1
50
51	!! * Substitutions
52	# include "do_loop_substitute.h90"
53	# include "domzgr_substitute.h90"
54	!!----------------------------------------------------------------------
55	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
56	!! $Id: step.F90 12377 2020-02-12 14:39:06Z acc $
57	!! Software governed by the CeCILL license (see ./LICENSE)
58	!!----------------------------------------------------------------------
59	CONTAINS
60
61	SUBROUTINE stp_RK3_stg( kstg, kstp, Kbb, Kmm, Krhs, Kaa )
62	!!----------------------------------------------------------------------
63	!! * ROUTINE stp_RK3_stg *
64	!!
65	!! ** Purpose : - stage of RK3 time stepping of OCE and TOP
66	!!
67	!! ** Method : input: computed in dynspg_ts
68	!! ssh shea surface height at N+1 (oce.F90)
69	!! (uu_b,vv_b) barotropic velocity at N, N+1 (oce.F90)
70	!! (un_adv,vn_adv) barotropic transport from N to N+1 (dynspg_ts.F90)
71	!! ,
72	!! -1- set ssh(Naa) (Naa=N+1/3, N+1/2, or N)
73	!! -2- set the advective velocity (zadU,zaV)
74	!! -4- Compute the after (Naa) T-S
75	!! -5- Update now
76	!! -6- Update the horizontal velocity
77	!!----------------------------------------------------------------------
78	INTEGER, INTENT(in) :: kstg ! RK3 stage
79	INTEGER, INTENT(in) :: kstp, Kbb, Kmm, Krhs, Kaa ! ocean time-step and time-level indices
80	!
81	INTEGER :: ji, jj, jk, jn, jtile ! dummy loop indices
82	REAL(wp) :: ze3Tb, ze3Sb, z1_e3t ! local scalars
83	REAL(wp) :: ze3Tr, ze3Sr ! - -
84	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zaU, zaV ! advective horizontal velocity
85	REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb ! advective transport
86	!! ---------------------------------------------------------------------
87	!
88	IF( ln_timing ) CALL timing_start('stp_RK3_stg')
89	!
90	IF( kstp == nit000 ) THEN
91	IF(lwp) WRITE(numout,*)
92	IF(lwp) WRITE(numout,*) 'stp_RK3_stg : Runge Kutta 3rd order at stage ', kstg
93	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
94	ENDIF
95	!
96	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
97	! ssh, uu_b, vv_b, and ssh/h0 at Kaa
98	! 3D advective velocity at Kmm
99	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
100	!
101	SELECT CASE( kstg )
102	! !---------------!
103	CASE ( 1 ) !== Stage 1 ==! Kbb = Kmm = N ; Kaa = N+1/3
104	! !---------------!
105	!
106	ALLOCATE( ssha(jpi,jpj) , ua_b(jpi,jpj) , va_b(jpi,jpj) )
107	!
108	rDt = r1_3 * rn_Dt ! set time-step : rn_Dt/3
109	r1_Dt = 1._wp / rDt
110	!
111	ssha(:,:) = ssh (:,:,Kaa) ! save ssh, uu_b, vv_b at N+1 (computed in dynspg_ts)
112	ua_b(:,:) = uu_b(:,:,Kaa)
113	va_b(:,:) = vv_b(:,:,Kaa)
114	! ! interpolated ssh and (uu_b,vv_b) at Kaa (N+1/3)
115	ssh (:,:,Kaa) = r2_3 * ssh (:,:,Kbb) + r1_3 * ssha(:,:)
116	uu_b(:,:,Kaa) = r2_3 * uu_b(:,:,Kbb) + r1_3 * ua_b(:,:)
117	vv_b(:,:,Kaa) = r2_3 * vv_b(:,:,Kbb) + r1_3 * va_b(:,:)
118	!
119	! !---------------!
120	CASE ( 2 ) !== Stage 2 ==! Kbb = N ; Kmm = N+1/3 ; Kaa = N+1/2
121	! !---------------!
122	!
123	rDt = r1_2 * rn_Dt ! set time-step : rn_Dt/2
124	r1_Dt = 1._wp / rDt
125	!
126	! ! set ssh and (uu_b,vv_b) at N+1/2 (Kaa)
127	ssh (:,:,Kaa) = r1_2 * ( ssh (:,:,Kbb) + ssha(:,:) )
128	uu_b(:,:,Kaa) = r1_2 * ( uu_b(:,:,Kbb) + ua_b(:,:) )
129	vv_b(:,:,Kaa) = r1_2 * ( vv_b(:,:,Kbb) + va_b(:,:) )
130	!
131	! !---------------!
132	CASE ( 3 ) !== Stage 3 ==! Kbb = N ; Kmm = N+1/2 ; Kaa = N+1
133	! !---------------!
134	!
135	rDt = rn_Dt ! set time-step : rn_Dt
136	r1_Dt = 1._wp / rDt
137	!
138	ssh (:,:,Kaa) = ssha(:,:) ! recover ssh and (uu_b,vv_b) at N + 1
139	uu_b(:,:,Kaa) = ua_b(:,:)
140	vv_b(:,:,Kaa) = va_b(:,:)
141	!
142	DEALLOCATE( ssha , ua_b , va_b )
143	!
144	END SELECT
145	!
146	! !== ssh/h0 ratio at Kaa ==!
147	!
148	IF( .NOT.lk_linssh ) CALL dom_qco_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa), r3f(:,:) ) ! "after" ssh/h_0 ratio at t,u,v-column
149	!
150	!
151	! !== advective velocity at Kmm ==!
152	!
153	! !- horizontal components -! (zaU,zaV)
154	zub(:,:) = un_adv(:,:)*r1_hu(:,:,Kmm) - uu_b(:,:,Kmm) ! barotropic velocity correction
155	zvb(:,:) = vn_adv(:,:)*r1_hv(:,:,Kmm) - vv_b(:,:,Kmm)
156	DO jk = 1, jpkm1 ! horizontal advective velocity
157	zaU(:,:,jk) = uu(:,:,jk,Kmm) + zub(:,:)*umask(:,:,jk)
158	zaV(:,:,jk) = vv(:,:,jk,Kmm) + zvb(:,:)*vmask(:,:,jk)
159	END DO
160	! !- vertical components -! ww
161	CALL wzv ( kstp, Kbb, Kmm, Kaa, zaU, zaV, ww ) ! ww cross-level velocity
162
163	!!st IF( ln_zad_Aimp ) CALL wAimp( kstp, ww, wi ) ! Adaptive-implicit vertical advection partitioning
164	! !==>>> implicite for stages 1 & 2 ????
165	!
166
167	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
168	! RHS of ocean dynamics : ADV + VOR/COR + HPG (+ ASM ) <<<=== Question: Stokes drift ?
169	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
170	!
171	uu(:,:,:,Krhs) = 0._wp ! set dynamics trends to zero
172	vv(:,:,:,Krhs) = 0._wp
173	!
174	!===>>>>>> Modify dyn_adv_... dyn_keg routines so that Krhs to zero useless
175	! ! advection (VF or FF) ==> RHS
176	CALL dyn_adv( kstp, Kbb, Kmm , uu, vv, Krhs, zaU, zaV, ww )
177	! ! Coriolis / vorticity ==> RHS
178	CALL dyn_vor( kstp, Kmm , uu, vv, Krhs )
179	!
180	!!gm à appeler que pour ln_zad_Aimp=T et en ne faisant que wi par zdf
181	!! ! ZAD (implicit part) ==> RHS
182	!! CALL dyn_zdf ( kstp, Kbb, Kmm, Krhs, uu, vv, Kaa )
183
184	!===>>>>>> Modify dyn_hpg & dyn_hpg_... routines : rhd computed in dyn_hpg and pass in argument to dyn_hpg_...
185
186	CALL eos ( ts, Kmm, rhd ) ! Kmm in situ density anomaly for hpg computation
187
188	!!gm end
189	CALL dyn_hpg( kstp, Kmm , uu, vv, Krhs )
190	!
191	!!gm ===>>>>>> Probably useless since uu_b(Kaa) will be imposed at the end of stage 1 and 2
192	! but may be necessary in stage 3 due to implicite in dynzdf.
193	! except if my idea for the matrice construction is OK !
194	! ! ! grad_h of ps ==> RHS
195	! DO_3D( 0, 0, 0, 0, 1, jpkm1 )
196	! uu(ji,jj,jk,Krhs) = uu(ji,jj,jk,Krhs) - grav * ( ssh(ji+1,jj ,Kmm) - ssh(ji,jj,Kmm) )
197	! vv(ji,jj,jk,Krhs) = vv(ji,jj,jk,Krhs) - grav * ( ssh(ji ,jj+1,Kmm) - ssh(ji,jj,Kmm) )
198	! END_3D
199	!!gm
200
201	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
202	! RHS of tracers : ADV only using (zaU,zaV,ww)
203	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
204
205	# if defined key_top
206	!
207	! !== Passive Tracer ==!
208	!
209	IF( kstg == 1 ) THEN
210	CALL trc_stp_start( kstp, Kbb, Kmm, Krhs, Kaa )
211	ENDIF
212	!
213	DO jn = 1, jptra
214	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
215	tr(ji,jj,jk,jn,Krhs) = 0._wp ! set tracer trends to zero
216	END_3D
217	END DO
218	! !== advection of passive tracers ==!
219	rDt_trc = rDt
220	CALL trc_adv( kstp, Kbb, Kmm, tr, Krhs, zaU, zaV, ww ) ! horizontal & vertical advection
221	!
222	!
223	SELECT CASE( kstg )
224	! !-------------------!
225	CASE ( 1 , 2 ) !== Stage 1 & 2 ==! stg1: Kbb = N ; Kaa = N+1/3
226	! !-------------------! stg2: Kbb = N ; Kmm = N+1/3 ; Kaa = N+1/2
227	!
228	! !== time integration ==! ∆t = rn_Dt/3 (stg1) or rn_Dt/2 (stg2)
229	DO jn = 1, jptra
230	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
231	ze3Tb = e3t(ji,jj,jk,Kbb) * tr(ji,jj,jk,jn,Kbb )
232	ze3Tr = e3t(ji,jj,jk,Kmm) * tr(ji,jj,jk,jn,Krhs)
233	z1_e3t= 1._wp / e3t(ji,jj,jk, Kaa)
234	tr(ji,jj,jk,jn,Kaa) = ( ze3Tb + rDt * ze3Trtmask(ji,jj,jk) ) z1_e3t
235	END_3D
236	END DO
237	! !---------------!
238	CASE ( 3 ) !== Stage 3 ==! add all RHS terms but advection (=> Kbb only)
239	! !---------------!
240	CALL trc_sms ( kstp, Kbb, Kbb, Krhs ) ! tracers: sinks and sources
241	CALL trc_trp ( kstp, Kbb, Kmm, Krhs, Kaa ) ! transport of passive tracers (without advection)
242	!
243	!
244	CALL trc_stp_end( kstp, Kbb, Kmm, Kaa )
245	!
246	END SELECT
247	# endif
248
249	! !== T-S Tracers ==!
250
251	!===>>>>>> Modify tra_adv_... routines so that Krhs to zero useless
252	DO jn = 1, jpts
253	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
254	ts(ji,jj,jk,jn,Krhs) = 0._wp ! set tracer trends to zero
255	END_3D
256	END DO
257
258	!===>>> CAUTION here may be without GM velocity but stokes drift required ! 0 barotropic divergence for GM != 0 barotropic divergence for SD
259	!!st consistence 2D / 3D - flux de masse
260	CALL tra_adv( kstp, Kbb, Kmm, ts, Krhs, zaU, zaV, ww ) ! hor. + vert. advection ==> RHS
261
262	!===>>>>>> stg1&2: Verify the necessity of these trends (we may need it as there are in the RHS of dynspg_ts ?)
263	!!gm ====>>>> needed for heat and salt fluxes associated with mass/volume flux
264	CALL tra_sbc_RK3( kstp, Kmm, ts, Krhs, kstg ) ! surface boundary condition
265
266	IF( ln_isf ) CALL tra_isf ( kstp, Kmm, ts, Krhs ) ! ice shelf heat flux
267	IF( ln_traqsr ) CALL tra_qsr ( kstp, Kmm, ts, Krhs ) ! penetrative solar radiation qsr
268	!!gm
269
270	!
271	!!gm ===>>>>>> Verify the necessity of these trends at stages 1 and 2
272	! (we may need it as they are in the RHS of dynspg_ts ?)
273	! IF( lk_asminc .AND. ln_asmiau ) THEN ! apply assimilation increment
274	! IF( ln_dyninc ) CALL dyn_asm_inc( kstp, Kbb, Kmm, uu, vv, Krhs ) ! dynamics ==> RHS
275	! IF( ln_trainc ) CALL tra_asm_inc( kstp, Kbb, Kmm, ts , Krhs ) ! tracers ==> RHS
276	! ENDIF
277	!!gm end Verif
278
279	!
280	SELECT CASE( kstg )
281	! !-------------------!
282	CASE ( 1 , 2 ) !== Stage 1 & 2 ==! stg1: Kbb = N ; Kaa = N+1/3
283	! !-------------------! stg2: Kbb = N ; Kmm = N+1/3 ; Kaa = N+1/2
284	!
285	! !== time integration ==! ∆t = rn_Dt/3 (stg1) or rn_Dt/2 (stg2)
286	IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity
287	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
288	uu(ji,jj,jk,Kaa) = ( uu(ji,jj,jk,Kbb) + rDt * uu(ji,jj,jk,Krhs) ) * umask(ji,jj,jk)
289	vv(ji,jj,jk,Kaa) = ( vv(ji,jj,jk,Kbb) + rDt * vv(ji,jj,jk,Krhs) ) * vmask(ji,jj,jk)
290	END_3D
291	ELSE ! applied on thickness weighted velocity
292	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
293	uu(ji,jj,jk,Kaa) = ( e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb ) &
294	& + rDt * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Krhs) ) &
295	& / e3u(ji,jj,jk,Kaa) * umask(ji,jj,jk)
296	vv(ji,jj,jk,Kaa) = ( e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb ) &
297	& + rDt * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Krhs) ) &
298	& / e3v(ji,jj,jk,Kaa) * vmask(ji,jj,jk)
299	END_3D
300	ENDIF
301	!
302	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
303	ze3Tb = e3t(ji,jj,jk,Kbb) * ts(ji,jj,jk,jp_tem,Kbb )
304	ze3Sb = e3t(ji,jj,jk,Kbb) * ts(ji,jj,jk,jp_sal,Kbb )
305	ze3Tr = e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Krhs)
306	ze3Sr = e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Krhs)
307	z1_e3t= 1._wp / e3t(ji,jj,jk, Kaa)
308	ts(ji,jj,jk,jp_tem,Kaa) = ( ze3Tb + rDt * ze3Trtmask(ji,jj,jk) ) z1_e3t
309	ts(ji,jj,jk,jp_sal,Kaa) = ( ze3Sb + rDt * ze3Srtmask(ji,jj,jk) ) z1_e3t
310	END_3D
311	!
312	!
313	IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=uu(:,:,:,Kaa), clinfo1='stp stg - Ua: ', mask1=umask, &
314	& tab3d_2=vv(:,:,:,Kaa), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
315	!
316	IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Kaa), clinfo1='stp stg - Ta: ', mask1=tmask, &
317	& tab3d_2=ts(:,:,:,jp_sal,Kaa), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
318	!
319	! !---------------!
320	CASE ( 3 ) !== Stage 3 ==! add all remaining RHS terms
321	! !---------------!
322	!
323	! !== complete the momentum RHS ==! except ZDF (implicit)
324	! ! lateral mixing ==> RHS
325	CALL dyn_ldf( kstp, Kbb, Kmm, uu, vv, Krhs )
326	! ! OSMOSIS non-local velocity fluxes ==> RHS
327	IF( ln_zdfosm ) CALL dyn_osm( kstp, Kmm, uu, vv, Krhs )
328	!
329	IF( ln_bdy ) THEN ! bdy damping trends ==> RHS
330	CALL bdy_dyn3d_dmp ( kstp, Kbb, uu, vv, Krhs )
331	CALL bdy_tra_dmp ( kstp, Kbb, ts , Krhs )
332	ENDIF
333
334	# if defined key_agrif
335	IF(.NOT. Agrif_Root() ) THEN ! AGRIF: sponge ==> momentum and tracer RHS
336	CALL Agrif_Sponge_dyn
337	CALL Agrif_Sponge_tra
338	ENDIF
339	# endif
340	! !== complete the tracers RHS ==! except ZDF (implicit)
341	! !* T-S Tracer *!
342	!
343	CALL tra_ldf( kstp, Kbb, Kmm, ts, Krhs ) ! lateral mixing
344	IF( ln_trabbc ) CALL tra_bbc( kstp, Kmm, ts, Krhs ) ! bottom heat flux
345	IF( ln_trabbl ) CALL tra_bbl( kstp, Kbb, Kmm, ts, Krhs ) ! advective (and/or diffusive) bottom boundary layer scheme
346	IF( ln_tradmp ) CALL tra_dmp( kstp, Kbb, Kmm, ts, Krhs ) ! internal damping trends
347
348	IF( ln_zdfmfc ) CALL tra_mfc( kstp, Kbb, ts, Krhs ) ! Mass Flux Convection
349	IF( ln_zdfosm ) THEN
350	CALL tra_osm( kstp, Kmm, ts, Krhs ) ! OSMOSIS non-local tracer fluxes ==> RHS
351	IF( lrst_oce ) CALL osm_rst( kstp, Kmm, 'WRITE' ) ! write OSMOSIS outputs + ww (so must do here) to restarts
352	ENDIF
353	!
354	! !== DYN & TRA time integration + ZDF ==! ∆t = rDt
355	!
356	CALL dyn_zdf( kstp, Kbb, Kmm, Krhs, uu, vv, Kaa ) ! vertical diffusion and time integration
357	CALL tra_zdf( kstp, Kbb, Kmm, Krhs, ts , Kaa ) ! vertical mixing and after tracer fields
358	IF( ln_zdfnpc ) CALL tra_npc( kstp, Kmm, Krhs, ts , Kaa ) ! update after fields by non-penetrative convection
359	!
360	END SELECT
361	! !== correction of the barotropic (all stages) ==! at Kaa = N+1/3, N+1/2 or N+1
362	! ! barotropic velocity correction
363	zub(A2D(0)) = uu_b(A2D(0),Kaa) - SUM( e3u_0(A2D(0),:)uu(A2D(0),:,Kaa), 3 ) r1_hu_0(A2D(0))
364	zvb(A2D(0)) = vv_b(A2D(0),Kaa) - SUM( e3v_0(A2D(0),:)vv(A2D(0),:,Kaa), 3 ) r1_hv_0(A2D(0))
365	!
366	DO jk = 1, jpkm1 ! corrected horizontal velocity
367	uu(:,:,jk,Kaa) = uu(:,:,jk,Kaa) + zub(:,:)*umask(:,:,jk)
368	vv(:,:,jk,Kaa) = vv(:,:,jk,Kaa) + zvb(:,:)*vmask(:,:,jk)
369	END DO
370
371
372	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
373	! Set boundary conditions
374	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
375	!
376	# if defined key_agrif
377	CALL Agrif_tra( kstp, kstg ) !* AGRIF zoom boundaries
378	CALL Agrif_dyn( kstp, kstg )
379	# endif
380	! !* local domain boundaries (T-point, unchanged sign)
381	CALL lbc_lnk_multi( 'stp_RK3_stg', uu(:,:,:, Kaa), 'U', -1., vv(:,:,: ,Kaa), 'V', -1. &
382	& , ts(:,:,:,jp_tem,Kaa), 'T', 1., ts(:,:,:,jp_sal,Kaa), 'T', 1. )
383	!
384	! !* BDY open boundaries
385	IF( ln_bdy ) THEN
386	CALL bdy_tra( kstp, Kbb, ts, Kaa )
387	IF( ln_dynspg_exp ) CALL bdy_dyn( kstp, Kbb, uu, vv, Kaa )
388	IF( ln_dynspg_ts ) CALL bdy_dyn( kstp, Kbb, uu, vv, Kaa, dyn3d_only=.true. )
389	ENDIF
390	!
391	IF( ln_timing ) CALL timing_stop('stp_RK3_stg')
392	!
393	END SUBROUTINE stp_RK3_stg
394
395	#else
396	!!----------------------------------------------------------------------
397	!! default option EMPTY MODULE qco not activated
398	!!----------------------------------------------------------------------
399	#endif
400
401	!!======================================================================
402	END MODULE stprk3_stg

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

Download in other formats: