Context Navigation

tamtst.F90 @ 2587

Last change on this file since 2587 was 2587, checked in by vidard, 13 years ago
refer to ticket #798
Property svn:executable set to ``*
File size: 10.7 KB

Line
1	MODULE tamtst
2	!!======================================================================
3	!! * MODULE tamtst *
4	!! NEMOVAR : Testing routine
5	!!======================================================================
6
7	!!----------------------------------------------------------------------
8	!!----------------------------------------------------------------------
9	!!----------------------------------------------------------------------
10	!! * Modules used
11	USE par_kind, ONLY : & ! Precision variables
12	& wp
13	USE par_oce, ONLY : & ! Ocean space and time domain variables
14	& jpi, jpj, jpk
15	USE dom_oce, ONLY : & ! Processor area number
16	& narea
17	USE dynspg_oce , ONLY: &
18	& lk_dynspg_rl ! Rigid-lid flag
19	USE trabbc , ONLY: &! bottom boundary condition
20	& lk_trabbc
21	USE in_out_manager ! Input/output
22	USE iom ! netCDF output/input
23	USE paresp ! Weights for energy-type scalar product
24	USE tamctl ! TAM control
25	USE sbcmod_tam ! Tangent/adjoint of surface BCs
26	USE eosbn2_tam ! Tangent/adjoint of eq. of state, Brunt-Vaisala
27	USE trasbc_tam ! Tangent/adjoint of surface BCs application
28	USE traqsr_tam ! Tangent/adjoint of penetrative solar radiation
29	USE trabbc_tam ! Tangent/adjoint of bottom heat flux
30	USE tradmp_tam ! Tangent/adjoint of internal damping trends
31	USE traadv_tam ! Tangent/adjoint of horizontal/vertical advection
32	USE cla_tam ! Tangent/adjoint of cross land advection
33	USE cla_div_tam ! Tangent/adjoint of cross land advection
34	USE traldf_tam ! Tangent/adjoint of lateral mixing
35	USE trazdf_tam ! Tangent/adjoint of vertical diffusion
36	USE tranxt_tam ! Tangent/adjoint of tracers at next time step
37	USE zpshde_tam ! Tangent/adjoint of horiz. derivs. for partial steps
38	USE divcur_tam ! Tangent/adjoint of horiz. div. and rel. vorticity
39	USE dynadv_tam ! Tangent/adjoint of horizontal/vertical advection
40	USE dynhpg_tam ! Tangent/adjoint of horiz. pressure gradient
41	USE dynkeg_tam ! Tangent/adjoint of kinetic energy gradient
42	USE dynldf_tam ! Tangent/adjoint of lateral mixing
43	USE dynnxt_tam ! Tangent/adjoint of dynamics at next time step
44	USE dynspg_tam ! Tangent/adjoint of surface pressure gradient
45	USE dynvor_tam ! Tangent/adjoint of relative and planetary vorticity
46	USE dynzdf_tam ! Tangent/adjoint of vertical diffusion
47	USE wzvmod_tam ! Tangent/adjoint of vertical velocity
48	USE step_tam ! manager of the adjoint ocean time stepping
49	USE trj_tam ! reference trajectory
50	USE istate_tam
51	USE solsor_tam
52	#if defined key_obc
53	USE obcdyn_tam
54	#endif
55
56	USE step_tam_cpd ! Temporary
57
58	IMPLICIT NONE
59
60	!! * Routine accessibility
61	PRIVATE
62
63	PUBLIC &
64	& tsttam, & !: Scalar product test of the adjoint routines
65	& numadt !: File unit number for adjoint test output
66
67	!! * Module variables
68	INTEGER :: &
69	& numadt !: File unit number for adjoint test output
70
71	CONTAINS
72
73	SUBROUTINE tsttam
74	!!-----------------------------------------------------------------------
75	!!
76	!! * ROUTINE tsttam *
77	!!
78	!! ** Purpose : Apply various tests (linearization, adjoint)
79	!! on the NEMOTAM code.
80	!!
81	!! ** Method :
82	!!
83	!! ** Action :
84	!!
85	!! History :
86	!! ! 07-09 (K. Mogensen) NEMOVAR version based on balubt.F
87	!! ! 07-11 (A. Weaver) Add adjoint tests
88	!! ! 09-03 (I. Mirouze) Filter call depends on type
89	!! ! 09-08 (F. Vigilant) Split TAM and Var and add tangent tests
90	!!-----------------------------------------------------------------------
91	!! * Modules used
92
93	!! * Arguments
94
95	!! * Local declarations
96	CHARACTER (LEN=128) :: file_out
97
98	! Open adjoint test output unit
99
100	IF (lwp) THEN
101
102	WRITE(file_out,FMT="('adjoint_test.output_',I4.4)") &
103	& narea-1
104	CALL ctlopn( numadt, file_out, 'UNKNOWN', 'FORMATTED', &
105	& 'SEQUENTIAL', 1, numadt, .FALSE., 1 )
106
107	WRITE(numout,*) ' tstopt: Start testing adjoint operators ...'
108	WRITE(numout,*) ' ------'
109
110	WRITE(numout,*)
111	WRITE(numout,990) file_out
112	990 FORMAT(' Output in file = ',A20)
113	WRITE(numout,*)
114
115	WRITE(numadt,*)
116	WRITE(numadt,997)
117	WRITE(numadt,998)
118	WRITE(numadt,999)
119	997 FORMAT(' Routine (L)',2X,' ( L * dx )^T W dy ',2X, &
120	& ' dx^T L^T W dy ',2X,'Rel.',2X, &
121	& 'Mach.',2X,'Status')
122	998 FORMAT(' ',2X,' ',2X, &
123	& ' ',2X,'Err.',2x, &
124	& 'Eps. ',2X,' ')
125	999 FORMAT(' -----------',2X,'-------------------',2X, &
126	& '----------------------',2X,'----',2X, &
127	& '-----',2X,'------')
128	CALL FLUSH(numout)
129	CALL FLUSH(numadt)
130
131	ENDIF
132
133	! Initialize energy weights
134
135	CALL par_esp
136
137	#if defined key_tam
138
139	IF ( ln_tst_nemotam ) THEN
140
141	IF ( ln_tst_cpd_tam ) THEN
142	! -----------------------------------------------------
143	! 1) Test the adjoint of the components of M (NEMOTAM)
144	! -----------------------------------------------------
145	! *** initialize the reference trajectory
146	! ------------
147	CALL trj_rea( nit000 - 1, 1 )
148
149	! *** Red-Black SOR solver
150	! ------------
151	CALL sol_sor_adj_tst( numadt )
152
153	IF (lwp) WRITE(numadt,*)
154
155	! *** Surface boundary conditions
156	! ------------
157	CALL sbc_adj_tst( numadt ) ! surface boundary conditions
158
159	IF (lwp) WRITE(numadt,*)
160
161	! *** Vertical physics
162	! --------------------
163
164	CALL bn2_adj_tst( numadt ) ! Brunt-Vaisala frequency
165
166	IF (lwp) WRITE(numadt,*)
167
168	CALL div_cla_adj_tst( numadt ) ! Cross land advection (update hor. divergence)
169
170	IF (lwp) WRITE(numadt,*)
171
172	CALL div_cur_adj_tst( numadt ) ! Horizontal divergence and relative vorticity
173
174	IF (lwp) WRITE(numadt,*)
175
176	CALL dyn_adv_adj_tst( numadt ) ! Advection (vector or flux form)
177
178	IF (lwp) WRITE(numadt,*)
179
180	CALL dyn_vor_adj_tst( numadt ) ! Vorticity term including Coriolis
181
182	IF (lwp) WRITE(numadt,*)
183
184	CALL dyn_ldf_adj_tst( numadt ) ! Lateral mixing
185
186	IF (lwp) WRITE(numadt,*)
187
188	CALL dyn_zdf_adj_tst( numadt ) ! Vertical diffusion
189
190	IF (lwp) WRITE(numadt,*)
191
192	CALL dyn_spg_adj_tst( numadt ) ! Surface pressure gradient
193
194	IF (lwp) WRITE(numadt,*)
195
196	#if defined key_obc
197	CALL obc_dyn_adj_tst( numadt ) ! OBC
198
199	IF (lwp) WRITE(numadt,*)
200	#endif
201
202	CALL dyn_hpg_adj_tst( numadt ) ! Horizontal pressure gradient
203
204	IF (lwp) WRITE(numadt,*)
205
206	CALL dyn_nxt_adj_tst( numadt ) ! Lateral velocity at next time step
207
208	IF (lwp) WRITE(numadt,*)
209
210	CALL wzv_adj_tst( numadt ) ! Vertical velocity
211
212	IF (lwp) WRITE(numadt,*)
213
214	! *** Tracers
215	! -----------
216
217	CALL tra_sbc_adj_tst( numadt ) ! Surface boundary condition
218
219	IF (lwp) WRITE(numadt,*)
220
221	CALL tra_qsr_adj_tst( numadt ) ! Penetrative solar radiation
222
223	IF (lwp) WRITE(numadt,*)
224
225	IF( lk_trabbc ) &
226	& CALL tra_bbc_adj_tst( numadt ) ! Bottom heat flux
227
228	IF (lwp) WRITE(numadt,*)
229
230	IF( lk_tradmp ) &
231	& CALL tra_dmp_adj_tst( numadt ) ! Internal damping trends
232
233	IF (lwp) WRITE(numadt,*)
234
235	CALL tra_adv_adj_tst( numadt ) ! Horizontal and vertical advection
236
237	IF (lwp) WRITE(numadt,*)
238
239	CALL tra_cla_adj_tst( numadt ) ! Cross land advection (update hor. advection)
240
241	IF (lwp) WRITE(numadt,*)
242
243	CALL tra_ldf_adj_tst( numadt ) ! Lateral mixing
244
245	IF (lwp) WRITE(numadt,*)
246
247	CALL tra_zdf_adj_tst( numadt ) ! Vertical mixing
248
249	IF (lwp) WRITE(numadt,*)
250
251	CALL tra_nxt_adj_tst( numadt ) ! Tracer fields at next time step
252
253	IF (lwp) WRITE(numadt,*)
254
255	CALL eos_adj_tst( numadt ) ! In situ density
256
257	IF (lwp) WRITE(numadt,*)
258
259	CALL zps_hde_adj_tst( numadt ) ! Partial steps: horiz. grad. at bottom level
260
261	IF (lwp) WRITE(numadt,*)
262
263	CALL istate_init_adj_tst( numadt )
264
265	IF (lwp) WRITE(numadt,*)
266
267	CALL flush(numout)
268
269	IF (lwp) THEN
270	WRITE(numout,*)
271	WRITE(numout,*) ' tstopt: Finished testing standalone operators'
272	WRITE(numout,*) ' ------'
273	WRITE(numout,*)
274	ENDIF
275	ENDIF
276
277	! -----------------------------------------------------
278	! 2) Test the adjoint of of M (NEMOTAM)
279	! -----------------------------------------------------
280	IF ( ln_tst_stp_tam ) THEN
281
282	CALL stp_adj_tst( numadt ) ! Time-stepping
283
284	IF (lwp) WRITE(numadt,*)
285
286	CALL flush(numout)
287
288	ENDIF
289	#if defined key_tst_tlm
290	! -----------------------------------------------------
291	! 3) Test the Tangent accuracy
292	! ----------------------
293	IF ( ln_tst_tan ) THEN
294
295	IF (ln_tst_tan_cpd) THEN
296
297	CALL dyn_hpg_tlm_tst( numadt )
298
299	CALL dyn_spg_tlm_tst( numadt )
300
301	CALL sol_sor_tlm_tst( numadt )
302
303	CALL zps_hde_tlm_tst( numadt )
304
305	CALL tra_sbc_tlm_tst( numadt )
306
307	CALL dyn_adv_tlm_tst( numadt )
308
309	CALL eos_tlm_tst( numadt )
310
311	CALL bn2_tlm_tst( numadt )
312
313	CALL tra_zdf_tlm_tst( numadt )
314
315	CALL tra_adv_tlm_tst( numadt )
316
317	CALL tra_ldf_tlm_tst( numadt )
318
319	ELSE
320
321	CALL stp_tlm_tst( numadt )
322
323	IF (lwp) WRITE(numadt,*)
324
325	CALL flush(numout)
326
327	ENDIF
328
329	ENDIF
330	#endif
331	ENDIF
332	#endif
333	! Close output file
334
335	IF (lwp) CLOSE(numadt)
336
337	IF (lwp) THEN
338	WRITE(numout,*)
339	WRITE(numout,*) ' tsttam: Finished testing operators'
340	WRITE(numout,*) ' ------'
341	WRITE(numout,*)
342	ENDIF
343	CALL flush(numout)
344	END SUBROUTINE tsttam
345
346	END MODULE tamtst

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

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

Context Navigation

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/tamtst.F90 @ 2587

Download in other formats: