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.

trdvor.F90 in NEMO/trunk/src/OCE/TRD – NEMO

Context Navigation

source: NEMO/trunk/src/OCE/TRD/trdvor.F90 @ 13286

Last change on this file since 13286 was 13237, checked in by smasson, 4 years ago
trunk: Mid-year merge, merge back KERNEL-06_techene_e3
Property svn:keywords set to `Id`
File size: 26.1 KB

Rev	Line
[109]	1	MODULE trdvor
	2	!!======================================================================
	3	!! * MODULE trdvor *
	4	!! Ocean diagnostics: momentum trends
	5	!!=====================================================================
[4990]	6	!! History : 1.0 ! 2006-01 (L. Brunier, A-M. Treguier) Original code
	7	!! 2.0 ! 2008-04 (C. Talandier) New trends organization
	8	!! 3.5 ! 2012-02 (G. Madec) regroup beta.V computation with pvo trend
[503]	9	!!----------------------------------------------------------------------
[4990]	10
[109]	11	!!----------------------------------------------------------------------
	12	!! trd_vor : momentum trends averaged over the depth
[216]	13	!! trd_vor_zint : vorticity vertical integration
	14	!! trd_vor_init : initialization step
[109]	15	!!----------------------------------------------------------------------
[129]	16	USE oce ! ocean dynamics and tracers variables
[109]	17	USE dom_oce ! ocean space and time domain variables
[4990]	18	USE trd_oce ! trends: ocean variables
[109]	19	USE zdf_oce ! ocean vertical physics
[4990]	20	USE sbc_oce ! surface boundary condition: ocean
[109]	21	USE phycst ! Define parameters for the routines
[5836]	22	USE ldfdyn ! ocean active tracers: lateral physics
[109]	23	USE dianam ! build the name of file (routine)
[216]	24	USE zdfmxl ! mixed layer depth
[5836]	25	!
[4990]	26	USE in_out_manager ! I/O manager
[216]	27	USE ioipsl ! NetCDF library
[5836]	28	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[2715]	29	USE lib_mpp ! MPP library
[109]	30
	31	IMPLICIT NONE
	32	PRIVATE
[129]	33
[216]	34	INTERFACE trd_vor_zint
	35	MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d
	36	END INTERFACE
[129]	37
[4990]	38	PUBLIC trd_vor ! routine called by trddyn.F90
[503]	39	PUBLIC trd_vor_init ! routine called by opa.F90
[2715]	40	PUBLIC trd_vor_alloc ! routine called by nemogcm.F90
[109]	41
[2715]	42	INTEGER :: nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount ! needs for IOIPSL output
	43	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndexvor1 ! needed for IOIPSL output
[2528]	44	INTEGER :: ndebug ! (0/1) set it to 1 in case of problem to have more print
[109]	45
[2715]	46	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avr ! average
	47	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrb ! before vorticity (kt-1)
[11536]	48	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbb ! vorticity at begining of the nn_write-1 timestep averaging period
[2715]	49	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbn ! after vorticity at time step after the
[11536]	50	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rotot ! begining of the NN_WRITE-1 timesteps
[2715]	51	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrtot !
	52	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrres !
	53	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: vortrd ! curl of trends
[503]	54
[216]	55	CHARACTER(len=12) :: cvort
	56
[109]	57	!! * Substitutions
[12377]	58	# include "do_loop_substitute.h90"
[13237]	59	# include "domzgr_substitute.h90"
[109]	60	!!----------------------------------------------------------------------
[9598]	61	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[1152]	62	!! $Id$
[10068]	63	!! Software governed by the CeCILL license (see ./LICENSE)
[109]	64	!!----------------------------------------------------------------------
	65	CONTAINS
	66
[2715]	67	INTEGER FUNCTION trd_vor_alloc()
	68	!!----------------------------------------------------------------------------
	69	!! * ROUTINE trd_vor_alloc *
	70	!!----------------------------------------------------------------------------
	71	ALLOCATE( vor_avr (jpi,jpj) , vor_avrb(jpi,jpj) , vor_avrbb (jpi,jpj) , &
	72	& vor_avrbn (jpi,jpj) , rotot (jpi,jpj) , vor_avrtot(jpi,jpj) , &
	73	& vor_avrres(jpi,jpj) , vortrd (jpi,jpj,jpltot_vor) , &
	74	& ndexvor1 (jpi*jpj) , STAT= trd_vor_alloc )
	75	!
[10425]	76	CALL mpp_sum ( 'trdvor', trd_vor_alloc )
	77	IF( trd_vor_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trd_vor_alloc: failed to allocate arrays' )
[2715]	78	END FUNCTION trd_vor_alloc
	79
	80
[12377]	81	SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt, Kmm )
[4990]	82	!!----------------------------------------------------------------------
	83	!! * ROUTINE trd_vor *
	84	!!
	85	!! ** Purpose : computation of cumulated trends over analysis period
[6140]	86	!! and make outputs (NetCDF format)
[4990]	87	!!----------------------------------------------------------------------
	88	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
	89	INTEGER , INTENT(in ) :: ktrd ! trend index
	90	INTEGER , INTENT(in ) :: kt ! time step
[12377]	91	INTEGER , INTENT(in ) :: Kmm ! time level index
[4990]	92	!
	93	INTEGER :: ji, jj ! dummy loop indices
[9125]	94	REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv ! 2D workspace
[4990]	95	!!----------------------------------------------------------------------
	96
	97	SELECT CASE( ktrd )
[12377]	98	CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg, Kmm ) ! Hydrostatique Pressure Gradient
	99	CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg, Kmm ) ! KE Gradient
	100	CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo, Kmm ) ! Relative Vorticity
	101	CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo, Kmm ) ! Planetary Vorticity Term
	102	CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf, Kmm ) ! Horizontal Diffusion
	103	CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad, Kmm ) ! Vertical Advection
	104	CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm ) ! Surface Pressure Grad.
[4990]	105	CASE( jpdyn_zdf ) ! Vertical Diffusion
	106	ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0
[12377]	107	DO_2D_00_00
[12489]	108	ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 )
	109	ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 )
[12377]	110	END_2D
[4990]	111	!
[12377]	112	CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf, Kmm ) ! zdf trend including surf./bot. stresses
	113	CALL trd_vor_zint( ztswu, ztswv, jpvor_swf, Kmm ) ! surface wind stress
[4990]	114	CASE( jpdyn_bfr )
[12377]	115	CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr, Kmm ) ! Bottom stress
[4990]	116	!
	117	CASE( jpdyn_atf ) ! last trends: perform the output of 2D vorticity trends
[12377]	118	CALL trd_vor_iom( kt, Kmm )
[4990]	119	END SELECT
	120	!
	121	END SUBROUTINE trd_vor
	122
	123
[12377]	124	SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd, Kmm )
[129]	125	!!----------------------------------------------------------------------------
[216]	126	!! * ROUTINE trd_vor_zint *
[109]	127	!!
	128	!! ** Purpose : computation of vertically integrated vorticity budgets
[2528]	129	!! from ocean surface down to control surface (NetCDF output)
[109]	130	!!
[11536]	131	!! ** Method/usage : integration done over nn_write-1 time steps
[109]	132	!!
[2528]	133	!! ** Action : trends :
[503]	134	!! vortrd (,, 1) = Pressure Gradient Trend
	135	!! vortrd (,, 2) = KE Gradient Trend
	136	!! vortrd (,, 3) = Relative Vorticity Trend
	137	!! vortrd (,, 4) = Coriolis Term Trend
	138	!! vortrd (,, 5) = Horizontal Diffusion Trend
	139	!! vortrd (,, 6) = Vertical Advection Trend
	140	!! vortrd (,, 7) = Vertical Diffusion Trend
	141	!! vortrd (,, 8) = Surface Pressure Grad. Trend
	142	!! vortrd (,, 9) = Beta V
[109]	143	!! vortrd (,,10) = forcing term
[2528]	144	!! vortrd (,,11) = bottom friction term
[11536]	145	!! rotot(,) : total cumulative trends over nn_write-1 time steps
[109]	146	!! vor_avrtot(,) : first membre of vrticity equation
	147	!! vor_avrres(,) : residual = dh/dt entrainment
	148	!!
	149	!! trends output in netCDF format using ioipsl
	150	!!----------------------------------------------------------------------
[2528]	151	INTEGER , INTENT(in ) :: ktrd ! ocean trend index
[12377]	152	INTEGER , INTENT(in ) :: Kmm ! time level index
[2528]	153	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend
	154	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvtrdvor ! v vorticity trend
[2715]	155	!
[2528]	156	INTEGER :: ji, jj ! dummy loop indices
	157	INTEGER :: ikbu, ikbv ! local integers
[9125]	158	REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends
[216]	159	!!----------------------------------------------------------------------
[109]	160
[3294]	161	!
[2715]	162
[3294]	163	zudpvor(:,:) = 0._wp ; zvdpvor(:,:) = 0._wp ! Initialisation
[13226]	164	CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) ! lateral boundary condition
[2715]	165
[216]	166
	167	! =====================================
	168	! I vertical integration of 2D trends
	169	! =====================================
	170
[4990]	171	SELECT CASE( ktrd )
[2528]	172	!
[4990]	173	CASE( jpvor_bfr ) ! bottom friction
[12377]	174	DO_2D_00_00
	175	ikbu = mbkv(ji,jj)
	176	ikbv = mbkv(ji,jj)
	177	zudpvor(ji,jj) = putrdvor(ji,jj) * e3u(ji,jj,ikbu,Kmm) * e1u(ji,jj) * umask(ji,jj,ikbu)
	178	zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v(ji,jj,ikbv,Kmm) * e2v(ji,jj) * vmask(ji,jj,ikbv)
	179	END_2D
[2528]	180	!
[4990]	181	CASE( jpvor_swf ) ! wind stress
[12377]	182	zudpvor(:,:) = putrdvor(:,:) * e3u(:,:,1,Kmm) * e1u(:,:) * umask(:,:,1)
	183	zvdpvor(:,:) = pvtrdvor(:,:) * e3v(:,:,1,Kmm) * e2v(:,:) * vmask(:,:,1)
[2528]	184	!
[216]	185	END SELECT
	186
	187	! Average except for Beta.V
[12377]	188	zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm)
	189	zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm)
[216]	190
	191	! Curl
[4990]	192	DO ji = 1, jpim1
	193	DO jj = 1, jpjm1
[2528]	194	vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) &
[13237]	195	& - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) &
	196	& / ( e1f(ji,jj) * e2f(ji,jj) )
[216]	197	END DO
	198	END DO
[2528]	199	vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) ! Surface mask
[216]	200
[2528]	201	IF( ndebug /= 0 ) THEN
[216]	202	IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
	203	CALL FLUSH(numout)
	204	ENDIF
[503]	205	!
[216]	206	END SUBROUTINE trd_vor_zint_2d
	207
	208
[12377]	209	SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd , Kmm )
[216]	210	!!----------------------------------------------------------------------------
	211	!! * ROUTINE trd_vor_zint *
	212	!!
	213	!! ** Purpose : computation of vertically integrated vorticity budgets
[2528]	214	!! from ocean surface down to control surface (NetCDF output)
[216]	215	!!
[11536]	216	!! ** Method/usage : integration done over nn_write-1 time steps
[216]	217	!!
[2528]	218	!! ** Action : trends :
[216]	219	!! vortrd (,,1) = Pressure Gradient Trend
	220	!! vortrd (,,2) = KE Gradient Trend
	221	!! vortrd (,,3) = Relative Vorticity Trend
	222	!! vortrd (,,4) = Coriolis Term Trend
	223	!! vortrd (,,5) = Horizontal Diffusion Trend
	224	!! vortrd (,,6) = Vertical Advection Trend
	225	!! vortrd (,,7) = Vertical Diffusion Trend
	226	!! vortrd (,,8) = Surface Pressure Grad. Trend
	227	!! vortrd (,,9) = Beta V
	228	!! vortrd (,,10) = forcing term
	229	!! vortrd (,,11) = bottom friction term
[11536]	230	!! rotot(,) : total cumulative trends over nn_write-1 time steps
[216]	231	!! vor_avrtot(,) : first membre of vrticity equation
	232	!! vor_avrres(,) : residual = dh/dt entrainment
	233	!!
	234	!! trends output in netCDF format using ioipsl
[109]	235	!!----------------------------------------------------------------------
[2715]	236	!
[2528]	237	INTEGER , INTENT(in ) :: ktrd ! ocean trend index
[12377]	238	INTEGER , INTENT(in ) :: Kmm ! time level index
[2528]	239	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: putrdvor ! u vorticity trend
	240	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvtrdvor ! v vorticity trend
[2715]	241	!
	242	INTEGER :: ji, jj, jk ! dummy loop indices
[9125]	243	REAL(wp), DIMENSION(jpi,jpj) :: zubet , zvbet ! Beta.V
	244	REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends
[216]	245	!!----------------------------------------------------------------------
[109]	246
[216]	247	! Initialization
[2528]	248	zubet (:,:) = 0._wp
	249	zvbet (:,:) = 0._wp
	250	zudpvor(:,:) = 0._wp
	251	zvdpvor(:,:) = 0._wp
[9097]	252	! ! lateral boundary condition on input momentum trends
[13226]	253	CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp )
[109]	254
[216]	255	! =====================================
	256	! I vertical integration of 3D trends
	257	! =====================================
	258	! putrdvor and pvtrdvor terms
	259	DO jk = 1,jpk
[12377]	260	zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u(:,:,jk,Kmm) * e1u(:,:) * umask(:,:,jk)
	261	zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v(:,:,jk,Kmm) * e2v(:,:) * vmask(:,:,jk)
[216]	262	END DO
[109]	263
[4990]	264	! Planetary vorticity: 2nd computation (Beta.V term) store the vertical sum
	265	! as Beta.V term need intergration, not average
	266	IF( ktrd == jpvor_pvo ) THEN
[216]	267	zubet(:,:) = zudpvor(:,:)
	268	zvbet(:,:) = zvdpvor(:,:)
[4990]	269	DO ji = 1, jpim1
	270	DO jj = 1, jpjm1
	271	vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) &
[13237]	272	& - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) &
	273	& / ( e1f(ji,jj) * e2f(ji,jj) )
[4990]	274	END DO
	275	END DO
	276	! Average of the Curl and Surface mask
[12377]	277	vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1)
[216]	278	ENDIF
[4990]	279	!
	280	! Average
[12377]	281	zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm)
	282	zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm)
[4990]	283	!
[216]	284	! Curl
	285	DO ji=1,jpim1
	286	DO jj=1,jpjm1
[2528]	287	vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) &
[13237]	288	& - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) &
	289	& / ( e1f(ji,jj) * e2f(ji,jj) )
[216]	290	END DO
	291	END DO
	292	! Surface mask
	293	vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)
	294
[2528]	295	IF( ndebug /= 0 ) THEN
[216]	296	IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
	297	CALL FLUSH(numout)
	298	ENDIF
[503]	299	!
[216]	300	END SUBROUTINE trd_vor_zint_3d
[109]	301
[216]	302
[12377]	303	SUBROUTINE trd_vor_iom( kt , Kmm )
[216]	304	!!----------------------------------------------------------------------
	305	!! * ROUTINE trd_vor *
	306	!!
	307	!! ** Purpose : computation of cumulated trends over analysis period
[6140]	308	!! and make outputs (NetCDF format)
[216]	309	!!----------------------------------------------------------------------
[4990]	310	INTEGER , INTENT(in ) :: kt ! time step
[12377]	311	INTEGER , INTENT(in ) :: Kmm ! time level index
[2715]	312	!
[2528]	313	INTEGER :: ji, jj, jk, jl ! dummy loop indices
	314	INTEGER :: it, itmod ! local integers
	315	REAL(wp) :: zmean ! local scalars
[12377]	316	REAL(wp), DIMENSION(jpi,jpj) :: zuu, zvv
[216]	317	!!----------------------------------------------------------------------
	318
	319	! =================
	320	! I. Initialization
	321	! =================
	322
	323
	324	! I.1 set before values of vertically average u and v
	325	! ---------------------------------------------------
	326
[2528]	327	IF( kt > nit000 ) vor_avrb(:,:) = vor_avr(:,:)
[109]	328
[216]	329	! I.2 vertically integrated vorticity
	330	! ----------------------------------
[109]	331
[2528]	332	vor_avr (:,:) = 0._wp
[12377]	333	zuu (:,:) = 0._wp
	334	zvv (:,:) = 0._wp
[2528]	335	vor_avrtot(:,:) = 0._wp
	336	vor_avrres(:,:) = 0._wp
[109]	337
[216]	338	! Vertically averaged velocity
[109]	339	DO jk = 1, jpk - 1
[12377]	340	zuu(:,:) = zuu(:,:) + e1u(:,:) * uu(:,:,jk,Kmm) * e3u(:,:,jk,Kmm)
	341	zvv(:,:) = zvv(:,:) + e2v(:,:) * vv(:,:,jk,Kmm) * e3v(:,:,jk,Kmm)
[109]	342	END DO
	343
[12377]	344	zuu(:,:) = zuu(:,:) * r1_hu(:,:,Kmm)
	345	zvv(:,:) = zvv(:,:) * r1_hv(:,:,Kmm)
[109]	346
[216]	347	! Curl
[4990]	348	DO ji = 1, jpim1
	349	DO jj = 1, jpjm1
[12377]	350	vor_avr(ji,jj) = ( ( zvv(ji+1,jj) - zvv(ji,jj) ) &
[13237]	351	& - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) &
	352	& / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1)
[129]	353	END DO
[109]	354	END DO
	355
	356	! =================================
[216]	357	! II. Cumulated trends
[109]	358	! =================================
	359
[216]	360	! II.1 set `before' mixed layer values for kt = nit000+1
	361	! ------------------------------------------------------
[109]	362	IF( kt == nit000+1 ) THEN
	363	vor_avrbb(:,:) = vor_avrb(:,:)
	364	vor_avrbn(:,:) = vor_avr (:,:)
	365	ENDIF
	366
[11536]	367	! II.2 cumulated trends over analysis period (kt=2 to nn_write)
[109]	368	! ----------------------
[11536]	369	! trends cumulated over nn_write-2 time steps
[109]	370
	371	IF( kt >= nit000+2 ) THEN
	372	nmoydpvor = nmoydpvor + 1
[503]	373	DO jl = 1, jpltot_vor
[129]	374	IF( jl /= 9 ) THEN
	375	rotot(:,:) = rotot(:,:) + vortrd(:,:,jl)
	376	ENDIF
[109]	377	END DO
	378	ENDIF
	379
	380	! =============================================
[216]	381	! III. Output in netCDF + residual computation
[109]	382	! =============================================
[11536]	383
[1317]	384	! define time axis
[2528]	385	it = kt
[1334]	386	itmod = kt - nit000 + 1
[109]	387
[1601]	388	IF( MOD( it, nn_trd ) == 0 ) THEN
[1317]	389
[216]	390	! III.1 compute total trend
[109]	391	! ------------------------
[12489]	392	zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * rn_Dt )
[2528]	393	vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean
[109]	394
	395
[216]	396	! III.2 compute residual
[109]	397	! ---------------------
[2528]	398	zmean = 1._wp / REAL( nmoydpvor, wp )
[109]	399	vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean
	400
[129]	401	! Boundary conditions
[13226]	402	CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp )
[109]	403
	404
[216]	405	! III.3 time evolution array swap
[109]	406	! ------------------------------
	407	vor_avrbb(:,:) = vor_avrb(:,:)
[2528]	408	vor_avrbn(:,:) = vor_avr (:,:)
	409	!
	410	nmoydpvor = 0
	411	!
[109]	412	ENDIF
	413
[216]	414	! III.4 write trends to output
[109]	415	! ---------------------------
[216]	416
[109]	417	IF( kt >= nit000+1 ) THEN
	418
[1601]	419	IF( lwp .AND. MOD( itmod, nn_trd ) == 0 ) THEN
[503]	420	WRITE(numout,*) ''
	421	WRITE(numout,*) 'trd_vor : write trends in the NetCDF file at kt = ', kt
	422	WRITE(numout,*) '~~~~~~~ '
[216]	423	ENDIF
	424
[503]	425	CALL histwrite( nidvor,"sovortPh",it,vortrd(:,:,jpvor_prg),ndimvor1,ndexvor1) ! grad Ph
	426	CALL histwrite( nidvor,"sovortEk",it,vortrd(:,:,jpvor_keg),ndimvor1,ndexvor1) ! Energy
	427	CALL histwrite( nidvor,"sovozeta",it,vortrd(:,:,jpvor_rvo),ndimvor1,ndexvor1) ! rel vorticity
	428	CALL histwrite( nidvor,"sovortif",it,vortrd(:,:,jpvor_pvo),ndimvor1,ndexvor1) ! coriolis
	429	CALL histwrite( nidvor,"sovodifl",it,vortrd(:,:,jpvor_ldf),ndimvor1,ndexvor1) ! lat diff
	430	CALL histwrite( nidvor,"sovoadvv",it,vortrd(:,:,jpvor_zad),ndimvor1,ndexvor1) ! vert adv
	431	CALL histwrite( nidvor,"sovodifv",it,vortrd(:,:,jpvor_zdf),ndimvor1,ndexvor1) ! vert diff
	432	CALL histwrite( nidvor,"sovortPs",it,vortrd(:,:,jpvor_spg),ndimvor1,ndexvor1) ! grad Ps
	433	CALL histwrite( nidvor,"sovortbv",it,vortrd(:,:,jpvor_bev),ndimvor1,ndexvor1) ! beta.V
	434	CALL histwrite( nidvor,"sovowind",it,vortrd(:,:,jpvor_swf),ndimvor1,ndexvor1) ! wind stress
	435	CALL histwrite( nidvor,"sovobfri",it,vortrd(:,:,jpvor_bfr),ndimvor1,ndexvor1) ! bottom friction
[216]	436	CALL histwrite( nidvor,"1st_mbre",it,vor_avrtot ,ndimvor1,ndexvor1) ! First membre
	437	CALL histwrite( nidvor,"sovorgap",it,vor_avrres ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre
[503]	438	!
[2528]	439	IF( ndebug /= 0 ) THEN
[216]	440	WRITE(numout,*) ' debuging trd_vor: III.4 done'
[109]	441	CALL FLUSH(numout)
	442	ENDIF
[503]	443	!
[109]	444	ENDIF
[503]	445	!
[1601]	446	IF( MOD( it, nn_trd ) == 0 ) rotot(:,:)=0
[503]	447	!
[216]	448	IF( kt == nitend ) CALL histclo( nidvor )
[503]	449	!
[4990]	450	END SUBROUTINE trd_vor_iom
[216]	451
	452
	453	SUBROUTINE trd_vor_init
	454	!!----------------------------------------------------------------------
	455	!! * ROUTINE trd_vor_init *
	456	!!
	457	!! ** Purpose : computation of vertically integrated T and S budgets
	458	!! from ocean surface down to control surface (NetCDF output)
	459	!!----------------------------------------------------------------------
[503]	460	REAL(wp) :: zjulian, zsto, zout
[216]	461	CHARACTER (len=40) :: clhstnam
	462	CHARACTER (len=40) :: clop
	463	!!----------------------------------------------------------------------
	464
	465	! ===================
	466	! I. initialization
	467	! ===================
	468
	469	cvort='averaged-vor'
	470
	471	! Open specifier
[2528]	472	ndebug = 0 ! set it to 1 in case of problem to have more Print
[216]	473
	474	IF(lwp) THEN
	475	WRITE(numout,*) ' '
[503]	476	WRITE(numout,*) ' trd_vor_init: vorticity trends'
	477	WRITE(numout,*) ' ~~~~~~~~~~~~'
[216]	478	WRITE(numout,*) ' '
[503]	479	WRITE(numout,*) ' ##########################################################################'
	480	WRITE(numout,*) ' CAUTION: The interpretation of the vorticity trends is'
	481	WRITE(numout,*) ' not obvious, please contact Anne-Marie TREGUIER at: treguier@ifremer.fr '
	482	WRITE(numout,*) ' ##########################################################################'
[216]	483	WRITE(numout,*) ' '
[129]	484	ENDIF
[109]	485
[2715]	486	IF( trd_vor_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_vor_init : unable to allocate trdvor arrays' )
	487
	488
[216]	489	! cumulated trends array init
	490	nmoydpvor = 0
	491	rotot(:,:)=0
	492	vor_avrtot(:,:)=0
	493	vor_avrres(:,:)=0
	494
[2528]	495	IF( ndebug /= 0 ) THEN
[216]	496	WRITE(numout,*) ' debuging trd_vor_init: I. done'
	497	CALL FLUSH(numout)
[129]	498	ENDIF
[109]	499
[216]	500	! =================================
	501	! II. netCDF output initialization
	502	! =================================
[109]	503
[216]	504	!-----------------------------------------
	505	! II.1 Define frequency of output and means
	506	! -----------------------------------------
[1312]	507	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
	508	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
	509	ENDIF
[216]	510	#if defined key_diainstant
[12489]	511	zsto = nn_write*rn_Dt
[1312]	512	clop = "inst("//TRIM(clop)//")"
[109]	513	#else
[12489]	514	zsto = rn_Dt
[1312]	515	clop = "ave("//TRIM(clop)//")"
[216]	516	#endif
[12489]	517	zout = nn_trd*rn_Dt
[216]	518
[503]	519	IF(lwp) WRITE(numout,*) ' netCDF initialization'
[216]	520
	521	! II.2 Compute julian date from starting date of the run
	522	! ------------------------
[12489]	523	CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )
[1310]	524	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
[503]	525	IF(lwp) WRITE(numout,*)' '
	526	IF(lwp) WRITE(numout,*)' Date 0 used :',nit000, &
	527	& ' YEAR ', nyear,' MONTH ' , nmonth, &
	528	& ' DAY ' , nday, 'Julian day : ', zjulian
[216]	529
	530	! II.3 Define the T grid trend file (nidvor)
	531	! ---------------------------------
[1601]	532	CALL dia_nam( clhstnam, nn_trd, 'vort' ) ! filename
[216]	533	IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
	534	CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit
[12489]	535	& 1, jpj, nit000-1, zjulian, rn_Dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
[216]	536	CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 ) ! surface
	537
	538	! Declare output fields as netCDF variables
	539	CALL histdef( nidvor, "sovortPh", cvort//"grad Ph" , "s-2", & ! grad Ph
	540	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	541	CALL histdef( nidvor, "sovortEk", cvort//"Energy", "s-2", & ! Energy
	542	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	543	CALL histdef( nidvor, "sovozeta", cvort//"rel vorticity", "s-2", & ! rel vorticity
	544	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	545	CALL histdef( nidvor, "sovortif", cvort//"coriolis", "s-2", & ! coriolis
	546	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	547	CALL histdef( nidvor, "sovodifl", cvort//"lat diff ", "s-2", & ! lat diff
	548	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	549	CALL histdef( nidvor, "sovoadvv", cvort//"vert adv", "s-2", & ! vert adv
	550	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	551	CALL histdef( nidvor, "sovodifv", cvort//"vert diff" , "s-2", & ! vert diff
	552	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	553	CALL histdef( nidvor, "sovortPs", cvort//"grad Ps", "s-2", & ! grad Ps
	554	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	555	CALL histdef( nidvor, "sovortbv", cvort//"Beta V", "s-2", & ! beta.V
	556	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	557	CALL histdef( nidvor, "sovowind", cvort//"wind stress", "s-2", & ! wind stress
	558	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	559	CALL histdef( nidvor, "sovobfri", cvort//"bottom friction", "s-2", & ! bottom friction
	560	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	561	CALL histdef( nidvor, "1st_mbre", cvort//"1st mbre", "s-2", & ! First membre
	562	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	563	CALL histdef( nidvor, "sovorgap", cvort//"gap", "s-2", & ! gap between 1st and 2 nd mbre
	564	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
[2528]	565	CALL histend( nidvor, snc4set )
[216]	566
[2528]	567	IF( ndebug /= 0 ) THEN
[216]	568	WRITE(numout,*) ' debuging trd_vor_init: II. done'
	569	CALL FLUSH(numout)
	570	ENDIF
[503]	571	!
[216]	572	END SUBROUTINE trd_vor_init
	573
[109]	574	!!======================================================================
	575	END MODULE trdvor

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

Download in other formats: