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 @ 15184

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

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

Download in other formats: