source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SBC/sbcmod_tam.F90 @ 3640

Last change on this file since 3640 was 3640, checked in by pabouttier, 8 years ago

Missing allocation/deallocation in TAM routines - See ticket #1013

  • Property svn:executable set to *
File size: 12.5 KB
Line 
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
92         !CALL sbc_init
93         IF( nn_ice == 0  )   fr_i_tl(:,:) = 0.e0       ! no ice in the domain, ice fraction is always zero
94         lfirst = .FALSE.
95      END IF
96      !
97   END SUBROUTINE sbc_init_tam
98
99
100   SUBROUTINE sbc_tan( kt )
101      !!---------------------------------------------------------------------
102      !!                    ***  ROUTINE sbc_tan  ***
103      !!
104      !! ** Purpose of the direct routine:
105      !!                provide at each time-step the ocean surface boundary
106      !!                condition (momentum, heat and freshwater fluxes)
107      !!
108      !! ** Method  :   blah blah  to be written ?????????
109      !!                CAUTION : never mask the surface stress field (tke sbc)
110      !!
111      !! ** Action  : - set the ocean surface boundary condition, i.e.
112      !!                utau, vtau, qns, qsr, emp, emps, qrp, erp
113      !!              - updte the ice fraction : fr_i
114      !!----------------------------------------------------------------------
115      INTEGER, INTENT(in) ::   kt       ! ocean time step
116      !!---------------------------------------------------------------------
117
118      ! ocean to sbc mean sea surface variables (ss._m)
119      ! ---------------------------------------
120      CALL sbc_ssm_tan( kt )                         ! sea surface mean currents (at U- and V-points),
121      !                                          ! temperature and salinity (at T-point) over nf_sbc time-step
122      !                                          ! (i.e. sst_m, sss_m, ssu_m, ssv_m)
123
124      ! sbc formulation
125      ! ---------------
126
127      SELECT CASE( nsbc )                        ! Compute ocean surface boundary condition
128      !                                          ! (i.e. utau,vtau, qns, qsr, emp, emps)
129      CASE(  0 )   ;   CALL sbc_gyre_tan    ( kt )      ! analytical formulation : GYRE configuration
130         ! no! in default
131      !CASE(  1 )   ;   CALL sbc_ana_tan     ( kt )      ! analytical formulation : uniform sbc
132      CASE(  2 )   ;   CALL sbc_flx_tan     ( kt )      ! flux formulation
133      !CASE(  3 )   ;   CALL sbc_blk_clio_tan( kt )      ! bulk formulation : CLIO for the ocean
134      !CASE(  4 )   ;   CALL sbc_blk_core_tan( kt )      ! bulk formulation : CORE for the ocean
135      !CASE(  5 )   ;   CALL sbc_cpl_tan     ( kt )      ! coupled formulation
136      CASE( 6 )     ;  CALL sbc_sqb_tan     (kt)
137      END SELECT
138
139      ! Misc. Options
140      ! -------------
141      ! not available
142!*B      SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over sea-ice areas
143!*B      CASE(  1 )   ;       CALL sbc_ice_if_tan   ( kt )                   ! Ice-cover climatology ("Ice-if" model)
144!*B         !
145!*B      CASE(  2 )   ;       CALL sbc_ice_lim_2_tan( kt, nsbc )             ! LIM 2.0 ice model
146!*B         !
147!*B      CASE(  3 )   ;       CALL sbc_ice_lim_tan  ( kt, nsbc, nn_ico_cpl)  ! LIM 3.0 ice model
148!*B      END SELECT
149
150      ! add runoffs to fresh water fluxes... not needed in tangent
151
152      IF( ln_ssr       )   CALL sbc_ssr_tan( kt )                   ! add SST/SSS damping term
153
154      IF( nn_fwb  /= 0 )   CALL sbc_fwb_tan( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
155
156      IF( nn_closea == 1 )   CALL sbc_clo_tan( kt )                   ! treatment of closed sea in the model domain
157      !                                                         ! (update freshwater fluxes)
158      !
159!RBbug do not understand why see ticket 667
160      CALL lbc_lnk( emp_tl, 'T', 1. )
161      !
162      !
163   END SUBROUTINE sbc_tan
164
165   !!======================================================================
166   SUBROUTINE sbc_adj( kt )
167      !!---------------------------------------------------------------------
168      !!                    ***  ROUTINE sbc_adj  ***
169      !!
170      !! ** Purpose of the direct routine:
171      !!                provide at each time-step the ocean surface boundary
172      !!                condition (momentum, heat and freshwater fluxes)
173      !!
174      !! ** Method  :   blah blah  to be written ?????????
175      !!                CAUTION : never mask the surface stress field (tke sbc)
176      !!
177      !! ** Action  : - set the ocean surface boundary condition, i.e.
178      !!                utau, vtau, qns, qsr, emp, emps, qrp, erp
179      !!              - updte the ice fraction : fr_i
180      !!----------------------------------------------------------------------
181      INTEGER, INTENT(in) ::   kt       ! ocean time step
182      !!---------------------------------------------------------------------
183
184      ! Misc. Options
185      ! -------------
186!RBbug do not understand why see ticket 667
187      CALL lbc_lnk_adj( emp_ad, 'T', 1. )
188      !
189      IF( nn_closea == 1 )   CALL sbc_clo_adj( kt )                   ! treatment of closed sea in the model domain
190      IF( nn_fwb  /= 0 )   CALL sbc_fwb_adj( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
191      IF( ln_ssr       )   CALL sbc_ssr_adj( kt )                   ! add SST/SSS damping term
192      SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over ice-covered areas
193!      CASE(  1 )   ;       CALL sbc_ice_if_adj ( kt )                     ! Ice-cover climatology ("Ice-if" model)
194         !
195!      CASE(  2 )   ;       CALL sbc_ice_lim_2_adj( kt, nsbc )             ! LIM 2.0 ice model
196         !
197!      CASE(  3 )   ;       CALL sbc_ice_lim_adj  ( kt, nsbc, nn_ico_cpl)  ! LIM 3.0 ice model
198      END SELECT
199      ! sbc formulation
200      ! ---------------
201
202      SELECT CASE( nsbc )                        ! Compute ocean surface boundary condition
203      !                                          ! (i.e. utau,vtau, qns, qsr, emp, emps)
204      CASE(  0 )   ;   CALL sbc_gyre_adj    ( kt )      ! analytical formulation : GYRE configuration
205!      CASE(  1 )   ;   CALL sbc_ana_adj     ( kt )      ! analytical formulation : uniform sbc
206      CASE(  2 )   ;   CALL sbc_flx_adj     ( kt )      ! flux formulation
207!      CASE(  3 )   ;   CALL sbc_blk_clio_adj( kt )      ! bulk formulation : CLIO for the ocean
208!      CASE(  4 )   ;   CALL sbc_blk_core_adj( kt )      ! bulk formulation : CORE for the ocean
209!      CASE(  5 )   ;   CALL sbc_cpl_adj     ( kt )      ! coupled formulation
210       !CASE(  6 )  ;   CALL sbc_sqb_adj     ( kt )
211      END SELECT
212      ! ocean to sbc mean sea surface variables (ss._m)
213      ! ---------------------------------------
214      CALL sbc_ssm_adj( kt )                         ! sea surface mean currents (at U- and V-points),
215      !                                          ! temperature and salinity (at T-point) over nf_sbc time-step
216      !                                          ! (i.e. sst_m, sss_m, ssu_m, ssv_m)
217
218
219   END SUBROUTINE sbc_adj
220   SUBROUTINE sbc_adj_tst( kumadt )
221      !!-----------------------------------------------------------------------
222      !!
223      !!                  ***  ROUTINE sbc_adj_tst ***
224      !!
225      !! ** Purpose : Test the adjoint routine.
226      !!
227      !! ** Method  : Verify the scalar product
228      !!
229      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
230      !!
231      !!              where  L   = tangent routine
232      !!                     L^T = adjoint routine
233      !!                     W   = diagonal matrix of scale factors
234      !!                     dx  = input perturbation (random field)
235      !!                     dy  = L dx
236      !!
237      !!-----------------------------------------------------------------------
238      !! * Modules used
239
240      !! * Arguments
241      INTEGER, INTENT(IN) :: &
242         & kumadt             ! Output unit
243      CALL sbc_fwb_adj_tst( kumadt )       ! control the freshwater budget
244      CALL sbc_ssr_adj_tst( kumadt )       ! add SST/SSS damping term
245!!      CALL sbc_rnf_adj_tst( kumadt )       ! add runoffs to fresh water fluxes
246!!      CALL sbc_ice_if_adj_tst( kumadt )    ! Ice-cover climatology ("Ice-if" model)
247!!      CALL sbc_ice_lim_2_adj_tst( kumadt ) ! LIM 2.0 ice model
248!!      CALL sbc_ice_lim_adj_tst( kumadt )   ! LIM 3.0 ice model
249#if defined key_gyre
250      CALL sbc_gyre_adj_tst( kumadt )      ! analytical formulation : GYRE configuration
251#endif
252!!      CALL sbc_ana_adj_tst( kumadt )       ! analytical formulation : uniform sbc
253      CALL sbc_flx_adj_tst( kumadt )        ! flux formulation
254!      CALL sbc_blk_clio_adj_tst( kumadt )  ! bulk formulation : CLIO for the ocean
255!      CALL sbc_blk_core_adj_tst( kumadt )  ! bulk formulation : CORE for the ocean
256!      CALL sbc_cpl_adj_tst( kumadt )       ! coupled formulation
257      CALL sbc_ssm_adj_tst( kumadt )       ! sea surface mean currents (at U- and V-points),
258      IF( nn_closea == 1 ) CALL sbc_clo_adj_tst( kumadt )       ! closed seas,
259
260   END SUBROUTINE sbc_adj_tst
261   !!======================================================================
262#endif
263END MODULE sbcmod_tam
Note: See TracBrowser for help on using the repository browser.