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.
sbcmod_tam.F90 in NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/SBC – NEMO

source: NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/SBC/sbcmod_tam.F90 @ 11806

Last change on this file since 11806 was 11806, checked in by smueller, 5 years ago

Enabling of the selection of the flux formulation as surface boundary condition (ln_flx set to .TRUE. in namelist namsbc) and elimination of the use of an unassigned variable (variable nsbc of module sbcmod_tam) in NEMOTAM (application of the patch attached to ticket #1738)
  • Property svn:executable set to *
File size: 12.9 KB
RevLine 
[3611]1MODULE sbcmod_tam
2#ifdef key_tam
3   !!======================================================================
4   !!                       ***  MODULE  sbcmod_tam  ***
5   !! Surface module :  provide to the ocean its surface boundary condition
6   !!                       Tangent&Adjoint module
7   !!======================================================================
8   !! History of the direct module :
9   !!            3.0   !  07-2006  (G. Madec)  Original code
10   !!             -    !  08-2008  (S. Masson, E. .... ) coupled interface
11   !! History of the T&A module :
12   !!            3.0   !  11-2008  (A. Vidard) TAM of the 2006-07 version
13   !!            3.2   !  04-2010  (A. Vidard) Nemo3.2 update
14   !!----------------------------------------------------------------------
15
16   !!----------------------------------------------------------------------
17   !!   sbc_init       : read namsbc namelist
18   !!   sbc            : surface ocean momentum, heat and freshwater boundary conditions
19   !!----------------------------------------------------------------------
20   USE par_kind
21   USE phycst
22   USE lbclnk
23   USE lbclnk_tam
24   !   USE ice_oce         ! sea-ice model : LIM
25   USE dom_oce
26   USE sbc_oce
27   USE sbcmod
28   USE sbc_oce_tam
29   USE sbcssm_tam
30   USE sbcana_tam
31!*B      & sbc_ana_tan,       &
32!*B      & sbc_ana_adj,       &
33!*B      & sbc_ana_adj_tst
34   USE sbcflx_tam
35!   USE sbcblk_clio     ! surface boundary condition: bulk formulation : CLIO
36!   USE sbcblk_core     ! surface boundary condition: bulk formulation : CORE
37!   USE sbcice_if       ! surface boundary condition: ice-if sea-ice model
38!   USE sbcice_lim      ! surface boundary condition: LIM 3.0 sea-ice model
39!   USE sbcice_lim_2    ! surface boundary condition: LIM 2.0 sea-ice model
40!   USE sbccpl          ! surface boundary condition: coupled florulation
41   USE sbcssr_tam
42   USE closea_tam
43!   USE sbcrnf_tam          ! surface boundary condition: runoffs
44   USE sbcrnf
45   USE sbcfwb_tam
46   USE in_out_manager
47
48   IMPLICIT NONE
49   PRIVATE
50
51   PUBLIC   sbc_init_tam ! routine called by step_tam.F90
52   PUBLIC   sbc_tan      ! routine called by step_tam.F90
53   PUBLIC   sbc_adj      ! routine called by step_tam.F90
54   PUBLIC   sbc_adj_tst  ! routine called by tst.F90
55
56   INTEGER          ::   nn_ico_cpl  = 0         !: ice-ocean coupling indicator
57   !                                             !  = 0   LIM-3 old case
58   !                                             !  = 1   stresses computed using now ocean velocity
59   !                                             !  = 2   combination of 0 and 1 cases
60
61   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations)
62   INTEGER ::   nice   ! type of ice in the surface boundary condition (deduced from namsbc informations)
63   LOGICAL, SAVE :: lfirst = .TRUE. ! initialisation flag
64
65   !! * Substitutions
66#  include "domzgr_substitute.h90"
67   !!----------------------------------------------------------------------
68   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
69   !! $Id: sbcmod.F90 1172 2008-09-10 15:32:47Z ctlod $
70   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
71   !!----------------------------------------------------------------------
72
73CONTAINS
74
75   SUBROUTINE sbc_init_tam
76      !!---------------------------------------------------------------------
77      !!                    ***  ROUTINE sbc_init_tam ***
78      !!
79      !! ** Purpose of the direct routine:
80      !!           Initialisation of the ocean surface boundary computation
81      !!
82      !! ** Method  :   Read the namsbc namelist and set derived parameters
83      !!
84      !! ** Action  : - read namsbc parameters
85      !!              - nsbc: type of sbc
86      !!----------------------------------------------------------------------
87      INTEGER ::   icpt      ! temporary integer
88      !!
89      !!----------------------------------------------------------------------
90      IF (lfirst) THEN
91
[11806]92         nsbc = 0
93         IF (ln_flx) THEN
94            nsbc = 2
95            IF (lwp) WRITE(numout, *) 'sbc_init_tam: flux formulation'
96         ELSE
97            IF (lwp) WRITE(numout, *) 'sbc_init_tam: analytical SBC formulation '// &
98                 &                    '              of GYRE configuration'
99         ENDIF
[3611]100         !CALL sbc_init
101         IF( nn_ice == 0  )   fr_i_tl(:,:) = 0.e0       ! no ice in the domain, ice fraction is always zero
102         lfirst = .FALSE.
103      END IF
104      !
105   END SUBROUTINE sbc_init_tam
106
107
108   SUBROUTINE sbc_tan( kt )
109      !!---------------------------------------------------------------------
110      !!                    ***  ROUTINE sbc_tan  ***
111      !!
112      !! ** Purpose of the direct routine:
113      !!                provide at each time-step the ocean surface boundary
114      !!                condition (momentum, heat and freshwater fluxes)
115      !!
116      !! ** Method  :   blah blah  to be written ?????????
117      !!                CAUTION : never mask the surface stress field (tke sbc)
118      !!
119      !! ** Action  : - set the ocean surface boundary condition, i.e.
120      !!                utau, vtau, qns, qsr, emp, emps, qrp, erp
121      !!              - updte the ice fraction : fr_i
122      !!----------------------------------------------------------------------
123      INTEGER, INTENT(in) ::   kt       ! ocean time step
124      !!---------------------------------------------------------------------
125
126      ! ocean to sbc mean sea surface variables (ss._m)
127      ! ---------------------------------------
128      CALL sbc_ssm_tan( kt )                         ! sea surface mean currents (at U- and V-points),
129      !                                          ! temperature and salinity (at T-point) over nf_sbc time-step
130      !                                          ! (i.e. sst_m, sss_m, ssu_m, ssv_m)
131
132      ! sbc formulation
133      ! ---------------
134
135      SELECT CASE( nsbc )                        ! Compute ocean surface boundary condition
136      !                                          ! (i.e. utau,vtau, qns, qsr, emp, emps)
137      CASE(  0 )   ;   CALL sbc_gyre_tan    ( kt )      ! analytical formulation : GYRE configuration
138         ! no! in default
139      !CASE(  1 )   ;   CALL sbc_ana_tan     ( kt )      ! analytical formulation : uniform sbc
140      CASE(  2 )   ;   CALL sbc_flx_tan     ( kt )      ! flux formulation
141      !CASE(  3 )   ;   CALL sbc_blk_clio_tan( kt )      ! bulk formulation : CLIO for the ocean
142      !CASE(  4 )   ;   CALL sbc_blk_core_tan( kt )      ! bulk formulation : CORE for the ocean
143      !CASE(  5 )   ;   CALL sbc_cpl_tan     ( kt )      ! coupled formulation
144      CASE( 6 )     ;  CALL sbc_sqb_tan     (kt)
145      END SELECT
146
147      ! Misc. Options
148      ! -------------
149      ! not available
150!*B      SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over sea-ice areas
151!*B      CASE(  1 )   ;       CALL sbc_ice_if_tan   ( kt )                   ! Ice-cover climatology ("Ice-if" model)
152!*B         !
153!*B      CASE(  2 )   ;       CALL sbc_ice_lim_2_tan( kt, nsbc )             ! LIM 2.0 ice model
154!*B         !
155!*B      CASE(  3 )   ;       CALL sbc_ice_lim_tan  ( kt, nsbc, nn_ico_cpl)  ! LIM 3.0 ice model
156!*B      END SELECT
157
158      ! add runoffs to fresh water fluxes... not needed in tangent
159
160      IF( ln_ssr       )   CALL sbc_ssr_tan( kt )                   ! add SST/SSS damping term
161
162      IF( nn_fwb  /= 0 )   CALL sbc_fwb_tan( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
163
164      IF( nn_closea == 1 )   CALL sbc_clo_tan( kt )                   ! treatment of closed sea in the model domain
165      !                                                         ! (update freshwater fluxes)
166      !
167!RBbug do not understand why see ticket 667
168      CALL lbc_lnk( emp_tl, 'T', 1. )
169      !
170      !
171   END SUBROUTINE sbc_tan
172
173   !!======================================================================
174   SUBROUTINE sbc_adj( kt )
175      !!---------------------------------------------------------------------
176      !!                    ***  ROUTINE sbc_adj  ***
177      !!
178      !! ** Purpose of the direct routine:
179      !!                provide at each time-step the ocean surface boundary
180      !!                condition (momentum, heat and freshwater fluxes)
181      !!
182      !! ** Method  :   blah blah  to be written ?????????
183      !!                CAUTION : never mask the surface stress field (tke sbc)
184      !!
185      !! ** Action  : - set the ocean surface boundary condition, i.e.
186      !!                utau, vtau, qns, qsr, emp, emps, qrp, erp
187      !!              - updte the ice fraction : fr_i
188      !!----------------------------------------------------------------------
189      INTEGER, INTENT(in) ::   kt       ! ocean time step
190      !!---------------------------------------------------------------------
191
192      ! Misc. Options
193      ! -------------
194!RBbug do not understand why see ticket 667
195      CALL lbc_lnk_adj( emp_ad, 'T', 1. )
196      !
197      IF( nn_closea == 1 )   CALL sbc_clo_adj( kt )                   ! treatment of closed sea in the model domain
198      IF( nn_fwb  /= 0 )   CALL sbc_fwb_adj( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
199      IF( ln_ssr       )   CALL sbc_ssr_adj( kt )                   ! add SST/SSS damping term
200      SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over ice-covered areas
201!      CASE(  1 )   ;       CALL sbc_ice_if_adj ( kt )                     ! Ice-cover climatology ("Ice-if" model)
202         !
203!      CASE(  2 )   ;       CALL sbc_ice_lim_2_adj( kt, nsbc )             ! LIM 2.0 ice model
204         !
205!      CASE(  3 )   ;       CALL sbc_ice_lim_adj  ( kt, nsbc, nn_ico_cpl)  ! LIM 3.0 ice model
206      END SELECT
207      ! sbc formulation
208      ! ---------------
209
210      SELECT CASE( nsbc )                        ! Compute ocean surface boundary condition
211      !                                          ! (i.e. utau,vtau, qns, qsr, emp, emps)
212      CASE(  0 )   ;   CALL sbc_gyre_adj    ( kt )      ! analytical formulation : GYRE configuration
213!      CASE(  1 )   ;   CALL sbc_ana_adj     ( kt )      ! analytical formulation : uniform sbc
214      CASE(  2 )   ;   CALL sbc_flx_adj     ( kt )      ! flux formulation
215!      CASE(  3 )   ;   CALL sbc_blk_clio_adj( kt )      ! bulk formulation : CLIO for the ocean
216!      CASE(  4 )   ;   CALL sbc_blk_core_adj( kt )      ! bulk formulation : CORE for the ocean
217!      CASE(  5 )   ;   CALL sbc_cpl_adj     ( kt )      ! coupled formulation
218       !CASE(  6 )  ;   CALL sbc_sqb_adj     ( kt )
219      END SELECT
220      ! ocean to sbc mean sea surface variables (ss._m)
221      ! ---------------------------------------
222      CALL sbc_ssm_adj( kt )                         ! sea surface mean currents (at U- and V-points),
223      !                                          ! temperature and salinity (at T-point) over nf_sbc time-step
224      !                                          ! (i.e. sst_m, sss_m, ssu_m, ssv_m)
225
226
227   END SUBROUTINE sbc_adj
228   SUBROUTINE sbc_adj_tst( kumadt )
229      !!-----------------------------------------------------------------------
230      !!
231      !!                  ***  ROUTINE sbc_adj_tst ***
232      !!
233      !! ** Purpose : Test the adjoint routine.
234      !!
235      !! ** Method  : Verify the scalar product
236      !!
237      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
238      !!
239      !!              where  L   = tangent routine
240      !!                     L^T = adjoint routine
241      !!                     W   = diagonal matrix of scale factors
242      !!                     dx  = input perturbation (random field)
243      !!                     dy  = L dx
244      !!
245      !!-----------------------------------------------------------------------
246      !! * Modules used
247
248      !! * Arguments
249      INTEGER, INTENT(IN) :: &
250         & kumadt             ! Output unit
251      CALL sbc_fwb_adj_tst( kumadt )       ! control the freshwater budget
252      CALL sbc_ssr_adj_tst( kumadt )       ! add SST/SSS damping term
253!!      CALL sbc_rnf_adj_tst( kumadt )       ! add runoffs to fresh water fluxes
254!!      CALL sbc_ice_if_adj_tst( kumadt )    ! Ice-cover climatology ("Ice-if" model)
255!!      CALL sbc_ice_lim_2_adj_tst( kumadt ) ! LIM 2.0 ice model
256!!      CALL sbc_ice_lim_adj_tst( kumadt )   ! LIM 3.0 ice model
[3640]257#if defined key_gyre
[3612]258      CALL sbc_gyre_adj_tst( kumadt )      ! analytical formulation : GYRE configuration
[3640]259#endif
[3611]260!!      CALL sbc_ana_adj_tst( kumadt )       ! analytical formulation : uniform sbc
261      CALL sbc_flx_adj_tst( kumadt )        ! flux formulation
262!      CALL sbc_blk_clio_adj_tst( kumadt )  ! bulk formulation : CLIO for the ocean
263!      CALL sbc_blk_core_adj_tst( kumadt )  ! bulk formulation : CORE for the ocean
264!      CALL sbc_cpl_adj_tst( kumadt )       ! coupled formulation
265      CALL sbc_ssm_adj_tst( kumadt )       ! sea surface mean currents (at U- and V-points),
266      IF( nn_closea == 1 ) CALL sbc_clo_adj_tst( kumadt )       ! closed seas,
267
268   END SUBROUTINE sbc_adj_tst
269   !!======================================================================
270#endif
271END MODULE sbcmod_tam
Note: See TracBrowser for help on using the repository browser.