Context Navigation

tamtst.F90 @ 2579

Last change on this file since 2579 was 2579, checked in by rblod, 13 years ago
Correct TAM_V3_2_2
File size: 15.3 KB

Line
1	MODULE tamtst
2	#if defined key_tam
3	!!======================================================================
4	!! * MODULE tst *
5	!! NEMOVAR : Testing routine
6	!!======================================================================
7
8	!!----------------------------------------------------------------------
9	!!----------------------------------------------------------------------
10	!!----------------------------------------------------------------------
11	!! * Modules used
12	USE par_kind, ONLY : & ! Precision variables
13	& wp
14	USE par_oce, ONLY : & ! Ocean space and time domain variables
15	& jpi, jpj, jpk
16	USE dom_oce, ONLY : & ! Processor area number
17	& narea, n_cla
18	USE trabbc , ONLY: &! bottom boundary condition
19	& lk_trabbc
20	USE traqsr , ONLY: &
21	& ln_traqsr
22	USE in_out_manager ! Input/output
23	USE iom ! netCDF output/input
24	USE paresp ! Weights for energy-type scalar product
25	USE tamctl ! TAM control
26	USE sbcmod_tam ! Tangent/adjoint of surface BCs
27	USE eosbn2_tam ! Tangent/adjoint of eq. of state, Brunt-Vaisala
28	USE trasbc_tam ! Tangent/adjoint of surface BCs application
29	USE traqsr_tam ! Tangent/adjoint of penetrative solar radiation
30	USE trabbc_tam ! Tangent/adjoint of bottom heat flux
31	USE tradmp_tam ! Tangent/adjoint of internal damping trends
32	USE traadv_tam ! Tangent/adjoint of horizontal/vertical advection
33	USE cla_tam ! Tangent/adjoint of cross land advection
34	USE cla_div_tam ! Tangent/adjoint of cross land advection
35	USE traldf_tam ! Tangent/adjoint of lateral mixing
36	USE trazdf_tam ! Tangent/adjoint of vertical diffusion
37	USE tranxt_tam ! Tangent/adjoint of tracers at next time step
38	USE zpshde_tam ! Tangent/adjoint of horiz. derivs. for partial steps
39	USE divcur_tam ! Tangent/adjoint of horiz. div. and rel. vorticity
40	USE dynadv_tam ! Tangent/adjoint of horizontal/vertical advection
41	USE dynhpg_tam ! Tangent/adjoint of horiz. pressure gradient
42	USE dynkeg_tam ! Tangent/adjoint of kinetic energy gradient
43	USE dynldf_tam ! Tangent/adjoint of lateral mixing
44	USE dynnxt_tam ! Tangent/adjoint of dynamics at next time step
45	USE dynspg_tam ! Tangent/adjoint of surface pressure gradient
46	USE dynvor_tam ! Tangent/adjoint of relative and planetary vorticity
47	USE dynzdf_tam ! Tangent/adjoint of vertical diffusion
48	USE dynbfr_tam ! Tangent/adjoint of bottom friction
49	USE sshwzv_tam ! Tangent/adjoint of vertical velocity
50	USE step_tam ! manager of the adjoint ocean time stepping
51	USE trj_tam ! reference trajectory
52	USE istate_tam
53	USE solsor_tam
54	USE solpcg_tam
55	#if defined key_obc
56	USE obcdyn_tam
57	#endif
58	#if defined key_mpp_mpi
59	USE lbcnfd_tam
60	#endif
61
62	IMPLICIT NONE
63
64	!! * Routine accessibility
65	PRIVATE
66
67	PUBLIC &
68	& tam_tst, & !: Scalar product test of the adjoint routines
69	& tam_init, & !: Reading of the namelist
70	& numadt !: File unit number for adjoint test output
71
72	!! * Module variables
73	INTEGER :: &
74	& numadt !: File unit number for adjoint test output
75
76	CONTAINS
77
78	SUBROUTINE tam_tst
79	!!-----------------------------------------------------------------------
80	!!
81	!! * ROUTINE tam_tst *
82	!!
83	!! ** Purpose : Apply various tests (linearization, adjoint)
84	!! on the NEMOTAM code.
85	!!
86	!! ** Method :
87	!!
88	!! ** Action :
89	!!
90	!! History :
91	!! ! 2007-11 (A. Weaver) original (adjoint tests)
92	!! ! 2009-08 (F. Vigilant) Add tangent tests
93	!!-----------------------------------------------------------------------
94	!! * Modules used
95
96	!! * Arguments
97
98	!! * Local declarations
99	CHARACTER (LEN=128) :: file_out
100
101	! Open adjoint test output unit
102
103	IF (lwp) THEN
104
105	WRITE(file_out,FMT="('adjoint_test.output_',I4.4)") &
106	& narea-1
107	CALL ctl_opn( numadt, file_out, 'UNKNOWN', 'FORMATTED', &
108	& 'SEQUENTIAL', 1, numadt, .FALSE., 1 )
109
110	WRITE(numout,*) ' tstopt: Start testing adjoint operators ...'
111	WRITE(numout,*) ' ------'
112
113	WRITE(numout,*)
114	WRITE(numout,990) file_out
115	990 FORMAT(' Output in file = ',A20)
116	WRITE(numout,*)
117
118	WRITE(numadt,*)
119	WRITE(numadt,997)
120	WRITE(numadt,998)
121	WRITE(numadt,999)
122	997 FORMAT(' Routine (L)',2X,' ( L * dx )^T W dy ',2X, &
123	& ' dx^T L^T W dy ',2X,'Rel.',2X, &
124	& 'Mach.',2X,'Status')
125	998 FORMAT(' ',2X,' ',2X, &
126	& ' ',2X,'Err.',2x, &
127	& 'Eps. ',2X,' ')
128	999 FORMAT(' -----------',2X,'-------------------',2X, &
129	& '----------------------',2X,'----',2X, &
130	& '-----',2X,'------')
131	CALL FLUSH(numout)
132	CALL FLUSH(numadt)
133
134	ENDIF
135
136	! Initialize energy weights
137
138	CALL par_esp
139
140	! -----------------------------------------------------
141	! Test the adjoint of the components of M (NEMOTAM)
142	! -----------------------------------------------------
143
144	IF ( ln_tst_opatam ) THEN
145	!
146	IF ( ln_tst_adj_cpd ) THEN
147	! *** initialize the reference trajectory
148	! ------------
149	CALL trj_rea( nit000 - 1, 1 )
150	! *** Tracers
151	! -----------
152	CALL tra_adv_adj_tst( numadt ) ! Horizontal and vertical advection
153	IF (lwp) WRITE(numadt,*)
154	IF ( ln_traqsr ) THEN
155	CALL tra_qsr_adj_tst( numadt ) ! Penetrative solar radiation
156	IF (lwp) WRITE(numadt,*)
157	ENDIF
158	CALL tra_ldf_adj_tst( numadt ) ! Lateral mixing
159	IF (lwp) WRITE(numadt,*)
160	CALL eos_adj_tst( numadt ) ! In situ density
161	IF (lwp) WRITE(numadt,*)
162	IF ( lk_tradmp ) THEN
163	CALL tra_dmp_adj_tst( numadt ) ! Internal damping trends
164	IF (lwp) WRITE(numadt,*)
165	ENDIF
166	IF ( lk_trabbc ) THEN
167	CALL tra_bbc_adj_tst( numadt ) ! Bottom heat flux
168	IF (lwp) WRITE(numadt,*)
169	ENDIF
170	IF ( n_cla == 1 ) THEN
171	CALL tra_cla_adj_tst( numadt ) ! Cross land advection (update hor. advection)
172	IF (lwp) WRITE(numadt,*)
173	ENDIF
174	CALL tra_zdf_adj_tst( numadt ) ! Vertical mixing
175	IF (lwp) WRITE(numadt,*)
176	CALL tra_nxt_adj_tst( numadt ) ! Tracer fields at next time step
177	IF (lwp) WRITE(numadt,*)
178	CALL istate_init_adj_tst( numadt )
179	IF (lwp) WRITE(numadt,*)
180	CALL tra_sbc_adj_tst( numadt ) ! Surface boundary condition
181	IF (lwp) WRITE(numadt,*)
182	CALL bn2_adj_tst( numadt ) ! Brunt-Vaisala frequency
183	IF (lwp) WRITE(numadt,*)
184	CALL zps_hde_adj_tst( numadt ) ! Partial steps: horiz. grad. at bottom level
185	IF (lwp) WRITE(numadt,*)
186	! *** Vertical physics
187	! --------------------
188	CALL dyn_zdf_adj_tst( numadt ) ! Vertical diffusion
189	IF (lwp) WRITE(numadt,*)
190	CALL dyn_ldf_adj_tst( numadt ) ! Lateral mixing
191	IF (lwp) WRITE(numadt,*)
192	CALL dyn_adv_adj_tst( numadt ) ! Advection (vector or flux form)
193	IF (lwp) WRITE(numadt,*)
194	CALL dyn_hpg_adj_tst( numadt ) ! Horizontal pressure gradient
195	IF (lwp) WRITE(numadt,*)
196	CALL div_cur_adj_tst( numadt ) ! Horizontal divergence and relative vorticity
197	IF (lwp) WRITE(numadt,*)
198	CALL ssh_wzv_adj_tst( numadt ) ! Vertical velocity
199	IF (lwp) WRITE(numadt,*)
200	CALL ssh_nxt_adj_tst( numadt ) ! Sea surface height time stepping
201	IF (lwp) WRITE(numadt,*)
202	IF ( n_cla == 1 ) THEN
203	CALL div_cla_adj_tst( numadt ) ! Cross land advection (update hor. divergence)
204	IF (lwp) WRITE(numadt,*)
205	ENDIF
206	# if defined key_mpp_mpi
207	CALL lbc_nfd_adj_tst( numadt )
208	IF (lwp) WRITE(numadt,*)
209	# endif
210	CALL dyn_vor_adj_tst( numadt ) ! Vorticity term including Coriolis
211	IF (lwp) WRITE(numadt,*)
212	CALL dyn_spg_adj_tst( numadt ) ! Surface pressure gradient
213	IF (lwp) WRITE(numadt,*)
214	CALL dyn_nxt_adj_tst( numadt ) ! Lateral velocity at next time step
215	IF (lwp) WRITE(numadt,*)
216	CALL dyn_bfr_adj_tst( numadt ) ! Surface pressure gradient
217	IF (lwp) WRITE(numadt,*)
218	# if defined key_dynspg_flt
219	! *** Red-Black SOR solver
220	! ------------
221	CALL sol_sor_adj_tst( numadt )
222	IF (lwp) WRITE(numadt,*)
223	# endif
224	! *** Surface boundary conditions
225	! ------------
226	CALL sbc_adj_tst( numadt ) ! surface boundary conditions
227	CALL flush(numadt)
228	IF (lwp) THEN
229	WRITE(numout,*)
230	WRITE(numout,*) ' tstopt: Finished testing standalone operators'
231	WRITE(numout,*) ' ------'
232	WRITE(numout,*)
233	ENDIF
234	ENDIF
235	!
236	! *** Time-loop operator
237	! ----------------------
238	IF ( ln_tst_adj_stp ) THEN
239	CALL stp_adj_tst( numadt ) ! Time-stepping
240	IF (lwp) WRITE(numadt,*)
241	CALL flush(numadt)
242	ENDIF
243	! *** Tangent accuracy
244	! ----------------------
245	#if defined key_tst_tlm
246	IF (ln_tst_tan_cpd) THEN
247	CALL sol_sor_tlm_tst( numadt )
248	IF (lwp) WRITE(numadt,*)
249
250	CALL dyn_hpg_tlm_tst( numadt )
251	IF (lwp) WRITE(numadt,*)
252
253	CALL dyn_spg_tlm_tst( numadt )
254	IF (lwp) WRITE(numadt,*)
255
256	CALL dyn_adv_tlm_tst( numadt )
257	IF (lwp) WRITE(numadt,*)
258
259	CALL eos_tlm_tst( numadt )
260	IF (lwp) WRITE(numadt,*)
261
262	CALL zps_hde_tlm_tst( numadt )
263	IF (lwp) WRITE(numadt,*)
264
265	CALL tra_sbc_tlm_tst( numadt )
266	IF (lwp) WRITE(numadt,*)
267
268	CALL bn2_tlm_tst( numadt )
269	IF (lwp) WRITE(numadt,*)
270
271	CALL tra_zdf_tlm_tst( numadt )
272	IF (lwp) WRITE(numadt,*)
273
274	CALL tra_adv_tlm_tst( numadt )
275	IF (lwp) WRITE(numadt,*)
276
277	CALL tra_ldf_tlm_tst( numadt )
278	IF (lwp) WRITE(numadt,*)
279	CALL flush( numadt )
280	ENDIF
281	IF ( ln_tst_tan_stp ) THEN
282	CALL stp_tlm_tst( numadt )
283	IF (lwp) WRITE(numadt,*)
284	CALL flush( numadt )
285	ENDIF
286	#endif
287
288	ENDIF
289
290	! Close output file
291
292	IF (lwp) CLOSE(numadt)
293
294	IF (lwp) THEN
295	WRITE(numout,*)
296	WRITE(numout,*) ' tamtst: Finished testing operators'
297	WRITE(numout,*) ' ------'
298	WRITE(numout,*)
299	ENDIF
300	CALL flush(numout)
301	END SUBROUTINE tam_tst
302	SUBROUTINE tam_init
303	!!----------------------------------------------------------------------
304	!! * ROUTINE tam_init *
305	!!
306	!! ** Purpose : read tam related namelists and print the variables.
307	!!
308	!! ** input : - namtst namelist
309	!! - namtlh namelist
310	!!----------------------------------------------------------------------
311	!! NAMELIST/namtam/
312	NAMELIST/namtst/ ln_tst_opatam, ln_tst_adj_cpd, ln_tst_adj_stp, &
313	& ln_tst_tan_cpd, ln_tst_tan_stp, ln_tst_tlh, ln_tst_stop
314
315	NAMELIST/namtlh/ nn_stage, ln_tlht, ln_tlhs, ln_tlhuv, ln_tlhssh, cn_tlhinc_in, ln_incdx, ln_hnorm, &
316	& rn_hstdt, rn_hstds, rn_hstduv, rn_hstdssh, cn_tlhrst_in
317
318
319
320	ln_tst_opatam = .TRUE.
321	ln_tst_adj_cpd = .TRUE.
322	ln_tst_adj_stp = .TRUE.
323	ln_tst_tan_cpd = .FALSE.
324	ln_tst_tan_stp = .FALSE.
325	ln_tst_tlh = .FALSE.
326	ln_tst_stop = .FALSE.
327
328
329	REWIND( numnam ) ! Namelist namrun : parameters of the run
330	READ ( numnam, namtst )
331	IF (lwp) THEN ! control print
332	WRITE(numout,*)
333	WRITE(numout,*) 'tam_tst : Tangent and Adjoint testing'
334	WRITE(numout,*) '~~~~~~~'
335	WRITE(numout,*) ' Namelist nam_tst'
336	WRITE(numout,*) ' switch for tam testing ln_tst_opatam = ', ln_tst_opatam
337	WRITE(numout,*) ' switch for adjoint module testing ln_tst_adj_cpd = ', ln_tst_adj_cpd
338	WRITE(numout,*) ' switch for adjoint of step testing ln_tst_adj_stp = ', ln_tst_adj_stp
339	WRITE(numout,*) ' switch for tangent module testing ln_tst_tan_cpd = ', ln_tst_tan_cpd
340	WRITE(numout,*) ' switch for tangent of step testing ln_tst_tan_stp = ', ln_tst_tan_stp
341	WRITE(numout,*) ' switch for T.L. hypothesis testing ln_tst_tlh = ', ln_tst_tlh
342	WRITE(numout,*) ' switch for stopping after the test ln_tst_stop = ', ln_tst_stop
343	END IF
344
345	IF ( ln_tst_tlh ) THEN
346
347	cn_tlhrst_in= 'restart_tlh.nc'
348	cn_tlhinc_in= 'increment_tlh.nc'
349	nn_stage = 0
350	ln_tlht = .TRUE.
351	ln_tlhs = .TRUE.
352	ln_tlhuv = .TRUE.
353	ln_tlhssh = .TRUE.
354	ln_incdx = .FALSE.
355	ln_hnorm = .FALSE.
356	rn_hstdt = 1.
357	rn_hstds = 0.1
358	rn_hstduv = 0.01
359	rn_hstdssh = 0.01
360
361	REWIND( numnam ) ! Namelist namrun : parameters of the run
362	READ ( numnam, namtlh )
363	!
364	IF (lwp) THEN ! control print
365	WRITE(numout,*)
366	WRITE(numout,*) 'tam_tlh : Tangent linear hypothesis testing'
367	WRITE(numout,*) '~~~~~~~ initialization through namelist read'
368	WRITE(numout,*) ' Namelist nam_tlh'
369	WRITE(numout,*) ' current stage nn_stage = ', nn_stage
370	WRITE(numout,*) ' switch for testing temperature ln_tlht = ', ln_tlht
371	WRITE(numout,*) ' switch for testing salinity ln_tlhs = ', ln_tlhs
372	WRITE(numout,*) ' switch for testing velocities ln_tlhuv = ', ln_tlhuv
373	WRITE(numout,*) ' switch for testing sea surf height ln_tlhssh = ', ln_tlhssh
374	WRITE(numout,*) ' switch for reading an increment ln_incdx = ', ln_incdx
375	WRITE(numout,*) ' switch for a normed perturbation ln_hnorm = ', ln_hnorm
376	WRITE(numout,*) ' Upper bound of norm. for T rn_hstdt = ', rn_hstdt
377	WRITE(numout,*) ' Upper bound of norm. for S rn_hstds = ', rn_hstds
378	WRITE(numout,*) ' Upper bound of norm. for UV rn_hstduv = ', rn_hstduv
379	WRITE(numout,*) ' Upper bound of norm. for SSH rn_hstdssh = ', rn_hstdssh
380	END IF
381	END IF
382
383	END SUBROUTINE tam_init
384	#endif
385	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_2_2/NEMOTAM/OPATAM_SRC/tamtst.F90 @ 2579

Download in other formats: