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/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/tamtst.F90 @ 3612

Last change on this file since 3612 was 3611, checked in by pabouttier, 11 years ago

Add TAM code and ORCA2_TAM configuration - see Ticket #1007
  • Property svn:executable set to *
File size: 10.9 KB
Line 
1MODULE 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_oce
13   USE dom_oce
14   USE trabbc
15   USE traqsr
16   USE trabbl
17   USE in_out_manager      ! Input/output
18   USE iom                 ! netCDF output/input
19   USE paresp              ! Weights for energy-type scalar product
20   USE tamctl              ! TAM control
21   USE tradmp
22   USE sbcmod_tam          ! Tangent/adjoint of surface BCs
23   USE eosbn2_tam          ! Tangent/adjoint of eq. of state, Brunt-Vaisala
24   USE trasbc_tam          ! Tangent/adjoint of surface BCs application
25   USE traqsr_tam          ! Tangent/adjoint of penetrative solar radiation
26   USE trabbc_tam          ! Tangent/adjoint of bottom heat flux
27   USE trabbl_tam          ! Tangent/adjoint of bottom boundary layer
28   USE tradmp_tam          ! Tangent/adjoint of internal damping trends
29   USE traadv_tam          ! Tangent/adjoint of horizontal/vertical advection
30   USE cla_tam             ! Tangent/adjoint of cross land advection
31   USE traldf_tam          ! Tangent/adjoint of lateral mixing
32   USE trazdf_tam          ! Tangent/adjoint of vertical diffusion
33   USE tranxt_tam          ! Tangent/adjoint of tracers at next time step
34   USE zpshde_tam          ! Tangent/adjoint of horiz. derivs. for partial steps
35   USE divcur_tam          ! Tangent/adjoint of horiz. div. and rel. vorticity
36   USE dynadv_tam          ! Tangent/adjoint of horizontal/vertical advection
37   USE dynhpg_tam          ! Tangent/adjoint of horiz. pressure gradient
38   USE dynkeg_tam          ! Tangent/adjoint of kinetic energy gradient
39   USE dynldf_tam          ! Tangent/adjoint of lateral mixing
40   USE dynnxt_tam          ! Tangent/adjoint of dynamics at next time step
41   USE dynspg_tam          ! Tangent/adjoint of surface pressure gradient
42   USE dynvor_tam          ! Tangent/adjoint of relative and planetary vorticity
43   USE dynzdf_tam          ! Tangent/adjoint of vertical diffusion
44   USE dynbfr_tam          ! Tangent/adjoint of bottom friction
45   USE sshwzv_tam          ! Tangent/adjoint of vertical velocity
46   USE step_tam            ! manager of the adjoint ocean time stepping
47   USE trj_tam             ! reference trajectory
48   USE istate_tam
49   USE solsor_tam
50   USE closea_tam
51   USE zdfbfr_tam
52#if defined key_mpp_mpi
53   USE lbcnfd_tam
54#endif
55
56   IMPLICIT NONE
57
58   !! * Routine accessibility
59   PRIVATE
60
61   PUBLIC &
62      & tam_tst,  &        !: Scalar product test of the adjoint routines
63      & tam_tst_init, &    !: Reading of the namelist
64      & numadt             !: File unit number for adjoint test output
65
66   !! * Module variables
67   INTEGER :: &
68      & numadt             !: File unit number for adjoint test output
69
70CONTAINS
71
72   SUBROUTINE tam_tst
73      !!-----------------------------------------------------------------------
74      !!
75      !!                  ***  ROUTINE tam_tst  ***
76      !!
77      !! ** Purpose : Apply various tests (linearization, adjoint)
78      !!              on the NEMOTAM code.
79      !!
80      !! ** Method  :
81      !!
82      !! ** Action  :
83      !!
84      !! History :
85      !!        ! 2007-11 (A. Weaver) original (adjoint tests)
86      !!        ! 2009-08 (F. Vigilant) Add tangent tests
87      !!-----------------------------------------------------------------------
88      !! * Modules used
89
90      !! * Arguments
91
92      !! * Local declarations
93      CHARACTER (LEN=128) :: file_out
94
95      ! Open adjoint test output unit
96
97      IF (lwp) THEN
98
99         WRITE(file_out,FMT="('adjoint_test.output_',I4.4)") &
100            &   narea-1
101         CALL ctl_opn( numadt, file_out, 'UNKNOWN', 'FORMATTED',   &
102            &         'SEQUENTIAL', 1, numadt, .FALSE., 1 )
103
104         WRITE(numout,*) ' tstopt: Start testing adjoint operators ...'
105         WRITE(numout,*) ' ------'
106
107         WRITE(numout,*)
108         WRITE(numout,990) file_out
109990      FORMAT('          Output in file = ',A20)
110         WRITE(numout,*)
111
112         WRITE(numadt,*)
113         WRITE(numadt,997)
114         WRITE(numadt,998)
115         WRITE(numadt,999)
116997      FORMAT('  Routine (L)',2X,' ( L * dx )^T W dy ',2X, &
117            &   '     dx^T L^T W dy    ',2X,'Rel.',2X,      &
118            &   'Mach.',2X,'Status')
119998      FORMAT('             ',2X,'                   ',2X, &
120            &   '                      ',2X,'Err.',2x,      &
121            &   'Eps. ',2X,'      ')
122999      FORMAT('  -----------',2X,'-------------------',2X, &
123            &   '----------------------',2X,'----',2X,      &
124            &   '-----',2X,'------')
125         CALL FLUSH(numout)
126         CALL FLUSH(numadt)
127
128      ENDIF
129
130      ! Initialize energy weights
131
132      CALL par_esp
133
134      ! -----------------------------------------------------
135      ! Test the adjoint of the components of M (NEMOTAM)
136      ! -----------------------------------------------------
137
138      IF ( ln_swi_opatam == 0 ) THEN
139         !
140         ! *** initialize the reference trajectory
141         ! ------------
142          CALL trj_rea( nit000 - 1, 1 )
143         ! *** Tracers
144         ! -----------
145         ! *** Surface boundary conditions
146         ! ------------
147         CALL sbc_adj_tst( numadt )        ! surface boundary conditions
148         CALL tra_adv_adj_tst( numadt )    ! Horizontal and vertical advection
149         IF (lwp) WRITE(numadt,*)
150         IF ( ln_traqsr      )  THEN
151            CALL tra_qsr_adj_tst( numadt )    ! Penetrative solar radiation
152            IF (lwp) WRITE(numadt,*)
153         ENDIF
154         CALL tra_ldf_adj_tst( numadt )    ! Lateral mixing
155         IF (lwp) WRITE(numadt,*)
156         CALL eos_adj_tst( numadt )        ! In situ density
157         IF (lwp) WRITE(numadt,*)
158         IF ( ln_tradmp      )  THEN
159            CALL tra_dmp_adj_tst( numadt )    ! Internal damping trends
160            IF (lwp) WRITE(numadt,*)
161         ENDIF
162# if defined key_trabbl   ||   defined key_esopa
163         CALL tra_bbl_adj_tst( numadt )! Bottom boundary layer
164         IF (lwp) WRITE(numadt,*)
165# endif
166         IF ( nn_cla == 1     )  THEN
167            CALL cla_traadv_adj_tst( numadt )    ! Cross land advection (update hor. advection)
168            IF (lwp) WRITE(numadt,*)
169         ENDIF
170         CALL tra_zdf_adj_tst( numadt )    ! Vertical mixing
171         IF (lwp) WRITE(numadt,*)
172         CALL tra_nxt_adj_tst( numadt )    ! Tracer fields at next time step
173         IF (lwp) WRITE(numadt,*)
174         CALL istate_init_adj_tst( numadt )
175         IF (lwp) WRITE(numadt,*)
176         CALL tra_sbc_adj_tst( numadt )    ! Surface boundary condition
177         IF (lwp) WRITE(numadt,*)
178         CALL bn2_adj_tst( numadt )        ! Brunt-Vaisala frequency
179         IF (lwp) WRITE(numadt,*)
180         !
181         !-------------- TESTED IN istate_adj_tst ----------------!
182         !CALL zps_hde_adj_tst( numadt )    ! Partial steps: horiz. grad. at bottom level
183         !IF (lwp) WRITE(numadt,*)
184         !--------------------------------------------------------!
185         !
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 ( nn_cla == 1     )  THEN
203            CALL cla_div_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         IF ( nn_cla == 1 ) THEN
215            CALL cla_dynspg_adj_tst( numadt )    ! Surface pressure gradient
216            IF (lwp) WRITE(numadt,*)
217         END IF
218         CALL dyn_nxt_adj_tst( numadt )    ! Lateral velocity at next time step
219         IF (lwp) WRITE(numadt,*)
220         CALL dyn_bfr_adj_tst( numadt )    ! Surface pressure gradient
221         IF (lwp) WRITE(numadt,*)
222         CALL zdf_bfr_adj_tst( numadt )    ! Surface pressure gradient
223         IF (lwp) WRITE(numadt,*)
224# if defined key_dynspg_flt
225         ! *** Red-Black SOR solver
226         ! ------------
227         CALL sol_sor_adj_tst( numadt )
228         IF (lwp) WRITE(numadt,*)
229# endif
230         CALL flush(numadt)
231         IF (lwp) THEN
232            WRITE(numout,*)
233            WRITE(numout,*) ' tstopt: Finished testing standalone operators'
234            WRITE(numout,*) ' ------'
235            WRITE(numout,*)
236         ENDIF
237
238      ELSEIF (ln_swi_opatam == 1) THEN
239         !
240         ! *** Time-loop operator
241         ! ----------------------
242            CALL stp_adj_tst( numadt )        !Time-stepping
243            IF (lwp) WRITE(numadt,*)
244            CALL flush(numadt)
245      ENDIF
246
247      ! Close output file
248
249      IF (lwp) CLOSE(numadt)
250
251      IF (lwp) THEN
252         WRITE(numout,*)
253         WRITE(numout,*) ' tamtst: Finished testing operators'
254         WRITE(numout,*) ' ------'
255         WRITE(numout,*)
256      ENDIF
257      CALL flush(numout)
258   END SUBROUTINE tam_tst
259   SUBROUTINE tam_tst_init
260      !!----------------------------------------------------------------------
261      !!                     ***  ROUTINE tam_init  ***
262      !!
263      !! ** Purpose :   read tam related namelists and print the variables.
264      !!
265      !! ** input   : - namtst_tam namelist
266      !!              - namtlh namelist
267      !!----------------------------------------------------------------------
268      NAMELIST/namtst_tam/ ln_swi_opatam
269
270
271      ln_swi_opatam  = 0
272
273      REWIND( numnam )              ! Namelist namrun : parameters of the run
274      READ  ( numnam, namtst_tam )
275      IF (lwp) THEN                 ! control print
276         WRITE(numout,*)
277         WRITE(numout,*) 'tam_tst  : Tangent and Adjoint testing'
278         WRITE(numout,*) '~~~~~~~'
279         WRITE(numout,*) '   Namelist namtst_tam'
280         WRITE(numout,*) '      switch for tam testing             ln_swi_opatam  = ', ln_swi_opatam
281      END IF
282   END SUBROUTINE tam_tst_init
283#endif
284END MODULE tamtst
Note: See TracBrowser for help on using the repository browser.