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/trunk/src/OCE/TRA – NEMO

Context Navigation

source: NEMO/trunk/src/OCE/TRA/traldf_lap_blp.F90 @ 11993

Last change on this file since 11993 was 11993, checked in by cetlod, 4 years ago
trunk : undo bad commit. Oups
Property svn:keywords set to `Id`
File size: 13.4 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	!!==============================================================================
[5883]	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
	39	# include "vectopt_loop_substitute.h90"
	40	!!----------------------------------------------------------------------
[9598]	41	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2528]	42	!! $Id$
[10068]	43	!! Software governed by the CeCILL license (see ./LICENSE)
[3]	44	!!----------------------------------------------------------------------
	45	CONTAINS
	46
[5836]	47	SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv , &
	48	& pgui, pgvi, &
	49	& ptb , pta , kjpt, kpass )
[3]	50	!!----------------------------------------------------------------------
	51	!! * ROUTINE tra_ldf_lap *
	52	!!
	53	!! ** Purpose : Compute the before horizontal tracer (t & s) diffusive
	54	!! trend and add it to the general trend of tracer equation.
	55	!!
	56	!! ** Method : Second order diffusive operator evaluated using before
	57	!! fields (forward time scheme). The horizontal diffusive trends of
[2528]	58	!! the tracer is given by:
[5836]	59	!! difft = 1/(e1e2te3t) { di-1[ pahu e2ue3u/e1u di(tb) ]
	60	!! + dj-1[ pahv e1v*e3v/e2v dj(tb) ] }
[2528]	61	!! Add this trend to the general tracer trend pta :
	62	!! pta = pta + difft
[3]	63	!!
[2528]	64	!! ** Action : - Update pta arrays with the before iso-level
[3]	65	!! harmonic mixing trend.
[2528]	66	!!----------------------------------------------------------------------
	67	INTEGER , INTENT(in ) :: kt ! ocean time-step index
[5836]	68	INTEGER , INTENT(in ) :: kit000 ! first time step index
[2528]	69	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	70	INTEGER , INTENT(in ) :: kjpt ! number of tracers
[5836]	71	INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage
	72	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
[2528]	73	REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
[5836]	74	REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
[2528]	75	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields
	76	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend
[2715]	77	!
[5836]	78	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	79	REAL(wp) :: zsign ! local scalars
[9019]	80	REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zaheeu, zaheev
[3]	81	!!----------------------------------------------------------------------
[3294]	82	!
[5836]	83	IF( kt == nit000 .AND. lwp ) THEN
	84	WRITE(numout,*)
	85	WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
	86	WRITE(numout,*) '~~~~~~~~~~~ '
[3]	87	ENDIF
[5836]	88	!
[7646]	89	l_hst = .FALSE.
	90	l_ptr = .FALSE.
[11993]	91	IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE.
[7646]	92	IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
	93	& iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
	94	!
[5836]	95	! !== Initialization of metric arrays used for all tracers ==!
	96	IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0)
	97	ELSE ; zsign = -1._wp
	98	ENDIF
	99	DO jk = 1, jpkm1
	100	DO jj = 1, jpjm1
	101	DO ji = 1, fs_jpim1 ! vector opt.
[5845]	102	zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) !!gm * umask(ji,jj,jk) pah masked!
	103	zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) !!gm * vmask(ji,jj,jk)
[5836]	104	END DO
	105	END DO
	106	END DO
	107	!
	108	! ! =========== !
	109	DO jn = 1, kjpt ! tracer loop !
	110	! ! =========== !
	111	!
	112	DO jk = 1, jpkm1 !== First derivative (gradient) ==!
[457]	113	DO jj = 1, jpjm1
[5836]	114	DO ji = 1, fs_jpim1
	115	ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) )
	116	ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
[457]	117	END DO
	118	END DO
[5836]	119	END DO
	120	IF( ln_zps ) THEN ! set gradient at bottom/top ocean level
	121	DO jj = 1, jpjm1 ! bottom
	122	DO ji = 1, fs_jpim1
	123	ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
	124	ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
[5120]	125	END DO
[5836]	126	END DO
	127	IF( ln_isfcav ) THEN ! top in ocean cavities only
[5120]	128	DO jj = 1, jpjm1
	129	DO ji = 1, fs_jpim1 ! vector opt.
[5836]	130	IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn)
	131	IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn)
[2528]	132	END DO
	133	END DO
	134	ENDIF
[5836]	135	ENDIF
	136	!
	137	DO jk = 1, jpkm1 !== Second derivative (divergence) added to the general tracer trends ==!
[2528]	138	DO jj = 2, jpjm1
[5836]	139	DO ji = fs_2, fs_jpim1
	140	pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) &
	141	& + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) &
[5845]	142	& / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
[3]	143	END DO
	144	END DO
[5836]	145	END DO
[2528]	146	!
[5836]	147	! !== "Poleward" diffusive heat or salt transports ==!
	148	IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR. & !== first pass only ( laplacian) ==!
	149	( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass only (bilaplacian) ==!
[7646]	150
	151	IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -ztv(:,:,:) )
	152	IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -ztu(:,:,:), -ztv(:,:,:) )
[457]	153	ENDIF
[5836]	154	! ! ==================
	155	END DO ! end of tracer loop
	156	! ! ==================
[3294]	157	!
[3]	158	END SUBROUTINE tra_ldf_lap
[5836]	159
[5883]	160
	161	SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv , &
	162	& pgui, pgvi, &
	163	& ptb , pta , kjpt, kldf )
	164	!!----------------------------------------------------------------------
	165	!! * ROUTINE tra_ldf_blp *
	166	!!
	167	!! ** Purpose : Compute the before lateral tracer diffusive
	168	!! trend and add it to the general trend of tracer equation.
	169	!!
	170	!! ** Method : The lateral diffusive trends is provided by a bilaplacian
	171	!! operator applied to before field (forward in time).
	172	!! It is computed by two successive calls to laplacian routine
	173	!!
	174	!! ** Action : pta updated with the before rotated bilaplacian diffusion
	175	!!----------------------------------------------------------------------
	176	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	177	INTEGER , INTENT(in ) :: kit000 ! first time step index
	178	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	179	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	180	INTEGER , INTENT(in ) :: kldf ! type of operator used
	181	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
	182	REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
	183	REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
	184	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields
	185	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend
	186	!
	187	INTEGER :: ji, jj, jk, jn ! dummy loop indices
[9019]	188	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) :: zlap ! laplacian at t-point
	189	REAL(wp), DIMENSION(jpi,jpj, kjpt) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points)
	190	REAL(wp), DIMENSION(jpi,jpj, kjpt) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points)
[5883]	191	!!---------------------------------------------------------------------
	192	!
	193	IF( kt == kit000 .AND. lwp ) THEN
	194	WRITE(numout,*)
	195	SELECT CASE ( kldf )
	196	CASE ( np_blp ) ; WRITE(numout,*) 'tra_ldf_blp : iso-level bilaplacian operator on ', cdtype
	197	CASE ( np_blp_i ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)'
	198	CASE ( np_blp_it ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)'
	199	END SELECT
	200	WRITE(numout,*) '~~~~~~~~~~~'
	201	ENDIF
	202
	203	zlap(:,:,:,:) = 0._wp
	204	!
	205	SELECT CASE ( kldf ) !== 1st laplacian applied to ptb (output in zlap) ==!
	206	!
	207	CASE ( np_blp ) ! iso-level bilaplacian
	208	CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, zlap, kjpt, 1 )
	209	CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec)
	210	CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
	211	CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies)
	212	CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
	213	END SELECT
	214	!
[10425]	215	CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1. ) ! Lateral boundary conditions (unchanged sign)
[5883]	216	! ! Partial top/bottom cell: GRADh( zlap )
	217	IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom
	218	ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, kjpt, zlap, zglu, zglv ) ! only bottom
	219	ENDIF
	220	!
	221	SELECT CASE ( kldf ) !== 2nd laplacian applied to zlap (output in pta) ==!
	222	!
	223	CASE ( np_blp ) ! iso-level bilaplacian
	224	CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta, kjpt, 2 )
	225	CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec)
	226	CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
	227	CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies)
	228	CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
	229	END SELECT
	230	!
	231	END SUBROUTINE tra_ldf_blp
	232
[3]	233	!!==============================================================================
[5883]	234	END MODULE traldf_lap_blp

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

Download in other formats: