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 branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

Context Navigation

source: branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90 @ 3325

Last change on this file since 3325 was 3325, checked in by gm, 12 years ago
Ediag branche: #927 add Kinetic Energy trend diagnostics (trdken.F90)
Property svn:keywords set to `Id`
File size: 27.4 KB

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

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

Download in other formats: