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

Context Navigation

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90 @ 4409

Last change on this file since 4409 was 4409, checked in by trackstand2, 10 years ago
Changes to allow jpk to be modified to deepest level within a subdomain. jpkorig holds original value.
Property svn:keywords set to `Id`
File size: 27.9 KB

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

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

Download in other formats: