Context Navigation

trcdmp.F90 @ 15597

Last change on this file since 15597 was 15023, checked in by gsamson, 3 years ago
merge ticket2680_C1D_PAPA branch back into the trunk; see ticket #2680 for details
Property svn:keywords set to `Id`
File size: 18.7 KB

Rev	Line
[941]	1	MODULE trcdmp
	2	!!======================================================================
	3	!! * MODULE trcdmp *
	4	!! Ocean physics: internal restoring trend on passive tracers
	5	!!======================================================================
[2528]	6	!! History : OPA ! 1991-03 (O. Marti, G. Madec) Original code
	7	!! ! 1996-01 (G. Madec) statement function for e3
	8	!! ! 1997-05 (H. Loukos) adapted for passive tracers
	9	!! NEMO 9.0 ! 2004-03 (C. Ethe) free form + modules
	10	!! 3.2 ! 2007-02 (C. Deltel) Diagnose ML trends for passive tracers
	11	!! 3.3 ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC
[941]	12	!!----------------------------------------------------------------------
[4148]	13	#if defined key_top
[941]	14	!!----------------------------------------------------------------------
	15	!! trc_dmp : update the tracer trend with the internal damping
	16	!! trc_dmp_init : initialization, namlist read, parameters control
	17	!!----------------------------------------------------------------------
[14086]	18	USE par_trc ! need jptra, number of passive tracers
[941]	19	USE oce_trc ! ocean dynamics and tracers variables
[1175]	20	USE trc ! ocean passive tracers variables
[941]	21	USE trcdta
[2528]	22	USE tradmp
	23	USE trdtra
[4990]	24	USE trd_oce
[9169]	25	!
[5102]	26	USE iom
[13286]	27	USE prtctl ! Print control for debbuging
[941]	28
	29	IMPLICIT NONE
	30	PRIVATE
	31
[5836]	32	PUBLIC trc_dmp
	33	PUBLIC trc_dmp_clo
	34	PUBLIC trc_dmp_alloc
	35	PUBLIC trc_dmp_ini
[941]	36
[9169]	37	INTEGER , PUBLIC :: nn_zdmp_tr !: = 0/1/2 flag for damping in the mixed layer
	38	CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr !: File containing restoration coefficient
[5836]	39
[4148]	40	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1)
[2715]	41
[9169]	42	INTEGER, PARAMETER :: npncts = 8 ! number of closed sea
	43	INTEGER, DIMENSION(npncts) :: nctsi1, nctsj1 ! south-west closed sea limits (i,j)
	44	INTEGER, DIMENSION(npncts) :: nctsi2, nctsj2 ! north-east closed sea limits (i,j)
[941]	45
	46	!! * Substitutions
[12377]	47	# include "do_loop_substitute.h90"
[13237]	48	# include "domzgr_substitute.h90"
[941]	49	!!----------------------------------------------------------------------
[10067]	50	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
[5215]	51	!! $Id$
[10068]	52	!! Software governed by the CeCILL license (see ./LICENSE)
[941]	53	!!----------------------------------------------------------------------
	54	CONTAINS
	55
[2715]	56	INTEGER FUNCTION trc_dmp_alloc()
	57	!!----------------------------------------------------------------------
	58	!! * ROUTINE trc_dmp_alloc *
	59	!!----------------------------------------------------------------------
	60	ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc )
	61	!
	62	IF( trc_dmp_alloc /= 0 ) CALL ctl_warn('trc_dmp_alloc: failed to allocate array')
	63	!
	64	END FUNCTION trc_dmp_alloc
	65
	66
[12377]	67	SUBROUTINE trc_dmp( kt, Kbb, Kmm, ptr, Krhs )
[941]	68	!!----------------------------------------------------------------------
	69	!! * ROUTINE trc_dmp *
	70	!!
	71	!! ** Purpose : Compute the passive tracer trend due to a newtonian damping
	72	!! of the tracer field towards given data field and add it to the
	73	!! general tracer trends.
	74	!!
	75	!! ** Method : Newtonian damping towards trdta computed
	76	!! and add to the general tracer trends:
[12377]	77	!! tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb))
[941]	78	!! The trend is computed either throughout the water column
	79	!! (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or
	80	!! below the well mixed layer (nlmdmptr=2)
	81	!!
[12377]	82	!! ** Action : - update the tracer trends tr(:,:,:,:,Krhs) with the newtonian
[941]	83	!! damping trends.
[4990]	84	!! - save the trends ('key_trdmxl_trc')
[1175]	85	!!----------------------------------------------------------------------
[12377]	86	INTEGER, INTENT(in ) :: kt ! ocean time-step index
	87	INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices
	88	REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation
[6140]	89	!
	90	INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices
	91	CHARACTER (len=22) :: charout
[9125]	92	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrd
	93	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace
[941]	94	!!----------------------------------------------------------------------
[3294]	95	!
[9124]	96	IF( ln_timing ) CALL timing_start('trc_dmp')
[3294]	97	!
[9125]	98	IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) ! temporary save of trends
[4148]	99	!
	100	IF( nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping
	101	!
[9125]	102	ALLOCATE( ztrcdta(jpi,jpj,jpk) ) ! Memory allocation
[4148]	103	! ! ===========
	104	DO jn = 1, jptra ! tracer loop
	105	! ! ===========
[12377]	106	IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends
[4148]	107	!
	108	IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
[6140]	109	!
[4148]	110	jl = n_trc_index(jn)
[14086]	111	CALL trc_dta( kt, jl, ztrcdta ) ! read tracer data at nit000
[6140]	112	!
[4148]	113	SELECT CASE ( nn_zdmp_tr )
	114	!
	115	CASE( 0 ) !== newtonian damping throughout the water column ==!
[13295]	116	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
[12377]	117	ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) )
	118	END_3D
[6140]	119	!
[4148]	120	CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==!
[13295]	121	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
[12377]	122	IF( avt(ji,jj,jk) <= avt_c ) THEN
	123	ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) )
	124	ENDIF
	125	END_3D
[6140]	126	!
[4148]	127	CASE ( 2 ) !== no damping in the mixed layer ==!
[13295]	128	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
[12377]	129	IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN
	130	ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) )
	131	END IF
	132	END_3D
[6140]	133	!
[4148]	134	END SELECT
	135	!
	136	ENDIF
	137	!
	138	IF( l_trdtrc ) THEN
[12377]	139	ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:)
	140	CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_dmp, ztrtrd )
[4148]	141	END IF
	142	! ! ===========
	143	END DO ! tracer loop
	144	! ! ===========
[9125]	145	DEALLOCATE( ztrcdta )
[4148]	146	ENDIF
	147	!
[9125]	148	IF( l_trdtrc ) DEALLOCATE( ztrtrd )
[2528]	149	! ! print mean trends (used for debugging)
[12377]	150	IF( sn_cfctl%l_prttrc ) THEN
[6140]	151	WRITE(charout, FMT="('dmp ')")
[13286]	152	CALL prt_ctl_info( charout, cdcomp = 'top' )
	153	CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' )
[941]	154	ENDIF
[2528]	155	!
[9124]	156	IF( ln_timing ) CALL timing_stop('trc_dmp')
[3294]	157	!
[941]	158	END SUBROUTINE trc_dmp
	159
[6140]	160
[5836]	161	SUBROUTINE trc_dmp_ini
	162	!!----------------------------------------------------------------------
	163	!! * ROUTINE trc_dmp_ini *
	164	!!
	165	!! ** Purpose : Initialization for the newtonian damping
	166	!!
	167	!! ** Method : read the nammbf namelist and check the parameters
	168	!! called by trc_dmp at the first timestep (nittrc000)
	169	!!----------------------------------------------------------------------
[6140]	170	INTEGER :: ios, imask ! local integers
	171	!!
[5836]	172	NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr
	173	!!----------------------------------------------------------------------
[6140]	174	!
[5836]	175	READ ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909)
[11536]	176	909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist' )
[5836]	177	READ ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910)
[11536]	178	910 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist' )
[5836]	179	IF(lwm) WRITE ( numont, namtrc_dmp )
	180
	181	IF(lwp) THEN ! Namelist print
	182	WRITE(numout,*)
	183	WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping'
	184	WRITE(numout,*) '~~~~~~~'
	185	WRITE(numout,*) ' Namelist namtrc_dmp : set damping parameter'
[9169]	186	WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'
	187	WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr
[5836]	188	ENDIF
[6701]	189	! ! Allocate arrays
	190	IF( trc_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_dmp_ini: unable to allocate arrays' )
[5836]	191	!
	192	SELECT CASE ( nn_zdmp_tr )
[9169]	193	CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' ===>> tracer damping throughout the water column'
	194	CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' ===>> no tracer damping in the turbocline (avt > 5 cm2/s)'
	195	CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' ===>> no tracer damping in the mixed layer'
[5836]	196	CASE DEFAULT
	197	WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
	198	CALL ctl_stop(ctmp1)
	199	END SELECT
	200
[15023]	201	IF( .NOT.ln_c1d ) THEN
[9169]	202	IF( .NOT.ln_tradmp ) &
	203	& CALL ctl_stop( 'passive tracer damping need ln_tradmp to compute damping coef.' )
[5836]	204	!
	205	! ! Read damping coefficients from file
	206	!Read in mask from file
	207	CALL iom_open ( cn_resto_tr, imask)
[13286]	208	CALL iom_get ( imask, jpdom_auto, 'resto', restotr)
[5836]	209	CALL iom_close( imask )
	210	!
	211	ENDIF
	212	!
	213	END SUBROUTINE trc_dmp_ini
	214
[6140]	215
[12377]	216	SUBROUTINE trc_dmp_clo( kt, Kbb, Kmm )
[4148]	217	!!---------------------------------------------------------------------
	218	!! * ROUTINE trc_dmp_clo *
	219	!!
	220	!! ** Purpose : Closed sea domain initialization
	221	!!
	222	!! ** Method : if a closed sea is located only in a model grid point
	223	!! we restore to initial data
	224	!!
	225	!! ** Action : nctsi1(), nctsj1() : south-west closed sea limits (i,j)
	226	!! nctsi2(), nctsj2() : north-east Closed sea limits (i,j)
	227	!!----------------------------------------------------------------------
[12377]	228	INTEGER, INTENT( in ) :: kt ! ocean time-step index
	229	INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices
[4148]	230	!
[6701]	231	INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa
[6607]	232	INTEGER :: isrow ! local index
[6701]	233	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace
[4148]	234	!!----------------------------------------------------------------------
[6607]	235
[4148]	236	IF( kt == nit000 ) THEN
	237	! initial values
	238	nctsi1(:) = 1 ; nctsi2(:) = 1
	239	nctsj1(:) = 1 ; nctsj2(:) = 1
	240
	241	! set the closed seas (in data domain indices)
	242	! -------------------
	243
[10213]	244	IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA") THEN
[4148]	245	!
[7646]	246	SELECT CASE ( nn_cfg )
[4148]	247	! ! =======================
[5506]	248	CASE ( 1 ) ! eORCA_R1 configuration
[13286]	249	! ! =======================
	250	!
	251	isrow = 332 - (Nj0glo + 1) ! was 332 - jpjglo -> jpjglo_old_version = Nj0glo + 1
	252	!
	253	nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow ! Caspian Sea
	254	nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow
	255	!
	256	nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow ! Lake Superior
	257	nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow
	258	!
	259	nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow ! Lake Michigan
	260	nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow
	261	!
	262	nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow ! Lake Huron
	263	nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow
	264	!
	265	nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow ! Lake Erie
	266	nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow
	267	!
	268	nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow ! Lake Ontario
	269	nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow
	270	!
	271	nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow ! Victoria Lake
	272	nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow
	273	!
	274	nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow ! Baltic Sea
	275	nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow
	276	!
	277	! ! =======================
[4148]	278	CASE ( 2 ) ! ORCA_R2 configuration
	279	! ! =======================
[9169]	280	!
	281	nctsi1(1) = 11 ; nctsj1(1) = 103 ! Caspian Sea
[4148]	282	nctsi2(1) = 17 ; nctsj2(1) = 112
[9169]	283	!
	284	nctsi1(2) = 97 ; nctsj1(2) = 107 ! Great North American Lakes
[4148]	285	nctsi2(2) = 103 ; nctsj2(2) = 111
[9169]	286	!
	287	nctsi1(3) = 174 ; nctsj1(3) = 107 ! Black Sea 1 : west part of the Black Sea
[4148]	288	nctsi2(3) = 181 ; nctsj2(3) = 112
[9169]	289	!
[13286]	290	nctsi1(4) = 2 ; nctsj1(4) = 107 ! Black Sea 2 : est part of the Black Sea
[4148]	291	nctsi2(4) = 6 ; nctsj2(4) = 112
[9169]	292	!
	293	nctsi1(5) = 145 ; nctsj1(5) = 116 ! Baltic Sea
[4148]	294	nctsi2(5) = 150 ; nctsj2(5) = 126
[13286]	295	!
[4148]	296	! ! =======================
	297	CASE ( 4 ) ! ORCA_R4 configuration
	298	! ! =======================
[9169]	299	!
	300	nctsi1(1) = 4 ; nctsj1(1) = 53 ! Caspian Sea
[4148]	301	nctsi2(1) = 4 ; nctsj2(1) = 56
[9169]	302	!
	303	nctsi1(2) = 49 ; nctsj1(2) = 55 ! Great North American Lakes
[4148]	304	nctsi2(2) = 51 ; nctsj2(2) = 56
[9169]	305	!
	306	nctsi1(3) = 88 ; nctsj1(3) = 55 ! Black Sea
[4148]	307	nctsi2(3) = 91 ; nctsj2(3) = 56
[9169]	308	!
	309	nctsi1(4) = 75 ; nctsj1(4) = 59 ! Baltic Sea
[4148]	310	nctsi2(4) = 76 ; nctsj2(4) = 61
[13286]	311	!
[4148]	312	! ! =======================
	313	CASE ( 025 ) ! ORCA_R025 configuration
	314	! ! =======================
[9169]	315	!
	316	nctsi1(1) = 1330 ; nctsj1(1) = 645 ! Caspian + Aral sea
[4148]	317	nctsi2(1) = 1400 ; nctsj2(1) = 795
[9169]	318	!
	319	nctsi1(2) = 1284 ; nctsj1(2) = 722 ! Azov Sea
[4148]	320	nctsi2(2) = 1304 ; nctsj2(2) = 747
	321	!
	322	END SELECT
	323	!
	324	ENDIF
	325	!
[13286]	326	nctsi1(:) = nctsi1(:) + nn_hls - 1 ; nctsi2(:) = nctsi2(:) + nn_hls - 1 ! -1 as x-perio included in old input files
	327	nctsj1(:) = nctsj1(:) + nn_hls ; nctsj2(:) = nctsj2(:) + nn_hls
	328	!
[4148]	329	! convert the position in local domain indices
	330	! --------------------------------------------
	331	DO jc = 1, npncts
	332	nctsi1(jc) = mi0( nctsi1(jc) )
	333	nctsj1(jc) = mj0( nctsj1(jc) )
[9169]	334	!
[4148]	335	nctsi2(jc) = mi1( nctsi2(jc) )
	336	nctsj2(jc) = mj1( nctsj2(jc) )
	337	END DO
	338	!
	339	ENDIF
	340
	341	! Restore close seas values to initial data
	342	IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping
	343	!
	344	IF(lwp) WRITE(numout,*)
	345	IF(lwp) WRITE(numout,*) ' trc_dmp_clo : Restoring of nutrients on close seas at time-step kt = ', kt
	346	IF(lwp) WRITE(numout,*)
	347	!
[9125]	348	ALLOCATE( ztrcdta(jpi,jpj,jpk) ) ! Memory allocation
[6607]	349	!
[4148]	350	DO jn = 1, jptra
	351	IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
	352	jl = n_trc_index(jn)
[14086]	353	CALL trc_dta( kt, jl, ztrcdta ) ! read tracer data at nit000
[4148]	354	DO jc = 1, npncts
	355	DO jk = 1, jpkm1
	356	DO jj = nctsj1(jc), nctsj2(jc)
	357	DO ji = nctsi1(jc), nctsi2(jc)
[12377]	358	tr(ji,jj,jk,jn,Kmm) = ztrcdta(ji,jj,jk)
	359	tr(ji,jj,jk,jn,Kbb) = tr(ji,jj,jk,jn,Kmm)
[9169]	360	END DO
	361	END DO
	362	END DO
	363	END DO
[4148]	364	ENDIF
[9169]	365	END DO
[9125]	366	DEALLOCATE( ztrcdta )
[4148]	367	ENDIF
	368	!
	369	END SUBROUTINE trc_dmp_clo
[6607]	370
[941]	371	#else
	372	!!----------------------------------------------------------------------
[4148]	373	!! Dummy module : No passive tracer
[941]	374	!!----------------------------------------------------------------------
	375	CONTAINS
	376	SUBROUTINE trc_dmp( kt ) ! Empty routine
	377	INTEGER, INTENT(in) :: kt
	378	WRITE(,) 'trc_dmp: You should not have seen this print! error?', kt
	379	END SUBROUTINE trc_dmp
	380	#endif
[4148]	381
[941]	382	!!======================================================================
	383	END MODULE trcdmp

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/TOP/TRP/trcdmp.F90 @ 15597

Download in other formats: