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.
tamtst.F90 in branches/TAM_V3_0/NEMOTAM/OPATAM_SRC – NEMO

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

Last change on this file since 1885 was 1885, checked in by rblod, 14 years ago

add TAM sources
  • Property svn:executable set to *
File size: 11.5 KB
Line 
1MODULE 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   IMPLICIT NONE
57
58   !! * Routine accessibility
59   PRIVATE
60
61   PUBLIC &
62      & tstopt, &          !: Scalar product test of the adjoint routines
63      & numadt             !: File unit number for adjoint test output
64
65   !! * Module variables
66   INTEGER :: &
67      & numadt             !: File unit number for adjoint test output
68
69CONTAINS
70
71   SUBROUTINE tstopt
72      !!-----------------------------------------------------------------------
73      !!
74      !!                  ***  ROUTINE tstopt  ***
75      !!
76      !! ** Purpose : Apply various tests (linearization, adjoint, gradient)
77      !!              on the NEMOVAR code.
78      !!
79      !! ** Method  :
80      !!
81      !! ** Action  :
82      !!                   
83      !! History :
84      !!        ! 07-09 (K. Mogensen) NEMOVAR version based on balubt.F
85      !!        ! 07-11 (A. Weaver) Add adjoint tests
86      !!        ! 09-03 (I. Mirouze) Filter call depends on type
87      !!        ! 09-08 (F. Vigilant) Add tangent tests
88      !!-----------------------------------------------------------------------
89      !! * Modules used
90
91      !! * Arguments
92
93      !! * Local declarations
94      CHARACTER (LEN=128) :: file_out
95
96      ! Open adjoint test output unit
97
98      IF (lwp) THEN
99
100         WRITE(file_out,FMT="('adjoint_test.output_',I4.4)") &
101            &   narea-1
102         CALL ctlopn( numadt, file_out, 'UNKNOWN', 'FORMATTED',   &
103            &         'SEQUENTIAL', 1, numadt, .FALSE., 1 )
104
105         WRITE(numout,*) ' tstopt: Start testing adjoint operators ...'
106         WRITE(numout,*) ' ------'
107
108         WRITE(numout,*)
109         WRITE(numout,990) file_out
110990      FORMAT('          Output in file = ',A20)
111         WRITE(numout,*)
112
113         WRITE(numadt,*)
114         WRITE(numadt,997) 
115         WRITE(numadt,998) 
116         WRITE(numadt,999) 
117997      FORMAT('  Routine (L)',2X,' ( L * dx )^T W dy ',2X, &
118            &   '     dx^T L^T W dy    ',2X,'Rel.',2X,      &
119            &   'Mach.',2X,'Status')
120998      FORMAT('             ',2X,'                   ',2X, &
121            &   '                      ',2X,'Err.',2x,      &
122            &   'Eps. ',2X,'      ')
123999      FORMAT('  -----------',2X,'-------------------',2X, &
124            &   '----------------------',2X,'----',2X,      &
125            &   '-----',2X,'------')
126         CALL FLUSH(numout)
127         CALL FLUSH(numadt)
128
129      ENDIF
130
131      ! Initialize energy weights
132
133      CALL par_esp
134
135      ! ---------------------------------------------------------------
136      ! 1) Test the adjoint of the components of B
137      ! ---------------------------------------------------------------
138
139      ! Moved to NEMOVAR
140
141      ! -----------------------------------------------------
142      ! 2) Test the adjoint of H
143      ! -----------------------------------------------------
144
145      ! Moved to NEMOVAR
146
147#if defined key_tam
148      ! -----------------------------------------------------
149      ! 3) Test the adjoint of the simplification operator
150      ! -----------------------------------------------------
151
152      ! Not yet implemented
153
154      ! -----------------------------------------------------
155      ! 4) Test the adjoint of the components of M (NEMOTAM)
156      ! -----------------------------------------------------
157
158      IF ( ln_tst_nemotam ) THEN
159
160         IF ( ln_tst_cpd_tam ) THEN
161            ! *** initialize the reference trajectory
162            ! ------------
163            CALL  trj_rea( nit000 - 1, 1 ) 
164
165            ! *** Red-Black SOR solver
166            ! ------------
167            CALL sol_sor_adj_tst( numadt )
168
169            IF (lwp) WRITE(numadt,*)
170
171            ! *** Surface boundary conditions
172            ! ------------
173            CALL sbc_adj_tst( numadt )        ! surface boundary conditions
174
175            IF (lwp) WRITE(numadt,*)
176
177            ! *** Vertical physics
178            ! --------------------
179
180            CALL bn2_adj_tst( numadt )        ! Brunt-Vaisala frequency
181
182            IF (lwp) WRITE(numadt,*)
183
184            CALL div_cla_adj_tst( numadt )    ! Cross land advection (update hor. divergence)
185
186            IF (lwp) WRITE(numadt,*)
187
188            CALL div_cur_adj_tst( numadt )    ! Horizontal divergence and relative vorticity
189
190            IF (lwp) WRITE(numadt,*)
191
192            CALL dyn_adv_adj_tst( numadt )    ! Advection (vector or flux form)
193
194            IF (lwp) WRITE(numadt,*)
195
196            CALL dyn_vor_adj_tst( numadt )    ! Vorticity term including Coriolis
197
198            IF (lwp) WRITE(numadt,*)
199
200            CALL dyn_ldf_adj_tst( numadt )    ! Lateral mixing
201
202            IF (lwp) WRITE(numadt,*)
203
204            CALL dyn_zdf_adj_tst( numadt )    ! Vertical diffusion
205
206            IF (lwp) WRITE(numadt,*)
207
208            IF( lk_dynspg_rl ) &
209                & CALL dyn_spg_adj_tst( numadt )    ! Surface pressure gradient
210
211            IF (lwp) WRITE(numadt,*)
212
213#if defined key_obc
214            CALL obc_dyn_adj_tst( numadt )    ! OBC
215
216            IF (lwp) WRITE(numadt,*)
217#endif
218
219            CALL dyn_hpg_adj_tst( numadt )    ! Horizontal pressure gradient
220
221            IF (lwp) WRITE(numadt,*)
222
223            CALL dyn_nxt_adj_tst( numadt )    ! Lateral velocity at next time step
224
225            IF (lwp) WRITE(numadt,*)
226
227            CALL wzv_adj_tst( numadt )        ! Vertical velocity
228
229            IF (lwp) WRITE(numadt,*)
230
231            ! *** Tracers
232            ! -----------
233
234            CALL tra_sbc_adj_tst( numadt )    ! Surface boundary condition
235
236            IF (lwp) WRITE(numadt,*)
237
238            CALL tra_qsr_adj_tst( numadt )    ! Penetrative solar radiation
239
240            IF (lwp) WRITE(numadt,*)
241
242            IF( lk_trabbc      )  &
243                & CALL tra_bbc_adj_tst( numadt )    ! Bottom heat flux
244
245            IF (lwp) WRITE(numadt,*)
246
247            IF( lk_tradmp      )  &
248                & CALL tra_dmp_adj_tst( numadt )    ! Internal damping trends
249
250            IF (lwp) WRITE(numadt,*)
251
252            CALL tra_adv_adj_tst( numadt )    ! Horizontal and vertical advection
253
254            IF (lwp) WRITE(numadt,*)
255
256            CALL tra_cla_adj_tst( numadt )    ! Cross land advection (update hor. advection)
257
258            IF (lwp) WRITE(numadt,*)
259
260            CALL tra_ldf_adj_tst( numadt )    ! Lateral mixing
261
262            IF (lwp) WRITE(numadt,*)
263
264            CALL tra_zdf_adj_tst( numadt )    ! Vertical mixing
265
266            IF (lwp) WRITE(numadt,*)
267
268            CALL tra_nxt_adj_tst( numadt )    ! Tracer fields at next time step
269
270            IF (lwp) WRITE(numadt,*)
271
272            CALL eos_adj_tst( numadt )        ! In situ density
273
274            IF (lwp) WRITE(numadt,*)
275
276            CALL zps_hde_adj_tst( numadt )    ! Partial steps: horiz. grad. at bottom level
277
278            IF (lwp) WRITE(numadt,*)
279
280            CALL istate_init_adj_tst( numadt )
281
282            IF (lwp) WRITE(numadt,*)
283
284            CALL flush(numout)
285
286            IF (lwp) THEN
287               WRITE(numout,*)
288               WRITE(numout,*) ' tstopt: Finished testing standalone operators'
289               WRITE(numout,*) ' ------'
290               WRITE(numout,*)
291            ENDIF
292         ENDIF
293
294         ! *** Time-loop operator
295         ! ----------------------
296         IF ( ln_tst_stp_tam ) THEN
297
298            CALL stp_adj_tst( numadt )        ! Time-stepping
299
300            IF (lwp) WRITE(numadt,*)
301
302            CALL flush(numout)
303
304         ENDIF
305
306         ! *** Tangent accuracy
307         ! ----------------------
308         IF ( ln_tst_tan ) THEN     
309
310            IF (ln_tst_tan_cpd) THEN
311
312               CALL flush(numout)
313
314               CALL dyn_hpg_tlm_tst( numadt )
315
316               CALL flush(numout)
317
318               IF( lk_dynspg_rl ) &
319                  & CALL dyn_spg_tlm_tst( numadt )
320
321               CALL flush(numout)
322
323               CALL zps_hde_tlm_tst( numadt )
324
325               CALL flush(numout)
326
327               CALL tra_sbc_tlm_tst( numadt )
328
329               CALL flush(numout)
330
331               CALL dyn_adv_tlm_tst( numadt )
332
333               CALL flush(numout)
334
335               CALL eos_tlm_tst( numadt )
336
337               CALL flush(numout)
338
339               CALL bn2_tlm_tst( numadt )
340
341               CALL flush(numout)
342
343               CALL tra_zdf_tlm_tst( numadt )
344
345               CALL flush(numout)
346
347               CALL tra_adv_tlm_tst( numadt )       
348
349               CALL flush(numout)
350           
351               CALL tra_ldf_tlm_tst( numadt ) 
352       
353               CALL flush(numout)
354            ELSE
355
356               CALL stp_tlm_tst( numadt )
357
358               IF (lwp) WRITE(numadt,*)
359
360               CALL flush(numout)
361 
362            ENDIF
363
364         ENDIF
365
366      ENDIF
367#endif
368      ! Close output file
369
370      IF (lwp) CLOSE(numadt)
371
372      IF (lwp) THEN
373         WRITE(numout,*)
374         WRITE(numout,*) ' tstopt: Finished testing operators'
375         WRITE(numout,*) ' ------'
376         WRITE(numout,*)
377      ENDIF
378      CALL flush(numout)
379   END SUBROUTINE tstopt
380
381END MODULE tamtst
Note: See TracBrowser for help on using the repository browser.