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.

trddyn.F90 in NEMO/branches/UKMO/NEMO_4.0.4_momentum_trends/src/OCE/TRD – NEMO

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.4_momentum_trends/src/OCE/TRD/trddyn.F90 @ 15176

Last change on this file since 15176 was 15176, checked in by davestorkey, 3 years ago

UKMO/NEMO_4.0.4_momentum_trends:

Output complete budget of 2D trends.
Separate out ice-ocean stress from wind stress (for 2D budget).
Allow thickness weighting of 2D trends.

File size: 26.0 KB

Line
1	MODULE trddyn
2	!!======================================================================
3	!! * MODULE trddyn *
4	!! Ocean diagnostics: ocean dynamic trends
5	!!=====================================================================
6	!! History : 3.5 ! 2012-02 (G. Madec) creation from trdmod: split DYN and TRA trends
7	!! and manage 3D trends output for U, V, and KE
8	!!----------------------------------------------------------------------
9
10	!!----------------------------------------------------------------------
11	!! trd_dyn : manage the type of momentum trend diagnostics (3D I/O, domain averaged, KE)
12	!! trd_dyn_iom : output 3D momentum and/or tracer trends using IOM
13	!! trd_dyn_init : initialization step
14	!!----------------------------------------------------------------------
15	USE oce ! ocean dynamics and tracers variables
16	USE dom_oce ! ocean space and time domain variables
17	USE phycst ! physical constants
18	USE sbc_oce ! surface boundary condition: ocean
19	USE zdf_oce ! ocean vertical physics: variables
20	USE trd_oce ! trends: ocean variables
21	USE trdken ! trends: Kinetic ENergy
22	USE trdglo ! trends: global domain averaged
23	USE trdvor ! trends: vertical averaged vorticity
24	USE trdmxl ! trends: mixed layer averaged
25	!
26	USE in_out_manager ! I/O manager
27	USE lbclnk ! lateral boundary condition
28	USE iom ! I/O manager library
29	USE lib_mpp ! MPP library
30
31	IMPLICIT NONE
32	PRIVATE
33
34	PUBLIC trd_dyn ! called by all dynXXX modules
35
36	INTERFACE trd_dyn
37	module procedure trd_dyn_3d, trd_dyn_2d
38	END INTERFACE
39
40	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: zutrd_hpg, zvtrd_hpg
41	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: zutrd_pvo, zvtrd_pvo
42	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: zutrd_tfre, zvtrd_tfre
43	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: zutrd_bfre, zvtrd_bfre
44	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: zutrd_tfr, zvtrd_tfr
45	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: zutrd_bfr, zvtrd_bfr
46	REAL(wp), ALLOCATABLE, DIMENSION(:,:) , SAVE :: zutrd_tau2d, zvtrd_tau2d
47	REAL(wp), ALLOCATABLE, DIMENSION(:,:) , SAVE :: zutrd_tau2d_ice, zvtrd_tau2d_ice
48	REAL(wp), ALLOCATABLE, DIMENSION(:,:) , SAVE :: zutrd_tfr2d, zvtrd_tfr2d
49	REAL(wp), ALLOCATABLE, DIMENSION(:,:) , SAVE :: zutrd_bfr2d, zvtrd_bfr2d
50
51	!! * Substitutions
52	# include "vectopt_loop_substitute.h90"
53	!!----------------------------------------------------------------------
54	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
55	!! $Id$
56	!! Software governed by the CeCILL license (see ./LICENSE)
57	!!----------------------------------------------------------------------
58	CONTAINS
59
60	SUBROUTINE trd_dyn_3d( putrd, pvtrd, ktrd, kt )
61	!!---------------------------------------------------------------------
62	!! * ROUTINE trd_dyn_3d *
63	!!
64	!! ** Purpose : Dispatch momentum trend computation, e.g. 3D output,
65	!! integral constraints, barotropic vorticity, kinetic enrgy,
66	!! and/or mixed layer budget.
67	!!----------------------------------------------------------------------
68	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
69	INTEGER , INTENT(in ) :: ktrd ! trend index
70	INTEGER , INTENT(in ) :: kt ! time step
71	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve ! temporary 2D arrays
72	INTEGER :: jk
73	!!----------------------------------------------------------------------
74	!
75	putrd(:,:,:) = putrd(:,:,:) * umask(:,:,:) ! mask the trends
76	pvtrd(:,:,:) = pvtrd(:,:,:) * vmask(:,:,:)
77	!
78
79	!!gm NB : here a lbc_lnk should probably be added
80
81	SELECT CASE( ktrd )
82	CASE( jpdyn_hpg_save )
83	!
84	! save 3D HPG trends to possibly have barotropic part corrected later before writing out
85	ALLOCATE( zutrd_hpg(jpi,jpj,jpk), zvtrd_hpg(jpi,jpj,jpk) )
86	zutrd_hpg(:,:,:) = putrd(:,:,:)
87	zvtrd_hpg(:,:,:) = pvtrd(:,:,:)
88
89	CASE( jpdyn_pvo_save )
90	!
91	! save 3D coriolis trends to possibly have barotropic part corrected later before writing out
92	ALLOCATE( zutrd_pvo(jpi,jpj,jpk), zvtrd_pvo(jpi,jpj,jpk) )
93	zutrd_pvo(:,:,:) = putrd(:,:,:)
94	zvtrd_pvo(:,:,:) = pvtrd(:,:,:)
95
96	CASE( jpdyn_spg )
97	! For explicit scheme SPG trends come here as 3D fields
98	! Add SPG trend to 3D HPG trend and also output as 2D diagnostic in own right.
99	CALL trd_dyn_iom_2d( putrd(:,:,1), pvtrd(:,:,1), jpdyn_spg, kt )
100	zutrd_hpg(:,:,:) = zutrd_hpg(:,:,:) + putrd(:,:,:)
101	zvtrd_hpg(:,:,:) = zvtrd_hpg(:,:,:) + pvtrd(:,:,:)
102	CALL trd_dyn_iom_3d( zvtrd_hpg, zvtrd_hpg, jpdyn_hpg, kt )
103	DEALLOCATE( zutrd_hpg, zvtrd_hpg )
104
105	CASE( jpdyn_tfre )
106	!
107	! Explicit top drag trend calculated in zdf_drg. Save to add to
108	! ZDF trend later and add to 3D TFR trend.
109	IF( .NOT. ALLOCATED(zutrd_tfre) ) THEN
110	ALLOCATE( zutrd_tfre(jpi,jpj,jpk), zvtrd_tfre(jpi,jpj,jpk) )
111	zutrd_tfre(:,:,:) = putrd(:,:,:)
112	zvtrd_tfre(:,:,:) = pvtrd(:,:,:)
113	ENDIF
114	IF( .NOT. ALLOCATED(zutrd_tfr) ) THEN
115	ALLOCATE( zutrd_tfr(jpi,jpj,jpk), zvtrd_tfr(jpi,jpj,jpk) )
116	zutrd_tfr(:,:,:) = 0.0
117	zvtrd_tfr(:,:,:) = 0.0
118	ENDIF
119	zutrd_tfr(:,:,:) = zutrd_tfr(:,:,:) + putrd(:,:,:)
120	zvtrd_tfr(:,:,:) = zvtrd_tfr(:,:,:) + pvtrd(:,:,:)
121
122	CASE( jpdyn_tfre_bt, jpdyn_tfri )
123	!
124	! Add various top friction terms for baroclinic trend to saved quantity.
125	! Any depth-mean component removed later when TFR trend written out.
126	IF( .NOT. ALLOCATED(zutrd_tfr) ) THEN
127	ALLOCATE( zutrd_tfr(jpi,jpj,jpk), zvtrd_tfr(jpi,jpj,jpk) )
128	zutrd_tfr(:,:,:) = 0.0
129	zvtrd_tfr(:,:,:) = 0.0
130	ENDIF
131	zutrd_tfr(:,:,:) = zutrd_tfr(:,:,:) + putrd(:,:,:)
132	zvtrd_tfr(:,:,:) = zvtrd_tfr(:,:,:) + pvtrd(:,:,:)
133
134	CASE( jpdyn_bfre )
135	!
136	! Explicit bottom drag trend calculated in zdf_drg. Save to add to
137	! ZDF trend later and add to 3D BFR trend.
138	IF( .NOT. ALLOCATED(zutrd_bfre) ) THEN
139	ALLOCATE( zutrd_bfre(jpi,jpj,jpk), zvtrd_bfre(jpi,jpj,jpk) )
140	zutrd_bfre(:,:,:) = putrd(:,:,:)
141	zvtrd_bfre(:,:,:) = pvtrd(:,:,:)
142	ENDIF
143	IF( .NOT. ALLOCATED(zutrd_bfr) ) THEN
144	ALLOCATE( zutrd_bfr(jpi,jpj,jpk), zvtrd_bfr(jpi,jpj,jpk) )
145	zutrd_bfr(:,:,:) = 0.0
146	zvtrd_bfr(:,:,:) = 0.0
147	ENDIF
148	zutrd_bfr(:,:,:) = zutrd_bfr(:,:,:) + putrd(:,:,:)
149	zvtrd_bfr(:,:,:) = zvtrd_bfr(:,:,:) + pvtrd(:,:,:)
150
151	CASE( jpdyn_bfre_bt, jpdyn_bfri )
152	!
153	! Add various bottom friction terms for baroclinic trend to saved quantity.
154	! Any depth-mean component removed later when TFR trend written out.
155	IF( .NOT. ALLOCATED(zutrd_bfr) ) THEN
156	ALLOCATE( zutrd_bfr(jpi,jpj,jpk), zvtrd_bfr(jpi,jpj,jpk) )
157	zutrd_bfr(:,:,:) = 0.0
158	zvtrd_bfr(:,:,:) = 0.0
159	ENDIF
160	zutrd_bfr(:,:,:) = zutrd_bfr(:,:,:) + putrd(:,:,:)
161	zvtrd_bfr(:,:,:) = zvtrd_bfr(:,:,:) + pvtrd(:,:,:)
162
163	CASE( jpdyn_zdf )
164	! ZDF trend: Add explicit bottom friction if necessary. If ln_dynspg_ts, remove barotropic component
165	! and add wind stress, and top and bottom friction trends from dynspg_ts.
166	!
167	! If TFRE or BFRE arrays allocated at this stage then they will contain trends due
168	! to explicit top or bottom drag components which need to be added to the ZDF trend.
169	IF( ALLOCATED( zutrd_tfre ) )THEN
170	DO jk = 1, jpkm1
171	putrd(:,:,jk) = ( putrd(:,:,jk) + zutrd_tfre(:,:,jk) ) * umask(:,:,jk)
172	pvtrd(:,:,jk) = ( pvtrd(:,:,jk) + zvtrd_tfre(:,:,jk) ) * vmask(:,:,jk)
173	END DO
174	DEALLOCATE( zutrd_tfre, zvtrd_tfre )
175	ENDIF
176	IF( ALLOCATED( zutrd_bfre ) )THEN
177	DO jk = 1, jpkm1
178	putrd(:,:,jk) = ( putrd(:,:,jk) + zutrd_bfre(:,:,jk) ) * umask(:,:,jk)
179	pvtrd(:,:,jk) = ( pvtrd(:,:,jk) + zvtrd_bfre(:,:,jk) ) * vmask(:,:,jk)
180	END DO
181	DEALLOCATE( zutrd_bfre, zvtrd_bfre )
182	ENDIF
183	IF( ln_dynspg_ts ) THEN
184	ALLOCATE( zue(jpi,jpj), zve(jpi,jpj) )
185	zue(:,:) = e3u_a(:,:,1) * putrd(:,:,1) * umask(:,:,1)
186	zve(:,:) = e3v_a(:,:,1) * pvtrd(:,:,1) * vmask(:,:,1)
187	DO jk = 2, jpkm1
188	zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * putrd(:,:,jk) * umask(:,:,jk)
189	zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * pvtrd(:,:,jk) * vmask(:,:,jk)
190	END DO
191	DO jk = 1, jpkm1
192	putrd(:,:,jk) = ( zutrd_tau2d(:,:) + zutrd_bfr2d(:,:) + putrd(:,:,jk) - zue(:,:) * r1_hu_a(:,:) ) * umask(:,:,jk)
193	pvtrd(:,:,jk) = ( zvtrd_tau2d(:,:) + zvtrd_bfr2d(:,:) + pvtrd(:,:,jk) - zve(:,:) * r1_hv_a(:,:) ) * vmask(:,:,jk)
194	END DO
195	DEALLOCATE( zue, zve, zutrd_tau2d, zvtrd_tau2d, zutrd_bfr2d, zvtrd_bfr2d)
196	IF( ALLOCATED( zutrd_tfr2d ) ) THEN
197	DO jk = 1, jpkm1
198	putrd(:,:,jk) = ( putrd(:,:,jk) + zutrd_tfr2d(:,:) ) * umask(:,:,jk)
199	pvtrd(:,:,jk) = ( pvtrd(:,:,jk) + zvtrd_tfr2d(:,:) ) * vmask(:,:,jk)
200	END DO
201	DEALLOCATE( zutrd_tfr2d, zvtrd_tfr2d )
202	ENDIF
203	!
204	ENDIF
205	!
206	CASE( jpdyn_tot )
207	! Don't need to do anything special for TOT trends, but we are at the end of the timestep, so
208	! write out total top and bottom friction "trends" for the surface / bottom layers after
209	! removing any depth-mean component.
210	IF( ALLOCATED( zutrd_tfr ) ) THEN
211	ALLOCATE( zue(jpi,jpj), zve(jpi,jpj) )
212	zue(:,:) = e3u_a(:,:,1) * zutrd_tfr(:,:,1) * umask(:,:,1)
213	zve(:,:) = e3v_a(:,:,1) * zvtrd_tfr(:,:,1) * vmask(:,:,1)
214	DO jk = 2, jpkm1
215	zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * zutrd_tfr(:,:,jk) * umask(:,:,jk)
216	zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * zvtrd_tfr(:,:,jk) * vmask(:,:,jk)
217	END DO
218	DO jk = 1, jpkm1
219	zutrd_tfr(:,:,jk) = ( zutrd_tfr(:,:,jk) - zue(:,:) * r1_hu_a(:,:) ) * umask(:,:,jk)
220	zvtrd_tfr(:,:,jk) = ( zvtrd_tfr(:,:,jk) - zve(:,:) * r1_hv_a(:,:) ) * vmask(:,:,jk)
221	END DO
222	CALL trd_dyn_iom_3d( zutrd_tfr, zvtrd_tfr, jpdyn_tfr, kt )
223	DEALLOCATE( zue, zve, zutrd_tfr, zvtrd_tfr )
224	ENDIF
225	IF( ALLOCATED( zutrd_bfr ) ) THEN
226	ALLOCATE( zue(jpi,jpj), zve(jpi,jpj) )
227	zue(:,:) = e3u_a(:,:,1) * zutrd_bfr(:,:,1) * umask(:,:,1)
228	zve(:,:) = e3v_a(:,:,1) * zvtrd_bfr(:,:,1) * vmask(:,:,1)
229	DO jk = 2, jpkm1
230	zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * zutrd_bfr(:,:,jk) * umask(:,:,jk)
231	zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * zvtrd_bfr(:,:,jk) * vmask(:,:,jk)
232	END DO
233	DO jk = 1, jpkm1
234	zutrd_bfr(:,:,jk) = ( zutrd_bfr(:,:,jk) - zue(:,:) * r1_hu_a(:,:) ) * umask(:,:,jk)
235	zvtrd_bfr(:,:,jk) = ( zvtrd_bfr(:,:,jk) - zve(:,:) * r1_hv_a(:,:) ) * vmask(:,:,jk)
236	END DO
237	CALL trd_dyn_iom_3d( zutrd_bfr, zvtrd_bfr, jpdyn_bfr, kt )
238	DEALLOCATE( zue, zve, zutrd_bfr, zvtrd_bfr )
239	ENDIF
240
241	END SELECT
242
243	IF ( ktrd /= jpdyn_hpg_save .AND. ktrd /= jpdyn_pvo_save .AND. &
244	& ktrd /= jpdyn_tfre .AND. ktrd /= jpdyn_tfre_bt .AND. &
245	& ktrd /= jpdyn_tfri .AND. ktrd /= jpdyn_bfre .AND. &
246	& ktrd /= jpdyn_bfre_bt .AND. ktrd /= jpdyn_bfri ) THEN
247	!
248	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
249	! 3D output of momentum and/or tracers trends using IOM interface
250	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
251	IF( ln_dyn_trd ) CALL trd_dyn_iom_3d( putrd, pvtrd, ktrd, kt )
252
253	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
254	! Integral Constraints Properties for momentum and/or tracers trends
255	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
256	IF( ln_glo_trd ) CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt )
257
258	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
259	! Kinetic Energy trends
260	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
261	IF( ln_KE_trd ) CALL trd_ken( putrd, pvtrd, ktrd, kt )
262
263	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
264	! Vorticity trends
265	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
266	IF( ln_vor_trd ) CALL trd_vor( putrd, pvtrd, ktrd, kt )
267
268	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
269	! Mixed layer trends for active tracers
270	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
271	!!gm IF( ln_dyn_mxl ) CALL trd_mxl_dyn
272	!
273	ENDIF
274	!
275	END SUBROUTINE trd_dyn_3d
276
277
278	SUBROUTINE trd_dyn_2d( putrd, pvtrd, ktrd, kt )
279	!!---------------------------------------------------------------------
280	!! * ROUTINE trd_mod *
281	!!
282	!! ** Purpose : Dispatch momentum trend computation, e.g. 2D output,
283	!! integral constraints, barotropic vorticity, kinetic enrgy,
284	!! and/or mixed layer budget.
285	!!----------------------------------------------------------------------
286	REAL(wp), DIMENSION(:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
287	INTEGER , INTENT(in ) :: ktrd ! trend index
288	INTEGER , INTENT(in ) :: kt ! time step
289	INTEGER :: jk
290	!!----------------------------------------------------------------------
291	!
292	putrd(:,:) = putrd(:,:) * umask(:,:,1) ! mask the trends
293	pvtrd(:,:) = pvtrd(:,:) * vmask(:,:,1)
294	!
295
296	!!gm NB : here a lbc_lnk should probably be added
297
298	SELECT CASE(ktrd)
299
300	CASE ( jpdyn_hpg_corr )
301	!
302	! Remove "first-guess" SPG trend from 3D HPG trend.
303	DO jk = 1, jpkm1
304	zutrd_hpg(:,:,jk) = zutrd_hpg(:,:,jk) - putrd(:,:)
305	zvtrd_hpg(:,:,jk) = zvtrd_hpg(:,:,jk) - pvtrd(:,:)
306	ENDDO
307
308	CASE( jpdyn_pvo_corr )
309	!
310	! Remove "first-guess" barotropic coriolis trend from 3D PVO trend.
311	DO jk = 1, jpkm1
312	zutrd_pvo(:,:,jk) = zutrd_pvo(:,:,jk) - putrd(:,:)
313	zvtrd_pvo(:,:,jk) = zvtrd_pvo(:,:,jk) - pvtrd(:,:)
314	ENDDO
315
316	CASE( jpdyn_spg )
317	!
318	! For split-explicit scheme SPG trends come here as 2D fields
319	! Add SPG trend to 3D HPG trend and also output as 2D diagnostic in own right.
320	DO jk = 1, jpkm1
321	zutrd_hpg(:,:,jk) = zutrd_hpg(:,:,jk) + putrd(:,:)
322	zvtrd_hpg(:,:,jk) = zvtrd_hpg(:,:,jk) + pvtrd(:,:)
323	ENDDO
324	CALL trd_dyn_3d( zutrd_hpg, zvtrd_hpg, jpdyn_hpg, kt )
325	DEALLOCATE( zutrd_hpg, zvtrd_hpg )
326
327	CASE( jpdyn_pvo )
328	!
329	! Add 2D PVO trend to 3D PVO trend and also output as diagnostic in own right.
330	DO jk = 1, jpkm1
331	zutrd_pvo(:,:,jk) = zutrd_pvo(:,:,jk) + putrd(:,:)
332	zvtrd_pvo(:,:,jk) = zvtrd_pvo(:,:,jk) + pvtrd(:,:)
333	ENDDO
334	CALL trd_dyn_3d( zutrd_pvo, zvtrd_pvo, jpdyn_pvo, kt )
335	DEALLOCATE( zutrd_pvo, zvtrd_pvo )
336
337	CASE( jpdyn_tau2d_ice )
338	!
339	! Save 2D ice-ocean stress trend locally to be subtracted from
340	! 2D wind stress trend and added to 2D top friction trend.
341	IF( .NOT. ALLOCATED(zutrd_tau2d_ice) ) ALLOCATE( zutrd_tau2d_ice(jpi,jpj), zvtrd_tau2d_ice(jpi,jpj) )
342	zutrd_tau2d_ice(:,:) = putrd(:,:)
343	zvtrd_tau2d_ice(:,:) = pvtrd(:,:)
344
345	CASE( jpdyn_tau2d )
346	!
347	! Save 2D wind forcing trend locally (to be added to ZDF trend)
348	! and output as a trend in its own right.
349	ALLOCATE( zutrd_tau2d(jpi,jpj), zvtrd_tau2d(jpi,jpj) )
350	zutrd_tau2d(:,:) = putrd(:,:)
351	zvtrd_tau2d(:,:) = pvtrd(:,:)
352	IF( ALLOCATED(zutrd_tau2d_ice) ) THEN
353	zutrd_tau2d(:,:) = zutrd_tau2d(:,:) - zutrd_tau2d_ice(:,:)
354	zvtrd_tau2d(:,:) = zvtrd_tau2d(:,:) - zvtrd_tau2d_ice(:,:)
355	ENDIF
356
357	CASE( jpdyn_tfr )
358	!
359	! Save 2D field to add to ZDF trend (and also output 2D field as diagnostic in own right below).
360	ALLOCATE( zutrd_tfr2d(jpi,jpj), zvtrd_tfr2d(jpi,jpj) )
361	zutrd_tfr2d(:,:) = putrd(:,:)
362	zvtrd_tfr2d(:,:) = pvtrd(:,:)
363	IF( ALLOCATED(zutrd_tau2d_ice) ) THEN
364	zutrd_tfr2d(:,:) = zutrd_tfr2d(:,:) + zutrd_tau2d_ice(:,:)
365	zvtrd_tfr2d(:,:) = zvtrd_tfr2d(:,:) + zvtrd_tau2d_ice(:,:)
366	ENDIF
367
368	CASE( jpdyn_bfr )
369	!
370	! Create 3D BFR trend from 2D field and also output 2D field as diagnostic in own right.
371	ALLOCATE( zutrd_bfr2d(jpi,jpj), zvtrd_bfr2d(jpi,jpj) )
372	zutrd_bfr2d(:,:) = putrd(:,:)
373	zvtrd_bfr2d(:,:) = pvtrd(:,:)
374
375	END SELECT
376
377	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
378	! 2D output of momentum and/or tracers trends using IOM interface
379	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
380	IF( ln_dyn_trd ) CALL trd_dyn_iom_2d( putrd, pvtrd, ktrd, kt )
381
382
383	!!$ CALLS TO THESE ROUTINES FOR 2D DIAGOSTICS NOT CODED YET
384	!!$ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
385	!!$ ! Integral Constraints Properties for momentum and/or tracers trends
386	!!$ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
387	!!$ IF( ln_glo_trd ) CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt )
388	!!$
389	!!$ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
390	!!$ ! Kinetic Energy trends
391	!!$ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
392	!!$ IF( ln_KE_trd ) CALL trd_ken( putrd, pvtrd, ktrd, kt )
393	!!$
394	!!$ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
395	!!$ ! Vorticity trends
396	!!$ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
397	!!$ IF( ln_vor_trd ) CALL trd_vor( putrd, pvtrd, ktrd, kt )
398
399	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
400	! Mixed layer trends for active tracers
401	!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
402	!!gm IF( ln_dyn_mxl ) CALL trd_mxl_dyn
403	!
404	END SUBROUTINE trd_dyn_2d
405
406
407	SUBROUTINE trd_dyn_iom_3d( putrd, pvtrd, ktrd, kt )
408	!!---------------------------------------------------------------------
409	!! * ROUTINE trd_dyn_iom *
410	!!
411	!! ** Purpose : output 3D trends using IOM
412	!!----------------------------------------------------------------------
413	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
414	INTEGER , INTENT(in ) :: ktrd ! trend index
415	INTEGER , INTENT(in ) :: kt ! time step
416	!
417	INTEGER :: ji, jj, jk ! dummy loop indices
418	INTEGER :: ikbu, ikbv ! local integers
419	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace
420	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace
421	!!----------------------------------------------------------------------
422	!
423	SELECT CASE( ktrd )
424	CASE( jpdyn_hpg ) ; CALL iom_put( "utrd_hpg", putrd ) ! hydrostatic pressure gradient
425	CALL iom_put( "vtrd_hpg", pvtrd )
426	CASE( jpdyn_pvo ) ; CALL iom_put( "utrd_pvo", putrd ) ! planetary vorticity
427	CALL iom_put( "vtrd_pvo", pvtrd )
428	CASE( jpdyn_rvo ) ; CALL iom_put( "utrd_rvo", putrd ) ! relative vorticity (or metric term)
429	CALL iom_put( "vtrd_rvo", pvtrd )
430	CASE( jpdyn_keg ) ; CALL iom_put( "utrd_keg", putrd ) ! Kinetic Energy gradient (or had)
431	CALL iom_put( "vtrd_keg", pvtrd )
432	ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) )
433	z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation)
434	z3dy(:,:,:) = 0._wp
435	DO jk = 1, jpkm1 ! no mask as un,vn are masked
436	DO jj = 2, jpjm1
437	DO ji = 2, jpim1
438	z3dx(ji,jj,jk) = un(ji,jj,jk) * ( un(ji+1,jj,jk) - un(ji-1,jj,jk) ) / ( 2._wp * e1u(ji,jj) )
439	z3dy(ji,jj,jk) = vn(ji,jj,jk) * ( vn(ji,jj+1,jk) - vn(ji,jj-1,jk) ) / ( 2._wp * e2v(ji,jj) )
440	END DO
441	END DO
442	END DO
443	CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. )
444	CALL iom_put( "utrd_udx", z3dx )
445	CALL iom_put( "vtrd_vdy", z3dy )
446	DEALLOCATE( z3dx , z3dy )
447	CASE( jpdyn_zad ) ; CALL iom_put( "utrd_zad", putrd ) ! vertical advection
448	CALL iom_put( "vtrd_zad", pvtrd )
449	CASE( jpdyn_ldf ) ; CALL iom_put( "utrd_ldf", putrd ) ! lateral diffusion
450	CALL iom_put( "vtrd_ldf", pvtrd )
451	CASE( jpdyn_zdf ) ; CALL iom_put( "utrd_zdf", putrd ) ! vertical diffusion
452	CALL iom_put( "vtrd_zdf", pvtrd )
453	!
454	! ! wind stress trends in surface layer
455	ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) )
456	z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 )
457	z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 )
458	CALL iom_put( "utrd_tau", z2dx )
459	CALL iom_put( "vtrd_tau", z2dy )
460	DEALLOCATE( z2dx , z2dy )
461	CASE( jpdyn_bfr ) ; CALL iom_put( "utrd_bfr", putrd ) ! bottom friction for bottom layer
462	CALL iom_put( "vtrd_bfr", pvtrd )
463	CASE( jpdyn_tfr ) ; CALL iom_put( "utrd_tfr", putrd ) ! total top friction for top layer
464	CALL iom_put( "vtrd_tfr", pvtrd )
465	CASE( jpdyn_tot ) ; CALL iom_put( "utrd_tot", putrd ) ! total trends excluding asselin filter
466	CALL iom_put( "vtrd_tot", pvtrd )
467	CASE( jpdyn_atf ) ; CALL iom_put( "utrd_atf", putrd ) ! asselin filter trends
468	CALL iom_put( "vtrd_atf", pvtrd )
469	END SELECT
470	!
471	END SUBROUTINE trd_dyn_iom_3d
472
473
474	SUBROUTINE trd_dyn_iom_2d( putrd, pvtrd, ktrd, kt )
475	!!---------------------------------------------------------------------
476	!! * ROUTINE trd_dyn_iom *
477	!!
478	!! ** Purpose : output 2D trends using IOM
479	!!----------------------------------------------------------------------
480	REAL(wp), DIMENSION(:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
481	INTEGER , INTENT(in ) :: ktrd ! trend index
482	INTEGER , INTENT(in ) :: kt ! time step
483	!
484	INTEGER :: ji, jj, jk ! dummy loop indices
485	INTEGER :: ikbu, ikbv ! local integers
486	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace
487	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace
488	!!----------------------------------------------------------------------
489	!
490	SELECT CASE( ktrd )
491	CASE( jpdyn_spg ) ; CALL iom_put( "utrd_spg2d", putrd ) ! surface pressure gradient
492	CALL iom_put( "vtrd_spg2d", pvtrd )
493	CASE( jpdyn_pvo ) ; CALL iom_put( "utrd_pvo2d", putrd ) ! planetary vorticity (barotropic part)
494	CALL iom_put( "vtrd_pvo2d", pvtrd )
495	CASE( jpdyn_hpg_corr ) ; CALL iom_put( "utrd_hpg_corr", putrd ) ! horizontal pressure gradient correction
496	CALL iom_put( "vtrd_hpg_corr", pvtrd )
497	CASE( jpdyn_pvo_corr ) ; CALL iom_put( "utrd_pvo_corr", putrd ) ! planetary vorticity correction
498	CALL iom_put( "vtrd_pvo_corr", pvtrd )
499	CASE( jpdyn_frc2d ) ; CALL iom_put( "utrd_frc2d", putrd ) ! constant forcing term from barotropic calcn.
500	CALL iom_put( "vtrd_frc2d", pvtrd )
501	CASE( jpdyn_tau2d ) ; CALL iom_put( "utrd_tau2d", putrd ) ! wind stress depth-mean trend
502	CALL iom_put( "vtrd_tau2d", pvtrd )
503	CASE( jpdyn_bfr ) ; CALL iom_put( "utrd_bfr2d", putrd ) ! bottom friction depth-mean trend
504	CALL iom_put( "vtrd_bfr2d", pvtrd )
505	CASE( jpdyn_tfr ) ; CALL iom_put( "utrd_tfr2d", putrd ) ! top friction depth-mean trend
506	CALL iom_put( "vtrd_tfr2d", pvtrd )
507	CASE( jpdyn_tot ) ; CALL iom_put( "utrd_tot2d", putrd ) ! total 2D trend, excluding time filter
508	CALL iom_put( "vtrd_tot2d", pvtrd )
509	END SELECT
510	!
511	END SUBROUTINE trd_dyn_iom_2d
512
513	!!======================================================================
514	END MODULE trddyn

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

Download in other formats: