Context Navigation

traldf_lap_blp.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

Property svn:keywords set to Id

File size: 14.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
	19	USE trc_oce ! share passive tracers/Ocean variables
	20	USE zpshde ! partial step: hor. derivative (zps_hde routine)
[5836]	21	!
[5883]	22	USE in_out_manager ! I/O manager
	23	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	24	USE lib_mpp ! distribued memory computing library
	25	USE timing ! Timing
	26	USE wrk_nemo ! Memory allocation
[3]	27
	28	IMPLICIT NONE
	29	PRIVATE
	30
[5883]	31	PUBLIC tra_ldf_lap ! called by traldf.F90
	32	PUBLIC tra_ldf_blp ! called by traldf.F90
[3]	33
[5883]	34	! ! Flag to control the type of lateral diffusive operator
	35	INTEGER, PARAMETER, PUBLIC :: np_ERROR =-10 ! error in specification of lateral diffusion
	36	INTEGER, PARAMETER, PUBLIC :: np_no_ldf = 00 ! without operator (i.e. no lateral diffusive trend)
	37	! !! laplacian ! bilaplacian !
	38	INTEGER, PARAMETER, PUBLIC :: np_lap = 10 , np_blp = 20 ! iso-level operator
	39	INTEGER, PARAMETER, PUBLIC :: np_lap_i = 11 , np_blp_i = 21 ! standard iso-neutral or geopotential operator
	40	INTEGER, PARAMETER, PUBLIC :: np_lap_it = 12 , np_blp_it = 22 ! triad iso-neutral or geopotential operator
	41
[3]	42	!! * Substitutions
	43	# include "vectopt_loop_substitute.h90"
	44	!!----------------------------------------------------------------------
[5836]	45	!! NEMO/OPA 3.7 , NEMO Consortium (2014)
[2528]	46	!! $Id$
	47	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	48	!!----------------------------------------------------------------------
	49	CONTAINS
	50
[5836]	51	SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv , &
	52	& pgui, pgvi, &
	53	& ptb , pta , kjpt, kpass )
[3]	54	!!----------------------------------------------------------------------
	55	!! * ROUTINE tra_ldf_lap *
	56	!!
	57	!! ** Purpose : Compute the before horizontal tracer (t & s) diffusive
	58	!! trend and add it to the general trend of tracer equation.
	59	!!
	60	!! ** Method : Second order diffusive operator evaluated using before
	61	!! fields (forward time scheme). The horizontal diffusive trends of
[2528]	62	!! the tracer is given by:
[5836]	63	!! difft = 1/(e1e2te3t) { di-1[ pahu e2ue3u/e1u di(tb) ]
	64	!! + dj-1[ pahv e1v*e3v/e2v dj(tb) ] }
[2528]	65	!! Add this trend to the general tracer trend pta :
	66	!! pta = pta + difft
[3]	67	!!
[2528]	68	!! ** Action : - Update pta arrays with the before iso-level
[3]	69	!! harmonic mixing trend.
[2528]	70	!!----------------------------------------------------------------------
	71	INTEGER , INTENT(in ) :: kt ! ocean time-step index
[5836]	72	INTEGER , INTENT(in ) :: kit000 ! first time step index
[2528]	73	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	74	INTEGER , INTENT(in ) :: kjpt ! number of tracers
[5836]	75	INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage
	76	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
[2528]	77	REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
[5836]	78	REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
[2528]	79	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields
	80	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend
[2715]	81	!
[5836]	82	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	83	REAL(wp) :: zsign ! local scalars
	84	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zaheeu, zaheev
[3]	85	!!----------------------------------------------------------------------
[3294]	86	!
[5836]	87	IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap')
[3294]	88	!
[5836]	89	IF( kt == nit000 .AND. lwp ) THEN
	90	WRITE(numout,*)
	91	WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
	92	WRITE(numout,*) '~~~~~~~~~~~ '
[3]	93	ENDIF
[5836]	94	!
	95	CALL wrk_alloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev )
	96	!
	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
	101	DO jk = 1, jpkm1
	102	DO jj = 1, jpjm1
	103	DO ji = 1, fs_jpim1 ! vector opt.
[5845]	104	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!
	105	zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) !!gm * vmask(ji,jj,jk)
[5836]	106	END DO
	107	END DO
	108	END DO
	109	!
	110	! ! =========== !
	111	DO jn = 1, kjpt ! tracer loop !
	112	! ! =========== !
	113	!
	114	DO jk = 1, jpkm1 !== First derivative (gradient) ==!
[457]	115	DO jj = 1, jpjm1
[5836]	116	DO ji = 1, fs_jpim1
	117	ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) )
	118	ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
[457]	119	END DO
	120	END DO
[5836]	121	END DO
	122	IF( ln_zps ) THEN ! set gradient at bottom/top ocean level
	123	DO jj = 1, jpjm1 ! bottom
	124	DO ji = 1, fs_jpim1
	125	ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
	126	ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
[5120]	127	END DO
[5836]	128	END DO
	129	IF( ln_isfcav ) THEN ! top in ocean cavities only
[5120]	130	DO jj = 1, jpjm1
	131	DO ji = 1, fs_jpim1 ! vector opt.
[5836]	132	IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn)
	133	IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn)
[2528]	134	END DO
	135	END DO
	136	ENDIF
[5836]	137	ENDIF
	138	!
	139	DO jk = 1, jpkm1 !== Second derivative (divergence) added to the general tracer trends ==!
[2528]	140	DO jj = 2, jpjm1
[5836]	141	DO ji = fs_2, fs_jpim1
	142	pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) &
	143	& + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) &
[5845]	144	& / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
[3]	145	END DO
	146	END DO
[5836]	147	END DO
[2528]	148	!
[5836]	149	! !== "Poleward" diffusive heat or salt transports ==!
	150	IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR. & !== first pass only ( laplacian) ==!
	151	( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass only (bilaplacian) ==!
	152	IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
	153	IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -ztv(:,:,:) )
	154	IF( jn == jp_sal) str_ldf(:) = ptr_sj( -ztv(:,:,:) )
	155	ENDIF
[457]	156	ENDIF
[5836]	157	! ! ==================
	158	END DO ! end of tracer loop
	159	! ! ==================
[3294]	160	!
[5836]	161	CALL wrk_dealloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev )
	162	!
	163	IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap')
	164	!
[3]	165	END SUBROUTINE tra_ldf_lap
[5836]	166
[5883]	167
	168	SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv , &
	169	& pgui, pgvi, &
	170	& ptb , pta , kjpt, kldf )
	171	!!----------------------------------------------------------------------
	172	!! * ROUTINE tra_ldf_blp *
	173	!!
	174	!! ** Purpose : Compute the before lateral tracer diffusive
	175	!! trend and add it to the general trend of tracer equation.
	176	!!
	177	!! ** Method : The lateral diffusive trends is provided by a bilaplacian
	178	!! operator applied to before field (forward in time).
	179	!! It is computed by two successive calls to laplacian routine
	180	!!
	181	!! ** Action : pta updated with the before rotated bilaplacian diffusion
	182	!!----------------------------------------------------------------------
	183	INTEGER , INTENT(in ) :: kt ! ocean time-step index
	184	INTEGER , INTENT(in ) :: kit000 ! first time step index
	185	CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
	186	INTEGER , INTENT(in ) :: kjpt ! number of tracers
	187	INTEGER , INTENT(in ) :: kldf ! type of operator used
	188	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
	189	REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
	190	REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
	191	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields
	192	REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend
	193	!
	194	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	195	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap ! laplacian at t-point
	196	REAL(wp), POINTER, DIMENSION(:,:,:) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points)
	197	REAL(wp), POINTER, DIMENSION(:,:,:) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points)
	198	!!---------------------------------------------------------------------
	199	!
	200	IF( nn_timing == 1 ) CALL timing_start('tra_ldf_blp')
	201	!
	202	CALL wrk_alloc( jpi,jpj,jpk,kjpt, zlap )
	203	CALL wrk_alloc( jpi,jpj, kjpt, zglu, zglv, zgui, zgvi )
	204	!
	205	IF( kt == kit000 .AND. lwp ) THEN
	206	WRITE(numout,*)
	207	SELECT CASE ( kldf )
	208	CASE ( np_blp ) ; WRITE(numout,*) 'tra_ldf_blp : iso-level bilaplacian operator on ', cdtype
	209	CASE ( np_blp_i ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)'
	210	CASE ( np_blp_it ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)'
	211	END SELECT
	212	WRITE(numout,*) '~~~~~~~~~~~'
	213	ENDIF
	214
	215	zlap(:,:,:,:) = 0._wp
	216	!
	217	SELECT CASE ( kldf ) !== 1st laplacian applied to ptb (output in zlap) ==!
	218	!
	219	CASE ( np_blp ) ! iso-level bilaplacian
	220	CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, zlap, kjpt, 1 )
	221	CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec)
	222	CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
	223	CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies)
	224	CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
	225	END SELECT
	226	!
	227	DO jn = 1, kjpt
	228	CALL lbc_lnk( zlap(:,:,:,jn) , 'T', 1. ) ! Lateral boundary conditions (unchanged sign)
	229	END DO
	230	! ! Partial top/bottom cell: GRADh( zlap )
	231	IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom
	232	ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, kjpt, zlap, zglu, zglv ) ! only bottom
	233	ENDIF
	234	!
	235	SELECT CASE ( kldf ) !== 2nd laplacian applied to zlap (output in pta) ==!
	236	!
	237	CASE ( np_blp ) ! iso-level bilaplacian
	238	CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta, kjpt, 2 )
	239	CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec)
	240	CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
	241	CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies)
	242	CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
	243	END SELECT
	244	!
	245	CALL wrk_dealloc( jpi,jpj,jpk,kjpt, zlap )
	246	CALL wrk_dealloc( jpi,jpj ,kjpt, zglu, zglv, zgui, zgvi )
	247	!
	248	IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_blp')
	249	!
	250	END SUBROUTINE tra_ldf_blp
	251
[3]	252	!!==============================================================================
[5883]	253	END MODULE traldf_lap_blp

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

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

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90 @ 6140

Download in other formats: