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.
sbcssm_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SBC – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SBC/sbcssm_tam.F90 @ 3611

Last change on this file since 3611 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: 25.1 KB
Line 
1MODULE sbcssm_tam
2#ifdef key_tam
3   !!======================================================================
4   !!                       ***  MODULE  sbcssm_tam  ***
5   !! Surface module :  provide time-mean ocean surface variables
6   !!                   Tangent and adjoint module
7   !!======================================================================
8   !! History of the direct module:
9   !!            9.0   !  06-07  (G. Madec)  Original code
10   !! History of the TAM module:
11   !!            9.0   !  08-11  (A. Vidard) Original code
12   !!            9.0   !  10-04  (A. Vidard) Nemo3.2 update
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   sbc_ssm_[tan adj]: calculate sea surface mean currents, temperature,
17   !!                    and salinity over nn_fsbc time-step
18   !!----------------------------------------------------------------------
19   USE par_oce
20   USE par_kind
21   USE oce_tam
22   USE dom_oce
23   USE sbc_oce                ! Surface boundary condition: frequency of sbc computation (as well as sea-ice model)
24   USE sbc_oce_tam
25   USE in_out_manager
26   USE gridrandom
27   USE dotprodfld
28   USE paresp
29   USE tstool_tam
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   sbc_ssm_tan     ! routine called by step_tam.F90
35   PUBLIC   sbc_ssm_adj     ! routine called by step_tam.F90
36   PUBLIC   sbc_ssm_adj_tst ! routine called by tst.F90
37
38   !! * Substitutions
39#  include "domzgr_substitute.h90"
40   !!----------------------------------------------------------------------
41   !!   OPA 9.0 , LOCEAN-IPSL (2006)
42   !! $Id: sbcssm.F90 1196 2008-09-19 07:07:00Z ctlod $
43   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
44   !!----------------------------------------------------------------------
45
46CONTAINS
47
48   SUBROUTINE sbc_ssm_tan( kt )
49      !!---------------------------------------------------------------------
50      !!                     ***  ROUTINE sbc_ssm_tan  ***
51      !!
52      !! ** Purpose of the direct routine:
53      !!                provide ocean surface variable to sea-surface boundary
54      !!                condition computation
55      !!
56      !! ** Method of the direct routine:
57      !!      compute mean surface velocity (2 components at U and
58      !!      V-points) [m/s], temperature [Celcius] and salinity [psu] over
59      !!      the periode (kt - nn_fsbc) to kt
60      !!---------------------------------------------------------------------
61      INTEGER, INTENT(in) ::   kt        ! ocean time step
62      !
63      REAL(wp) ::   zcoef       ! temporary scalar
64      REAL(wp) ::   zf_sbc      ! read sbc frequency
65      !!---------------------------------------------------------------------
66      !                                                   ! ---------------------------------------- !
67      IF( nn_fsbc == 1 ) THEN                             !      Instantaneous surface fields        !
68         !                                                ! ---------------------------------------- !
69         IF( kt == nit000 ) THEN
70            IF(lwp) WRITE(numout,*)
71            IF(lwp) WRITE(numout,*) 'sbc_ssm_tan: sea surface mean fields, nn_fsbc=1 : instantaneous values'
72            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
73         ENDIF
74         !
75         ssu_m_tl(:,:) = ub_tl(:,:,1)
76         ssv_m_tl(:,:) = vb_tl(:,:,1)
77         sst_m_tl(:,:) = tsn_tl(:,:,1,jp_tem)
78         sss_m_tl(:,:) = tsn_tl(:,:,1,jp_sal)
79         ssh_m_tl(:,:) = sshn_tl(:,:)
80         !
81      ELSE
82         !                                                ! ---------------------------------------- !
83         IF( kt == nit000) THEN                           !       Initialisation: 1st time-step      !
84            !                                             ! ---------------------------------------- !
85            IF(lwp) WRITE(numout,*)
86            IF(lwp) WRITE(numout,*) 'sbc_ssm_tan : sea surface mean fields'
87            !
88            IF( ln_rstart ) THEN
89                  ssu_m_tl(:,:) = 0.0_wp
90                  ssv_m_tl(:,:) = 0.0_wp
91                  sst_m_tl(:,:) = 0.0_wp
92                  sss_m_tl(:,:) = 0.0_wp
93                  ssh_m_tl(:,:) = 0.0_wp
94             ELSE
95               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values'
96               zcoef = REAL( nn_fsbc - 1, wp )
97               ssu_m_tl(:,:) = zcoef * ub_tl(:,:,1)
98               ssv_m_tl(:,:) = zcoef * vb_tl(:,:,1)
99               sst_m_tl(:,:) = zcoef * tsn_tl(:,:,1,jp_tem)
100               sss_m_tl(:,:) = zcoef * tsn_tl(:,:,1,jp_sal)
101               ssh_m_tl(:,:) = zcoef * sshn_tl(:,:)
102            ENDIF
103            !                                             ! ---------------------------------------- !
104         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !
105            !                                             ! ---------------------------------------- !
106            ssu_m_tl(:,:) = 0.0_wp      ! reset to zero ocean mean sbc fields
107            ssv_m_tl(:,:) = 0.0_wp
108            sst_m_tl(:,:) = 0.0_wp
109            sss_m_tl(:,:) = 0.0_wp
110            ssh_m_tl(:,:) = 0.0_wp
111         ENDIF
112         !                                                ! ---------------------------------------- !
113         !                                                !        Cumulate at each time step        !
114         !                                                ! ---------------------------------------- !
115         ssu_m_tl(:,:) = ssu_m_tl(:,:) + ub_tl(:,:,1)
116         ssv_m_tl(:,:) = ssv_m_tl(:,:) + vb_tl(:,:,1)
117         sst_m_tl(:,:) = sst_m_tl(:,:) + tsn_tl(:,:,1,jp_tem)
118         sss_m_tl(:,:) = sss_m_tl(:,:) + tsn_tl(:,:,1,jp_sal)
119         ssh_m_tl(:,:) = ssh_m_tl(:,:) + sshn_tl(:,:)
120         !                                                ! ---------------------------------------- !
121         IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !
122            !                                             ! ---------------------------------------- !
123            zcoef = 1. / REAL( nn_fsbc, wp )
124            sst_m_tl(:,:) = sst_m_tl(:,:) * zcoef           ! mean SST             [Celcius]
125            sss_m_tl(:,:) = sss_m_tl(:,:) * zcoef           ! mean SSS             [psu]
126            ssu_m_tl(:,:) = ssu_m_tl(:,:) * zcoef           ! mean suface current  [m/s]
127            ssv_m_tl(:,:) = ssv_m_tl(:,:) * zcoef           !
128            ssh_m_tl(:,:) = ssh_m_tl(:,:) * zcoef           !
129            !
130         ENDIF
131         !
132      ENDIF
133      !
134   END SUBROUTINE sbc_ssm_tan
135
136   SUBROUTINE sbc_ssm_adj( kt )
137      !!---------------------------------------------------------------------
138      !!                     ***  ROUTINE sbc_ssm_adj  ***
139      !!
140      !! ** Purpose of the direct routine:
141      !!                provide ocean surface variable to sea-surface boundary
142      !!                condition computation
143      !!
144      !! ** Method of the direct routine:
145      !!      compute mean surface velocity (2 components at U and
146      !!      V-points) [m/s], temperature [Celcius] and salinity [psu] over
147      !!      the periode (kt - nn_fsbc) to kt
148      !!---------------------------------------------------------------------
149      INTEGER, INTENT(in) ::   kt        ! ocean time step
150      !
151      REAL(wp) ::   zcoef       ! temporary scalar
152      REAL(wp) ::   zf_sbc      ! read sbc frequency
153      !!---------------------------------------------------------------------
154      !                                                   ! ---------------------------------------- !
155      IF( nn_fsbc == 1 ) THEN                             !      Instantaneous surface fields        !
156         !                                                ! ---------------------------------------- !
157         IF( kt == nitend) THEN
158            IF(lwp) WRITE(numout,*)
159            IF(lwp) WRITE(numout,*) 'sbc_ssm_adj: sea surface mean fields, nn_fsbc=1 : instantaneous values'
160            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
161         ENDIF
162         !
163         ub_ad(:,:,1)  = ub_ad(:,:,1) + ssu_m_ad(:,:)
164         vb_ad(:,:,1)  = vb_ad(:,:,1) + ssv_m_ad(:,:)
165         tsn_ad(:,:,1,jp_tem)  = tsn_ad(:,:,1,jp_tem) + sst_m_ad(:,:)
166         tsn_ad(:,:,1,jp_sal)  = tsn_ad(:,:,1,jp_sal) + sss_m_ad(:,:)
167         sshn_ad(:,:)  = sshn_ad(:,:) + ssh_m_ad(:,:)
168         ssu_m_ad(:,:) = 0.0_wp
169         ssv_m_ad(:,:) = 0.0_wp
170         sst_m_ad(:,:) = 0.0_wp
171         sss_m_ad(:,:) = 0.0_wp
172         ssh_m_ad(:,:) = 0.0_wp
173         !
174      ELSE
175         !                                                ! ---------------------------------------- !
176         IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !
177            !                                             ! ---------------------------------------- !
178            zcoef = 1. / REAL( nn_fsbc, wp )
179            sst_m_ad(:,:) = sst_m_ad(:,:) * zcoef           ! mean SST             [Celcius]
180            sss_m_ad(:,:) = sss_m_ad(:,:) * zcoef           ! mean SSS             [psu]
181            ssu_m_ad(:,:) = ssu_m_ad(:,:) * zcoef           ! mean suface current  [m/s]
182            ssv_m_ad(:,:) = ssv_m_ad(:,:) * zcoef           !
183            ssh_m_ad(:,:) = ssh_m_ad(:,:) * zcoef           !
184            !
185         ENDIF
186         !                                                ! ---------------------------------------- !
187         !                                                !        Cumulate at each time step        !
188         !                                                ! ---------------------------------------- !
189         ub_ad(:,:,1) = ssu_m_ad(:,:) + ub_ad(:,:,1)
190         vb_ad(:,:,1) = ssv_m_ad(:,:) + vb_ad(:,:,1)
191         tsn_ad(:,:,1,jp_tem) = sst_m_ad(:,:) + tsn_ad(:,:,1,jp_tem)
192         tsn_ad(:,:,1,jp_sal) = sss_m_ad(:,:) + tsn_ad(:,:,1,jp_sal)
193         sshn_ad(:,:) = ssh_m_ad(:,:) + sshn_ad(:,:)
194         !                                                ! ---------------------------------------- !
195         IF( kt == nitend) THEN                           !       Initialisation: 1st time-step      !
196            !                                             ! ---------------------------------------- !
197            IF(lwp) WRITE(numout,*)
198            IF(lwp) WRITE(numout,*) 'sbc_ssm_adj : sea surface mean fields'
199            !
200         ENDIF
201         !                                                ! ---------------------------------------- !
202         IF( kt == nit000) THEN                           !       Initialisation: 1st time-step      !
203            !                                             ! ---------------------------------------- !
204
205            IF( ln_rstart ) THEN
206                  ssu_m_ad(:,:) = 0.0_wp
207                  ssv_m_ad(:,:) = 0.0_wp
208                  sst_m_ad(:,:) = 0.0_wp
209                  sss_m_ad(:,:) = 0.0_wp
210                  ssh_m_ad(:,:) = 0.0_wp
211             ELSE
212               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values'
213               zcoef = REAL( nn_fsbc - 1, wp )
214               ub_ad(:,:,1)  = ub_ad(:,:,1) + zcoef * ssu_m_ad(:,:)
215               vb_ad(:,:,1)  = vb_ad(:,:,1) + zcoef * ssv_m_ad(:,:)
216               tsn_ad(:,:,1,jp_tem)  = tsn_ad(:,:,1,jp_tem) + zcoef * sst_m_ad(:,:)
217               tsn_ad(:,:,1,jp_sal)  = tsn_ad(:,:,1,jp_sal) + zcoef * sss_m_ad(:,:)
218               sshn_ad(:,:)  = sshn_ad(:,:) + zcoef * ssh_m_ad(:,:)
219               ssu_m_ad(:,:) = 0.0_wp
220               ssv_m_ad(:,:) = 0.0_wp
221               sst_m_ad(:,:) = 0.0_wp
222               sss_m_ad(:,:) = 0.0_wp
223               ssh_m_ad(:,:) = 0.0_wp
224            ENDIF
225            !                                             ! ---------------------------------------- !
226         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !
227            !                                             ! ---------------------------------------- !
228            ssu_m_ad(:,:) = 0.0_wp      ! reset to zero ocean mean sbc fields
229            ssv_m_ad(:,:) = 0.0_wp
230            sst_m_ad(:,:) = 0.0_wp
231            sss_m_ad(:,:) = 0.0_wp
232            ssh_m_ad(:,:) = 0.0_wp
233         ENDIF
234
235         !
236      ENDIF
237      !
238   END SUBROUTINE sbc_ssm_adj
239
240   SUBROUTINE sbc_ssm_adj_tst( kumadt )
241      !!-----------------------------------------------------------------------
242      !!
243      !!                  ***  ROUTINE sbc_ssm_adj_tst ***
244      !!
245      !! ** Purpose : Test the adjoint routine.
246      !!
247      !! ** Method  : Verify the scalar product
248      !!
249      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
250      !!
251      !!              where  L   = tangent routine
252      !!                     L^T = adjoint routine
253      !!                     W   = diagonal matrix of scale factors
254      !!                     dx  = input perturbation (random field)
255      !!                     dy  = L dx
256      !!
257      !! ** Action
258      !!              dx = ( un_tl, vn_tl, tn_tl, sn_tl )
259      !!              dy = ( ssu_m_tl, ssv_m_tl, sst_m_tl, sss_m_tl )
260      !!
261      !! History :
262      !!        ! 08-08 (A. Vidard)
263      !!        ! 09-01 (A. Weaver) cleaning
264      !!-----------------------------------------------------------------------
265      !! * Modules used
266
267      !! * Arguments
268      INTEGER, INTENT(IN) :: &
269         & kumadt             ! Output unit
270
271      INTEGER ::  &
272         & ji,    &        ! dummy loop indices
273         & jj
274      INTEGER, DIMENSION(jpi,jpj) :: &
275         & iseed_2d        ! 2D seed for the random number generator
276      REAL(KIND=wp) :: &
277         & zsp1,         & ! scalar product involving the tangent routine
278         & zsp2            ! scalar product involving the adjoint routine
279      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
280         & zub_tlin   ,     & ! Tangent input
281         & zvb_tlin   ,     & ! Tangent input
282         & ztn_tlin   ,     & ! Tangent input
283         & zsn_tlin   ,     & ! Tangent input
284         & zsshn_tlin ,     & ! Adjoint output
285         & zssum_tlin ,     & ! Tangent input
286         & zssvm_tlin ,     & ! Tangent input
287         & zsstm_tlin ,     & ! Tangent input
288         & zsssm_tlin ,     & ! Tangent input
289         & zsshm_tlin ,     & ! Tangent input
290         & zssum_tlout,     & ! Tangent output
291         & zssvm_tlout,     & ! Tangent output
292         & zsstm_tlout,     & ! Tangent output
293         & zsssm_tlout,     & ! Tangent output
294         & zsshm_tlout,     & ! Tangent output
295         & zub_adout  ,     & ! Adjoint input
296         & zvb_adout  ,     & ! Adjoint input
297         & ztn_adout  ,     & ! Adjoint input
298         & zsn_adout  ,     & ! Adjoint input
299         & zsshn_adout,     & ! Adjoint output
300         & zssum_adout,     & ! Adjoint input
301         & zssvm_adout,     & ! Adjoint input
302         & zsstm_adout,     & ! Adjoint input
303         & zsssm_adout,     & ! Adjoint input
304         & zsshm_adout,     & ! Adjoint input
305         & zssum_adin ,     & ! Adjoint output
306         & zssvm_adin ,     & ! Adjoint output
307         & zsstm_adin ,     & ! Adjoint output
308         & zsssm_adin ,     & ! Adjoint output
309         & zsshm_adin ,     & ! Adjoint output
310         & zr                 ! 2D random field
311      CHARACTER(LEN=14) :: cl_name
312      ! Allocate memory
313
314      ALLOCATE(                      &
315         & zub_tlin   (jpi,jpj),     &
316         & zvb_tlin   (jpi,jpj),     &
317         & ztn_tlin   (jpi,jpj),     &
318         & zsn_tlin   (jpi,jpj),     &
319         & zsshn_tlin (jpi,jpj),     &
320         & zssum_tlin (jpi,jpj),     &
321         & zssvm_tlin (jpi,jpj),     &
322         & zsstm_tlin (jpi,jpj),     &
323         & zsssm_tlin (jpi,jpj),     &
324         & zsshm_tlin (jpi,jpj),     &
325         & zssum_tlout(jpi,jpj),     &
326         & zssvm_tlout(jpi,jpj),     &
327         & zsstm_tlout(jpi,jpj),     &
328         & zsssm_tlout(jpi,jpj),     &
329         & zsshm_tlout(jpi,jpj),     &
330         & zub_adout  (jpi,jpj),     &
331         & zvb_adout  (jpi,jpj),     &
332         & ztn_adout  (jpi,jpj),     &
333         & zsn_adout  (jpi,jpj),     &
334         & zsshn_adout(jpi,jpj),     &
335         & zssum_adout(jpi,jpj),     &
336         & zssvm_adout(jpi,jpj),     &
337         & zsstm_adout(jpi,jpj),     &
338         & zsssm_adout(jpi,jpj),     &
339         & zsshm_adout(jpi,jpj),     &
340         & zssum_adin (jpi,jpj),     &
341         & zssvm_adin (jpi,jpj),     &
342         & zsstm_adin (jpi,jpj),     &
343         & zsssm_adin (jpi,jpj),     &
344         & zsshm_adin (jpi,jpj),     &
345         & zr         (jpi,jpj)      &
346         & )
347      !==================================================================
348      ! 1) dx = ( un_tl, vn_tl, tn_tl, sn_tl ) and
349      !    dy = ( ssu_m_tl, ssv_m_tl, sst_m_tl, sss_m_tl )
350      !==================================================================
351
352      !--------------------------------------------------------------------
353      ! Reset the tangent and adjoint variables
354      !--------------------------------------------------------------------
355      zub_tlin   (:,:) = 0.0_wp
356      zvb_tlin   (:,:) = 0.0_wp
357      ztn_tlin   (:,:) = 0.0_wp
358      zsn_tlin   (:,:) = 0.0_wp
359      zssum_tlin (:,:) = 0.0_wp
360      zssvm_tlin (:,:) = 0.0_wp
361      zsstm_tlin (:,:) = 0.0_wp
362      zsssm_tlin (:,:) = 0.0_wp
363      zsshm_tlin (:,:) = 0.0_wp
364      zssum_tlout(:,:) = 0.0_wp
365      zssvm_tlout(:,:) = 0.0_wp
366      zsstm_tlout(:,:) = 0.0_wp
367      zsssm_tlout(:,:) = 0.0_wp
368      zsshm_tlout(:,:) = 0.0_wp
369      zub_adout  (:,:) = 0.0_wp
370      zvb_adout  (:,:) = 0.0_wp
371      ztn_adout  (:,:) = 0.0_wp
372      zsn_adout  (:,:) = 0.0_wp
373      zsshn_adout(:,:) = 0.0_wp
374      zssum_adout(:,:) = 0.0_wp
375      zssvm_adout(:,:) = 0.0_wp
376      zsstm_adout(:,:) = 0.0_wp
377      zsssm_adout(:,:) = 0.0_wp
378      zsshm_adout(:,:) = 0.0_wp
379      zssum_adin (:,:) = 0.0_wp
380      zssvm_adin (:,:) = 0.0_wp
381      zsstm_adin (:,:) = 0.0_wp
382      zsssm_adin (:,:) = 0.0_wp
383      zsshm_adin (:,:) = 0.0_wp
384      zr         (:,:) = 0.0_wp
385
386      !--------------------------------------------------------------------
387      ! Initialize the tangent input with random noise: dx
388      !--------------------------------------------------------------------
389
390      CALL grid_random( zr, 'U', 0.0_wp, stdu )
391      DO jj = nldj, nlej
392         DO ji = nldi, nlei
393            zub_tlin(ji,jj) = zr(ji,jj)
394         END DO
395      END DO
396
397      CALL grid_random(  zr, 'V', 0.0_wp, stdv )
398      DO jj = nldj, nlej
399         DO ji = nldi, nlei
400            zvb_tlin(ji,jj) = zr(ji,jj)
401         END DO
402      END DO
403
404      CALL grid_random(  zr, 'T', 0.0_wp, stds )
405      DO jj = nldj, nlej
406         DO ji = nldi, nlei
407            zsn_tlin(ji,jj) = zr(ji,jj)
408         END DO
409      END DO
410
411      CALL grid_random(  zr, 'T', 0.0_wp, stdt )
412      DO jj = nldj, nlej
413         DO ji = nldi, nlei
414            ztn_tlin(ji,jj) = zr(ji,jj)
415         END DO
416      END DO
417      CALL grid_random(  zr, 'T', 0.0_wp, stdssh )
418      DO jj = nldj, nlej
419         DO ji = nldi, nlei
420            zsshn_tlin(ji,jj) = zr(ji,jj)
421         END DO
422      END DO
423
424      CALL grid_random(  zr, 'U', 0.0_wp, stdu )
425      DO jj = nldj, nlej
426         DO ji = nldi, nlei
427            zssum_tlin(ji,jj) = zr(ji,jj)
428         END DO
429      END DO
430      CALL grid_random(  zr, 'V', 0.0_wp, stdv )
431      DO jj = nldj, nlej
432         DO ji = nldi, nlei
433            zssvm_tlin(ji,jj) = zr(ji,jj)
434         END DO
435      END DO
436      CALL grid_random(  zr, 'T', 0.0_wp, stdt )
437      DO jj = nldj, nlej
438         DO ji = nldi, nlei
439            zsstm_tlin(ji,jj) = zr(ji,jj)
440         END DO
441      END DO
442
443      CALL grid_random(  zr, 'T', 0.0_wp, stds )
444      DO jj = nldj, nlej
445         DO ji = nldi, nlei
446            zsssm_tlin(ji,jj) = zr(ji,jj)
447         END DO
448      END DO
449
450      CALL grid_random(  zr, 'T', 0.0_wp, stdssh )
451      DO jj = nldj, nlej
452         DO ji = nldi, nlei
453            zsshm_tlin(ji,jj) = zr(ji,jj)
454         END DO
455      END DO
456
457      ub_tl (:,:,1) = zub_tlin  (:,:)
458      vb_tl (:,:,1) = zvb_tlin  (:,:)
459      tsn_tl (:,:,1,jp_tem) = ztn_tlin  (:,:)
460      tsn_tl (:,:,1,jp_sal) = zsn_tlin  (:,:)
461      sshn_tl (:,:) = zsshn_tlin(:,:)
462      ssu_m_tl(:,:) = zssum_tlin(:,:)
463      ssv_m_tl(:,:) = zssvm_tlin(:,:)
464      sst_m_tl(:,:) = zsstm_tlin(:,:)
465      sss_m_tl(:,:) = zsssm_tlin(:,:)
466      ssh_m_tl(:,:) = zsshm_tlin(:,:)
467
468      CALL sbc_ssm_tan( nit000 + 1 )
469
470      zssum_tlout (:,:) = ssu_m_tl(:,:)
471      zssvm_tlout (:,:) = ssv_m_tl(:,:)
472      zsstm_tlout (:,:) = sst_m_tl(:,:)
473      zsssm_tlout (:,:) = sss_m_tl(:,:)
474      zsshm_tlout (:,:) = ssh_m_tl(:,:)
475
476      !--------------------------------------------------------------------
477      ! Initialize the adjoint variables: dy^* = W dy
478      !--------------------------------------------------------------------
479
480      DO jj = nldj, nlej
481         DO ji = nldi, nlei
482            zssum_adin(ji,jj) = zssum_tlout(ji,jj) &
483               &               * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) &
484               &               * umask(ji,jj,1)
485            zssvm_adin(ji,jj) = zssvm_tlout(ji,jj) &
486               &               * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) &
487               &               * umask(ji,jj,1)
488            zsstm_adin(ji,jj) = zsstm_tlout(ji,jj) &
489               &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) &
490               &               * tmask(ji,jj,1) * wesp_t(1)
491            zsssm_adin(ji,jj) = zsssm_tlout(ji,jj) &
492               &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) &
493               &               * tmask(ji,jj,1) * wesp_s(1)
494            zsshm_adin(ji,jj) = zsshm_tlout(ji,jj) &
495               &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) &
496               &               * tmask(ji,jj,1) * wesp_s(1)
497         END DO
498      END DO
499
500      !--------------------------------------------------------------------
501      ! Compute the scalar product: ( L dx )^T W dy
502      !--------------------------------------------------------------------
503
504      zsp1 = DOT_PRODUCT( zssum_tlout, zssum_adin ) &
505         & + DOT_PRODUCT( zssvm_tlout, zssvm_adin ) &
506         & + DOT_PRODUCT( zsstm_tlout, zsstm_adin ) &
507         & + DOT_PRODUCT( zsssm_tlout, zsssm_adin ) &
508         & + DOT_PRODUCT( zsshm_tlout, zsshm_adin )
509
510      !--------------------------------------------------------------------
511      ! Call the adjoint routine: dx^* = L^T dy^*
512      !--------------------------------------------------------------------
513
514      ssu_m_ad(:,:) = zssum_adin(:,:)
515      ssv_m_ad(:,:) = zssvm_adin(:,:)
516      sst_m_ad(:,:) = zsstm_adin(:,:)
517      sss_m_ad(:,:) = zsssm_adin(:,:)
518      ssh_m_ad(:,:) = zsshm_adin(:,:)
519      ub_ad(:,:,1)  = 0.0_wp
520      vb_ad(:,:,1)  = 0.0_wp
521      tsn_ad(:,:,1,jp_tem)  = 0.0_wp
522      tsn_ad(:,:,1,jp_tem)  = 0.0_wp
523      sshn_ad(:,:)  = 0.0_wp
524
525      CALL sbc_ssm_adj( nit000 + 1 )
526
527      zub_adout  (:,:) = ub_ad(:,:,1)
528      zvb_adout  (:,:) = vb_ad(:,:,1)
529      ztn_adout  (:,:) = tsn_ad(:,:,1,jp_tem)
530      zsn_adout  (:,:) = tsn_ad(:,:,1,jp_sal)
531      zsshn_adout(:,:) = sshn_ad(:,:)
532      zssum_adout(:,:) = ssu_m_ad(:,:)
533      zssvm_adout(:,:) = ssv_m_ad(:,:)
534      zsstm_adout(:,:) = sst_m_ad(:,:)
535      zsssm_adout(:,:) = sss_m_ad(:,:)
536      zsshm_adout(:,:) = ssh_m_ad(:,:)
537
538      !--------------------------------------------------------------------
539      ! Compute the scalar product: dx^T dx^*
540      !--------------------------------------------------------------------
541
542      zsp2 = DOT_PRODUCT( zub_tlin  , zub_adout   ) &
543         & + DOT_PRODUCT( zvb_tlin  , zvb_adout   ) &
544         & + DOT_PRODUCT( ztn_tlin  , ztn_adout   ) &
545         & + DOT_PRODUCT( zsn_tlin  , zsn_adout   ) &
546         & + DOT_PRODUCT( zsshn_tlin, zsshn_adout ) &
547         & + DOT_PRODUCT( zssum_tlin, zssum_adout ) &
548         & + DOT_PRODUCT( zssvm_tlin, zssvm_adout ) &
549         & + DOT_PRODUCT( zsstm_tlin, zsstm_adout ) &
550         & + DOT_PRODUCT( zsssm_tlin, zsssm_adout ) &
551         & + DOT_PRODUCT( zsshm_tlin, zsshm_adout )
552
553      ! 14 char:'12345678901234'
554      cl_name = 'sbc_ssm_adj   '
555      CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
556
557      DEALLOCATE(           &
558         & zub_tlin   ,     & ! Tangent input
559         & zvb_tlin   ,     & ! Tangent input
560         & ztn_tlin   ,     & ! Tangent input
561         & zsn_tlin   ,     & ! Tangent input
562         & zssum_tlin ,     & ! Tangent input
563         & zssvm_tlin ,     & ! Tangent input
564         & zsstm_tlin ,     & ! Tangent input
565         & zsssm_tlin ,     & ! Tangent input
566         & zsshm_tlin ,     & ! Tangent input
567         & zssum_tlout,     & ! Tangent output
568         & zssvm_tlout,     & ! Tangent output
569         & zsstm_tlout,     & ! Tangent output
570         & zsssm_tlout,     & ! Tangent output
571         & zsshm_tlout,     & ! Tangent output
572         & zub_adout  ,     & ! Adjoint input
573         & zvb_adout  ,     & ! Adjoint input
574         & ztn_adout  ,     & ! Adjoint input
575         & zsn_adout  ,     & ! Adjoint input
576         & zssum_adout,     & ! Adjoint input
577         & zssvm_adout,     & ! Adjoint input
578         & zsstm_adout,     & ! Adjoint input
579         & zsssm_adout,     & ! Adjoint input
580         & zsshm_adout,     & ! Adjoint input
581         & zssum_adin ,     & ! Adjoint output
582         & zssvm_adin ,     & ! Adjoint output
583         & zsstm_adin ,     & ! Adjoint output
584         & zsssm_adin ,     & ! Adjoint output
585         & zsshm_adin ,     & ! Adjoint output
586         & zr               &
587         & )
588
589   END SUBROUTINE sbc_ssm_adj_tst
590#endif
591   !!======================================================================
592END MODULE sbcssm_tam
Note: See TracBrowser for help on using the repository browser.