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.

trcsub.F90 in branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC – NEMO

Context Navigation

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90 @ 7398

Last change on this file since 7398 was 7398, checked in by cbricaud, 7 years ago
coarsening branch: first implementation of coarsening in PISCES
Property svn:keywords set to `Id`
File size: 26.9 KB

Rev	Line
[2892]	1	MODULE trcsub
	2	!!======================================================================
	3	!! * MODULE trcsubstp *
	4	!!TOP : Averages physics variables for TOP substepping.
	5	!!======================================================================
	6	!! History : 1.0 ! 2011-10 (K. Edwards) Original
	7	!!----------------------------------------------------------------------
	8	#if defined key_top
	9	!!----------------------------------------------------------------------
	10	!! trc_sub : passive tracer system sub-stepping
	11	!!----------------------------------------------------------------------
	12	USE oce_trc ! ocean dynamics and active tracers variables
	13	USE trc
	14	USE prtctl_trc ! Print control for debbuging
[5105]	15	USE iom, ONLY : jpnf90
[5601]	16	USE iom_def, ONLY : jprstlib
[2892]	17	USE lbclnk
[7256]	18	USE divcur, ONLY : div_cur ! hor. divergence and curl (div & cur routines)
[2892]	19	USE bdy_oce
	20	#if defined key_agrif
	21	USE agrif_opa_update
	22	USE agrif_opa_interp
	23	#endif
	24
	25	IMPLICIT NONE
	26
[2910]	27	PUBLIC trc_sub_stp ! called by trc_stp
	28	PUBLIC trc_sub_ini ! called by trc_ini to initialize substepping arrays.
	29	PUBLIC trc_sub_reset ! called by trc_stp to reset physics variables
	30	PUBLIC trc_sub_ssh ! called by trc_stp to reset physics variables
[2892]	31
[2910]	32	!!* Module variables
	33	REAL(wp) :: r1_ndttrc ! 1 / nn_dttrc
	34	REAL(wp) :: r1_ndttrcp1 ! 1 / (nn_dttrc+1)
	35
	36	!!* Substitution
[7332]	37	# include "top_substitute.h90"
[2892]	38	!!----------------------------------------------------------------------
	39	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
[5602]	40	!! $Id$
[2892]	41	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	42	!!----------------------------------------------------------------------
	43	CONTAINS
	44
	45	SUBROUTINE trc_sub_stp( kt )
	46	!!-------------------------------------------------------------------
	47	!! * ROUTINE trc_stp *
	48	!!
	49	!! ** Purpose : Average variables needed for sub-stepping passive tracers
	50	!!
	51	!! ** Method : Called every timestep to increment _tm (time mean) variables
	52	!! on TOP steps, calculate averages.
	53	!!-------------------------------------------------------------------
[2910]	54	INTEGER, INTENT( in ) :: kt ! ocean time-step index
	55	INTEGER :: ji,jj,jk ! dummy loop indices
	56	REAL(wp) :: z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w
[2892]	57	!!-------------------------------------------------------------------
[3160]	58	!
	59	IF( nn_timing == 1 ) CALL timing_start('trc_sub_stp')
	60	!
	61	IF( kt == nit000 ) THEN
[2892]	62	IF(lwp) WRITE(numout,*)
	63	IF(lwp) WRITE(numout,*) 'trc_sub_stp : substepping of the passive tracers'
	64	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
[2910]	65	!
	66	sshb_hold (:,:) = sshn (:,:)
	67	emp_b_hold (:,:) = emp_b (:,:)
	68	!
	69	r1_ndttrc = 1._wp / REAL( nn_dttrc , wp )
	70	r1_ndttrcp1 = 1._wp / REAL( nn_dttrc + 1, wp )
	71	!
[3160]	72	ENDIF
[2892]	73
	74	IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
[2910]	75	!
	76	un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)
	77	vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)
	78	tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)
[2944]	79	tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)
[3175]	80	rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)
[2910]	81	avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)
[2892]	82	# if defined key_zdfddm
[2910]	83	avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)
[2892]	84	# endif
	85	#if defined key_ldfslp
[4611]	86	wslpi_tm(:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)
	87	wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)
	88	uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:)
	89	vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:)
[2892]	90	#endif
[2971]	91	# if defined key_trabbl
	92	IF( nn_bbl_ldf == 1 ) THEN
	93	ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:)
	94	ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:)
	95	ENDIF
	96	IF( nn_bbl_adv == 1 ) THEN
	97	utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:)
	98	vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:)
	99	ENDIF
	100	# endif
[2910]	101	!
	102	sshn_tm (:,:) = sshn_tm (:,:) + sshn (:,:)
[6772]	103	IF( ln_rnf )THEN
	104	rnf_tm (:,:) = rnf_tm (:,:) + rnf (:,:)
	105	h_rnf_tm (:,:) = h_rnf_tm (:,:) + h_rnf (:,:)
	106	ENDIF
[2910]	107	hmld_tm (:,:) = hmld_tm (:,:) + hmld (:,:)
	108	fr_i_tm (:,:) = fr_i_tm (:,:) + fr_i (:,:)
	109	emp_tm (:,:) = emp_tm (:,:) + emp (:,:)
[4148]	110	fmmflx_tm(:,:) = fmmflx_tm(:,:) + fmmflx(:,:)
[2910]	111	qsr_tm (:,:) = qsr_tm (:,:) + qsr (:,:)
	112	wndm_tm (:,:) = wndm_tm (:,:) + wndm (:,:)
[2892]	113
[2910]	114	ELSE ! It is time to substep
	115	! 1. set temporary arrays to hold physics variables
[2944]	116	un_temp (:,:,:) = un (:,:,:)
	117	vn_temp (:,:,:) = vn (:,:,:)
	118	wn_temp (:,:,:) = wn (:,:,:)
	119	tsn_temp (:,:,:,:) = tsn (:,:,:,:)
[3192]	120	rhop_temp (:,:,:) = rhop (:,:,:)
[2944]	121	avt_temp (:,:,:) = avt (:,:,:)
	122	# if defined key_zdfddm
[3192]	123	avs_temp (:,:,:) = avs (:,:,:)
[2944]	124	# endif
	125	#if defined key_ldfslp
	126	wslpi_temp (:,:,:) = wslpi (:,:,:)
	127	wslpj_temp (:,:,:) = wslpj (:,:,:)
	128	uslp_temp (:,:,:) = uslp (:,:,:)
	129	vslp_temp (:,:,:) = vslp (:,:,:)
	130	#endif
[2971]	131	# if defined key_trabbl
	132	IF( nn_bbl_ldf == 1 ) THEN
	133	ahu_bbl_temp(:,:) = ahu_bbl(:,:)
	134	ahv_bbl_temp(:,:) = ahv_bbl(:,:)
	135	ENDIF
	136	IF( nn_bbl_adv == 1 ) THEN
	137	utr_bbl_temp(:,:) = utr_bbl(:,:)
	138	vtr_bbl_temp(:,:) = vtr_bbl(:,:)
	139	ENDIF
	140	# endif
[2910]	141	sshn_temp (:,:) = sshn (:,:)
	142	sshb_temp (:,:) = sshb (:,:)
	143	ssha_temp (:,:) = ssha (:,:)
	144	rnf_temp (:,:) = rnf (:,:)
[6772]	145	IF( ln_rnf )THEN
	146	h_rnf_temp (:,:) = h_rnf (:,:)
	147	hmld_temp (:,:) = hmld (:,:)
	148	ENDIF
[2944]	149	fr_i_temp (:,:) = fr_i (:,:)
[2910]	150	emp_temp (:,:) = emp (:,:)
	151	emp_b_temp (:,:) = emp_b (:,:)
[4148]	152	fmmflx_temp(:,:) = fmmflx(:,:)
[2944]	153	qsr_temp (:,:) = qsr (:,:)
	154	wndm_temp (:,:) = wndm (:,:)
[2971]	155	! ! Variables reset in trc_sub_ssh
[5105]	156	#if ! defined key_crs
[2944]	157	rotn_temp (:,:,:) = rotn (:,:,:)
[5105]	158	# endif
[2944]	159	hdivn_temp (:,:,:) = hdivn (:,:,:)
[5105]	160	#if ! defined key_crs
[2944]	161	rotb_temp (:,:,:) = rotb (:,:,:)
[5105]	162	# endif
[2944]	163	hdivb_temp (:,:,:) = hdivb (:,:,:)
[2910]	164	!
	165	! 2. Create averages and reassign variables
[4611]	166	un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)
	167	vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)
	168	tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)
	169	tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)
	170	rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)
	171	avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)
[2944]	172	# if defined key_zdfddm
[4611]	173	avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)
[2944]	174	# endif
	175	#if defined key_ldfslp
[4611]	176	wslpi_tm (:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)
	177	wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)
	178	uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:)
	179	vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:)
[2944]	180	#endif
[2971]	181	# if defined key_trabbl
	182	IF( nn_bbl_ldf == 1 ) THEN
	183	ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:)
	184	ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:)
	185	ENDIF
	186	IF( nn_bbl_adv == 1 ) THEN
	187	utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:)
	188	vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:)
	189	ENDIF
	190	# endif
[2910]	191	sshn_tm (:,:) = sshn_tm (:,:) + sshn (:,:)
[6772]	192	IF( ln_rnf )THEN
	193	rnf_tm (:,:) = rnf_tm (:,:) + rnf (:,:)
	194	h_rnf_tm (:,:) = h_rnf_tm (:,:) + h_rnf (:,:)
	195	ENDIF
[2910]	196	hmld_tm (:,:) = hmld_tm (:,:) + hmld (:,:)
	197	fr_i_tm (:,:) = fr_i_tm (:,:) + fr_i (:,:)
	198	emp_tm (:,:) = emp_tm (:,:) + emp (:,:)
[4148]	199	fmmflx_tm(:,:) = fmmflx_tm (:,:) + fmmflx(:,:)
[2910]	200	qsr_tm (:,:) = qsr_tm (:,:) + qsr (:,:)
	201	wndm_tm (:,:) = wndm_tm (:,:) + wndm (:,:)
	202	!
	203	sshn (:,:) = sshn_tm (:,:) * r1_ndttrcp1
	204	sshb (:,:) = sshb_hold (:,:)
[6772]	205	IF( ln_rnf )THEN
	206	rnf (:,:) = rnf_tm (:,:) * r1_ndttrcp1
	207	h_rnf (:,:) = h_rnf_tm (:,:) * r1_ndttrcp1
	208	ENDIF
[2910]	209	hmld (:,:) = hmld_tm (:,:) * r1_ndttrcp1
[4611]	210	! variables that are initialized after averages
[2910]	211	emp_b (:,:) = emp_b_hold (:,:)
	212	IF( kt == nittrc000 ) THEN
	213	wndm (:,:) = wndm_tm (:,:) * r1_ndttrc
	214	qsr (:,:) = qsr_tm (:,:) * r1_ndttrc
	215	emp (:,:) = emp_tm (:,:) * r1_ndttrc
[4148]	216	fmmflx(:,:) = fmmflx_tm (:,:) * r1_ndttrc
[2944]	217	fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrc
[2971]	218	# if defined key_trabbl
	219	IF( nn_bbl_ldf == 1 ) THEN
	220	ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrc
	221	ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrc
	222	ENDIF
	223	IF( nn_bbl_adv == 1 ) THEN
	224	utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrc
	225	vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrc
	226	ENDIF
	227	# endif
[2910]	228	ELSE
	229	wndm (:,:) = wndm_tm (:,:) * r1_ndttrcp1
	230	qsr (:,:) = qsr_tm (:,:) * r1_ndttrcp1
	231	emp (:,:) = emp_tm (:,:) * r1_ndttrcp1
[4148]	232	fmmflx(:,:) = fmmflx_tm (:,:) * r1_ndttrcp1
[2944]	233	fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrcp1
[2971]	234	# if defined key_trabbl
	235	IF( nn_bbl_ldf == 1 ) THEN
	236	ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrcp1
	237	ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrcp1
	238	ENDIF
	239	IF( nn_bbl_adv == 1 ) THEN
	240	utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrcp1
	241	vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrcp1
	242	ENDIF
	243	# endif
[2910]	244	ENDIF
	245	!
[2892]	246	DO jk = 1, jpk
	247	DO jj = 1, jpj
	248	DO ji = 1, jpi
[2910]	249	z1_ne3t = r1_ndttrcp1 / fse3t(ji,jj,jk)
	250	z1_ne3u = r1_ndttrcp1 / fse3u(ji,jj,jk)
	251	z1_ne3v = r1_ndttrcp1 / fse3v(ji,jj,jk)
	252	z1_ne3w = r1_ndttrcp1 / fse3w(ji,jj,jk)
	253	!
	254	un (ji,jj,jk) = un_tm (ji,jj,jk) * z1_ne3u
	255	vn (ji,jj,jk) = vn_tm (ji,jj,jk) * z1_ne3v
	256	tsn (ji,jj,jk,jp_tem) = tsn_tm (ji,jj,jk,jp_tem) * z1_ne3t
	257	tsn (ji,jj,jk,jp_sal) = tsn_tm (ji,jj,jk,jp_sal) * z1_ne3t
[3175]	258	rhop (ji,jj,jk) = rhop_tm (ji,jj,jk) * z1_ne3t
[2910]	259	avt (ji,jj,jk) = avt_tm (ji,jj,jk) * z1_ne3w
	260	# if defined key_zdfddm
	261	avs (ji,jj,jk) = avs_tm (ji,jj,jk) * z1_ne3w
	262	# endif
	263	#if defined key_ldfslp
[4611]	264	wslpi(ji,jj,jk) = wslpi_tm(ji,jj,jk)
	265	wslpj(ji,jj,jk) = wslpj_tm(ji,jj,jk)
	266	uslp (ji,jj,jk) = uslp_tm (ji,jj,jk)
	267	vslp (ji,jj,jk) = vslp_tm (ji,jj,jk)
[2910]	268	#endif
	269	ENDDO
	270	ENDDO
	271	ENDDO
[2944]	272	!
	273	CALL trc_sub_ssh( kt ) ! after ssh & vertical velocity
	274	!
[2892]	275	ENDIF
[3160]	276	!
	277	IF( nn_timing == 1 ) CALL timing_start('trc_sub_stp')
	278	!
[2892]	279	END SUBROUTINE trc_sub_stp
	280
	281	SUBROUTINE trc_sub_ini
	282	!!-------------------------------------------------------------------
	283	!! * ROUTINE trc_sub_ini *
	284	!!
	285	!! ** Purpose : Initialize variables needed for sub-stepping passive tracers
	286	!!
	287	!! ** Method :
	288	!! Compute the averages for sub-stepping
	289	!!-------------------------------------------------------------------
	290	INTEGER :: ierr
	291	!!-------------------------------------------------------------------
[3160]	292	!
	293	IF( nn_timing == 1 ) CALL timing_start('trc_sub_ini')
	294	!
[2892]	295	IF(lwp) WRITE(numout,*)
	296	IF(lwp) WRITE(numout,*) 'trc_sub_ini : initial set up of the passive tracers substepping'
	297	IF(lwp) WRITE(numout,*) '~~~~~~~'
	298
	299	ierr = trc_sub_alloc ()
	300	IF( lk_mpp ) CALL mpp_sum( ierr )
	301	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' )
	302
[2910]	303	un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)
	304	vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)
	305	tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)
	306	tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)
[3175]	307	rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)
[2910]	308	avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)
	309	# if defined key_zdfddm
	310	avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)
	311	# endif
[2892]	312	#if defined key_ldfslp
[4611]	313	wslpi_tm(:,:,:) = wslpi(:,:,:)
	314	wslpj_tm(:,:,:) = wslpj(:,:,:)
	315	uslp_tm (:,:,:) = uslp (:,:,:)
	316	vslp_tm (:,:,:) = vslp (:,:,:)
[2892]	317	#endif
[2944]	318	sshn_tm (:,:) = sshn (:,:)
[6772]	319	IF( ln_rnf )THEN
	320	rnf_tm (:,:) = rnf (:,:)
	321	h_rnf_tm (:,:) = h_rnf (:,:)
	322	ENDIF
[2944]	323	hmld_tm (:,:) = hmld (:,:)
[2892]	324
[2910]	325	! Physics variables that are set after initialization:
[2971]	326	fr_i_tm(:,:) = 0._wp
	327	emp_tm (:,:) = 0._wp
[4148]	328	fmmflx_tm(:,:) = 0._wp
[2971]	329	qsr_tm (:,:) = 0._wp
	330	wndm_tm(:,:) = 0._wp
	331	# if defined key_trabbl
	332	IF( nn_bbl_ldf == 1 ) THEN
	333	ahu_bbl_tm(:,:) = 0._wp
	334	ahv_bbl_tm(:,:) = 0._wp
	335	ENDIF
	336	IF( nn_bbl_adv == 1 ) THEN
	337	utr_bbl_tm(:,:) = 0._wp
	338	vtr_bbl_tm(:,:) = 0._wp
	339	ENDIF
	340	# endif
[2910]	341	!
[3160]	342	IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ini')
	343	!
[2892]	344	END SUBROUTINE trc_sub_ini
	345
[2910]	346	SUBROUTINE trc_sub_reset( kt )
[2892]	347	!!-------------------------------------------------------------------
	348	!! * ROUTINE trc_sub_reset *
	349	!!
	350	!! ** Purpose : Reset physics variables averaged for substepping
	351	!!
	352	!! ** Method :
	353	!! Compute the averages for sub-stepping
	354	!!-------------------------------------------------------------------
	355	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[2910]	356	INTEGER :: jk ! dummy loop indices
[2892]	357	!!-------------------------------------------------------------------
[3160]	358	!
	359	IF( nn_timing == 1 ) CALL timing_start('trc_sub_reset')
	360	!
[2910]	361	! restore physics variables
	362	un (:,:,:) = un_temp (:,:,:)
	363	vn (:,:,:) = vn_temp (:,:,:)
	364	wn (:,:,:) = wn_temp (:,:,:)
[2944]	365	tsn (:,:,:,:) = tsn_temp (:,:,:,:)
[3175]	366	rhop (:,:,:) = rhop_temp (:,:,:)
[2944]	367	avt (:,:,:) = avt_temp (:,:,:)
	368	# if defined key_zdfddm
	369	avs (:,:,:) = avs_temp (:,:,:)
	370	# endif
	371	#if defined key_ldfslp
	372	wslpi (:,:,:) = wslpi_temp (:,:,:)
	373	wslpj (:,:,:) = wslpj_temp (:,:,:)
	374	uslp (:,:,:) = uslp_temp (:,:,:)
	375	vslp (:,:,:) = vslp_temp (:,:,:)
	376	#endif
[2910]	377	sshn (:,:) = sshn_temp (:,:)
	378	sshb (:,:) = sshb_temp (:,:)
	379	ssha (:,:) = ssha_temp (:,:)
[6772]	380	IF( ln_rnf )THEN
	381	rnf (:,:) = rnf_temp (:,:)
	382	h_rnf (:,:) = h_rnf_temp (:,:)
	383	ENDIF
[2910]	384	!
	385	hmld (:,:) = hmld_temp (:,:)
	386	fr_i (:,:) = fr_i_temp (:,:)
	387	emp (:,:) = emp_temp (:,:)
[4148]	388	fmmflx(:,:) = fmmflx_temp(:,:)
[2910]	389	emp_b (:,:) = emp_b_temp (:,:)
[2944]	390	qsr (:,:) = qsr_temp (:,:)
	391	wndm (:,:) = wndm_temp (:,:)
[2971]	392	# if defined key_trabbl
	393	IF( nn_bbl_ldf == 1 ) THEN
	394	ahu_bbl(:,:) = ahu_bbl_temp(:,:)
	395	ahv_bbl(:,:) = ahv_bbl_temp(:,:)
	396	ENDIF
	397	IF( nn_bbl_adv == 1 ) THEN
	398	utr_bbl(:,:) = utr_bbl_temp(:,:)
	399	vtr_bbl(:,:) = vtr_bbl_temp(:,:)
	400	ENDIF
	401	# endif
[2910]	402	!
[2944]	403	hdivn (:,:,:) = hdivn_temp (:,:,:)
[5105]	404	hdivb (:,:,:) = hdivb_temp (:,:,:)
	405	#if ! defined key_crs
[2944]	406	rotn (:,:,:) = rotn_temp (:,:,:)
	407	rotb (:,:,:) = rotb_temp (:,:,:)
[5105]	408	#endif
[2910]	409	!
[2892]	410
[2910]	411	! Start new averages
[2944]	412	un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)
	413	vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)
	414	tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)
	415	tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)
[3175]	416	rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)
[2944]	417	avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)
[2892]	418	# if defined key_zdfddm
[2944]	419	avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)
[2892]	420	# endif
	421	#if defined key_ldfslp
[4611]	422	wslpi_tm(:,:,:) = wslpi(:,:,:)
	423	wslpj_tm(:,:,:) = wslpj(:,:,:)
	424	uslp_tm (:,:,:) = uslp (:,:,:)
	425	vslp_tm (:,:,:) = vslp (:,:,:)
[2892]	426	#endif
[2910]	427	!
[2944]	428	sshb_hold (:,:) = sshn (:,:)
	429	emp_b_hold (:,:) = emp (:,:)
[2910]	430	sshn_tm (:,:) = sshn (:,:)
[6772]	431	IF( ln_rnf )THEN
	432	rnf_tm (:,:) = rnf (:,:)
	433	h_rnf_tm (:,:) = h_rnf (:,:)
	434	ENDIF
[2910]	435	hmld_tm (:,:) = hmld (:,:)
	436	fr_i_tm (:,:) = fr_i (:,:)
	437	emp_tm (:,:) = emp (:,:)
[4148]	438	fmmflx_tm (:,:) = fmmflx(:,:)
[2910]	439	qsr_tm (:,:) = qsr (:,:)
	440	wndm_tm (:,:) = wndm (:,:)
[2971]	441	# if defined key_trabbl
	442	IF( nn_bbl_ldf == 1 ) THEN
	443	ahu_bbl_tm(:,:) = ahu_bbl(:,:)
	444	ahv_bbl_tm(:,:) = ahv_bbl(:,:)
	445	ENDIF
	446	IF( nn_bbl_adv == 1 ) THEN
	447	utr_bbl_tm(:,:) = utr_bbl(:,:)
	448	vtr_bbl_tm(:,:) = vtr_bbl(:,:)
	449	ENDIF
	450	# endif
[2910]	451	!
	452	!
[3160]	453	IF( nn_timing == 1 ) CALL timing_stop('trc_sub_reset')
	454	!
[2910]	455	END SUBROUTINE trc_sub_reset
[2892]	456
	457
	458	SUBROUTINE trc_sub_ssh( kt )
	459	!!----------------------------------------------------------------------
	460	!! * ROUTINE trc_sub_ssh *
	461	!!
	462	!! ** Purpose : compute the after ssh (ssha), the now vertical velocity
	463	!! and update the now vertical coordinate (lk_vvl=T).
	464	!!
	465	!! ** Method : - Using the incompressibility hypothesis, the vertical
	466	!! velocity is computed by integrating the horizontal divergence
	467	!! from the bottom to the surface minus the scale factor evolution.
	468	!! The boundary conditions are w=0 at the bottom (no flux) and.
	469	!!
	470	!! ** action : ssha : after sea surface height
	471	!! wn : now vertical velocity
	472	!! sshu_a, sshv_a, sshf_a : after sea surface height (lk_vvl=T)
	473	!!
	474	!! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling.
	475	!!----------------------------------------------------------------------
	476	!
	477	INTEGER, INTENT(in) :: kt ! time step
	478	!
	479	INTEGER :: ji, jj, jk ! dummy loop indices
	480	REAL(wp) :: zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0 ! local scalars
[3147]	481	REAL(wp), POINTER, DIMENSION(:,:) :: zhdiv
	482	!!---------------------------------------------------------------------
[3160]	483	!
	484	IF( nn_timing == 1 ) CALL timing_start('trc_sub_ssh')
	485	!
[3147]	486	! Allocate temporary workspace
	487	CALL wrk_alloc( jpi, jpj, zhdiv )
[2892]	488
	489	IF( kt == nittrc000 ) THEN
	490	!
	491	IF(lwp) WRITE(numout,*)
	492	IF(lwp) WRITE(numout,*) 'trc_sub_ssh : after sea surface height and now vertical velocity '
	493	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
	494	!
	495	wn(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all)
	496	!
	497	ENDIF
	498	!
	499	CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity
	500	!
	501	z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog)
	502	IF( neuler == 0 .AND. kt == nittrc000 ) z2dt = rdt
	503
	504	! !------------------------------!
	505	! ! After Sea Surface Height !
	506	! !------------------------------!
	507	zhdiv(:,:) = 0._wp
	508	DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports
	509	zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)
	510	END DO
	511	! ! Sea surface elevation time stepping
	512	! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used
	513	! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp
	514	z1_rau0 = 0.5 / rau0
	515	ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * tmask(:,:,1)
[4611]	516	#if ! defined key_dynspg_ts
	517	! These lines are not necessary with time splitting since
	518	! boundary condition on sea level is set during ts loop
[2892]	519	#if defined key_agrif
	520	CALL agrif_ssh( kt )
	521	#endif
	522	#if defined key_bdy
	523	ssha(:,:) = ssha(:,:) * bdytmask(:,:)
	524	CALL lbc_lnk( ssha, 'T', 1. )
	525	#endif
[4611]	526	#endif
[2892]	527
	528
	529	! !------------------------------!
	530	! ! Now Vertical Velocity !
	531	! !------------------------------!
	532	z1_2dt = 1.e0 / z2dt
	533	DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence
	534	! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
	535	wn(:,:,jk) = wn(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) &
	536	& - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) &
	537	& * tmask(:,:,jk) * z1_2dt
	538	#if defined key_bdy
	539	wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
	540	#endif
	541	END DO
	542
	543	!
[3147]	544	CALL wrk_dealloc( jpi, jpj, zhdiv )
[2892]	545	!
[3160]	546	IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ssh')
	547	!
[2892]	548	END SUBROUTINE trc_sub_ssh
	549
	550	INTEGER FUNCTION trc_sub_alloc()
	551	!!-------------------------------------------------------------------
	552	!! * ROUTINE trc_sub_alloc *
	553	!!-------------------------------------------------------------------
	554	USE lib_mpp, ONLY: ctl_warn
[2910]	555	INTEGER :: ierr
[2892]	556	!!-------------------------------------------------------------------
	557	!
	558	ALLOCATE( un_temp(jpi,jpj,jpk) , vn_temp(jpi,jpj,jpk) , &
	559	& wn_temp(jpi,jpj,jpk) , avt_temp(jpi,jpj,jpk) , &
[3192]	560	& rhop_temp(jpi,jpj,jpk) , rhop_tm(jpi,jpj,jpk) , &
[2892]	561	& sshn_temp(jpi,jpj) , sshb_temp(jpi,jpj) , &
[4611]	562	& ssha_temp(jpi,jpj) , &
[2892]	563	#if defined key_ldfslp
	564	& wslpi_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), &
	565	& uslp_temp(jpi,jpj,jpk) , vslp_temp(jpi,jpj,jpk), &
	566	#endif
[2971]	567	#if defined key_trabbl
	568	& ahu_bbl_temp(jpi,jpj) , ahv_bbl_temp(jpi,jpj), &
	569	& utr_bbl_temp(jpi,jpj) , vtr_bbl_temp(jpi,jpj), &
	570	#endif
[2892]	571	& rnf_temp(jpi,jpj) , h_rnf_temp(jpi,jpj) , &
[2971]	572	& tsn_temp(jpi,jpj,jpk,2) , emp_b_temp(jpi,jpj), &
[4148]	573	& emp_temp(jpi,jpj) , fmmflx_temp(jpi,jpj), &
[2892]	574	& hmld_temp(jpi,jpj) , qsr_temp(jpi,jpj) , &
	575	& fr_i_temp(jpi,jpj) , fr_i_tm(jpi,jpj) , &
	576	& wndm_temp(jpi,jpj) , wndm_tm(jpi,jpj) , &
	577	# if defined key_zdfddm
[2944]	578	& avs_tm(jpi,jpj,jpk) , avs_temp(jpi,jpj,jpk) , &
[2892]	579	# endif
	580	& hdivn_temp(jpi,jpj,jpk) , hdivb_temp(jpi,jpj,jpk), &
	581	& rotn_temp(jpi,jpj,jpk) , rotb_temp(jpi,jpj,jpk), &
	582	& un_tm(jpi,jpj,jpk) , vn_tm(jpi,jpj,jpk) , &
[2971]	583	& avt_tm(jpi,jpj,jpk) , &
[2892]	584	& sshn_tm(jpi,jpj) , sshb_hold(jpi,jpj) , &
	585	& tsn_tm(jpi,jpj,jpk,2) , &
[4148]	586	& emp_tm(jpi,jpj) , fmmflx_tm(jpi,jpj) , &
[2892]	587	& emp_b_hold(jpi,jpj) , &
	588	& hmld_tm(jpi,jpj) , qsr_tm(jpi,jpj) , &
	589	#if defined key_ldfslp
	590	& wslpi_tm(jpi,jpj,jpk) , wslpj_tm(jpi,jpj,jpk), &
	591	& uslp_tm(jpi,jpj,jpk) , vslp_tm(jpi,jpj,jpk), &
	592	#endif
[2971]	593	#if defined key_trabbl
	594	& ahu_bbl_tm(jpi,jpj) , ahv_bbl_tm(jpi,jpj), &
	595	& utr_bbl_tm(jpi,jpj) , vtr_bbl_tm(jpi,jpj), &
	596	#endif
[2892]	597	& rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , &
	598	& STAT=trc_sub_alloc )
	599	IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate arrays')
	600
	601	!
	602	END FUNCTION trc_sub_alloc
	603
	604	#else
	605	!!----------------------------------------------------------------------
	606	!! Default key NO passive tracers
	607	!!----------------------------------------------------------------------
	608	CONTAINS
	609	SUBROUTINE trc_sub_stp( kt ) ! Empty routine
	610	WRITE(,) 'trc_sub_stp: You should not have seen this print! error?', kt
	611	END SUBROUTINE trc_sub_stp
	612	SUBROUTINE trc_sub_ini ! Empty routine
	613	WRITE(,) 'trc_sub_ini: You should not have seen this print! error?', kt
	614	END SUBROUTINE trc_sub_ini
	615
	616	#endif
	617
	618	!!======================================================================
	619	END MODULE trcsub

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

Download in other formats: