Context Navigation

tradmp.F90 @ 11932

Last change on this file since 11932 was 11468, checked in by mattmartin, 5 years ago
Merged changes to allow writing of climatological information to feedback files.
File size: 12.0 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
[3]	45
[4147]	46	! !!* Namelist namtra_dmp : T & S newtonian damping *
[5102]	47	! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90
[4247]	48	LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag
	49	INTEGER , PUBLIC :: nn_zdmp ! = 0/1/2 flag for damping in the mixed layer
[5102]	50	CHARACTER(LEN=200) , PUBLIC :: cn_resto ! name of netcdf file containing restoration coefficient field
	51	!
[3294]	52
[5102]	53
[2715]	54	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: strdmp !: damping salinity trend (psu/s)
	55	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ttrdmp !: damping temperature trend (Celcius/s)
	56	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1)
[11468]	57	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tclim !: temperature climatology on each time step(Celcius)
	58	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sclim !: salinity climatology on each time step (psu)
	59
[3]	60	!! * Substitutions
	61	# include "domzgr_substitute.h90"
	62	# include "vectopt_loop_substitute.h90"
	63	!!----------------------------------------------------------------------
[2528]	64	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[7959]	65	!! $Id$
[2528]	66	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	67	!!----------------------------------------------------------------------
	68	CONTAINS
	69
[2715]	70	INTEGER FUNCTION tra_dmp_alloc()
	71	!!----------------------------------------------------------------------
[3294]	72	!! * FUNCTION tra_dmp_alloc *
[2715]	73	!!----------------------------------------------------------------------
[11468]	74	ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), &
	75	& tclim(jpi,jpj,jpk) , sclim(jpi,jpj,jpk), STAT= tra_dmp_alloc )
[2715]	76	!
	77	IF( lk_mpp ) CALL mpp_sum ( tra_dmp_alloc )
	78	IF( tra_dmp_alloc > 0 ) CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
[3294]	79	!
[2715]	80	END FUNCTION tra_dmp_alloc
	81
	82
[3]	83	SUBROUTINE tra_dmp( kt )
	84	!!----------------------------------------------------------------------
	85	!! * ROUTINE tra_dmp *
	86	!!
	87	!! ** Purpose : Compute the tracer trend due to a newtonian damping
	88	!! of the tracer field towards given data field and add it to the
	89	!! general tracer trends.
	90	!!
	91	!! ** Method : Newtonian damping towards t_dta and s_dta computed
	92	!! and add to the general tracer trends:
	93	!! ta = ta + resto * (t_dta - tb)
	94	!! sa = sa + resto * (s_dta - sb)
	95	!! The trend is computed either throughout the water column
	96	!! (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
	97	!! below the well mixed layer (nlmdmp=2)
	98	!!
[1601]	99	!! ** Action : - (ta,sa) tracer trends updated with the damping trend
[503]	100	!!----------------------------------------------------------------------
[3294]	101	!
[1601]	102	INTEGER, INTENT(in) :: kt ! ocean time-step index
[503]	103	!!
[2528]	104	INTEGER :: ji, jj, jk ! dummy loop indices
[3294]	105	REAL(wp) :: zta, zsa ! local scalars
	106	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dta
[3]	107	!!----------------------------------------------------------------------
[503]	108	!
[3294]	109	IF( nn_timing == 1 ) CALL timing_start( 'tra_dmp')
	110	!
	111	CALL wrk_alloc( jpi, jpj, jpk, jpts, zts_dta )
[4990]	112	!
[3294]	113	! !== input T-S data at kt ==!
	114	CALL dta_tsd( kt, zts_dta ) ! read and interpolates T-S data at kt
[11468]	115
	116	tclim(:,:,:) = zts_dta(:,:,:,jp_tem)
	117	sclim(:,:,:) = zts_dta(:,:,:,jp_sal)
[3294]	118	!
[2528]	119	SELECT CASE ( nn_zdmp ) !== type of damping ==!
	120	!
[1601]	121	CASE( 0 ) !== newtonian damping throughout the water column ==!
[3]	122	DO jk = 1, jpkm1
	123	DO jj = 2, jpjm1
	124	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	125	zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
	126	zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[2528]	127	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
	128	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
[3294]	129	strdmp(ji,jj,jk) = zsa ! save the trend (used in asmtrj)
	130	ttrdmp(ji,jj,jk) = zta
[3]	131	END DO
	132	END DO
	133	END DO
[503]	134	!
[1601]	135	CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==!
[3]	136	DO jk = 1, jpkm1
	137	DO jj = 2, jpjm1
	138	DO ji = fs_2, fs_jpim1 ! vector opt.
[2528]	139	IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
[3294]	140	zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
	141	zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[2528]	142	ELSE
	143	zta = 0._wp
	144	zsa = 0._wp
[3]	145	ENDIF
[2528]	146	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
	147	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
	148	strdmp(ji,jj,jk) = zsa ! save the salinity trend (used in asmtrj)
	149	ttrdmp(ji,jj,jk) = zta
[3]	150	END DO
	151	END DO
	152	END DO
[503]	153	!
[1601]	154	CASE ( 2 ) !== no damping in the mixed layer ==!
[3]	155	DO jk = 1, jpkm1
	156	DO jj = 2, jpjm1
	157	DO ji = fs_2, fs_jpim1 ! vector opt.
	158	IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
[3294]	159	zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
	160	zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[2528]	161	ELSE
	162	zta = 0._wp
	163	zsa = 0._wp
[3]	164	ENDIF
[2528]	165	tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
	166	tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
	167	strdmp(ji,jj,jk) = zsa ! save the salinity trend (used in asmtrj)
	168	ttrdmp(ji,jj,jk) = zta
[3]	169	END DO
	170	END DO
	171	END DO
[503]	172	!
[3]	173	END SELECT
[2528]	174	!
[1601]	175	IF( l_trdtra ) THEN ! trend diagnostic
[4990]	176	CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ttrdmp )
	177	CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, strdmp )
[216]	178	ENDIF
[1601]	179	! ! Control print
[2528]	180	IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp - Ta: ', mask1=tmask, &
	181	& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	182	!
[3294]	183	CALL wrk_dealloc( jpi, jpj, jpk, jpts, zts_dta )
	184	!
	185	IF( nn_timing == 1 ) CALL timing_stop( 'tra_dmp')
	186	!
[3]	187	END SUBROUTINE tra_dmp
	188
	189
	190	SUBROUTINE tra_dmp_init
	191	!!----------------------------------------------------------------------
	192	!! * ROUTINE tra_dmp_init *
	193	!!
	194	!! ** Purpose : Initialization for the newtonian damping
	195	!!
[4245]	196	!! ** Method : read the namtra_dmp namelist and check the parameters
[3]	197	!!----------------------------------------------------------------------
[5102]	198	NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
	199	INTEGER :: ios ! Local integer for output status of namelist read
	200	INTEGER :: imask ! File handle
[4990]	201	!!
[541]	202	!!----------------------------------------------------------------------
[4990]	203	!
[5102]	204	REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : T & S relaxation
[4147]	205	READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
	206	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
[4990]	207	!
[5102]	208	REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : T & S relaxation
[4147]	209	READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
	210	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
[4624]	211	IF(lwm) WRITE ( numond, namtra_dmp )
[3]	212
[5102]	213	IF(lwp) THEN !Namelist print
[3]	214	WRITE(numout,*)
[5102]	215	WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
[3]	216	WRITE(numout,*) '~~~~~~~'
[5102]	217	WRITE(numout,*) ' Namelist namtra_dmp : set relaxation parameters'
	218	WRITE(numout,*) ' Apply relaxation or not ln_tradmp = ', ln_tradmp
	219	WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp
	220	WRITE(numout,*) ' Damping file name cn_resto = ', cn_resto
[3294]	221	WRITE(numout,*)
[3]	222	ENDIF
	223
[5102]	224	IF( ln_tradmp) THEN
[3294]	225	!
[5102]	226	!Allocate arrays
[3294]	227	IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
[5102]	228
	229	!Check values of nn_zdmp
	230	SELECT CASE (nn_zdmp)
	231	CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping as specified by mask'
	232	CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline'
	233	CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer'
[3294]	234	END SELECT
[5102]	235
	236	!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
	237	!so can damp to something other than intitial conditions files?
[3294]	238	IF( .NOT.ln_tsd_tradmp ) THEN
	239	CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' )
	240	CALL dta_tsd_init( ld_tradmp=ln_tradmp ) ! forces the initialisation of T-S data
	241	ENDIF
[5102]	242
	243	!initialise arrays - Are these actually used anywhere else?
	244	strdmp(:,:,:) = 0._wp
[3294]	245	ttrdmp(:,:,:) = 0._wp
[3]	246
[5102]	247	!Read in mask from file
	248	CALL iom_open ( cn_resto, imask)
	249	CALL iom_get ( imask, jpdom_autoglo, 'resto', resto)
	250	CALL iom_close( imask )
	251	ENDIF
[3]	252
[5102]	253	END SUBROUTINE tra_dmp_init
[3]	254
	255	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/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 @ 11932

Download in other formats: