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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

trdicp.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90 @ 2588

Last change on this file since 2588 was 2528, checked in by rblod, 13 years ago
Update NEMOGCM from branch nemo_v3_3_beta
Property svn:keywords set to `Id`
File size: 32.5 KB

Rev	Line
[215]	1	MODULE trdicp
	2	!!======================================================================
	3	!! * MODULE trdicp *
	4	!! Ocean diagnostics: ocean tracers and dynamic trends
	5	!!=====================================================================
[2528]	6	!! History : 1.0 ! 2004-08 (C. Talandier) New trends organization
[503]	7	!!----------------------------------------------------------------------
[215]	8	#if defined key_trdtra \|\| defined key_trddyn \|\| defined key_esopa
	9	!!----------------------------------------------------------------------
	10	!! 'key_trdtra' or active tracers trends diagnostics
	11	!! 'key_trddyn' momentum trends diagnostics
	12	!!----------------------------------------------------------------------
[503]	13	!! trd_icp : compute the basin averaged properties for tra/dyn
[215]	14	!! trd_dwr : print dynmaic trends in ocean.output file
	15	!! trd_twr : print tracers trends in ocean.output file
	16	!! trd_icp_init : initialization step
	17	!!----------------------------------------------------------------------
	18	USE oce ! ocean dynamics and tracers variables
	19	USE dom_oce ! ocean space and time domain variables
	20	USE trdmod_oce ! ocean variables trends
	21	USE ldftra_oce ! ocean active tracers: lateral physics
	22	USE ldfdyn_oce ! ocean dynamics: lateral physics
	23	USE zdf_oce ! ocean vertical physics
	24	USE in_out_manager ! I/O manager
	25	USE lib_mpp ! distibuted memory computing library
	26	USE eosbn2 ! equation of state
	27	USE phycst ! physical constants
	28
	29	IMPLICIT NONE
	30	PRIVATE
	31
[503]	32	INTERFACE trd_icp
[215]	33	MODULE PROCEDURE trd_2d, trd_3d
	34	END INTERFACE
	35
[503]	36	PUBLIC trd_icp ! called by trdmod.F90
	37	PUBLIC trd_dwr ! called by step.F90
	38	PUBLIC trd_twr ! called by step.F90
	39	PUBLIC trd_icp_init ! called by opa.F90
[215]	40
	41	!! * Substitutions
	42	# include "domzgr_substitute.h90"
	43	# include "vectopt_loop_substitute.h90"
	44	!!----------------------------------------------------------------------
[2528]	45	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	46	!! $Id$
	47	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[215]	48	!!----------------------------------------------------------------------
	49
	50	CONTAINS
	51
[2528]	52	SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype )
[215]	53	!!---------------------------------------------------------------------
	54	!! * ROUTINE trd_2d *
	55	!!
	56	!! ** Purpose : verify the basin averaged properties of tracers and/or
[1601]	57	!! momentum equations at every time step frequency nn_trd.
[503]	58	!!----------------------------------------------------------------------
	59	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrd2dx ! Temperature or U trend
	60	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrd2dy ! Salinity or V trend
	61	INTEGER , INTENT(in ) :: ktrd ! tracer trend index
	62	CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends
[215]	63	!!
[503]	64	INTEGER :: ji, jj ! loop indices
	65	REAL(wp) :: zmsku, zbtu, zbt ! temporary scalars
	66	REAL(wp) :: zmskv, zbtv ! " "
[215]	67	!!----------------------------------------------------------------------
	68
	69
[503]	70	! 1. Mask trends
	71	! --------------
[215]	72
[503]	73	SELECT CASE( ctype )
	74	!
	75	CASE( 'DYN' ) ! Momentum
[215]	76	DO jj = 1, jpjm1
	77	DO ji = 1, jpim1
	78	zmsku = tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,1)
	79	zmskv = tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1)
	80	ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * zmsku
	81	ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * zmskv
	82	END DO
	83	END DO
	84	ptrd2dx(jpi, : ) = 0.e0 ; ptrd2dy(jpi, : ) = 0.e0
	85	ptrd2dx( : ,jpj) = 0.e0 ; ptrd2dy( : ,jpj) = 0.e0
[503]	86	!
	87	CASE( 'TRA' ) ! Tracers
[215]	88	ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:)
	89	ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:)
[503]	90	!
[215]	91	END SELECT
	92
[503]	93	! 2. Basin averaged tracer/momentum trends
	94	! ----------------------------------------
[215]	95
[503]	96	SELECT CASE( ctype )
	97	!
	98	CASE( 'DYN' ) ! Momentum
[215]	99	umo(ktrd) = 0.e0
	100	vmo(ktrd) = 0.e0
[503]	101	!
	102	SELECT CASE( ktrd )
	103	!
	104	CASE( jpdyn_trd_swf ) ! surface forcing
[215]	105	DO jj = 1, jpj
	106	DO ji = 1, jpi
	107	umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)
	108	vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1)
	109	END DO
	110	END DO
[503]	111	!
[215]	112	END SELECT
[503]	113	!
	114	CASE( 'TRA' ) ! Tracers
[2528]	115	tmo(ktrd) = 0.e0
	116	smo(ktrd) = 0.e0
[215]	117	DO jj = 1, jpj
	118	DO ji = 1, jpi
	119	zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
	120	tmo(ktrd) = tmo(ktrd) + ptrd2dx(ji,jj) * zbt
	121	smo(ktrd) = smo(ktrd) + ptrd2dy(ji,jj) * zbt
	122	END DO
	123	END DO
[503]	124	!
[215]	125	END SELECT
	126
[503]	127	! 3. Basin averaged tracer/momentum square trends
	128	! ----------------------------------------------
[215]	129	! c a u t i o n: field now
	130
[503]	131	SELECT CASE( ctype )
	132	!
	133	CASE( 'DYN' ) ! Momentum
[215]	134	hke(ktrd) = 0.e0
	135	DO jj = 1, jpj
	136	DO ji = 1, jpi
	137	zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)
	138	zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1)
	139	hke(ktrd) = hke(ktrd) &
	140	& + un(ji,jj,1) * ptrd2dx(ji,jj) * zbtu &
	141	& + vn(ji,jj,1) * ptrd2dy(ji,jj) * zbtv
	142	END DO
	143	END DO
[503]	144	!
	145	CASE( 'TRA' ) ! Tracers
[2528]	146	t2(ktrd) = 0.e0
	147	s2(ktrd) = 0.e0
[215]	148	DO jj = 1, jpj
	149	DO ji = 1, jpi
	150	zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
	151	t2(ktrd) = t2(ktrd) + ptrd2dx(ji,jj) * zbt * tn(ji,jj,1)
	152	s2(ktrd) = s2(ktrd) + ptrd2dy(ji,jj) * zbt * sn(ji,jj,1)
	153	END DO
	154	END DO
[503]	155	!
[215]	156	END SELECT
[503]	157	!
[215]	158	END SUBROUTINE trd_2d
	159
	160
[2528]	161	SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd, ctype )
[215]	162	!!---------------------------------------------------------------------
	163	!! * ROUTINE trd_3d *
	164	!!
	165	!! ** Purpose : verify the basin averaged properties of tracers and/or
[1601]	166	!! momentum equations at every time step frequency nn_trd.
[503]	167	!!----------------------------------------------------------------------
	168	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrd3dx ! Temperature or U trend
	169	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrd3dy ! Salinity or V trend
	170	INTEGER, INTENT(in ) :: ktrd ! momentum or tracer trend index
	171	CHARACTER(len=3), INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends
[215]	172	!!
	173	INTEGER :: ji, jj, jk
[503]	174	REAL(wp) :: zbt, zbtu, zbtv, zmsku, zmskv ! temporary scalars
[215]	175	!!----------------------------------------------------------------------
	176
[503]	177	! 1. Mask the trends
	178	! ------------------
[215]	179
[503]	180	SELECT CASE( ctype )
	181	!
	182	CASE( 'DYN' ) ! Momentum
[215]	183	DO jk = 1, jpk
	184	DO jj = 1, jpjm1
	185	DO ji = 1, jpim1
	186	zmsku = tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk)
	187	zmskv = tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
	188	ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * zmsku
	189	ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * zmskv
[503]	190	END DO
	191	END DO
	192	END DO
[215]	193	ptrd3dx(jpi, : ,:) = 0.e0 ; ptrd3dy(jpi, : ,:) = 0.e0
	194	ptrd3dx( : ,jpj,:) = 0.e0 ; ptrd3dy( : ,jpj,:) = 0.e0
[503]	195	!
	196	CASE( 'TRA' ) ! Tracers
[215]	197	DO jk = 1, jpk
	198	ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
	199	ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
[503]	200	END DO
	201	!
[215]	202	END SELECT
	203
[503]	204	! 2. Basin averaged tracer/momentum trends
	205	! ----------------------------------------
[215]	206
[503]	207	SELECT CASE( ctype )
	208	!
	209	CASE( 'DYN' ) ! Momentum
[215]	210	umo(ktrd) = 0.e0
	211	vmo(ktrd) = 0.e0
	212	DO jk = 1, jpk
	213	DO jj = 1, jpj
	214	DO ji = 1, jpi
	215	zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
	216	zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
	217	umo(ktrd) = umo(ktrd) + ptrd3dx(ji,jj,jk) * zbtu
	218	vmo(ktrd) = vmo(ktrd) + ptrd3dy(ji,jj,jk) * zbtv
	219	END DO
	220	END DO
	221	END DO
[503]	222	!
	223	CASE( 'TRA' ) ! Tracers
[2528]	224	tmo(ktrd) = 0.e0
	225	smo(ktrd) = 0.e0
[215]	226	DO jk = 1, jpkm1
	227	DO jj = 1, jpj
	228	DO ji = 1, jpi
	229	zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
	230	tmo(ktrd) = tmo(ktrd) + ptrd3dx(ji,jj,jk) * zbt
	231	smo(ktrd) = smo(ktrd) + ptrd3dy(ji,jj,jk) * zbt
	232	END DO
	233	END DO
	234	END DO
[503]	235	!
[215]	236	END SELECT
	237
[503]	238	! 3. Basin averaged tracer/momentum square trends
	239	! -----------------------------------------------
[215]	240	! c a u t i o n: field now
	241
[503]	242	SELECT CASE( ctype )
	243	!
	244	CASE( 'DYN' ) ! Momentum
[215]	245	hke(ktrd) = 0.e0
	246	DO jk = 1, jpk
	247	DO jj = 1, jpj
	248	DO ji = 1, jpi
	249	zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
	250	zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
	251	hke(ktrd) = hke(ktrd) &
	252	& + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * zbtu &
	253	& + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * zbtv
	254	END DO
	255	END DO
	256	END DO
[503]	257	!
	258	CASE( 'TRA' ) ! Tracers
[2528]	259	t2(ktrd) = 0.e0
	260	s2(ktrd) = 0.e0
[215]	261	DO jk = 1, jpk
	262	DO jj = 1, jpj
	263	DO ji = 1, jpi
	264	zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
	265	t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * zbt * tn(ji,jj,jk)
	266	s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * zbt * sn(ji,jj,jk)
	267	END DO
	268	END DO
	269	END DO
[503]	270	!
[215]	271	END SELECT
[503]	272	!
[215]	273	END SUBROUTINE trd_3d
	274
	275
	276
	277	SUBROUTINE trd_icp_init
	278	!!---------------------------------------------------------------------
	279	!! * ROUTINE trd_icp_init *
	280	!!
[503]	281	!! ** Purpose : Read the namtrd namelist
[215]	282	!!----------------------------------------------------------------------
[503]	283	INTEGER :: ji, jj, jk
[215]	284	REAL(wp) :: zmskt
	285	#if defined key_trddyn
[503]	286	REAL(wp) :: zmsku, zmskv
[215]	287	#endif
	288	!!----------------------------------------------------------------------
	289
	290	IF(lwp) THEN
	291	WRITE(numout,*)
	292	WRITE(numout,*) 'trd_icp_init : integral constraints properties trends'
	293	WRITE(numout,*) '~~~~~~~~~~~~~'
	294	ENDIF
	295
	296	! Total volume at t-points:
	297	tvolt = 0.e0
	298	DO jk = 1, jpkm1
	299	DO jj = 2, jpjm1
	300	DO ji = fs_2, fs_jpim1 ! vector opt.
	301	zmskt = tmask(ji,jj,jk) * tmask_i(ji,jj)
	302	tvolt = tvolt + zmskt * e1t(ji,jj) e2t(ji,jj) fse3t(ji,jj,jk)
	303	END DO
	304	END DO
	305	END DO
	306	IF( lk_mpp ) CALL mpp_sum( tvolt ) ! sum over the global domain
	307
[503]	308	IF(lwp) WRITE(numout,*) ' total ocean volume at T-point tvolt = ',tvolt
[215]	309
	310	#if defined key_trddyn
	311	! Initialization of potential to kinetic energy conversion
	312	rpktrd = 0.e0
	313
	314	! Total volume at u-, v- points:
	315	tvolu = 0.e0
	316	tvolv = 0.e0
	317
	318	DO jk = 1, jpk
	319	DO jj = 2, jpjm1
	320	DO ji = fs_2, fs_jpim1 ! vector opt.
	321	zmsku = tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk)
	322	zmskv = tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
	323	tvolu = tvolu + zmsku * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
	324	tvolv = tvolv + zmskv * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
	325	END DO
	326	END DO
	327	END DO
	328	IF( lk_mpp ) CALL mpp_sum( tvolu ) ! sums over the global domain
	329	IF( lk_mpp ) CALL mpp_sum( tvolv )
	330
	331	IF(lwp) THEN
[503]	332	WRITE(numout,*) ' total ocean volume at U-point tvolu = ',tvolu
	333	WRITE(numout,*) ' total ocean volume at V-point tvolv = ',tvolv
[215]	334	ENDIF
	335	#endif
[503]	336	!
[215]	337	END SUBROUTINE trd_icp_init
	338
	339
	340	SUBROUTINE trd_dwr( kt )
	341	!!---------------------------------------------------------------------
	342	!! * ROUTINE trd_dwr *
	343	!!
	344	!! ** Purpose : write dynamic trends in ocean.output
[503]	345	!!----------------------------------------------------------------------
	346	INTEGER, INTENT(in) :: kt ! ocean time-step index
[215]	347	!!
[503]	348	INTEGER :: ji, jj, jk
	349	REAL(wp) :: ze1e2w, zcof, zbe1ru, zbe2rv, zbtr, ztz, zth ! " scalars
	350	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkepe, zkx, zky, zkz ! temporary arrays
[215]	351	!!----------------------------------------------------------------------
	352
	353	! I. Momentum trends
	354	! -------------------
	355
[1601]	356	IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
[215]	357
	358	! I.1 Conversion potential energy - kinetic energy
	359	! --------------------------------------------------
	360	! c a u t i o n here, trends are computed at kt+1 (now , but after the swap)
	361
[503]	362	zkx(:,:,:) = 0.e0
	363	zky(:,:,:) = 0.e0
	364	zkz(:,:,:) = 0.e0
[215]	365	zkepe(:,:,:) = 0.e0
	366
[2528]	367	CALL eos( tsn, rhd, rhop ) ! now potential and in situ densities
[215]	368
[503]	369	! Density flux at w-point
[215]	370	DO jk = 2, jpk
	371	DO jj = 1, jpj
	372	DO ji = 1, jpi
	373	ze1e2w = 0.5 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) * tmask_i(ji,jj)
	374	zkz(ji,jj,jk) = ze1e2w / rau0 * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) )
	375	END DO
	376	END DO
	377	END DO
[503]	378	zkz(:,:,1) = 0.e0
[215]	379
	380	! Density flux at u and v-points
	381	DO jk = 1, jpk
	382	DO jj = 1, jpjm1
	383	DO ji = 1, jpim1
	384	zcof = 0.5 / rau0
	385	zbe1ru = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk)
	386	zbe2rv = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk)
	387	zkx(ji,jj,jk) = zbe1ru * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
	388	zky(ji,jj,jk) = zbe2rv * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
	389	END DO
	390	END DO
	391	END DO
	392
	393	! Density flux divergence at t-point
	394	DO jk = 1, jpkm1
	395	DO jj = 2, jpjm1
	396	DO ji = 2, jpim1
	397	zbtr = 1. / ( e1t(ji,jj)e2t(ji,jj)fse3t(ji,jj,jk) )
	398	ztz = - zbtr * ( zkz(ji,jj,jk) - zkz(ji,jj,jk+1) )
	399	zth = - zbtr * ( ( zkx(ji,jj,jk) - zkx(ji-1,jj,jk) ) &
	400	& + ( zky(ji,jj,jk) - zky(ji,jj-1,jk) ) )
	401	zkepe(ji,jj,jk) = (zth + ztz) * tmask(ji,jj,jk) * tmask_i(ji,jj)
	402	END DO
	403	END DO
	404	END DO
	405	zkepe( : , : ,jpk) = 0.e0
	406	zkepe( : ,jpj, : ) = 0.e0
	407	zkepe(jpi, : , : ) = 0.e0
	408
	409	! I.2 Basin averaged kinetic energy trend
	410	! ----------------------------------------
	411	peke = 0.e0
	412	DO jk = 1,jpk
	413	DO jj = 1, jpj
	414	DO ji = 1, jpi
	415	peke = peke + zkepe(ji,jj,jk) * grav * fsdept(ji,jj,jk) &
	416	& * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
	417	END DO
	418	END DO
	419	END DO
	420
	421	! I.3 Sums over the global domain
	422	! ---------------------------------
	423	IF( lk_mpp ) THEN
[503]	424	CALL mpp_sum( peke )
	425	CALL mpp_sum( umo , jptot_dyn )
	426	CALL mpp_sum( vmo , jptot_dyn )
	427	CALL mpp_sum( hke , jptot_dyn )
	428	ENDIF
[215]	429
	430	! I.2 Print dynamic trends in the ocean.output file
	431	! --------------------------------------------------
	432
	433	IF(lwp) THEN
	434	WRITE (numout,*)
	435	WRITE (numout,*)
	436	WRITE (numout,9500) kt
[503]	437	WRITE (numout,9501) umo(jpicpd_hpg) / tvolu, vmo(jpicpd_hpg) / tvolv
	438	WRITE (numout,9502) umo(jpicpd_keg) / tvolu, vmo(jpicpd_keg) / tvolv
	439	WRITE (numout,9503) umo(jpicpd_rvo) / tvolu, vmo(jpicpd_rvo) / tvolv
	440	WRITE (numout,9504) umo(jpicpd_pvo) / tvolu, vmo(jpicpd_pvo) / tvolv
	441	WRITE (numout,9505) umo(jpicpd_ldf) / tvolu, vmo(jpicpd_ldf) / tvolv
[1129]	442	WRITE (numout,9506) umo(jpicpd_had) / tvolu, vmo(jpicpd_had) / tvolv
	443	WRITE (numout,9507) umo(jpicpd_zad) / tvolu, vmo(jpicpd_zad) / tvolv
	444	WRITE (numout,9508) umo(jpicpd_zdf) / tvolu, vmo(jpicpd_zdf) / tvolv
	445	WRITE (numout,9509) umo(jpicpd_spg) / tvolu, vmo(jpicpd_spg) / tvolv
	446	WRITE (numout,9510) umo(jpicpd_swf) / tvolu, vmo(jpicpd_swf) / tvolv
	447	WRITE (numout,9511) umo(jpicpd_dat) / tvolu, vmo(jpicpd_dat) / tvolv
	448	WRITE (numout,9512) umo(jpicpd_bfr) / tvolu, vmo(jpicpd_bfr) / tvolv
	449	WRITE (numout,9513)
	450	WRITE (numout,9514) &
[503]	451	& ( umo(jpicpd_hpg) + umo(jpicpd_keg) + umo(jpicpd_rvo) + umo(jpicpd_pvo) + umo(jpicpd_ldf) &
[1129]	452	& + umo(jpicpd_had) + umo(jpicpd_zad) + umo(jpicpd_zdf) + umo(jpicpd_spg) + umo(jpicpd_dat) &
	453	& + umo(jpicpd_swf) + umo(jpicpd_bfr) ) / tvolu, &
[503]	454	& ( vmo(jpicpd_hpg) + vmo(jpicpd_keg) + vmo(jpicpd_rvo) + vmo(jpicpd_pvo) + vmo(jpicpd_ldf) &
[1129]	455	& + vmo(jpicpd_had) + vmo(jpicpd_zad) + vmo(jpicpd_zdf) + vmo(jpicpd_spg) + vmo(jpicpd_dat) &
	456	& + vmo(jpicpd_swf) + vmo(jpicpd_bfr) ) / tvolv
[215]	457	ENDIF
	458
	459	9500 FORMAT(' momentum trend at it= ', i6, ' :', /' ==============================')
	460	9501 FORMAT(' pressure gradient u= ', e20.13, ' v= ', e20.13)
	461	9502 FORMAT(' ke gradient u= ', e20.13, ' v= ', e20.13)
	462	9503 FORMAT(' relative vorticity term u= ', e20.13, ' v= ', e20.13)
	463	9504 FORMAT(' coriolis term u= ', e20.13, ' v= ', e20.13)
	464	9505 FORMAT(' horizontal diffusion u= ', e20.13, ' v= ', e20.13)
[1129]	465	9506 FORMAT(' horizontal advection u= ', e20.13, ' v= ', e20.13)
	466	9507 FORMAT(' vertical advection u= ', e20.13, ' v= ', e20.13)
	467	9508 FORMAT(' vertical diffusion u= ', e20.13, ' v= ', e20.13)
	468	9509 FORMAT(' surface pressure gradient u= ', e20.13, ' v= ', e20.13)
	469	9510 FORMAT(' surface wind forcing u= ', e20.13, ' v= ', e20.13)
	470	9511 FORMAT(' dampimg term u= ', e20.13, ' v= ', e20.13)
	471	9512 FORMAT(' bottom flux u= ', e20.13, ' v= ', e20.13)
	472	9513 FORMAT(' -----------------------------------------------------------------------------')
	473	9514 FORMAT(' total trend u= ', e20.13, ' v= ', e20.13)
[215]	474
	475	IF(lwp) THEN
	476	WRITE (numout,*)
	477	WRITE (numout,*)
	478	WRITE (numout,9520) kt
[503]	479	WRITE (numout,9521) hke(jpicpd_hpg) / tvolt
	480	WRITE (numout,9522) hke(jpicpd_keg) / tvolt
	481	WRITE (numout,9523) hke(jpicpd_rvo) / tvolt
	482	WRITE (numout,9524) hke(jpicpd_pvo) / tvolt
	483	WRITE (numout,9525) hke(jpicpd_ldf) / tvolt
[1129]	484	WRITE (numout,9526) hke(jpicpd_had) / tvolt
	485	WRITE (numout,9527) hke(jpicpd_zad) / tvolt
	486	WRITE (numout,9528) hke(jpicpd_zdf) / tvolt
	487	WRITE (numout,9529) hke(jpicpd_spg) / tvolt
	488	WRITE (numout,9530) hke(jpicpd_swf) / tvolt
	489	WRITE (numout,9531) hke(jpicpd_dat) / tvolt
[1708]	490	WRITE (numout,9532) hke(jpicpd_bfr) / tvolt
	491	WRITE (numout,9533)
	492	WRITE (numout,9534) &
[503]	493	& ( hke(jpicpd_hpg) + hke(jpicpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_pvo) + hke(jpicpd_ldf) &
[1129]	494	& + hke(jpicpd_had) + hke(jpicpd_zad) + hke(jpicpd_zdf) + hke(jpicpd_spg) + hke(jpicpd_dat) &
[1708]	495	& + hke(jpicpd_swf) + hke(jpicpd_bfr) ) / tvolt
[215]	496	ENDIF
	497
	498	9520 FORMAT(' kinetic energy trend at it= ', i6, ' :', /' ====================================')
	499	9521 FORMAT(' pressure gradient u2= ', e20.13)
	500	9522 FORMAT(' ke gradient u2= ', e20.13)
	501	9523 FORMAT(' relative vorticity term u2= ', e20.13)
	502	9524 FORMAT(' coriolis term u2= ', e20.13)
	503	9525 FORMAT(' horizontal diffusion u2= ', e20.13)
[1129]	504	9526 FORMAT(' horizontal advection u2= ', e20.13)
	505	9527 FORMAT(' vertical advection u2= ', e20.13)
	506	9528 FORMAT(' vertical diffusion u2= ', e20.13)
	507	9529 FORMAT(' surface pressure gradient u2= ', e20.13)
	508	9530 FORMAT(' surface wind forcing u2= ', e20.13)
	509	9531 FORMAT(' dampimg term u2= ', e20.13)
[1708]	510	9532 FORMAT(' bottom flux u2= ', e20.13)
	511	9533 FORMAT(' --------------------------------------------------')
	512	9534 FORMAT(' total trend u2= ', e20.13)
[215]	513
	514	IF(lwp) THEN
	515	WRITE (numout,*)
	516	WRITE (numout,*)
	517	WRITE (numout,9540) kt
[1129]	518	WRITE (numout,9541) ( hke(jpicpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_had) + hke(jpicpd_zad) ) / tvolt
	519	WRITE (numout,9542) ( hke(jpicpd_keg) + hke(jpicpd_had) + hke(jpicpd_zad) ) / tvolt
[503]	520	WRITE (numout,9543) ( hke(jpicpd_pvo) ) / tvolt
	521	WRITE (numout,9544) ( hke(jpicpd_rvo) ) / tvolt
	522	WRITE (numout,9545) ( hke(jpicpd_spg) ) / tvolt
	523	WRITE (numout,9546) ( hke(jpicpd_ldf) ) / tvolt
	524	WRITE (numout,9547) ( hke(jpicpd_zdf) ) / tvolt
	525	WRITE (numout,9548) ( hke(jpicpd_hpg) ) / tvolt, rpktrd / tvolt
	526	WRITE (numout,*)
	527	WRITE (numout,*)
[215]	528	ENDIF
	529
	530	9540 FORMAT(' energetic consistency at it= ', i6, ' :', /' =========================================')
	531	9541 FORMAT(' 0 = non linear term(true if key_vorenergy or key_combined): ', e20.13)
[1129]	532	9542 FORMAT(' 0 = ke gradient + horizontal + vertical advection : ', e20.13)
[215]	533	9543 FORMAT(' 0 = coriolis term (true if key_vorenergy or key_combined): ', e20.13)
[503]	534	9544 FORMAT(' 0 = uh.( rot(u) x uh ) (true if enstrophy conser.) : ', e20.13)
	535	9545 FORMAT(' 0 = surface pressure gradient : ', e20.13)
	536	9546 FORMAT(' 0 > horizontal diffusion : ', e20.13)
	537	9547 FORMAT(' 0 > vertical diffusion : ', e20.13)
	538	9548 FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop) : ', e20.13, ' u.dz(rhop) =', e20.13)
	539	!
[215]	540	! Save potential to kinetic energy conversion for next time step
	541	rpktrd = peke
[503]	542	!
[215]	543	ENDIF
[503]	544	!
[215]	545	END SUBROUTINE trd_dwr
	546
	547
	548	SUBROUTINE trd_twr( kt )
	549	!!---------------------------------------------------------------------
	550	!! * ROUTINE trd_twr *
	551	!!
	552	!! ** Purpose : write active tracers trends in ocean.output
	553	!!----------------------------------------------------------------------
[503]	554	INTEGER, INTENT(in) :: kt ! ocean time-step index
[215]	555	!!----------------------------------------------------------------------
	556
	557	! I. Tracers trends
	558	! -----------------
	559
[1601]	560	IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
[215]	561
	562	! I.1 Sums over the global domain
	563	! -------------------------------
	564	IF( lk_mpp ) THEN
[503]	565	CALL mpp_sum( tmo, jptot_tra )
	566	CALL mpp_sum( smo, jptot_tra )
	567	CALL mpp_sum( t2 , jptot_tra )
	568	CALL mpp_sum( s2 , jptot_tra )
[215]	569	ENDIF
	570
	571	! I.2 Print tracers trends in the ocean.output file
	572	! --------------------------------------------------
	573
	574	IF(lwp) THEN
	575	WRITE (numout,*)
	576	WRITE (numout,*)
	577	WRITE (numout,9400) kt
[2528]	578	WRITE (numout,9401) tmo(jpicpt_xad) / tvolt, smo(jpicpt_xad) / tvolt
	579	WRITE (numout,9411) tmo(jpicpt_yad) / tvolt, smo(jpicpt_yad) / tvolt
[503]	580	WRITE (numout,9402) tmo(jpicpt_zad) / tvolt, smo(jpicpt_zad) / tvolt
	581	WRITE (numout,9403) tmo(jpicpt_ldf) / tvolt, smo(jpicpt_ldf) / tvolt
	582	WRITE (numout,9404) tmo(jpicpt_zdf) / tvolt, smo(jpicpt_zdf) / tvolt
	583	WRITE (numout,9405) tmo(jpicpt_npc) / tvolt, smo(jpicpt_npc) / tvolt
	584	WRITE (numout,9406) tmo(jpicpt_dmp) / tvolt, smo(jpicpt_dmp) / tvolt
	585	WRITE (numout,9407) tmo(jpicpt_qsr) / tvolt
	586	WRITE (numout,9408) tmo(jpicpt_nsr) / tvolt, smo(jpicpt_nsr) / tvolt
	587	WRITE (numout,9409)
	588	WRITE (numout,9410) ( tmo(jpicpt_xad) + tmo(jpicpt_yad) + tmo(jpicpt_zad) + tmo(jpicpt_ldf) + tmo(jpicpt_zdf) &
	589	& + tmo(jpicpt_npc) + tmo(jpicpt_dmp) + tmo(jpicpt_qsr) + tmo(jpicpt_nsr) ) / tvolt, &
	590	& ( smo(jpicpt_xad) + smo(jpicpt_yad) + smo(jpicpt_zad) + smo(jpicpt_ldf) + smo(jpicpt_zdf) &
	591	& + smo(jpicpt_npc) + smo(jpicpt_dmp) + smo(jpicpt_nsr) ) / tvolt
[215]	592	ENDIF
	593
	594	9400 FORMAT(' tracer trend at it= ',i6,' : temperature', &
	595	' salinity',/' ============================')
[2528]	596	9401 FORMAT(' zonal advection ',e20.13,' ',e20.13)
	597	9411 FORMAT(' meridional advection ',e20.13,' ',e20.13)
[215]	598	9402 FORMAT(' vertical advection ',e20.13,' ',e20.13)
	599	9403 FORMAT(' horizontal diffusion ',e20.13,' ',e20.13)
	600	9404 FORMAT(' vertical diffusion ',e20.13,' ',e20.13)
[503]	601	9405 FORMAT(' static instability mixing ',e20.13,' ',e20.13)
[215]	602	9406 FORMAT(' damping term ',e20.13,' ',e20.13)
[503]	603	9407 FORMAT(' penetrative qsr ',e20.13)
	604	9408 FORMAT(' non solar radiation ',e20.13,' ',e20.13)
[215]	605	9409 FORMAT(' -------------------------------------------------------------------------')
	606	9410 FORMAT(' total trend ',e20.13,' ',e20.13)
	607
	608
	609	IF(lwp) THEN
	610	WRITE (numout,*)
	611	WRITE (numout,*)
	612	WRITE (numout,9420) kt
[2528]	613	WRITE (numout,9421) t2(jpicpt_xad) / tvolt, s2(jpicpt_xad) / tvolt
	614	WRITE (numout,9431) t2(jpicpt_yad) / tvolt, s2(jpicpt_yad) / tvolt
[503]	615	WRITE (numout,9422) t2(jpicpt_zad) / tvolt, s2(jpicpt_zad) / tvolt
	616	WRITE (numout,9423) t2(jpicpt_ldf) / tvolt, s2(jpicpt_ldf) / tvolt
	617	WRITE (numout,9424) t2(jpicpt_zdf) / tvolt, s2(jpicpt_zdf) / tvolt
	618	WRITE (numout,9425) t2(jpicpt_npc) / tvolt, s2(jpicpt_npc) / tvolt
	619	WRITE (numout,9426) t2(jpicpt_dmp) / tvolt, s2(jpicpt_dmp) / tvolt
	620	WRITE (numout,9427) t2(jpicpt_qsr) / tvolt
	621	WRITE (numout,9428) t2(jpicpt_nsr) / tvolt, s2(jpicpt_nsr) / tvolt
[215]	622	WRITE (numout,9429)
[503]	623	WRITE (numout,9430) ( t2(jpicpt_xad) + t2(jpicpt_yad) + t2(jpicpt_zad) + t2(jpicpt_ldf) + t2(jpicpt_zdf) &
	624	& + t2(jpicpt_npc) + t2(jpicpt_dmp) + t2(jpicpt_qsr) + t2(jpicpt_nsr) ) / tvolt, &
	625	& ( s2(jpicpt_xad) + s2(jpicpt_yad) + s2(jpicpt_zad) + s2(jpicpt_ldf) + s2(jpicpt_zdf) &
	626	& + s2(jpicpt_npc) + s2(jpicpt_dmp) + s2(jpicpt_nsr) ) / tvolt
[215]	627	ENDIF
	628
	629	9420 FORMAT(' tracer**2 trend at it= ', i6, ' : temperature', &
	630	' salinity', /, ' ===============================')
[2528]	631	9421 FORMAT(' zonal advection * t ', e20.13, ' ', e20.13)
	632	9431 FORMAT(' meridional advection * t ', e20.13, ' ', e20.13)
[215]	633	9422 FORMAT(' vertical advection * t ', e20.13, ' ', e20.13)
	634	9423 FORMAT(' horizontal diffusion * t ', e20.13, ' ', e20.13)
	635	9424 FORMAT(' vertical diffusion * t ', e20.13, ' ', e20.13)
[503]	636	9425 FORMAT(' static instability mixing * t ', e20.13, ' ', e20.13)
[215]	637	9426 FORMAT(' damping term * t ', e20.13, ' ', e20.13)
[503]	638	9427 FORMAT(' penetrative qsr * t ', e20.13)
	639	9428 FORMAT(' non solar radiation * t ', e20.13, ' ', e20.13)
[215]	640	9429 FORMAT(' -----------------------------------------------------------------------------')
	641	9430 FORMAT(' total trend t = ', e20.13, ' s = ', e20.13)
	642
	643
	644	IF(lwp) THEN
	645	WRITE (numout,*)
	646	WRITE (numout,*)
	647	WRITE (numout,9440) kt
[503]	648	WRITE (numout,9441) ( tmo(jpicpt_xad)+tmo(jpicpt_yad)+tmo(jpicpt_zad) )/tvolt, &
	649	& ( smo(jpicpt_xad)+smo(jpicpt_yad)+smo(jpicpt_zad) )/tvolt
	650	WRITE (numout,9442) tmo(jpicpt_zl1)/tvolt, smo(jpicpt_zl1)/tvolt
	651	WRITE (numout,9443) tmo(jpicpt_ldf)/tvolt, smo(jpicpt_ldf)/tvolt
	652	WRITE (numout,9444) tmo(jpicpt_zdf)/tvolt, smo(jpicpt_zdf)/tvolt
	653	WRITE (numout,9445) tmo(jpicpt_npc)/tvolt, smo(jpicpt_npc)/tvolt
	654	WRITE (numout,9446) ( t2(jpicpt_xad)+t2(jpicpt_yad)+t2(jpicpt_zad) )/tvolt, &
	655	& ( s2(jpicpt_xad)+s2(jpicpt_yad)+s2(jpicpt_zad) )/tvolt
	656	WRITE (numout,9447) t2(jpicpt_ldf)/tvolt, s2(jpicpt_ldf)/tvolt
	657	WRITE (numout,9448) t2(jpicpt_zdf)/tvolt, s2(jpicpt_zdf)/tvolt
	658	WRITE (numout,9449) t2(jpicpt_npc)/tvolt, s2(jpicpt_npc)/tvolt
[215]	659	ENDIF
	660
	661	9440 FORMAT(' tracer consistency at it= ',i6, &
	662	' : temperature',' salinity',/, &
	663	' ==================================')
[503]	664	9441 FORMAT(' 0 = horizontal+vertical advection + ',e20.13,' ',e20.13)
	665	9442 FORMAT(' 1st lev vertical advection ',e20.13,' ',e20.13)
	666	9443 FORMAT(' 0 = horizontal diffusion ',e20.13,' ',e20.13)
	667	9444 FORMAT(' 0 = vertical diffusion ',e20.13,' ',e20.13)
	668	9445 FORMAT(' 0 = static instability mixing ',e20.13,' ',e20.13)
	669	9446 FORMAT(' 0 = horizontal+vertical advection * t ',e20.13,' ',e20.13)
	670	9447 FORMAT(' 0 > horizontal diffusion * t ',e20.13,' ',e20.13)
	671	9448 FORMAT(' 0 > vertical diffusion * t ',e20.13,' ',e20.13)
	672	9449 FORMAT(' 0 > static instability mixing * t ',e20.13,' ',e20.13)
	673	!
[215]	674	ENDIF
[503]	675	!
[215]	676	END SUBROUTINE trd_twr
	677
	678	# else
	679	!!----------------------------------------------------------------------
	680	!! Default case : Empty module
	681	!!----------------------------------------------------------------------
[601]	682	INTERFACE trd_icp
	683	MODULE PROCEDURE trd_2d, trd_3d
	684	END INTERFACE
	685
[215]	686	CONTAINS
[2528]	687	SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype ) ! Empty routine
[503]	688	REAL, DIMENSION(:,:) :: ptrd2dx, ptrd2dy
[601]	689	INTEGER , INTENT(in ) :: ktrd ! tracer trend index
	690	CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends
[521]	691	WRITE(,) 'trd_2d: You should not have seen this print! error ?', &
[2528]	692	& ptrd2dx(1,1), ptrd2dy(1,1), ktrd, ctype
[215]	693	END SUBROUTINE trd_2d
[2528]	694	SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd , ctype ) ! Empty routine
[503]	695	REAL, DIMENSION(:,:,:) :: ptrd3dx, ptrd3dy
[601]	696	INTEGER , INTENT(in ) :: ktrd ! tracer trend index
	697	CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends
[521]	698	WRITE(,) 'trd_3d: You should not have seen this print! error ?', &
[2528]	699	& ptrd3dx(1,1,1), ptrd3dy(1,1,1), ktrd, ctype
[215]	700	END SUBROUTINE trd_3d
	701	SUBROUTINE trd_icp_init ! Empty routine
	702	END SUBROUTINE trd_icp_init
	703	SUBROUTINE trd_dwr( kt ) ! Empty routine
	704	WRITE(,) 'trd_dwr: You should not have seen this print! error ?', kt
	705	END SUBROUTINE trd_dwr
	706	SUBROUTINE trd_twr( kt ) ! Empty routine
	707	WRITE(,) 'trd_twr: You should not have seen this print! error ?', kt
	708	END SUBROUTINE trd_twr
	709	#endif
	710
	711	!!======================================================================
	712	END MODULE trdicp

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

Download in other formats: