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 NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP – NEMO

Context Navigation

source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/trcsub.F90 @ 10297

Last change on this file since 10297 was 10297, checked in by smasson, 5 years ago
dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2a: add report calls of mppmin/max/sum, see #2133
Property svn:keywords set to `Id`
File size: 29.0 KB

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

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

Download in other formats: