Context Navigation

tradmp.F90 @ 7054

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

Download in other formats: