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

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/DYN/dynspg_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: 10.2 KB
Line 
1MODULE dynspg_tam
2   !!----------------------------------------------------------------------
3   !!    This software is governed by the CeCILL licence (Version 2)
4   !!----------------------------------------------------------------------
5#if defined key_tam
6   !!======================================================================
7   !!                       ***  MODULE  dynspg_tam  ***
8   !! Ocean dynamics:  surface pressure gradient control
9   !!                  Tangent and Adjoint Module
10   !!======================================================================
11   !! History of the direct module:
12   !!            1.0  ! 2005-12  (C. Talandier, G. Madec, V. Garnier)  Original code
13   !!            3.2  ! 2009-07  (R. Benshila)  Suppression of rigid-lid option
14   !! History of the T&A module:
15   !!            9.0  ! 2008-06  (A. Vidard) Skeleton
16   !!                 ! 2008-11  (A. Vidard) nemo v3
17   !!                 ! 2009-03  (A. Weaver) dynspg_flt_tam
18   !!            3.2  ! 2010-04  (F. Vigilant) modification for 3.2
19   !!            3.4  ! 2012-07  (P.-A. Bouttier) phasing with 3.2
20   !!----------------------------------------------------------------------
21   !!   dyn_spg_tan     : update the dynamics trend with the surface pressure
22   !!                     gradient (tangent routine)
23   !!   dyn_spg_adj     : update the dynamics trend with the surface pressure
24   !!                     gradient (adjoint routine)
25   !!   dyn_spg_adj_tst : Test of the adjoint routine
26   !!----------------------------------------------------------------------
27   USE par_oce
28   USE phycst
29   USE sbc_oce
30   USE dom_oce
31   USE oce_tam
32   USE dynspg_oce
33   USE in_out_manager
34   USE dynspg_exp_tam ! surface pressure gradient     (dyn_spg_exp routine)
35!   USE dynspg_ts_tam  ! surface pressure gradient     (dyn_spg_ts  routine)
36   USE dynspg_flt_tam  ! surface pressure gradient     (dyn_spg_flt routine)
37   USE lib_mpp        ! MPP library
38   USE solver          ! solver initialization
39   USE wrk_nemo        ! Memory Allocation
40   USE timing          ! Timing
41
42   IMPLICIT NONE
43   PRIVATE
44
45   !! * Accessibility
46   PUBLIC dyn_spg_tan,      &   ! routine called by steptan module
47      &   dyn_spg_adj,      &   ! routine called by stepadj module
48      &   dyn_spg_adj_tst,  &   ! routine controlling adjoint tests
49      &   dyn_spg_init_tam
50
51   !! * module variables
52   INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_...
53
54   !! * Substitutions
55#  include "domzgr_substitute.h90"
56#  include "vectopt_loop_substitute.h90"
57
58CONTAINS
59
60   SUBROUTINE dyn_spg_tan( kt, kindic )
61      !!----------------------------------------------------------------------
62      !!                  ***  ROUTINE dyn_spg_tan  ***
63      !!
64      !! ** Purpose of the direct routine:
65      !!              achieve the momentum time stepping by computing the
66      !!              last trend, the surface pressure gradient, and performing
67      !!              the Leap-Frog integration.
68      !!gm              In the current version only the filtered solution provide
69      !!gm            the after velocity, in the 2 other (ua,va) are still the trends
70      !!
71      !! ** Method  :   Three schemes:
72      !!              - explicit computation      : the spg is evaluated at now
73      !!              - filtered computation      : the Roulet & madec (2000) technique is used
74      !!              - split-explicit computation: a time splitting technique is used
75      !!
76      !! N.B. : When key_esopa is used all the scheme are tested, regardless
77      !!        of the physical meaning of the results.
78      !!----------------------------------------------------------------------
79      INTEGER, INTENT( IN  ) :: &
80         & kt      ! ocean time-step index
81      INTEGER, INTENT( OUT ) :: &
82         & kindic  ! solver flag
83      INTEGER  ::   ji, jj, jk                             ! dummy loop indices
84      REAL(wp) ::   z2dt, zg_2                             ! temporary scalar
85      !!----------------------------------------------------------------------
86      !
87      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_tan')
88      !
89      SELECT CASE ( nspg )                       ! compute surf. pressure gradient
90                                                 ! trend and add it to the general trend
91      CASE (  0 )
92         CALL dyn_spg_exp_tan( kt )              ! explicit
93      CASE (  1 )
94         CALL ctl_stop ( 'dyn_spg_ts_tan not available yet' )
95      CASE (  2 )
96         CALL dyn_spg_flt_tan( kt, kindic )      ! filtered
97      !
98      END SELECT
99      !
100      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_tan')
101      !
102   END SUBROUTINE dyn_spg_tan
103
104   SUBROUTINE dyn_spg_adj( kt, kindic )
105      !!----------------------------------------------------------------------
106      !!                  ***  ROUTINE dyn_spg_adj  ***
107      !!
108      !! ** Purpose of the direct routine:
109      !!            compute the lateral ocean dynamics physics.
110      !!----------------------------------------------------------------------
111      INTEGER, INTENT( IN  ) :: &
112         & kt      ! ocean time-step index
113      INTEGER, INTENT( OUT ) :: &
114         & kindic  ! solver flag
115      !
116      INTEGER  ::   ji, jj, jk                             ! dummy loop indices
117      REAL(wp) ::   z2dt, zg_2                             ! temporary scalar
118      !!----------------------------------------------------------------------
119      !
120      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_adj')
121      !
122      kindic = 0
123      spgu_ad(:,:) = 0._wp
124      spgv_ad(:,:) = 0._wp
125
126      SELECT CASE ( nspg )                       ! compute surf. pressure gradient
127                                                 ! trend and add it to the general trend
128      CASE (  0 )
129         CALL dyn_spg_exp_adj( kt )              ! explicit
130      CASE (  1 )
131         CALL ctl_stop ( 'dyn_spg_ts_adj not available yet' )
132!!!      CALL dyn_spg_ts_adj ( kt )              ! time-splitting
133      CASE (  2 )
134         CALL dyn_spg_flt_adj( kt, kindic )      ! filtered
135      !
136      END SELECT
137      !
138      !
139      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_adj')
140      !
141   END SUBROUTINE dyn_spg_adj
142
143   SUBROUTINE dyn_spg_adj_tst( kumadt )
144      !!-----------------------------------------------------------------------
145      !!
146      !!                  ***  ROUTINE dyn_spg_flt_adj_tst ***
147      !!
148      !! ** Purpose : Test the adjoint routine.
149      !!
150      !! ** Method  : Verify the scalar product
151      !!
152      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
153      !!
154      !!              where  L   = tangent routine
155      !!                     L^T = adjoint routine
156      !!                     W   = diagonal matrix of scale factors
157      !!                     dx  = input perturbation (random field)
158      !!                     dy  = L dx
159      !!
160      !! ** Action  : Call the appropriate test routine depending on the
161      !!              choice of free surface.
162      !!
163      !! History :
164      !!        ! 09-01 (A. Weaver)
165      !!-----------------------------------------------------------------------
166      !! * Modules used
167
168      !! * Arguments
169      INTEGER, INTENT(IN) :: &
170         & kumadt        ! Output unit
171
172      SELECT CASE ( nspg )
173      CASE (  0 )
174         CALL dyn_spg_exp_adj_tst( kumadt )      ! explicit
175      CASE (  1 )
176         CALL ctl_stop ( 'dyn_spg_ts_adj_tst not available yet' )
177!!!      CALL dyn_spg_ts_adj_tst ( kumadt )      ! time-splitting
178      CASE (  2 )
179         CALL dyn_spg_flt_adj_tst( kumadt )      ! filtered
180      !
181      END SELECT
182      !
183   END SUBROUTINE dyn_spg_adj_tst
184
185   SUBROUTINE dyn_spg_init_tam
186      !!---------------------------------------------------------------------
187      !!                  ***  ROUTINE dyn_spg_ctl_tam  ***
188      !!
189      !! ** Purpose :  Control the consistency between cpp options for
190      !!               surface pressure gradient schemes
191      !!----------------------------------------------------------------------
192      !! * Local declarations
193      INTEGER :: &
194        & ioptio
195
196      !!----------------------------------------------------------------------
197      !
198      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_init_tam')
199      !
200      IF(lwp) THEN             ! Control print
201         WRITE(numout,*)
202         WRITE(numout,*) 'dyn_spg_init_tam : choice of the surface pressure gradient scheme'
203         WRITE(numout,*) '~~~~~~~~~~~~~~~'
204         WRITE(numout,*) '     Explicit free surface                  lk_dynspg_exp = ', lk_dynspg_exp
205         WRITE(numout,*) '     Free surface with time splitting       lk_dynspg_ts  = ', lk_dynspg_ts
206         WRITE(numout,*) '     Filtered free surface cst volume       lk_dynspg_flt = ', lk_dynspg_flt
207      ENDIF
208
209      ! Control of surface pressure gradient scheme options
210      ! ---------------------------------------------------
211      ioptio = 0
212      IF(lk_dynspg_exp)   ioptio = ioptio + 1
213      IF(lk_dynspg_ts )   ioptio = ioptio + 1
214      IF(lk_dynspg_flt)   ioptio = ioptio + 1
215
216      IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ioptio == 0 )   &
217           &   CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' )
218
219      IF( lk_esopa     )   nspg = -1
220      IF( lk_dynspg_exp)   nspg =  0
221      IF( lk_dynspg_ts )   nspg =  1
222      IF( lk_dynspg_flt)   nspg =  2
223
224      IF( lk_esopa     )   nspg = -1
225
226     IF(lwp) THEN
227         WRITE(numout,*)
228         IF( nspg == -1 )   WRITE(numout,*) '     ESOPA test All scheme used'
229         IF( nspg ==  0 )   WRITE(numout,*) '     explicit free surface'
230         IF( nspg ==  1 )   WRITE(numout,*) '     free surface with time splitting scheme'
231         IF( nspg ==  2 )   WRITE(numout,*) '     filtered free surface'
232      ENDIF
233#if defined key_dynspg_flt || defined key_esopa
234      !CALL solver_init( nit000 )   ! Elliptic solver initialisation
235#endif
236      ! Control of timestep choice
237      ! --------------------------
238      IF( lk_dynspg_ts .OR. lk_dynspg_exp) THEN
239         IF( nn_cla == 1 )   &
240           &   CALL ctl_stop( ' Crossland advection not implemented for this free surface formulation ' )
241      ENDIF
242      !
243      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_init_tam')
244      !
245   END SUBROUTINE dyn_spg_init_tam
246  !!======================================================================
247#endif
248END MODULE dynspg_tam
Note: See TracBrowser for help on using the repository browser.