Context Navigation

trdvor.F90 @ 11101

Last change on this file since 11101 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

Line
1	MODULE trdvor
2	!!======================================================================
3	!! * MODULE trdvor *
4	!! Ocean diagnostics: momentum trends
5	!!=====================================================================
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
9	!!----------------------------------------------------------------------
10
11	!!----------------------------------------------------------------------
12	!! trd_vor : momentum trends averaged over the depth
13	!! trd_vor_zint : vorticity vertical integration
14	!! trd_vor_init : initialization step
15	!!----------------------------------------------------------------------
16	USE oce ! ocean dynamics and tracers variables
17	USE dom_oce ! ocean space and time domain variables
18	USE trd_oce ! trends: ocean variables
19	USE zdf_oce ! ocean vertical physics
20	USE sbc_oce ! surface boundary condition: ocean
21	USE phycst ! Define parameters for the routines
22	USE ldfdyn_oce ! ocean active tracers: lateral physics
23	USE dianam ! build the name of file (routine)
24	USE zdfmxl ! mixed layer depth
25	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
26	USE in_out_manager ! I/O manager
27	USE ioipsl ! NetCDF library
28	USE lib_mpp ! MPP library
29	USE wrk_nemo ! Memory allocation
30
31	IMPLICIT NONE
32	PRIVATE
33
34	INTERFACE trd_vor_zint
35	MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d
36	END INTERFACE
37
38	PUBLIC trd_vor ! routine called by trddyn.F90
39	PUBLIC trd_vor_init ! routine called by opa.F90
40	PUBLIC trd_vor_alloc ! routine called by nemogcm.F90
41
42	INTEGER :: nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount ! needs for IOIPSL output
43	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndexvor1 ! needed for IOIPSL output
44	INTEGER :: ndebug ! (0/1) set it to 1 in case of problem to have more print
45
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
54
55	CHARACTER(len=12) :: cvort
56
57	!! * Substitutions
58	# include "domzgr_substitute.h90"
59	# include "ldfdyn_substitute.h90"
60	# include "vectopt_loop_substitute.h90"
61	!!----------------------------------------------------------------------
62	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
63	!! $Id$
64	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
65	!!----------------------------------------------------------------------
66	CONTAINS
67
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
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
130	SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )
131	!!----------------------------------------------------------------------------
132	!! * ROUTINE trd_vor_zint *
133	!!
134	!! ** Purpose : computation of vertically integrated vorticity budgets
135	!! from ocean surface down to control surface (NetCDF output)
136	!!
137	!! ** Method/usage : integration done over nwrite-1 time steps
138	!!
139	!! ** Action : trends :
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
149	!! vortrd (,,10) = forcing term
150	!! vortrd (,,11) = bottom friction term
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	!!----------------------------------------------------------------------
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
160	!
161	INTEGER :: ji, jj ! dummy loop indices
162	INTEGER :: ikbu, ikbv ! local integers
163	REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor ! total cmulative trends
164	!!----------------------------------------------------------------------
165
166	!
167	CALL wrk_alloc( jpi, jpj, zudpvor, zvdpvor ) ! Memory allocation
168	!
169
170	zudpvor(:,:) = 0._wp ; zvdpvor(:,:) = 0._wp ! Initialisation
171	CALL lbc_lnk( putrdvor, 'U', -1. ) ; CALL lbc_lnk( pvtrdvor, 'V', -1. ) ! lateral boundary condition
172
173
174	! =====================================
175	! I vertical integration of 2D trends
176	! =====================================
177
178	SELECT CASE( ktrd )
179	!
180	CASE( jpvor_bfr ) ! bottom friction
181	DO jj = 2, jpjm1
182	DO ji = fs_2, fs_jpim1
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)
187	END DO
188	END DO
189	!
190	CASE( jpvor_swf ) ! wind stress
191	zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1)
192	zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1)
193	!
194	END SELECT
195
196	! Average except for Beta.V
197	zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
198	zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
199
200	! Curl
201	DO ji = 1, jpim1
202	DO jj = 1, jpjm1
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) )
205	END DO
206	END DO
207	vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) ! Surface mask
208
209	IF( ndebug /= 0 ) THEN
210	IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
211	IF(lwp .AND. lflush) CALL flush(numout)
212	ENDIF
213	!
214	CALL wrk_dealloc( jpi, jpj, zudpvor, zvdpvor )
215	!
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
224	!! from ocean surface down to control surface (NetCDF output)
225	!!
226	!! ** Method/usage : integration done over nwrite-1 time steps
227	!!
228	!! ** Action : trends :
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
245	!!----------------------------------------------------------------------
246	!
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
250	!
251	INTEGER :: ji, jj, jk ! dummy loop indices
252	REAL(wp), POINTER, DIMENSION(:,:) :: zubet , zvbet ! Beta.V
253	REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor ! total cmulative trends
254	!!----------------------------------------------------------------------
255
256	CALL wrk_alloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )
257
258	! Initialization
259	zubet (:,:) = 0._wp
260	zvbet (:,:) = 0._wp
261	zudpvor(:,:) = 0._wp
262	zvdpvor(:,:) = 0._wp
263	!
264	CALL lbc_lnk( putrdvor, 'U', -1. ) ! lateral boundary condition on input momentum trends
265	CALL lbc_lnk( pvtrdvor, 'V', -1. )
266
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
275
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
279	zubet(:,:) = zudpvor(:,:)
280	zvbet(:,:) = zvdpvor(:,:)
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)
289	ENDIF
290	!
291	! Average
292	zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
293	zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
294	!
295	! Curl
296	DO ji=1,jpim1
297	DO jj=1,jpjm1
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) )
300	END DO
301	END DO
302	! Surface mask
303	vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)
304
305	IF( ndebug /= 0 ) THEN
306	IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
307	IF(lwp .AND. lflush) CALL flush(numout)
308	ENDIF
309	!
310	CALL wrk_dealloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )
311	!
312	END SUBROUTINE trd_vor_zint_3d
313
314
315	SUBROUTINE trd_vor_iom( kt )
316	!!----------------------------------------------------------------------
317	!! * ROUTINE trd_vor *
318	!!
319	!! ** Purpose : computation of cumulated trends over analysis period
320	!! and make outputs (NetCDF or DIMG format)
321	!!----------------------------------------------------------------------
322	INTEGER , INTENT(in ) :: kt ! time step
323	!
324	INTEGER :: ji, jj, jk, jl ! dummy loop indices
325	INTEGER :: it, itmod ! local integers
326	REAL(wp) :: zmean ! local scalars
327	REAL(wp), POINTER, DIMENSION(:,:) :: zun, zvn
328	!!----------------------------------------------------------------------
329
330	CALL wrk_alloc( jpi, jpj, zun, zvn )
331
332	! =================
333	! I. Initialization
334	! =================
335
336
337	! I.1 set before values of vertically average u and v
338	! ---------------------------------------------------
339
340	IF( kt > nit000 ) vor_avrb(:,:) = vor_avr(:,:)
341
342	! I.2 vertically integrated vorticity
343	! ----------------------------------
344
345	vor_avr (:,:) = 0._wp
346	zun (:,:) = 0._wp
347	zvn (:,:) = 0._wp
348	vor_avrtot(:,:) = 0._wp
349	vor_avrres(:,:) = 0._wp
350
351	! Vertically averaged velocity
352	DO jk = 1, jpk - 1
353	zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk)
354	zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)
355	END DO
356
357	zun(:,:) = zun(:,:) * hur(:,:)
358	zvn(:,:) = zvn(:,:) * hvr(:,:)
359
360	! Curl
361	DO ji = 1, jpim1
362	DO jj = 1, jpjm1
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)
365	END DO
366	END DO
367
368	! =================================
369	! II. Cumulated trends
370	! =================================
371
372	! II.1 set `before' mixed layer values for kt = nit000+1
373	! ------------------------------------------------------
374	IF( kt == nit000+1 ) THEN
375	vor_avrbb(:,:) = vor_avrb(:,:)
376	vor_avrbn(:,:) = vor_avr (:,:)
377	ENDIF
378
379	! II.2 cumulated trends over analysis period (kt=2 to nwrite)
380	! ----------------------
381	! trends cumulated over nwrite-2 time steps
382
383	IF( kt >= nit000+2 ) THEN
384	nmoydpvor = nmoydpvor + 1
385	DO jl = 1, jpltot_vor
386	IF( jl /= 9 ) THEN
387	rotot(:,:) = rotot(:,:) + vortrd(:,:,jl)
388	ENDIF
389	END DO
390	ENDIF
391
392	! =============================================
393	! III. Output in netCDF + residual computation
394	! =============================================
395
396	! define time axis
397	it = kt
398	itmod = kt - nit000 + 1
399
400	IF( MOD( it, nn_trd ) == 0 ) THEN
401
402	! III.1 compute total trend
403	! ------------------------
404	zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * rdt )
405	vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean
406
407
408	! III.2 compute residual
409	! ---------------------
410	zmean = 1._wp / REAL( nmoydpvor, wp )
411	vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean
412
413	! Boundary conditions
414	CALL lbc_lnk( vor_avrtot, 'F', 1. )
415	CALL lbc_lnk( vor_avrres, 'F', 1. )
416
417
418	! III.3 time evolution array swap
419	! ------------------------------
420	vor_avrbb(:,:) = vor_avrb(:,:)
421	vor_avrbn(:,:) = vor_avr (:,:)
422	!
423	nmoydpvor = 0
424	!
425	ENDIF
426
427	! III.4 write trends to output
428	! ---------------------------
429
430	IF( kt >= nit000+1 ) THEN
431
432	IF( lwp .AND. MOD( itmod, nn_trd ) == 0 ) THEN
433	WRITE(numout,*) ''
434	WRITE(numout,*) 'trd_vor : write trends in the NetCDF file at kt = ', kt
435	WRITE(numout,*) '~~~~~~~ '
436	IF(lflush) CALL flush(numout)
437	ENDIF
438
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
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
452	!
453	IF( ndebug /= 0 ) THEN
454	WRITE(numout,*) ' debuging trd_vor: III.4 done'
455	IF(lwp .AND. lflush) CALL flush(numout)
456	ENDIF
457	!
458	ENDIF
459	!
460	IF( MOD( it, nn_trd ) == 0 ) rotot(:,:)=0
461	!
462	IF( kt == nitend ) CALL histclo( nidvor )
463	!
464	CALL wrk_dealloc( jpi, jpj, zun, zvn )
465	!
466	END SUBROUTINE trd_vor_iom
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	!!----------------------------------------------------------------------
476	REAL(wp) :: zjulian, zsto, zout
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
488	ndebug = 0 ! set it to 1 in case of problem to have more Print
489
490	IF(lwp) THEN
491	WRITE(numout,*) ' '
492	WRITE(numout,*) ' trd_vor_init: vorticity trends'
493	WRITE(numout,*) ' ~~~~~~~~~~~~'
494	WRITE(numout,*) ' '
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,*) ' ##########################################################################'
499	WRITE(numout,*) ' '
500	IF(lflush) CALL flush(numout)
501	ENDIF
502
503	IF( trd_vor_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_vor_init : unable to allocate trdvor arrays' )
504
505
506	! cumulated trends array init
507	nmoydpvor = 0
508	rotot(:,:)=0
509	vor_avrtot(:,:)=0
510	vor_avrres(:,:)=0
511
512	IF( ndebug /= 0 ) THEN
513	WRITE(numout,*) ' debuging trd_vor_init: I. done'
514	IF(lflush) CALL flush(numout)
515	ENDIF
516
517	! =================================
518	! II. netCDF output initialization
519	! =================================
520
521	!-----------------------------------------
522	! II.1 Define frequency of output and means
523	! -----------------------------------------
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
527	#if defined key_diainstant
528	zsto = nwrite*rdt
529	clop = "inst("//TRIM(clop)//")"
530	#else
531	zsto = rdt
532	clop = "ave("//TRIM(clop)//")"
533	#endif
534	zout = nn_trd*rdt
535
536	IF(lwp) WRITE(numout,*) ' netCDF initialization'
537	IF(lwp .AND. lflush) CALL flush(numout)
538
539	! II.2 Compute julian date from starting date of the run
540	! ------------------------
541	CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
542	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
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
547	IF(lwp .AND. lflush) CALL flush(numout)
548
549	! II.3 Define the T grid trend file (nidvor)
550	! ---------------------------------
551	CALL dia_nam( clhstnam, nn_trd, 'vort' ) ! filename
552	IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
553	IF(lwp .AND. lflush) CALL flush(numout)
554	CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit
555	& 1, jpj, nit000-1, zjulian, rdt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
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)
585	CALL histend( nidvor, snc4set )
586
587	IF( ndebug /= 0 ) THEN
588	WRITE(numout,*) ' debuging trd_vor_init: II. done'
589	IF(lflush) CALL flush(numout)
590	ENDIF
591	!
592	END SUBROUTINE trd_vor_init
593
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 @ 11101

Download in other formats: