Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

traadv.F90 @ 8079

Last change on this file since 8079 was 8079, checked in by andmirek, 7 years ago
#1882 a first working version with XIOS writing restart file. Works with MO suite u-am389
File size: 15.0 KB

Rev	Line
[458]	1	MODULE traadv
	2	!!==============================================================================
	3	!! * MODULE traadv *
	4	!! Ocean active tracers: advection trend
	5	!!==============================================================================
[2528]	6	!! History : 2.0 ! 2005-11 (G. Madec) Original code
	7	!! 3.3 ! 2010-09 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport
[4245]	8	!! 4.0 ! 2011-06 (G. Madec) Addition of Mixed Layer Eddy parameterisation
[458]	9	!!----------------------------------------------------------------------
[503]	10
	11	!!----------------------------------------------------------------------
[458]	12	!! tra_adv : compute ocean tracer advection trend
	13	!! tra_adv_ctl : control the different options of advection scheme
	14	!!----------------------------------------------------------------------
	15	USE oce ! ocean dynamics and active tracers
	16	USE dom_oce ! ocean space and time domain
[4292]	17	USE domvvl ! variable vertical scale factors
[503]	18	USE traadv_cen2 ! 2nd order centered scheme (tra_adv_cen2 routine)
[637]	19	USE traadv_tvd ! TVD scheme (tra_adv_tvd routine)
	20	USE traadv_muscl ! MUSCL scheme (tra_adv_muscl routine)
	21	USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine)
	22	USE traadv_ubs ! UBS scheme (tra_adv_ubs routine)
[2528]	23	USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine)
[458]	24	USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine)
[4245]	25	USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine)
[2528]	26	USE cla ! cross land advection (cla_traadv routine)
[503]	27	USE ldftra_oce ! lateral diffusion coefficient on tracers
[7061]	28	USE trd_oce ! trends: ocean variables
	29	USE trdtra ! trends manager: tracers
[5147]	30	!
[458]	31	USE in_out_manager ! I/O manager
[2715]	32	USE iom ! I/O module
[458]	33	USE prtctl ! Print control
[2715]	34	USE lib_mpp ! MPP library
[3294]	35	USE wrk_nemo ! Memory Allocation
	36	USE timing ! Timing
[4990]	37	USE sbc_oce
[5147]	38	USE diaptr ! Poleward heat transport
[458]	39
[3294]	40
[458]	41	IMPLICIT NONE
	42	PRIVATE
	43
[2528]	44	PUBLIC tra_adv ! routine called by step module
	45	PUBLIC tra_adv_init ! routine called by opa module
[2715]	46
[4147]	47	! !!* Namelist namtra_adv *
[8079]	48	!make ln_traadv_cen2 public. It's needed when XIOS is used to write restart file
	49	LOGICAL, PUBLIC :: ln_traadv_cen2 ! 2nd order centered scheme flag
[4147]	50	LOGICAL :: ln_traadv_tvd ! TVD scheme flag
[4990]	51	LOGICAL :: ln_traadv_tvd_zts ! TVD scheme flag with vertical sub time-stepping
[4147]	52	LOGICAL :: ln_traadv_muscl ! MUSCL scheme flag
	53	LOGICAL :: ln_traadv_muscl2 ! MUSCL2 scheme flag
	54	LOGICAL :: ln_traadv_ubs ! UBS scheme flag
	55	LOGICAL :: ln_traadv_qck ! QUICKEST scheme flag
	56	LOGICAL :: ln_traadv_msc_ups ! use upstream scheme within muscl
[458]	57
[3680]	58
[503]	59	INTEGER :: nadv ! choice of the type of advection scheme
[458]	60
	61	!! * Substitutions
[503]	62	# include "domzgr_substitute.h90"
	63	# include "vectopt_loop_substitute.h90"
[458]	64	!!----------------------------------------------------------------------
[2528]	65	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	66	!! $Id$
	67	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[458]	68	!!----------------------------------------------------------------------
	69	CONTAINS
	70
	71	SUBROUTINE tra_adv( kt )
	72	!!----------------------------------------------------------------------
	73	!! * ROUTINE tra_adv *
	74	!!
	75	!! ** Purpose : compute the ocean tracer advection trend.
	76	!!
[503]	77	!! ** Method : - Update (ua,va) with the advection term following nadv
[458]	78	!!----------------------------------------------------------------------
[2715]	79	!
[503]	80	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[2528]	81	!
	82	INTEGER :: jk ! dummy loop index
[3294]	83	REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn
[7061]	84	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace
[458]	85	!!----------------------------------------------------------------------
[2715]	86	!
[3294]	87	IF( nn_timing == 1 ) CALL timing_start('tra_adv')
	88	!
	89	CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
[2528]	90	! ! set time step
	91	IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000
[2715]	92	r2dtra(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping)
[2528]	93	ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1
[2715]	94	r2dtra(:) = 2._wp * rdttra(:) ! = 2 rdttra (leapfrog)
[458]	95	ENDIF
[2528]	96	!
[4147]	97	IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_traadv( kt ) !== Cross Land Advection ==! (hor. advection)
[2528]	98	!
	99	! !== effective transport ==!
	100	DO jk = 1, jpkm1
	101	zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only
	102	zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
	103	zwn(:,:,jk) = e1t(:,:) * e2t(:,:) * wn(:,:,jk)
	104	END DO
[4292]	105	!
	106	IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
	107	zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
	108	zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
	109	ENDIF
	110	!
[2558]	111	zun(:,:,jpk) = 0._wp ! no transport trough the bottom
	112	zvn(:,:,jpk) = 0._wp ! no transport trough the bottom
	113	zwn(:,:,jpk) = 0._wp ! no transport trough the bottom
[2528]	114	!
	115	IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) &
[3294]	116	& CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary)
[2528]	117	!
[4245]	118	IF( ln_mle ) CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the mle transport (if necessary)
[5147]	119	!
[2561]	120	CALL iom_put( "uocetr_eff", zun ) ! output effective transport
	121	CALL iom_put( "vocetr_eff", zvn )
	122	CALL iom_put( "wocetr_eff", zwn )
[5147]	123	!
	124	IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF
	125	!
[7061]	126	IF( l_trdtra ) THEN !* Save ta and sa trends
	127	CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
	128	ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
	129	ztrds(:,:,:) = tsa(:,:,:,jp_sal)
	130	ENDIF
	131	!
[2528]	132	SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
[5147]	133	CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered
	134	CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD
	135	CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL
	136	CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2
	137	CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS
	138	CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST
	139	CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS
[503]	140	!
[2528]	141	CASE (-1 ) !== esopa: test all possibility with control print ==!
[3294]	142	CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	143	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, &
	144	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	145	CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	146	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, &
	147	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3718]	148	CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups )
[2528]	149	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, &
	150	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	151	CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	152	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, &
	153	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	154	CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	155	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, &
	156	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[3294]	157	CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )
[2528]	158	CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, &
	159	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[458]	160	END SELECT
[2528]	161	!
[7061]	162	IF( l_trdtra ) THEN ! save the advective trends for further diagnostics
	163	DO jk = 1, jpkm1
	164	ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk)
	165	ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk)
	166	END DO
	167	CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt )
	168	CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds )
	169	CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
	170	ENDIF
[503]	171	! ! print mean trends (used for debugging)
[2528]	172	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, &
	173	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	174	!
[4245]	175	IF( nn_timing == 1 ) CALL timing_stop( 'tra_adv' )
[2715]	176	!
[3294]	177	CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
	178	!
[458]	179	END SUBROUTINE tra_adv
	180
	181
[2528]	182	SUBROUTINE tra_adv_init
[458]	183	!!---------------------------------------------------------------------
[2528]	184	!! * ROUTINE tra_adv_init *
[458]	185	!!
[503]	186	!! ** Purpose : Control the consistency between namelist options for
	187	!! tracer advection schemes and set nadv
[458]	188	!!----------------------------------------------------------------------
	189	INTEGER :: ioptio
[4147]	190	INTEGER :: ios ! Local integer output status for namelist read
[2528]	191	!!
	192	NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, &
	193	& ln_traadv_muscl, ln_traadv_muscl2, &
[3680]	194	& ln_traadv_ubs , ln_traadv_qck, &
[4990]	195	& ln_traadv_msc_ups, ln_traadv_tvd_zts
[458]	196	!!----------------------------------------------------------------------
	197
[4147]	198	REWIND( numnam_ref ) ! Namelist namtra_adv in reference namelist : Tracer advection scheme
	199	READ ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
	200	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp )
[458]	201
[4147]	202	REWIND( numnam_cfg ) ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
	203	READ ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
	204	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp )
[4624]	205	IF(lwm) WRITE ( numond, namtra_adv )
[4147]	206
[503]	207	IF(lwp) THEN ! Namelist print
[458]	208	WRITE(numout,*)
[2528]	209	WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
[458]	210	WRITE(numout,*) '~~~~~~~~~~~'
[1601]	211	WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers'
[3718]	212	WRITE(numout,*) ' 2nd order advection scheme ln_traadv_cen2 = ', ln_traadv_cen2
	213	WRITE(numout,*) ' TVD advection scheme ln_traadv_tvd = ', ln_traadv_tvd
	214	WRITE(numout,*) ' MUSCL advection scheme ln_traadv_muscl = ', ln_traadv_muscl
	215	WRITE(numout,*) ' MUSCL2 advection scheme ln_traadv_muscl2 = ', ln_traadv_muscl2
	216	WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs
	217	WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck
	218	WRITE(numout,*) ' upstream scheme within muscl ln_traadv_msc_ups = ', ln_traadv_msc_ups
[4990]	219	WRITE(numout,*) ' TVD advection scheme with zts ln_traadv_tvd_zts = ', ln_traadv_tvd_zts
[2528]	220	ENDIF
[458]	221
[503]	222	ioptio = 0 ! Parameter control
[458]	223	IF( ln_traadv_cen2 ) ioptio = ioptio + 1
	224	IF( ln_traadv_tvd ) ioptio = ioptio + 1
	225	IF( ln_traadv_muscl ) ioptio = ioptio + 1
	226	IF( ln_traadv_muscl2 ) ioptio = ioptio + 1
[503]	227	IF( ln_traadv_ubs ) ioptio = ioptio + 1
[637]	228	IF( ln_traadv_qck ) ioptio = ioptio + 1
[4990]	229	IF( ln_traadv_tvd_zts) ioptio = ioptio + 1
[503]	230	IF( lk_esopa ) ioptio = 1
[458]	231
[5130]	232	IF( ( ln_traadv_muscl .OR. ln_traadv_muscl2 .OR. ln_traadv_ubs .OR. ln_traadv_qck .OR. ln_traadv_tvd_zts ) &
	233	.AND. ln_isfcav ) CALL ctl_stop( 'Only traadv_cen2 and traadv_tvd is compatible with ice shelf cavity')
[4990]	234
[1601]	235	IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
[458]	236
[503]	237	! ! Set nadv
	238	IF( ln_traadv_cen2 ) nadv = 1
	239	IF( ln_traadv_tvd ) nadv = 2
	240	IF( ln_traadv_muscl ) nadv = 3
	241	IF( ln_traadv_muscl2 ) nadv = 4
	242	IF( ln_traadv_ubs ) nadv = 5
[637]	243	IF( ln_traadv_qck ) nadv = 6
[4990]	244	IF( ln_traadv_tvd_zts) nadv = 7
[503]	245	IF( lk_esopa ) nadv = -1
[458]	246
[503]	247	IF(lwp) THEN ! Print the choice
	248	WRITE(numout,*)
[789]	249	IF( nadv == 1 ) WRITE(numout,*) ' 2nd order scheme is used'
[503]	250	IF( nadv == 2 ) WRITE(numout,*) ' TVD scheme is used'
	251	IF( nadv == 3 ) WRITE(numout,*) ' MUSCL scheme is used'
	252	IF( nadv == 4 ) WRITE(numout,*) ' MUSCL2 scheme is used'
	253	IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used'
[789]	254	IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used'
[4990]	255	IF( nadv == 7 ) WRITE(numout,*) ' TVD ZTS scheme is used'
[503]	256	IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme'
[458]	257	ENDIF
[503]	258	!
[4245]	259	CALL tra_adv_mle_init ! initialisation of the Mixed Layer Eddy parametrisation (MLE)
[8079]	260	lr_traadv_cen2 = ln_traadv_cen2
[4245]	261	!
[2528]	262	END SUBROUTINE tra_adv_init
[458]	263
	264	!!======================================================================
	265	END MODULE traadv

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

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

Context Navigation

source: branches/UKMO/dev_r7573_xios_write/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 @ 8079

Download in other formats: