Context Navigation

tradmp.F90 @ 9383

Last change on this file since 9383 was 9383, checked in by andmirek, 6 years ago
#2050 fixes and changes
File size: 12.4 KB

Rev	Line
[3]	1	MODULE tradmp
	2	!!======================================================================
	3	!! * MODULE tradmp *
	4	!! Ocean physics: internal restoring trend on active tracers (T and S)
	5	!!======================================================================
[1601]	6	!! History : OPA ! 1991-03 (O. Marti, G. Madec) Original code
	7	!! ! 1992-06 (M. Imbard) doctor norme
	8	!! ! 1996-01 (G. Madec) statement function for e3
	9	!! ! 1997-05 (G. Madec) macro-tasked on jk-slab
	10	!! ! 1998-07 (M. Imbard, G. Madec) ORCA version
	11	!! 7.0 ! 2001-02 (M. Imbard) cofdis, Original code
	12	!! 8.1 ! 2001-02 (G. Madec, E. Durand) cleaning
	13	!! NEMO 1.0 ! 2002-08 (G. Madec, E. Durand) free form + modules
	14	!! 3.2 ! 2009-08 (G. Madec, C. Talandier) DOCTOR norm for namelist parameter
[2528]	15	!! 3.3 ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC
[3294]	16	!! 3.4 ! 2011-04 (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
[503]	17	!!----------------------------------------------------------------------
[3294]	18
[3]	19	!!----------------------------------------------------------------------
[2715]	20	!! tra_dmp_alloc : allocate tradmp arrays
[2528]	21	!! tra_dmp : update the tracer trend with the internal damping
	22	!! tra_dmp_init : initialization, namlist read, parameters control
[3]	23	!!----------------------------------------------------------------------
[2528]	24	USE oce ! ocean: variables
	25	USE dom_oce ! ocean: domain variables
[4245]	26	USE c1d ! 1D vertical configuration
[4990]	27	USE trd_oce ! trends: ocean variables
	28	USE trdtra ! trends manager: tracers
[2528]	29	USE zdf_oce ! ocean: vertical physics
	30	USE phycst ! physical constants
[3294]	31	USE dtatsd ! data: temperature & salinity
[2528]	32	USE zdfmxl ! vertical physics: mixed layer depth
	33	USE in_out_manager ! I/O manager
	34	USE lib_mpp ! MPP library
	35	USE prtctl ! Print control
[3294]	36	USE wrk_nemo ! Memory allocation
	37	USE timing ! Timing
[5102]	38	USE iom
[3]	39
	40	IMPLICIT NONE
	41	PRIVATE
	42
[2528]	43	PUBLIC tra_dmp ! routine called by step.F90
	44	PUBLIC tra_dmp_init ! routine called by opa.F90
[9366]	45	PRIVATE dmp_namelist
[3]	46
[4147]	47	! !!* Namelist namtra_dmp : T & S newtonian damping *
[5102]	48	! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90
[4247]	49	LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag
	50	INTEGER , PUBLIC :: nn_zdmp ! = 0/1/2 flag for damping in the mixed layer
[5102]	51	CHARACTER(LEN=200) , PUBLIC :: cn_resto ! name of netcdf file containing restoration coefficient field
	52	!
[3294]	53
[5102]	54
[2715]	55	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: strdmp !: damping salinity trend (psu/s)
	56	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ttrdmp !: damping temperature trend (Celcius/s)
	57	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1)
[3]	58
	59	!! * Substitutions
	60	# include "domzgr_substitute.h90"
	61	# include "vectopt_loop_substitute.h90"
	62	!!----------------------------------------------------------------------
[2528]	63	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[6486]	64	!! $Id$
[2528]	65	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	66	!!----------------------------------------------------------------------
	67	CONTAINS
	68
[2715]	69	INTEGER FUNCTION tra_dmp_alloc()
	70	!!----------------------------------------------------------------------
[3294]	71	!! * FUNCTION tra_dmp_alloc *
[2715]	72	!!----------------------------------------------------------------------
[3294]	73	ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
[2715]	74	!
	75	IF( lk_mpp ) CALL mpp_sum ( tra_dmp_alloc )
	76	IF( tra_dmp_alloc > 0 ) CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
[3294]	77	!
[2715]	78	END FUNCTION tra_dmp_alloc
	79
	80
[3]	81	SUBROUTINE tra_dmp( kt )
	82	!!----------------------------------------------------------------------
	83	!! * ROUTINE tra_dmp *
	84	!!
	85	!! ** Purpose : Compute the tracer trend due to a newtonian damping
	86	!! of the tracer field towards given data field and add it to the
	87	!! general tracer trends.
	88	!!
	89	!! ** Method : Newtonian damping towards t_dta and s_dta computed
	90	!! and add to the general tracer trends:
	91	!! ta = ta + resto * (t_dta - tb)
	92	!! sa = sa + resto * (s_dta - sb)
	93	!! The trend is computed either throughout the water column
	94	!! (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
	95	!! below the well mixed layer (nlmdmp=2)
	96	!!
[1601]	97	!! ** Action : - (ta,sa) tracer trends updated with the damping trend
[503]	98	!!----------------------------------------------------------------------
[3294]	99	!
[1601]	100	INTEGER, INTENT(in) :: kt ! ocean time-step index
[503]	101	!!
[2528]	102	INTEGER :: ji, jj, jk ! dummy loop indices
[3294]	103	REAL(wp) :: zta, zsa ! local scalars
	104	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dta
[3]	105	!!----------------------------------------------------------------------
[503]	106	!
[3294]	107	IF( nn_timing == 1 ) CALL timing_start( 'tra_dmp')
	108	!
	109	CALL wrk_alloc( jpi, jpj, jpk, jpts, zts_dta )
[4990]	110	!
[3294]	111	! !== input T-S data at kt ==!
	112	CALL dta_tsd( kt, zts_dta ) ! read and interpolates T-S data at kt
	113	!
[2528]	114	SELECT CASE ( nn_zdmp ) !== type of damping ==!
	115	!
[1601]	116	CASE( 0 ) !== newtonian damping throughout the water column ==!
[3]	117	DO jk = 1, jpkm1
	118	DO jj = 2, jpjm1
	119	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	120	zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
	121	zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[2528]	122	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
	123	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
[3294]	124	strdmp(ji,jj,jk) = zsa ! save the trend (used in asmtrj)
	125	ttrdmp(ji,jj,jk) = zta
[3]	126	END DO
	127	END DO
	128	END DO
[503]	129	!
[1601]	130	CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==!
[3]	131	DO jk = 1, jpkm1
	132	DO jj = 2, jpjm1
	133	DO ji = fs_2, fs_jpim1 ! vector opt.
[2528]	134	IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
[3294]	135	zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
	136	zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[2528]	137	ELSE
	138	zta = 0._wp
	139	zsa = 0._wp
[3]	140	ENDIF
[2528]	141	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
	142	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
	143	strdmp(ji,jj,jk) = zsa ! save the salinity trend (used in asmtrj)
	144	ttrdmp(ji,jj,jk) = zta
[3]	145	END DO
	146	END DO
	147	END DO
[503]	148	!
[1601]	149	CASE ( 2 ) !== no damping in the mixed layer ==!
[3]	150	DO jk = 1, jpkm1
	151	DO jj = 2, jpjm1
	152	DO ji = fs_2, fs_jpim1 ! vector opt.
	153	IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
[3294]	154	zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
	155	zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[2528]	156	ELSE
	157	zta = 0._wp
	158	zsa = 0._wp
[3]	159	ENDIF
[2528]	160	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
	161	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
	162	strdmp(ji,jj,jk) = zsa ! save the salinity trend (used in asmtrj)
	163	ttrdmp(ji,jj,jk) = zta
[3]	164	END DO
	165	END DO
	166	END DO
[503]	167	!
[3]	168	END SELECT
[2528]	169	!
[1601]	170	IF( l_trdtra ) THEN ! trend diagnostic
[4990]	171	CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ttrdmp )
	172	CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, strdmp )
[216]	173	ENDIF
[1601]	174	! ! Control print
[2528]	175	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp - Ta: ', mask1=tmask, &
	176	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	177	!
[3294]	178	CALL wrk_dealloc( jpi, jpj, jpk, jpts, zts_dta )
	179	!
	180	IF( nn_timing == 1 ) CALL timing_stop( 'tra_dmp')
	181	!
[3]	182	END SUBROUTINE tra_dmp
	183
	184
	185	SUBROUTINE tra_dmp_init
	186	!!----------------------------------------------------------------------
	187	!! * ROUTINE tra_dmp_init *
	188	!!
	189	!! ** Purpose : Initialization for the newtonian damping
	190	!!
[4245]	191	!! ** Method : read the namtra_dmp namelist and check the parameters
[3]	192	!!----------------------------------------------------------------------
[5102]	193	NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
	194	INTEGER :: ios ! Local integer for output status of namelist read
	195	INTEGER :: imask ! File handle
[4990]	196	!!
[541]	197	!!----------------------------------------------------------------------
[4990]	198	!
[9366]	199	IF(lwm) THEN
	200	REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : T & S relaxation
	201	READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
[9383]	202	901 CONTINUE
	203	ENDIF
	204	call mpp_bcast(ios)
	205	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
	206	IF(lwm) THEN
[9366]	207	REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : T & S relaxation
	208	READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
[9383]	209	902 CONTINUE
[9366]	210	ENDIF
[9383]	211	call mpp_bcast(ios)
	212	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
[9366]	213
[4624]	214	IF(lwm) WRITE ( numond, namtra_dmp )
[3]	215
[9366]	216	call dmp_namelist()
	217
[5102]	218	IF(lwp) THEN !Namelist print
[3]	219	WRITE(numout,*)
[5102]	220	WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
[3]	221	WRITE(numout,*) '~~~~~~~'
[5102]	222	WRITE(numout,*) ' Namelist namtra_dmp : set relaxation parameters'
	223	WRITE(numout,*) ' Apply relaxation or not ln_tradmp = ', ln_tradmp
	224	WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp
	225	WRITE(numout,*) ' Damping file name cn_resto = ', cn_resto
[3294]	226	WRITE(numout,*)
[3]	227	ENDIF
	228
[5102]	229	IF( ln_tradmp) THEN
[3294]	230	!
[5102]	231	!Allocate arrays
[3294]	232	IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
[5102]	233
	234	!Check values of nn_zdmp
	235	SELECT CASE (nn_zdmp)
	236	CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping as specified by mask'
	237	CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline'
	238	CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer'
[3294]	239	END SELECT
[5102]	240
	241	!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
	242	!so can damp to something other than intitial conditions files?
[3294]	243	IF( .NOT.ln_tsd_tradmp ) THEN
	244	CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' )
	245	CALL dta_tsd_init( ld_tradmp=ln_tradmp ) ! forces the initialisation of T-S data
	246	ENDIF
[5102]	247
	248	!initialise arrays - Are these actually used anywhere else?
	249	strdmp(:,:,:) = 0._wp
[3294]	250	ttrdmp(:,:,:) = 0._wp
[3]	251
[5102]	252	!Read in mask from file
	253	CALL iom_open ( cn_resto, imask)
	254	CALL iom_get ( imask, jpdom_autoglo, 'resto', resto)
	255	CALL iom_close( imask )
	256	ENDIF
[3]	257
[5102]	258	END SUBROUTINE tra_dmp_init
[3]	259
[9366]	260	SUBROUTINE dmp_namelist()
	261	!!---------------------------------------------------------------------
	262	!! * ROUTINE dmp_namelist *
	263	!!
	264	!! ** Purpose : Broadcast namelist variables read by procesor lwm
	265	!!
	266	!! ** Method : use lib_mpp
	267	!!----------------------------------------------------------------------
	268	#if defined key_mpp_mpi
	269	CALL mpp_bcast(ln_tradmp)
	270	CALL mpp_bcast(nn_zdmp)
	271	CALL mpp_bcast(cn_resto, 200)
	272	#endif
	273	END SUBROUTINE dmp_namelist
	274
[3]	275	END MODULE tradmp

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/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 @ 9383

Download in other formats: