Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

traadv_cen.F90

Last change on this file was 14834, checked in by hadcv, 3 years ago
#2600: Merge in dev_r14273_HPC-02_Daley_Tiling
Property svn:keywords set to `Id`
File size: 10.6 KB

Rev	Line
[5770]	1	MODULE traadv_cen
	2	!!======================================================================
	3	!! * MODULE traadv_cen *
[6140]	4	!! Ocean tracers: advective trend (2nd/4th order centered)
[5770]	5	!!======================================================================
	6	!! History : 3.7 ! 2014-05 (G. Madec) original code
	7	!!----------------------------------------------------------------------
	8
	9	!!----------------------------------------------------------------------
[6140]	10	!! tra_adv_cen : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order)
	11	!! NB: on the vertical it is actually a 4th order COMPACT scheme which is used
[5770]	12	!!----------------------------------------------------------------------
[6140]	13	USE dom_oce ! ocean space and time domain
	14	USE eosbn2 ! equation of state
[14072]	15	USE traadv_fct ! acces to routine interp_4th_cpt
[6140]	16	USE trd_oce ! trends: ocean variables
[14072]	17	USE trdtra ! trends manager: tracers
[6140]	18	USE diaptr ! poleward transport diagnostics
[7646]	19	USE diaar5 ! AR5 diagnostics
[5770]	20	!
[6140]	21	USE in_out_manager ! I/O manager
	22	USE iom ! IOM library
	23	USE trc_oce ! share passive tracers/Ocean variables
	24	USE lib_mpp ! MPP library
[14834]	25	#if defined key_loop_fusion
	26	USE traadv_cen_lf ! centered scheme (tra_adv_cen routine - loop fusion version)
	27	#endif
[5770]	28
	29	IMPLICIT NONE
	30	PRIVATE
	31
[9019]	32	PUBLIC tra_adv_cen ! called by traadv.F90
[14072]	33
[5770]	34	REAL(wp) :: r1_6 = 1._wp / 6._wp ! =1/6
	35
[9019]	36	LOGICAL :: l_trd ! flag to compute trends
	37	LOGICAL :: l_ptr ! flag to compute poleward transport
	38	LOGICAL :: l_hst ! flag to compute heat/salt transport
[7646]	39
[5770]	40	!! * Substitutions
[12377]	41	# include "do_loop_substitute.h90"
[13237]	42	# include "domzgr_substitute.h90"
[5770]	43	!!----------------------------------------------------------------------
[9598]	44	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[10068]	45	!! $Id$
	46	!! Software governed by the CeCILL license (see ./LICENSE)
[5770]	47	!!----------------------------------------------------------------------
	48	CONTAINS
	49
[12377]	50	SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pU, pV, pW, &
[14072]	51	& Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
[5770]	52	!!----------------------------------------------------------------------
	53	!! * ROUTINE tra_adv_cen *
[14072]	54	!!
[5770]	55	!! ** Purpose : Compute the now trend due to the advection of tracers
	56	!! and add it to the general trend of passive tracer equations.
	57	!!
	58	!! ** Method : The advection is evaluated by a 2nd or 4th order scheme
[14072]	59	!! using now fields (leap-frog scheme).
[5770]	60	!! kn_cen_h = 2 ==>> 2nd order centered scheme on the horizontal
	61	!! = 4 ==>> 4th order - - - -
	62	!! kn_cen_v = 2 ==>> 2nd order centered scheme on the vertical
	63	!! = 4 ==>> 4th order COMPACT scheme - -
	64	!!
[12377]	65	!! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends
[6140]	66	!! - send trends to trdtra module for further diagnostcs (l_trdtra=T)
[12377]	67	!! - poleward advective heat and salt transport (l_diaptr=T)
[5770]	68	!!----------------------------------------------------------------------
[12377]	69	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	70	INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices
	71	INTEGER , INTENT(in ) :: kit000 ! first time step index
	72	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	73	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	74	INTEGER , INTENT(in ) :: kn_cen_h ! =2/4 (2nd or 4th order scheme)
	75	INTEGER , INTENT(in ) :: kn_cen_v ! =2/4 (2nd or 4th order scheme)
[14834]	76	! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
[12377]	77	REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components
	78	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
[5770]	79	!
	80	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	81	INTEGER :: ierr ! local integer
	82	REAL(wp) :: zC2t_u, zC4t_u ! local scalars
	83	REAL(wp) :: zC2t_v, zC4t_v ! - -
[13982]	84	REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwx, zwy, zwz, ztu, ztv, ztw
[5770]	85	!!----------------------------------------------------------------------
	86	!
[14834]	87	#if defined key_loop_fusion
	88	CALL tra_adv_cen_lf ( kt, nit000, cdtype, pU, pV, pW, Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
	89	#else
	90	IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
[13982]	91	IF( kt == kit000 ) THEN
	92	IF(lwp) WRITE(numout,*)
	93	IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v
	94	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
	95	ENDIF
	96	! ! set local switches
	97	l_trd = .FALSE.
	98	l_hst = .FALSE.
	99	l_ptr = .FALSE.
	100	IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
	101	IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
	102	IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
	103	& iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
[5770]	104	ENDIF
[7646]	105	!
[14072]	106	!
[6140]	107	zwz(:,:, 1 ) = 0._wp ! surface & bottom vertical flux set to zero for all tracers
	108	zwz(:,:,jpk) = 0._wp
[5770]	109	!
	110	DO jn = 1, kjpt !== loop over the tracers ==!
	111	!
[6140]	112	SELECT CASE( kn_cen_h ) !-- Horizontal fluxes --!
[5770]	113	!
[6140]	114	CASE( 2 ) !* 2nd order centered
[13295]	115	DO_3D( 1, 0, 1, 0, 1, jpkm1 )
[12377]	116	zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) )
	117	zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) )
	118	END_3D
[5770]	119	!
[6140]	120	CASE( 4 ) !* 4th order centered
	121	ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero
[5770]	122	ztv(:,:,jpk) = 0._wp
[13982]	123	DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) ! masked gradient
[12377]	124	ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
	125	ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
	126	END_3D
[14834]	127	IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. ) ! Lateral boundary cond.
[5770]	128	!
[13982]	129	DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 ) ! Horizontal advective fluxes
[12377]	130	zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! C2 interpolation of T at u- & v-points (x2)
	131	zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm)
	132	! ! C4 interpolation of T at u- & v-points (x2)
	133	zC4t_u = zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) )
	134	zC4t_v = zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) )
	135	! ! C4 fluxes
	136	zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * zC4t_u
	137	zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v
	138	END_3D
[14834]	139	IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. )
[5770]	140	!
	141	CASE DEFAULT
[13457]	142	CALL ctl_stop( 'traadv_cen: wrong value for nn_cen' )
[5770]	143	END SELECT
	144	!
[6140]	145	SELECT CASE( kn_cen_v ) !-- Vertical fluxes --! (interior)
[5770]	146	!
[6140]	147	CASE( 2 ) !* 2nd order centered
[13295]	148	DO_3D( 0, 0, 0, 0, 2, jpk )
[12377]	149	zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) * wmask(ji,jj,jk)
	150	END_3D
[5770]	151	!
[6140]	152	CASE( 4 ) !* 4th order compact
[12377]	153	CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! ztw = interpolated value of T at w-point
[13295]	154	DO_3D( 0, 0, 0, 0, 2, jpkm1 )
[12377]	155	zwz(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
	156	END_3D
[5770]	157	!
	158	END SELECT
	159	!
[6140]	160	IF( ln_linssh ) THEN !* top value (linear free surf. only as zwz is multiplied by wmask)
[5770]	161	IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean)
[13295]	162	DO_2D( 1, 1, 1, 1 )
[14072]	163	zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)
[12377]	164	END_2D
[5770]	165	ELSE ! no ice-shelf cavities (only ocean surface)
[13982]	166	DO_2D( 1, 1, 1, 1 )
	167	zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)
	168	END_2D
[5770]	169	ENDIF
	170	ENDIF
[14072]	171	!
[13497]	172	DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Divergence of advective fluxes --!
[12377]	173	pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) &
	174	& - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &
	175	& + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) &
[13237]	176	& + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) &
	177	& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
[12377]	178	END_3D
[13497]	179	! ! trend diagnostics
[7646]	180	IF( l_trd ) THEN
[12377]	181	CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
	182	CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
	183	CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
[13982]	184	ENDIF
	185	! ! "Poleward" heat and salt transports
[9019]	186	IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
[7646]	187	! ! heat and salt transport
[9019]	188	IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
[5770]	189	!
	190	END DO
	191	!
[14834]	192	#endif
[5770]	193	END SUBROUTINE tra_adv_cen
[14072]	194
[5770]	195	!!======================================================================
	196	END MODULE traadv_cen

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

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

Context Navigation

source: NEMO/trunk/src/OCE/TRA/traadv_cen.F90

Download in other formats: