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 trunk/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90 @ 2528

Last change on this file since 2528 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: 24.4 KB

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

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

Download in other formats: