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.

traldf_lap_blp.F90 in NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/TRA – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/TRA/traldf_lap_blp.F90 @ 13151

Last change on this file since 13151 was 13151, checked in by gm, 4 years ago
result from merge with qco r12983
Property svn:keywords set to `Id`
File size: 13.0 KB

Rev	Line
[5883]	1	MODULE traldf_lap_blp
[3]	2	!!==============================================================================
[5883]	3	!! * MODULE traldf_lap_blp *
[5836]	4	!! Ocean tracers: lateral diffusivity trend (laplacian and bilaplacian)
[3]	5	!!==============================================================================
[13151]	6	!! History : 3.7 ! 2014-01 (G. Madec, S. Masson) Original code, re-entrant laplacian
[2528]	7	!!----------------------------------------------------------------------
[3]	8
	9	!!----------------------------------------------------------------------
[5883]	10	!! tra_ldf_lap : tracer trend update with iso-level laplacian diffusive operator
	11	!! tra_ldf_blp : tracer trend update with iso-level or iso-neutral bilaplacian operator
[3]	12	!!----------------------------------------------------------------------
[5883]	13	USE oce ! ocean dynamics and active tracers
	14	USE dom_oce ! ocean space and time domain
	15	USE ldftra ! lateral physics: eddy diffusivity
	16	USE traldf_iso ! iso-neutral lateral diffusion (standard operator) (tra_ldf_iso routine)
	17	USE traldf_triad ! iso-neutral lateral diffusion (triad operator) (tra_ldf_triad routine)
	18	USE diaptr ! poleward transport diagnostics
[7646]	19	USE diaar5 ! AR5 diagnostics
[5883]	20	USE trc_oce ! share passive tracers/Ocean variables
	21	USE zpshde ! partial step: hor. derivative (zps_hde routine)
[5836]	22	!
[5883]	23	USE in_out_manager ! I/O manager
[9019]	24	USE iom ! I/O library
[5883]	25	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	26	USE lib_mpp ! distribued memory computing library
	27	USE timing ! Timing
[3]	28
	29	IMPLICIT NONE
	30	PRIVATE
	31
[5883]	32	PUBLIC tra_ldf_lap ! called by traldf.F90
	33	PUBLIC tra_ldf_blp ! called by traldf.F90
[3]	34
[7646]	35	LOGICAL :: l_ptr ! flag to compute poleward transport
	36	LOGICAL :: l_hst ! flag to compute heat transport
	37
[3]	38	!! * Substitutions
[12377]	39	# include "do_loop_substitute.h90"
[13151]	40	# include "domzgr_substitute.h90"
[3]	41	!!----------------------------------------------------------------------
[9598]	42	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2528]	43	!! $Id$
[10068]	44	!! Software governed by the CeCILL license (see ./LICENSE)
[3]	45	!!----------------------------------------------------------------------
	46	CONTAINS
	47
[12377]	48	SUBROUTINE tra_ldf_lap( kt, Kmm, kit000, cdtype, pahu, pahv , &
	49	& pgu , pgv , pgui, pgvi, &
[13151]	50	& pt , pt_rhs, kjpt, kpass )
[3]	51	!!----------------------------------------------------------------------
	52	!! * ROUTINE tra_ldf_lap *
[13151]	53	!!
	54	!! ** Purpose : Compute the before horizontal tracer (t & s) diffusive
[3]	55	!! trend and add it to the general trend of tracer equation.
	56	!!
	57	!! ** Method : Second order diffusive operator evaluated using before
[13151]	58	!! fields (forward time scheme). The horizontal diffusive trends of
[2528]	59	!! the tracer is given by:
[5836]	60	!! difft = 1/(e1e2te3t) { di-1[ pahu e2ue3u/e1u di(tb) ]
	61	!! + dj-1[ pahv e1v*e3v/e2v dj(tb) ] }
[12377]	62	!! Add this trend to the general tracer trend pt_rhs :
	63	!! pt_rhs = pt_rhs + difft
[3]	64	!!
[13151]	65	!! ** Action : - Update pt_rhs arrays with the before iso-level
[3]	66	!! harmonic mixing trend.
[2528]	67	!!----------------------------------------------------------------------
	68	INTEGER , INTENT(in ) :: kt ! ocean time-step index
[5836]	69	INTEGER , INTENT(in ) :: kit000 ! first time step index
[2528]	70	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	71	INTEGER , INTENT(in ) :: kjpt ! number of tracers
[5836]	72	INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage
[12377]	73	INTEGER , INTENT(in ) :: Kmm ! ocean time level index
[5836]	74	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
[2528]	75	REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
[5836]	76	REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
[12377]	77	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before tracer fields
[13151]	78	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend
[2715]	79	!
[5836]	80	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	81	REAL(wp) :: zsign ! local scalars
[9019]	82	REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zaheeu, zaheev
[3]	83	!!----------------------------------------------------------------------
[3294]	84	!
[5836]	85	IF( kt == nit000 .AND. lwp ) THEN
	86	WRITE(numout,*)
	87	WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
	88	WRITE(numout,*) '~~~~~~~~~~~ '
[3]	89	ENDIF
[5836]	90	!
[7646]	91	l_hst = .FALSE.
	92	l_ptr = .FALSE.
[12377]	93	IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE.
[7646]	94	IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
	95	& iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
	96	!
[5836]	97	! !== Initialization of metric arrays used for all tracers ==!
	98	IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0)
	99	ELSE ; zsign = -1._wp
	100	ENDIF
[12377]	101	DO_3D_10_10( 1, jpkm1 )
	102	zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) !!gm * umask(ji,jj,jk) pah masked!
	103	zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) !!gm * vmask(ji,jj,jk)
	104	END_3D
[5836]	105	!
	106	! ! =========== !
	107	DO jn = 1, kjpt ! tracer loop !
[13151]	108	! ! =========== !
	109	!
[12377]	110	DO_3D_10_10( 1, jpkm1 )
	111	ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) )
	112	ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) )
	113	END_3D
[5836]	114	IF( ln_zps ) THEN ! set gradient at bottom/top ocean level
[12377]	115	DO_2D_10_10
	116	ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
	117	ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
	118	END_2D
[5836]	119	IF( ln_isfcav ) THEN ! top in ocean cavities only
[12377]	120	DO_2D_10_10
[13151]	121	IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn)
	122	IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn)
[12377]	123	END_2D
[2528]	124	ENDIF
[5836]	125	ENDIF
	126	!
[12377]	127	DO_3D_00_00( 1, jpkm1 )
	128	pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) &
	129	& + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) &
	130	& / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) )
	131	END_3D
[2528]	132	!
[5836]	133	! !== "Poleward" diffusive heat or salt transports ==!
	134	IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR. & !== first pass only ( laplacian) ==!
	135	( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass only (bilaplacian) ==!
[7646]	136
	137	IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -ztv(:,:,:) )
	138	IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -ztu(:,:,:), -ztv(:,:,:) )
[457]	139	ENDIF
[5836]	140	! ! ==================
	141	END DO ! end of tracer loop
	142	! ! ==================
[3294]	143	!
[3]	144	END SUBROUTINE tra_ldf_lap
[5883]	145
[13151]	146
[12377]	147	SUBROUTINE tra_ldf_blp( kt, Kmm, kit000, cdtype, pahu, pahv , &
	148	& pgu , pgv , pgui, pgvi, &
	149	& pt , pt_rhs, kjpt, kldf )
[5883]	150	!!----------------------------------------------------------------------
	151	!! * ROUTINE tra_ldf_blp *
[13151]	152	!!
	153	!! ** Purpose : Compute the before lateral tracer diffusive
[5883]	154	!! trend and add it to the general trend of tracer equation.
	155	!!
	156	!! ** Method : The lateral diffusive trends is provided by a bilaplacian
	157	!! operator applied to before field (forward in time).
	158	!! It is computed by two successive calls to laplacian routine
	159	!!
	160	!! ** Action : pta updated with the before rotated bilaplacian diffusion
	161	!!----------------------------------------------------------------------
	162	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	163	INTEGER , INTENT(in ) :: kit000 ! first time step index
	164	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	165	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	166	INTEGER , INTENT(in ) :: kldf ! type of operator used
[12377]	167	INTEGER , INTENT(in ) :: Kmm ! ocean time level indices
[5883]	168	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
	169	REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
	170	REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
[12377]	171	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields
	172	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend
[5883]	173	!
	174	INTEGER :: ji, jj, jk, jn ! dummy loop indices
[9019]	175	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) :: zlap ! laplacian at t-point
	176	REAL(wp), DIMENSION(jpi,jpj, kjpt) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points)
	177	REAL(wp), DIMENSION(jpi,jpj, kjpt) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points)
[5883]	178	!!---------------------------------------------------------------------
	179	!
	180	IF( kt == kit000 .AND. lwp ) THEN
	181	WRITE(numout,*)
	182	SELECT CASE ( kldf )
	183	CASE ( np_blp ) ; WRITE(numout,*) 'tra_ldf_blp : iso-level bilaplacian operator on ', cdtype
	184	CASE ( np_blp_i ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)'
	185	CASE ( np_blp_it ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)'
	186	END SELECT
	187	WRITE(numout,*) '~~~~~~~~~~~'
	188	ENDIF
	189
	190	zlap(:,:,:,:) = 0._wp
	191	!
[12377]	192	SELECT CASE ( kldf ) !== 1st laplacian applied to pt (output in zlap) ==!
[5883]	193	!
	194	CASE ( np_blp ) ! iso-level bilaplacian
[12377]	195	CALL tra_ldf_lap ( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, zlap, kjpt, 1 )
[5883]	196	CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec)
[12377]	197	CALL tra_ldf_iso ( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 )
[5883]	198	CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies)
[12377]	199	CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 )
[5883]	200	END SELECT
	201	!
[10425]	202	CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1. ) ! Lateral boundary conditions (unchanged sign)
[13151]	203	! ! Partial top/bottom cell: GRADh( zlap )
[12377]	204	IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom
[13151]	205	ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, Kmm, kjpt, zlap, zglu, zglv ) ! only bottom
[5883]	206	ENDIF
	207	!
[12377]	208	SELECT CASE ( kldf ) !== 2nd laplacian applied to zlap (output in pt_rhs) ==!
[5883]	209	!
	210	CASE ( np_blp ) ! iso-level bilaplacian
[12377]	211	CALL tra_ldf_lap ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt_rhs, kjpt, 2 )
[5883]	212	CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec)
[12377]	213	CALL tra_ldf_iso ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt , pt_rhs, kjpt, 2 )
[5883]	214	CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies)
[12377]	215	CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt , pt_rhs, kjpt, 2 )
[5883]	216	END SELECT
	217	!
	218	END SUBROUTINE tra_ldf_blp
	219
[3]	220	!!==============================================================================
[5883]	221	END MODULE traldf_lap_blp

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

Download in other formats: