Context Navigation

trdvor.F90 @ 13322

Last change on this file since 13322 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 26.8 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
[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
[4990]	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
[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)
	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)
[6486]	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
[4990]	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
	118	CASE( jpdyn_bfr )
	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
[4990]	178	SELECT CASE( ktrd )
[2528]	179	!
[4990]	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	!
[4990]	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
[4990]	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'
[11101]	211	IF(lwp .AND. lflush) CALL flush(numout)
[216]	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
[4990]	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(:,:)
[4990]	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
[4990]	290	!
	291	! Average
[216]	292	zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
	293	zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
[4990]	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'
[11101]	307	IF(lwp .AND. lflush) CALL flush(numout)
[216]	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
[4990]	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	!!----------------------------------------------------------------------
[4990]	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
[216]	342	! I.2 vertically integrated vorticity
	343	! ----------------------------------
[109]	344
[2528]	345	vor_avr (:,:) = 0._wp
	346	zun (:,:) = 0._wp
	347	zvn (:,:) = 0._wp
	348	vor_avrtot(:,:) = 0._wp
	349	vor_avrres(:,:) = 0._wp
[109]	350
[216]	351	! Vertically averaged velocity
[109]	352	DO jk = 1, jpk - 1
[2528]	353	zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk)
	354	zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)
[109]	355	END DO
	356
[2528]	357	zun(:,:) = zun(:,:) * hur(:,:)
	358	zvn(:,:) = zvn(:,:) * hvr(:,:)
[109]	359
[216]	360	! Curl
[4990]	361	DO ji = 1, jpim1
	362	DO jj = 1, jpjm1
[2528]	363	vor_avr(ji,jj) = ( ( zvn(ji+1,jj) - zvn(ji,jj) ) &
	364	& - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1)
[129]	365	END DO
[109]	366	END DO
	367
	368	! =================================
[216]	369	! II. Cumulated trends
[109]	370	! =================================
	371
[216]	372	! II.1 set `before' mixed layer values for kt = nit000+1
	373	! ------------------------------------------------------
[109]	374	IF( kt == nit000+1 ) THEN
	375	vor_avrbb(:,:) = vor_avrb(:,:)
	376	vor_avrbn(:,:) = vor_avr (:,:)
	377	ENDIF
	378
[216]	379	! II.2 cumulated trends over analysis period (kt=2 to nwrite)
[109]	380	! ----------------------
	381	! trends cumulated over nwrite-2 time steps
	382
	383	IF( kt >= nit000+2 ) THEN
	384	nmoydpvor = nmoydpvor + 1
[503]	385	DO jl = 1, jpltot_vor
[129]	386	IF( jl /= 9 ) THEN
	387	rotot(:,:) = rotot(:,:) + vortrd(:,:,jl)
	388	ENDIF
[109]	389	END DO
	390	ENDIF
	391
	392	! =============================================
[216]	393	! III. Output in netCDF + residual computation
[109]	394	! =============================================
[216]	395
[1317]	396	! define time axis
[2528]	397	it = kt
[1334]	398	itmod = kt - nit000 + 1
[109]	399
[1601]	400	IF( MOD( it, nn_trd ) == 0 ) THEN
[1317]	401
[216]	402	! III.1 compute total trend
[109]	403	! ------------------------
[2528]	404	zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * rdt )
	405	vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean
[109]	406
	407
[216]	408	! III.2 compute residual
[109]	409	! ---------------------
[2528]	410	zmean = 1._wp / REAL( nmoydpvor, wp )
[109]	411	vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean
	412
[129]	413	! Boundary conditions
[109]	414	CALL lbc_lnk( vor_avrtot, 'F', 1. )
	415	CALL lbc_lnk( vor_avrres, 'F', 1. )
	416
	417
[216]	418	! III.3 time evolution array swap
[109]	419	! ------------------------------
	420	vor_avrbb(:,:) = vor_avrb(:,:)
[2528]	421	vor_avrbn(:,:) = vor_avr (:,:)
	422	!
	423	nmoydpvor = 0
	424	!
[109]	425	ENDIF
	426
[216]	427	! III.4 write trends to output
[109]	428	! ---------------------------
[216]	429
[109]	430	IF( kt >= nit000+1 ) THEN
	431
[1601]	432	IF( lwp .AND. MOD( itmod, nn_trd ) == 0 ) THEN
[503]	433	WRITE(numout,*) ''
	434	WRITE(numout,*) 'trd_vor : write trends in the NetCDF file at kt = ', kt
	435	WRITE(numout,*) '~~~~~~~ '
[11101]	436	IF(lflush) CALL flush(numout)
[216]	437	ENDIF
	438
[503]	439	CALL histwrite( nidvor,"sovortPh",it,vortrd(:,:,jpvor_prg),ndimvor1,ndexvor1) ! grad Ph
	440	CALL histwrite( nidvor,"sovortEk",it,vortrd(:,:,jpvor_keg),ndimvor1,ndexvor1) ! Energy
	441	CALL histwrite( nidvor,"sovozeta",it,vortrd(:,:,jpvor_rvo),ndimvor1,ndexvor1) ! rel vorticity
	442	CALL histwrite( nidvor,"sovortif",it,vortrd(:,:,jpvor_pvo),ndimvor1,ndexvor1) ! coriolis
	443	CALL histwrite( nidvor,"sovodifl",it,vortrd(:,:,jpvor_ldf),ndimvor1,ndexvor1) ! lat diff
	444	CALL histwrite( nidvor,"sovoadvv",it,vortrd(:,:,jpvor_zad),ndimvor1,ndexvor1) ! vert adv
	445	CALL histwrite( nidvor,"sovodifv",it,vortrd(:,:,jpvor_zdf),ndimvor1,ndexvor1) ! vert diff
	446	CALL histwrite( nidvor,"sovortPs",it,vortrd(:,:,jpvor_spg),ndimvor1,ndexvor1) ! grad Ps
	447	CALL histwrite( nidvor,"sovortbv",it,vortrd(:,:,jpvor_bev),ndimvor1,ndexvor1) ! beta.V
	448	CALL histwrite( nidvor,"sovowind",it,vortrd(:,:,jpvor_swf),ndimvor1,ndexvor1) ! wind stress
	449	CALL histwrite( nidvor,"sovobfri",it,vortrd(:,:,jpvor_bfr),ndimvor1,ndexvor1) ! bottom friction
[216]	450	CALL histwrite( nidvor,"1st_mbre",it,vor_avrtot ,ndimvor1,ndexvor1) ! First membre
	451	CALL histwrite( nidvor,"sovorgap",it,vor_avrres ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre
[503]	452	!
[2528]	453	IF( ndebug /= 0 ) THEN
[216]	454	WRITE(numout,*) ' debuging trd_vor: III.4 done'
[11101]	455	IF(lwp .AND. lflush) CALL flush(numout)
[109]	456	ENDIF
[503]	457	!
[109]	458	ENDIF
[503]	459	!
[1601]	460	IF( MOD( it, nn_trd ) == 0 ) rotot(:,:)=0
[503]	461	!
[216]	462	IF( kt == nitend ) CALL histclo( nidvor )
[503]	463	!
[3294]	464	CALL wrk_dealloc( jpi, jpj, zun, zvn )
[2715]	465	!
[4990]	466	END SUBROUTINE trd_vor_iom
[216]	467
	468
	469	SUBROUTINE trd_vor_init
	470	!!----------------------------------------------------------------------
	471	!! * ROUTINE trd_vor_init *
	472	!!
	473	!! ** Purpose : computation of vertically integrated T and S budgets
	474	!! from ocean surface down to control surface (NetCDF output)
	475	!!----------------------------------------------------------------------
[503]	476	REAL(wp) :: zjulian, zsto, zout
[216]	477	CHARACTER (len=40) :: clhstnam
	478	CHARACTER (len=40) :: clop
	479	!!----------------------------------------------------------------------
	480
	481	! ===================
	482	! I. initialization
	483	! ===================
	484
	485	cvort='averaged-vor'
	486
	487	! Open specifier
[2528]	488	ndebug = 0 ! set it to 1 in case of problem to have more Print
[216]	489
	490	IF(lwp) THEN
	491	WRITE(numout,*) ' '
[503]	492	WRITE(numout,*) ' trd_vor_init: vorticity trends'
	493	WRITE(numout,*) ' ~~~~~~~~~~~~'
[216]	494	WRITE(numout,*) ' '
[503]	495	WRITE(numout,*) ' ##########################################################################'
	496	WRITE(numout,*) ' CAUTION: The interpretation of the vorticity trends is'
	497	WRITE(numout,*) ' not obvious, please contact Anne-Marie TREGUIER at: treguier@ifremer.fr '
	498	WRITE(numout,*) ' ##########################################################################'
[216]	499	WRITE(numout,*) ' '
[11101]	500	IF(lflush) CALL flush(numout)
[129]	501	ENDIF
[109]	502
[2715]	503	IF( trd_vor_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_vor_init : unable to allocate trdvor arrays' )
	504
	505
[216]	506	! cumulated trends array init
	507	nmoydpvor = 0
	508	rotot(:,:)=0
	509	vor_avrtot(:,:)=0
	510	vor_avrres(:,:)=0
	511
[2528]	512	IF( ndebug /= 0 ) THEN
[216]	513	WRITE(numout,*) ' debuging trd_vor_init: I. done'
[11101]	514	IF(lflush) CALL flush(numout)
[129]	515	ENDIF
[109]	516
[216]	517	! =================================
	518	! II. netCDF output initialization
	519	! =================================
[109]	520
[216]	521	!-----------------------------------------
	522	! II.1 Define frequency of output and means
	523	! -----------------------------------------
[1312]	524	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
	525	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
	526	ENDIF
[216]	527	#if defined key_diainstant
	528	zsto = nwrite*rdt
[1312]	529	clop = "inst("//TRIM(clop)//")"
[109]	530	#else
[216]	531	zsto = rdt
[1312]	532	clop = "ave("//TRIM(clop)//")"
[216]	533	#endif
[1601]	534	zout = nn_trd*rdt
[216]	535
[503]	536	IF(lwp) WRITE(numout,*) ' netCDF initialization'
[11101]	537	IF(lwp .AND. lflush) CALL flush(numout)
[216]	538
	539	! II.2 Compute julian date from starting date of the run
	540	! ------------------------
[1310]	541	CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
	542	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
[503]	543	IF(lwp) WRITE(numout,*)' '
	544	IF(lwp) WRITE(numout,*)' Date 0 used :',nit000, &
	545	& ' YEAR ', nyear,' MONTH ' , nmonth, &
	546	& ' DAY ' , nday, 'Julian day : ', zjulian
[11101]	547	IF(lwp .AND. lflush) CALL flush(numout)
[216]	548
	549	! II.3 Define the T grid trend file (nidvor)
	550	! ---------------------------------
[1601]	551	CALL dia_nam( clhstnam, nn_trd, 'vort' ) ! filename
[216]	552	IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
[11101]	553	IF(lwp .AND. lflush) CALL flush(numout)
[216]	554	CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit
[2528]	555	& 1, jpj, nit000-1, zjulian, rdt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
[216]	556	CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 ) ! surface
	557
	558	! Declare output fields as netCDF variables
	559	CALL histdef( nidvor, "sovortPh", cvort//"grad Ph" , "s-2", & ! grad Ph
	560	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	561	CALL histdef( nidvor, "sovortEk", cvort//"Energy", "s-2", & ! Energy
	562	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	563	CALL histdef( nidvor, "sovozeta", cvort//"rel vorticity", "s-2", & ! rel vorticity
	564	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	565	CALL histdef( nidvor, "sovortif", cvort//"coriolis", "s-2", & ! coriolis
	566	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	567	CALL histdef( nidvor, "sovodifl", cvort//"lat diff ", "s-2", & ! lat diff
	568	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	569	CALL histdef( nidvor, "sovoadvv", cvort//"vert adv", "s-2", & ! vert adv
	570	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	571	CALL histdef( nidvor, "sovodifv", cvort//"vert diff" , "s-2", & ! vert diff
	572	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	573	CALL histdef( nidvor, "sovortPs", cvort//"grad Ps", "s-2", & ! grad Ps
	574	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	575	CALL histdef( nidvor, "sovortbv", cvort//"Beta V", "s-2", & ! beta.V
	576	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	577	CALL histdef( nidvor, "sovowind", cvort//"wind stress", "s-2", & ! wind stress
	578	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	579	CALL histdef( nidvor, "sovobfri", cvort//"bottom friction", "s-2", & ! bottom friction
	580	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	581	CALL histdef( nidvor, "1st_mbre", cvort//"1st mbre", "s-2", & ! First membre
	582	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	583	CALL histdef( nidvor, "sovorgap", cvort//"gap", "s-2", & ! gap between 1st and 2 nd mbre
	584	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
[2528]	585	CALL histend( nidvor, snc4set )
[216]	586
[2528]	587	IF( ndebug /= 0 ) THEN
[216]	588	WRITE(numout,*) ' debuging trd_vor_init: II. done'
[11101]	589	IF(lflush) CALL flush(numout)
[216]	590	ENDIF
[503]	591	!
[216]	592	END SUBROUTINE trd_vor_init
	593
[109]	594	!!======================================================================
	595	END MODULE trdvor

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_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90 @ 13322

Download in other formats: