Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

dynspg_tam.F90 @ 7797

Last change on this file since 7797 was 2578, checked in by rblod, 13 years ago
first import of NEMOTAM 3.2.2
File size: 12.6 KB

Line
1	MODULE dynspg_tam
2	!!----------------------------------------------------------------------
3	!! This software is governed by the CeCILL licence (Version 2)
4	!!----------------------------------------------------------------------
5	#if defined key_tam
6	!!======================================================================
7	!! * MODULE dynspg_tam *
8	!! Ocean dynamics: surface pressure gradient control
9	!! Tangent and Adjoint Module
10	!!======================================================================
11	!! History of the direct module:
12	!! 1.0 ! 2005-12 (C. Talandier, G. Madec, V. Garnier) Original code
13	!! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option
14	!! History of the T&A module:
15	!! 9.0 ! 2008-06 (A. Vidard) Skeleton
16	!! ! 2008-11 (A. Vidard) nemo v3
17	!! ! 2009-03 (A. Weaver) dynspg_flt_tam
18	!! 3.2 ! 2010-04 (F. Vigilant) modification for 3.2
19	!!----------------------------------------------------------------------
20	!! dyn_spg_tan : update the dynamics trend with the surface pressure
21	!! gradient (tangent routine)
22	!! dyn_spg_adj : update the dynamics trend with the surface pressure
23	!! gradient (adjoint routine)
24	!! dyn_spg_adj_tst : Test of the adjoint routine
25	!!----------------------------------------------------------------------
26	USE par_kind , ONLY: & ! Precision variables
27	& wp
28	USE par_oce , ONLY: & ! Ocean space and time domain variables
29	& lk_esopa
30	USE dom_oce , ONLY: & ! Ocean space and time domain
31	& n_cla
32	#if defined key_obc
33	USE obc_oce , ONLY: & ! ocean open boundary conditions
34	& ln_vol_cst, &
35	& ln_obc_fla
36	#endif
37	USE dynspg_oce , ONLY: & ! surface pressure gradient variables
38	& lk_dynspg_flt, &
39	& lk_dynspg_ts, &
40	& lk_dynspg_exp
41	USE in_out_manager, ONLY: & ! I/O manager
42	& lwp, &
43	& numout, &
44	& nit000, &
45	& nitend, &
46	& ctl_stop
47
48	USE dynspg_exp_tam ! surface pressure gradient (dyn_spg_exp routine)
49	! USE dynspg_ts_tam ! surface pressure gradient (dyn_spg_ts routine)
50	USE dynspg_flt_tam ! surface pressure gradient (dyn_spg_flt routine)
51
52	IMPLICIT NONE
53	PRIVATE
54
55	!! * Accessibility
56	PUBLIC dyn_spg_tan, & ! routine called by steptan module
57	& dyn_spg_adj, & ! routine called by stepadj module
58	& dyn_spg_adj_tst ! routine controlling adjoint tests
59	#if defined key_tst_tlm
60	PUBLIC dyn_spg_tlm_tst
61	#endif
62
63	!! * module variables
64	INTEGER :: nspg = 0 ! type of surface pressure gradient scheme defined from lk_dynspg_...
65
66	!! * Substitutions
67	# include "domzgr_substitute.h90"
68	# include "vectopt_loop_substitute.h90"
69
70	CONTAINS
71
72	SUBROUTINE dyn_spg_tan( kt, kindic )
73	!!----------------------------------------------------------------------
74	!! * ROUTINE dyn_spg_tan *
75	!!
76	!! ** Purpose of the direct routine:
77	!! achieve the momentum time stepping by computing the
78	!! last trend, the surface pressure gradient, and performing
79	!! the Leap-Frog integration.
80	!!gm In the current version only the filtered solution provide
81	!!gm the after velocity, in the 2 other (ua,va) are still the trends
82	!!
83	!! ** Method : Three schemes:
84	!! - explicit computation : the spg is evaluated at now
85	!! - filtered computation : the Roulet & madec (2000) technique is used
86	!! - split-explicit computation: a time splitting technique is used
87	!!
88	!! N.B. : When key_esopa is used all the scheme are tested, regardless
89	!! of the physical meaning of the results.
90	!!----------------------------------------------------------------------
91	INTEGER, INTENT( IN ) :: &
92	& kt ! ocean time-step index
93	INTEGER, INTENT( OUT ) :: &
94	& kindic ! solver flag
95	!!----------------------------------------------------------------------
96
97	!!gm NOTA BENE : the dynspg_exp and dynspg_ts should be modified so that
98	!!gm they return the after velocity, not the trends (as in trazdf_imp...)
99	!!gm In this case, change/simplify dynnxt
100
101	IF( kt == nit000 ) CALL dyn_spg_ctl_tam ! initialisation & control of options
102
103	SELECT CASE ( nspg ) ! compute surf. pressure gradient
104	! trend and add it to the general trend
105	CASE ( 0 )
106	CALL dyn_spg_exp_tan( kt ) ! explicit
107	CASE ( 1 )
108	CALL ctl_stop ( 'dyn_spg_ts_tan not available yet' )
109	!!! CALL dyn_spg_ts_tan ( kt ) ! time-splitting
110	CASE ( 2 )
111	CALL dyn_spg_flt_tan( kt, kindic ) ! filtered
112	!
113	END SELECT
114	!
115	END SUBROUTINE dyn_spg_tan
116
117	SUBROUTINE dyn_spg_adj( kt, kindic )
118	!!----------------------------------------------------------------------
119	!! * ROUTINE dyn_spg_adj *
120	!!
121	!! ** Purpose of the direct routine:
122	!! compute the lateral ocean dynamics physics.
123	!!----------------------------------------------------------------------
124	INTEGER, INTENT( IN ) :: &
125	& kt ! ocean time-step index
126	INTEGER, INTENT( OUT ) :: &
127	& kindic ! solver flag
128	!!----------------------------------------------------------------------
129
130	kindic = 0
131	!!gm NOTA BENE : the dynspg_exp and dynspg_ts should be modified so that
132	!!gm they return the after velocity, not the trends (as in trazdf_imp...)
133	!!gm In this case, change/simplify dynnxt
134
135	IF( kt == nitend ) CALL dyn_spg_ctl_tam ! initialisation & control of options
136
137	SELECT CASE ( nspg ) ! compute surf. pressure gradient
138	! trend and add it to the general trend
139	CASE ( 0 )
140	CALL dyn_spg_exp_adj( kt ) ! explicit
141	CASE ( 1 )
142	CALL ctl_stop ( 'dyn_spg_ts_adj not available yet' )
143	!!! CALL dyn_spg_ts_adj ( kt ) ! time-splitting
144	CASE ( 2 )
145	CALL dyn_spg_flt_adj( kt, kindic ) ! filtered
146	!
147	END SELECT
148	!
149	END SUBROUTINE dyn_spg_adj
150
151	SUBROUTINE dyn_spg_adj_tst( kumadt )
152	!!-----------------------------------------------------------------------
153	!!
154	!! * ROUTINE dyn_spg_flt_adj_tst *
155	!!
156	!! ** Purpose : Test the adjoint routine.
157	!!
158	!! ** Method : Verify the scalar product
159	!!
160	!! ( L dx )^T W dy = dx^T L^T W dy
161	!!
162	!! where L = tangent routine
163	!! L^T = adjoint routine
164	!! W = diagonal matrix of scale factors
165	!! dx = input perturbation (random field)
166	!! dy = L dx
167	!!
168	!! ** Action : Call the appropriate test routine depending on the
169	!! choice of free surface.
170	!!
171	!! History :
172	!! ! 09-01 (A. Weaver)
173	!!-----------------------------------------------------------------------
174	!! * Modules used
175
176	!! * Arguments
177	INTEGER, INTENT(IN) :: &
178	& kumadt ! Output unit
179
180	CALL dyn_spg_ctl_tam ! initialisation & control of options
181
182	SELECT CASE ( nspg )
183	CASE ( 0 )
184	CALL dyn_spg_exp_adj_tst( kumadt ) ! explicit
185	CASE ( 1 )
186	CALL ctl_stop ( 'dyn_spg_ts_adj_tst not available yet' )
187	!!! CALL dyn_spg_ts_adj_tst ( kumadt ) ! time-splitting
188	CASE ( 2 )
189	CALL dyn_spg_flt_adj_tst( kumadt ) ! filtered
190	!
191	END SELECT
192	!
193	END SUBROUTINE dyn_spg_adj_tst
194
195	SUBROUTINE dyn_spg_ctl_tam
196	!!---------------------------------------------------------------------
197	!! * ROUTINE dyn_spg_ctl_tam *
198	!!
199	!! ** Purpose : Control the consistency between cpp options for
200	!! surface pressure gradient schemes
201	!!----------------------------------------------------------------------
202	!! * Local declarations
203	INTEGER :: &
204	& ioptio
205
206	!!----------------------------------------------------------------------
207
208	IF(lwp) THEN ! Control print
209	WRITE(numout,*)
210	WRITE(numout,*) 'dyn_spg_ctl_tam : choice of the surface pressure gradient scheme'
211	WRITE(numout,*) '~~~~~~~~~~~~~~~'
212	WRITE(numout,*) ' Explicit free surface lk_dynspg_exp = ', lk_dynspg_exp
213	WRITE(numout,*) ' Free surface with time splitting lk_dynspg_ts = ', lk_dynspg_ts
214	WRITE(numout,*) ' Filtered free surface cst volume lk_dynspg_flt = ', lk_dynspg_flt
215	ENDIF
216
217	! Control of surface pressure gradient scheme options
218	! ---------------------------------------------------
219	ioptio = 0
220	IF(lk_dynspg_exp) ioptio = ioptio + 1
221	IF(lk_dynspg_ts ) ioptio = ioptio + 1
222	IF(lk_dynspg_flt) ioptio = ioptio + 1
223
224	IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ioptio == 0 ) &
225	& CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' )
226
227	IF( lk_esopa ) nspg = -1
228	IF( lk_dynspg_exp) nspg = 0
229	IF( lk_dynspg_ts ) nspg = 1
230	IF( lk_dynspg_flt) nspg = 2
231
232	IF( lk_esopa ) nspg = -1
233
234	IF(lwp) THEN
235	WRITE(numout,*)
236	IF( nspg == -1 ) WRITE(numout,*) ' ESOPA test All scheme used'
237	IF( nspg == 0 ) WRITE(numout,*) ' explicit free surface'
238	IF( nspg == 1 ) WRITE(numout,*) ' free surface with time splitting scheme'
239	IF( nspg == 2 ) WRITE(numout,*) ' filtered free surface'
240	ENDIF
241
242	! Control of timestep choice
243	! --------------------------
244	IF( lk_dynspg_ts .OR. lk_dynspg_exp) THEN
245	IF( n_cla == 1 ) &
246	& CALL ctl_stop( ' Crossland advection not implemented for this free surface formulation ' )
247	ENDIF
248
249	#if defined key_obc
250	! Conservation of ocean volume (key_dynspg_flt)
251	! ---------------------------------------------
252	IF( lk_dynspg_flt ) ln_vol_cst = .true.
253
254	! Application of Flather's algorithm at open boundaries
255	! -----------------------------------------------------
256	IF( lk_dynspg_flt ) ln_obc_fla = .false.
257	IF( lk_dynspg_exp ) ln_obc_fla = .true.
258	IF( lk_dynspg_ts ) ln_obc_fla = .true.
259	#endif
260
261	END SUBROUTINE dyn_spg_ctl_tam
262	#if defined key_tst_tlm
263	SUBROUTINE dyn_spg_tlm_tst( kumadt )
264	!!-----------------------------------------------------------------------
265	!!
266	!! * ROUTINE dyn_spg_tlm_tst *
267	!!
268	!! ** Purpose : Test the tangent linear routine.
269	!!
270	!! ** Method : Verify the relative error Er of the linear model
271	!!
272	!! Er = 100 norm( En ) / norm( L(t0,tn) gamma dx0 )
273	!! --> zero when gamma --> zero
274	!!
275	!! where En = Nn( gamma dx0 ) - L(t0, tn ) gamma dx0
276	!! L = Linear routine
277	!! Nn = Perturbation evolution ( M( x0 + gamma dx0 ) - M( x0 ) )
278	!! gamma dx0 = input perturbation (random field)
279	!!
280	!! History :
281	!! ! 09-06 (F. Vigilant)
282	!!-----------------------------------------------------------------------
283	!! * Modules used
284
285	!! * Arguments
286	INTEGER, INTENT(IN) :: &
287	& kumadt ! Output unit
288
289	CALL dyn_spg_ctl_tam ! initialisation & control of options
290
291	SELECT CASE ( nspg )
292	CASE ( 0 )
293	CALL ctl_stop ( 'dyn_spg_exp_adj_tst not available yet' )
294	CALL dyn_spg_exp_adj_tst( kumadt ) ! explicit
295	CASE ( 1 )
296	CALL ctl_stop ( 'dyn_spg_ts_adj_tst not available yet' )
297	!!! CALL dyn_spg_ts_adj_tst ( kumadt ) ! time-splitting
298	CASE ( 2 )
299	CALL dyn_spg_flt_tlm_tst( kumadt ) ! filtered
300	!
301	END SELECT
302	!
303	END SUBROUTINE dyn_spg_tlm_tst
304
305	!!======================================================================
306	#endif
307	#endif
308	END MODULE dynspg_tam

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/2010_and_older/TAM_V3_2_2/NEMOTAM/OPATAM_SRC/DYN/dynspg_tam.F90 @ 7797

Download in other formats: