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.
trabbl.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbl.F90 @ 10954

Last change on this file since 10954 was 10954, checked in by acc, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert TRA modules and all knock on effects of these conversions. SETTE tested
  • Property svn:keywords set to Id
File size: 32.5 KB
Line 
1MODULE trabbl
2   !!==============================================================================
3   !!                       ***  MODULE  trabbl  ***
4   !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
5   !!==============================================================================
6   !! History :  OPA  ! 1996-06  (L. Mortier)  Original code
7   !!            8.0  ! 1997-11  (G. Madec)    Optimization
8   !!   NEMO     1.0  ! 2002-08  (G. Madec)  free form + modules
9   !!             -   ! 2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl
10   !!            3.3  ! 2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization
11   !!             -   ! 2010-04  (G. Madec)  Campin & Goosse advective bbl
12   !!             -   ! 2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
13   !!             -   ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
14   !!             -   ! 2013-04  (F. Roquet, G. Madec)  use of eosbn2 instead of local hard coded alpha and beta
15   !!            4.0  ! 2017-04  (G. Madec)  ln_trabbl namelist variable instead of a CPP key
16   !!----------------------------------------------------------------------
17
18   !!----------------------------------------------------------------------
19   !!   tra_bbl_alloc : allocate trabbl arrays
20   !!   tra_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
21   !!   tra_bbl_dif   : generic routine to compute bbl diffusive trend
22   !!   tra_bbl_adv   : generic routine to compute bbl advective trend
23   !!   bbl           : computation of bbl diffu. flux coef. & transport in bottom boundary layer
24   !!   tra_bbl_init  : initialization, namelist read, parameters control
25   !!----------------------------------------------------------------------
26   USE oce            ! ocean dynamics and active tracers
27   USE dom_oce        ! ocean space and time domain
28   USE phycst         ! physical constant
29   USE eosbn2         ! equation of state
30   USE trd_oce        ! trends: ocean variables
31   USE trdtra         ! trends: active tracers
32   !
33   USE iom            ! IOM library               
34   USE in_out_manager ! I/O manager
35   USE lbclnk         ! ocean lateral boundary conditions
36   USE prtctl         ! Print control
37   USE timing         ! Timing
38   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
39
40   IMPLICIT NONE
41   PRIVATE
42
43   PUBLIC   tra_bbl       !  routine called by step.F90
44   PUBLIC   tra_bbl_init  !  routine called by nemogcm.F90
45   PUBLIC   tra_bbl_dif   !  routine called by trcbbl.F90
46   PUBLIC   tra_bbl_adv   !     -      -          -
47   PUBLIC   bbl           !  routine called by trcbbl.F90 and dtadyn.F90
48
49   !                                !!* Namelist nambbl *
50   LOGICAL , PUBLIC ::   ln_trabbl   !: bottom boundary layer flag
51   INTEGER , PUBLIC ::   nn_bbl_ldf  !: =1   : diffusive bbl or not (=0)
52   INTEGER , PUBLIC ::   nn_bbl_adv  !: =1/2 : advective bbl or not (=0)
53   !                                            !  =1 : advective bbl using the bottom ocean velocity
54   !                                            !  =2 :     -      -  using utr_bbl proportional to grad(rho)
55   REAL(wp), PUBLIC ::   rn_ahtbbl   !: along slope bbl diffusive coefficient [m2/s]
56   REAL(wp), PUBLIC ::   rn_gambbl   !: lateral coeff. for bottom boundary layer scheme [s]
57
58   LOGICAL , PUBLIC ::   l_bbl       !: flag to compute bbl diffu. flux coef and transport
59
60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer
61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coeff. at u & v-pts
62
63   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level (PUBLIC for TAM)
64   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM)
65   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
66   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM)
67
68   !! * Substitutions
69#  include "vectopt_loop_substitute.h90"
70   !!----------------------------------------------------------------------
71   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
72   !! $Id$
73   !! Software governed by the CeCILL license (see ./LICENSE)
74   !!----------------------------------------------------------------------
75CONTAINS
76
77   INTEGER FUNCTION tra_bbl_alloc()
78      !!----------------------------------------------------------------------
79      !!                ***  FUNCTION tra_bbl_alloc  ***
80      !!----------------------------------------------------------------------
81      ALLOCATE( utr_bbl  (jpi,jpj) , ahu_bbl  (jpi,jpj) , mbku_d(jpi,jpj) , mgrhu(jpi,jpj) ,     &
82         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d(jpi,jpj) , mgrhv(jpi,jpj) ,     &
83         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                        &
84         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) ,                                    STAT=tra_bbl_alloc )
85         !
86      CALL mpp_sum ( 'trabbl', tra_bbl_alloc )
87      IF( tra_bbl_alloc > 0 )   CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.')
88   END FUNCTION tra_bbl_alloc
89
90
91   SUBROUTINE tra_bbl( kt, Kbb, Kmm, Krhs )
92      !!----------------------------------------------------------------------
93      !!                  ***  ROUTINE bbl  ***
94      !!
95      !! ** Purpose :   Compute the before tracer (t & s) trend associated
96      !!              with the bottom boundary layer and add it to the general
97      !!              trend of tracer equations.
98      !!
99      !! ** Method  :   Depending on namtra_bbl namelist parameters the bbl
100      !!              diffusive and/or advective contribution to the tracer trend
101      !!              is added to the general tracer trend
102      !!----------------------------------------------------------------------
103      INTEGER, INTENT( in ) ::   kt   ! ocean time-step
104      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level indices
105      !
106      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
107      !!----------------------------------------------------------------------
108      !
109      IF( ln_timing )   CALL timing_start( 'tra_bbl')
110      !
111      IF( l_trdtra )   THEN                         !* Save the T-S input trends
112         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
113         ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs)
114         ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs)
115      ENDIF
116
117      IF( l_bbl )   CALL bbl( kt, nit000, 'TRA', Kbb, Kmm )   !* bbl coef. and transport (only if not already done in trcbbl)
118
119      IF( nn_bbl_ldf == 1 ) THEN                    !* Diffusive bbl
120         !
121         CALL tra_bbl_dif( ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, Kmm )
122         IF( ln_ctl )  &
123         CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, &
124            &          tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
125         ! lateral boundary conditions ; just need for outputs
126         CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. )
127         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef
128         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
129         !
130      ENDIF
131      !
132      IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl
133         !
134         CALL tra_bbl_adv( ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, Kmm )
135         IF(ln_ctl)   &
136         CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   &
137            &          tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
138         ! lateral boundary conditions ; just need for outputs
139         CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. )
140         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport
141         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
142         !
143      ENDIF
144
145      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics
146         ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
147         ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
148         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt )
149         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds )
150         DEALLOCATE( ztrdt, ztrds )
151      ENDIF
152      !
153      IF( ln_timing )  CALL timing_stop( 'tra_bbl')
154      !
155   END SUBROUTINE tra_bbl
156
157
158   SUBROUTINE tra_bbl_dif( ptb, pta, kjpt, Kmm )
159      !!----------------------------------------------------------------------
160      !!                  ***  ROUTINE tra_bbl_dif  ***
161      !!
162      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
163      !!                advection terms.
164      !!
165      !! ** Method  : * diffusive bbl only (nn_bbl_ldf=1) :
166      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
167      !!      along bottom slope gradient) an additional lateral 2nd order
168      !!      diffusion along the bottom slope is added to the general
169      !!      tracer trend, otherwise the additional trend is set to 0.
170      !!      A typical value of ahbt is 2000 m2/s (equivalent to
171      !!      a downslope velocity of 20 cm/s if the condition for slope
172      !!      convection is satified)
173      !!
174      !! ** Action  :   pta   increased by the bbl diffusive trend
175      !!
176      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
177      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
178      !!----------------------------------------------------------------------
179      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
180      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
181      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend
182      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices
183      !
184      INTEGER  ::   ji, jj, jn   ! dummy loop indices
185      INTEGER  ::   ik           ! local integers
186      REAL(wp) ::   zbtr         ! local scalars
187      REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! workspace
188      !!----------------------------------------------------------------------
189      !
190      DO jn = 1, kjpt                                     ! tracer loop
191         !                                                ! ===========
192         DO jj = 1, jpj
193            DO ji = 1, jpi
194               ik = mbkt(ji,jj)                             ! bottom T-level index
195               zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S
196            END DO
197         END DO
198         !               
199         DO jj = 2, jpjm1                                    ! Compute the trend
200            DO ji = 2, jpim1
201               ik = mbkt(ji,jj)                            ! bottom T-level index
202               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  &
203                  &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     &
204                  &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     &
205                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     &
206                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  &
207                  &             * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm)
208            END DO
209         END DO
210         !                                                  ! ===========
211      END DO                                                ! end tracer
212      !                                                     ! ===========
213   END SUBROUTINE tra_bbl_dif
214
215
216   SUBROUTINE tra_bbl_adv( ptb, pta, kjpt, Kmm )
217      !!----------------------------------------------------------------------
218      !!                  ***  ROUTINE trc_bbl  ***
219      !!
220      !! ** Purpose :   Compute the before passive tracer trend associated
221      !!     with the bottom boundary layer and add it to the general trend
222      !!     of tracer equations.
223      !! ** Method  :   advective bbl (nn_bbl_adv = 1 or 2) :
224      !!      nn_bbl_adv = 1   use of the ocean near bottom velocity as bbl velocity
225      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation i.e.
226      !!                       transport proportional to the along-slope density gradient
227      !!
228      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
229      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
230      !!----------------------------------------------------------------------
231      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
232      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields
233      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend
234      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices
235      !
236      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
237      INTEGER  ::   iis , iid , ijs , ijd    ! local integers
238      INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       -
239      REAL(wp) ::   zbtr, ztra               ! local scalars
240      REAL(wp) ::   zu_bbl, zv_bbl           !   -      -
241      !!----------------------------------------------------------------------
242      !
243      !                                                          ! ===========
244      DO jn = 1, kjpt                                            ! tracer loop
245         !                                                       ! ===========
246         DO jj = 1, jpjm1
247            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west
248               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection
249                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf)
250                  iid  = ji + MAX( 0, mgrhu(ji,jj) )   ;   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
251                  ikud = mbku_d(ji,jj)                 ;   ikus = mbku(ji,jj)
252                  zu_bbl = ABS( utr_bbl(ji,jj) )
253                  !
254                  !                                               ! up  -slope T-point (shelf bottom point)
255                  zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm)
256                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr
257                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra
258                  !
259                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
260                     zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm)
261                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr
262                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra
263                  END DO
264                  !
265                  zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm)
266                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr
267                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra
268               ENDIF
269               !
270               IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection
271                  ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf)
272                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )     ;   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
273                  ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv(ji,jj)
274                  zv_bbl = ABS( vtr_bbl(ji,jj) )
275                  !
276                  ! up  -slope T-point (shelf bottom point)
277                  zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm)
278                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr
279                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra
280                  !
281                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
282                     zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm)
283                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr
284                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra
285                  END DO
286                  !                                               ! down-slope T-point (deep bottom point)
287                  zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm)
288                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr
289                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra
290               ENDIF
291            END DO
292            !
293         END DO
294         !                                                  ! ===========
295      END DO                                                ! end tracer
296      !                                                     ! ===========
297   END SUBROUTINE tra_bbl_adv
298
299
300   SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm )
301      !!----------------------------------------------------------------------
302      !!                  ***  ROUTINE bbl  ***
303      !!
304      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
305      !!                advection terms.
306      !!
307      !! ** Method  : * diffusive bbl (nn_bbl_ldf=1) :
308      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
309      !!      along bottom slope gradient) an additional lateral 2nd order
310      !!      diffusion along the bottom slope is added to the general
311      !!      tracer trend, otherwise the additional trend is set to 0.
312      !!      A typical value of ahbt is 2000 m2/s (equivalent to
313      !!      a downslope velocity of 20 cm/s if the condition for slope
314      !!      convection is satified)
315      !!              * advective bbl (nn_bbl_adv=1 or 2) :
316      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity
317      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation
318      !!        i.e. transport proportional to the along-slope density gradient
319      !!
320      !!      NB: the along slope density gradient is evaluated using the
321      !!      local density (i.e. referenced at a common local depth).
322      !!
323      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
324      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
325      !!----------------------------------------------------------------------
326      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index
327      INTEGER         , INTENT(in   ) ::   kit000   ! first time step index
328      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
329      INTEGER         , INTENT(in   ) ::   Kbb, Kmm ! ocean time level index
330      !
331      INTEGER  ::   ji, jj                    ! dummy loop indices
332      INTEGER  ::   ik                        ! local integers
333      INTEGER  ::   iis, iid, ikus, ikud      !   -       -
334      INTEGER  ::   ijs, ijd, ikvs, ikvd      !   -       -
335      REAL(wp) ::   za, zb, zgdrho            ! local scalars
336      REAL(wp) ::   zsign, zsigna, zgbbl      !   -      -
337      REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zts, zab         ! 3D workspace
338      REAL(wp), DIMENSION(jpi,jpj)        :: zub, zvb, zdep   ! 2D workspace
339      !!----------------------------------------------------------------------
340      !
341      IF( kt == kit000 )  THEN
342         IF(lwp)  WRITE(numout,*)
343         IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype
344         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~'
345      ENDIF
346      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity)
347      DO jj = 1, jpj
348         DO ji = 1, jpi
349            ik = mbkt(ji,jj)                             ! bottom T-level index
350            zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb)    ! bottom before T and S
351            zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb)
352            !
353            zdep(ji,jj) = gdept(ji,jj,ik,Kmm)              ! bottom T-level reference depth
354            zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm)          ! bottom velocity
355            zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm)
356         END DO
357      END DO
358      !
359      CALL eos_rab( zts, zdep, zab, Kmm )
360      !
361      !                                   !-------------------!
362      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
363         !                                !-------------------!
364         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
365            DO ji = 1, fs_jpim1   ! vector opt.
366               !                                                   ! i-direction
367               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point
368               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
369               !                                                         ! 2*masked bottom density gradient
370               zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
371                  &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1)
372               !
373               zsign  = SIGN(  0.5, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope )
374               ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff.
375               !
376               !                                                   ! j-direction
377               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at v-point
378               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
379               !                                                         ! 2*masked bottom density gradient
380               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
381                  &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1)
382               !
383               zsign = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope )
384               ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj)
385            END DO
386         END DO
387         !
388      ENDIF
389      !
390      !                                   !-------------------!
391      IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   !
392         !                                !-------------------!
393         SELECT CASE ( nn_bbl_adv )             !* bbl transport type
394         !
395         CASE( 1 )                                   != use of upper velocity
396            DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
397               DO ji = 1, fs_jpim1   ! vector opt.
398                  !                                                  ! i-direction
399                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
400                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
401                  !                                                          ! 2*masked bottom density gradient
402                  zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
403                            - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1)
404                  !
405                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope
406                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope
407                  !
408                  !                                                          ! bbl velocity
409                  utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj)
410                  !
411                  !                                                  ! j-direction
412                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
413                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
414                  !                                                          ! 2*masked bottom density gradient
415                  zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
416                     &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1)
417                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope
418                  zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope
419                  !
420                  !                                                          ! bbl transport
421                  vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj)
422               END DO
423            END DO
424            !
425         CASE( 2 )                                 != bbl velocity = F( delta rho )
426            zgbbl = grav * rn_gambbl
427            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down
428               DO ji = 1, fs_jpim1   ! vector opt.
429                  !                                                  ! i-direction
430                  ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
431                  iid  = ji + MAX( 0, mgrhu(ji,jj) )
432                  iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
433                  !
434                  ikud = mbku_d(ji,jj)
435                  ikus = mbku(ji,jj)
436                  !
437                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
438                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
439                  !                                                          !   masked bottom density gradient
440                  zgdrho = 0.5 * (  za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) )    &
441                     &            - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) )  ) * umask(ji,jj,1)
442                  zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep
443                  !
444                  !                                                          ! bbl transport (down-slope direction)
445                  utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) )
446                  !
447                  !                                                  ! j-direction
448                  !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf)
449                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )
450                  ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
451                  !
452                  ikvd = mbkv_d(ji,jj)
453                  ikvs = mbkv(ji,jj)
454                  !
455                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
456                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
457                  !                                                          !   masked bottom density gradient
458                  zgdrho = 0.5 * (  za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) )    &
459                     &            - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) )  ) * vmask(ji,jj,1)
460                  zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep
461                  !
462                  !                                                          ! bbl transport (down-slope direction)
463                  vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) )
464               END DO
465            END DO
466         END SELECT
467         !
468      ENDIF
469      !
470   END SUBROUTINE bbl
471
472
473   SUBROUTINE tra_bbl_init
474      !!----------------------------------------------------------------------
475      !!                  ***  ROUTINE tra_bbl_init  ***
476      !!
477      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
478      !!
479      !! ** Method  :   Read the nambbl namelist and check the parameters
480      !!              called by nemo_init at the first timestep (kit000)
481      !!----------------------------------------------------------------------
482      INTEGER ::   ji, jj                      ! dummy loop indices
483      INTEGER ::   ii0, ii1, ij0, ij1, ios     ! local integer
484      REAL(wp), DIMENSION(jpi,jpj) ::   zmbku, zmbkv   ! workspace
485      !!
486      NAMELIST/nambbl/ ln_trabbl, nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
487      !!----------------------------------------------------------------------
488      !
489      REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme
490      READ  ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901)
491901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp )
492      !
493      REWIND( numnam_cfg )              ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme
494      READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 )
495902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp )
496      IF(lwm) WRITE ( numond, nambbl )
497      !
498      l_bbl = .TRUE.                 !* flag to compute bbl coef and transport
499      !
500      IF(lwp) THEN                   !* Parameter control and print
501         WRITE(numout,*)
502         WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation'
503         WRITE(numout,*) '~~~~~~~~~~~~'
504         WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
505         WRITE(numout,*) '          bottom boundary layer flag          ln_trabbl  = ', ln_trabbl
506      ENDIF
507      IF( .NOT.ln_trabbl )   RETURN
508      !
509      IF(lwp) THEN
510         WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
511         WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
512         WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
513         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
514      ENDIF
515      !
516      !                              ! allocate trabbl arrays
517      IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' )
518      !
519      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity'
520      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)'
521      !
522      !                             !* vertical index of  "deep" bottom u- and v-points
523      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv)
524         DO ji = 1, jpim1
525            mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land
526            mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
527         END DO
528      END DO
529      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
530      zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) 
531      CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1., zmbkv,'V',1.) 
532      mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ;  mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 )
533      !
534      !                             !* sign of grad(H) at u- and v-points; zero if grad(H) = 0
535      mgrhu(:,:) = 0   ;   mgrhv(:,:) = 0
536      DO jj = 1, jpjm1
537         DO ji = 1, jpim1
538            IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
539               mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
540            ENDIF
541            !
542            IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
543               mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
544            ENDIF
545         END DO
546      END DO
547      !
548      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point
549         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0)
550            e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) )
551            e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) )
552         END DO
553      END DO
554      CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1. , e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions
555      !
556      !                             !* masked diffusive flux coefficients
557      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1)
558      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1)
559      !
560   END SUBROUTINE tra_bbl_init
561
562   !!======================================================================
563END MODULE trabbl
Note: See TracBrowser for help on using the repository browser.