source: NEMO/trunk/src/OCE/TRA/trabbl.F90 @ 13226

Last change on this file since 13226 was 13226, checked in by orioltp, 3 months ago

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

  • Property svn:keywords set to Id
File size: 31.3 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 "do_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, pts, 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      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation
106      !
107      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
108      !!----------------------------------------------------------------------
109      !
110      IF( ln_timing )   CALL timing_start( 'tra_bbl')
111      !
112      IF( l_trdtra )   THEN                         !* Save the T-S input trends
113         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
114         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
115         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
116      ENDIF
117
118      IF( l_bbl )   CALL bbl( kt, nit000, 'TRA', Kbb, Kmm )   !* bbl coef. and transport (only if not already done in trcbbl)
119
120      IF( nn_bbl_ldf == 1 ) THEN                    !* Diffusive bbl
121         !
122         CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm )
123         IF( sn_cfctl%l_prtctl )  &
124         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, &
125            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
126         ! lateral boundary conditions ; just need for outputs
127         CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp )
128         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef
129         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
130         !
131      ENDIF
132      !
133      IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl
134         !
135         CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm )
136         IF(sn_cfctl%l_prtctl)   &
137         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   &
138            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
139         ! lateral boundary conditions ; just need for outputs
140         CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp )
141         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport
142         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
143         !
144      ENDIF
145
146      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics
147         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
148         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
149         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt )
150         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds )
151         DEALLOCATE( ztrdt, ztrds )
152      ENDIF
153      !
154      IF( ln_timing )  CALL timing_stop( 'tra_bbl')
155      !
156   END SUBROUTINE tra_bbl
157
158
159   SUBROUTINE tra_bbl_dif( pt, pt_rhs, kjpt, Kmm )
160      !!----------------------------------------------------------------------
161      !!                  ***  ROUTINE tra_bbl_dif  ***
162      !!
163      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
164      !!                advection terms.
165      !!
166      !! ** Method  : * diffusive bbl only (nn_bbl_ldf=1) :
167      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
168      !!      along bottom slope gradient) an additional lateral 2nd order
169      !!      diffusion along the bottom slope is added to the general
170      !!      tracer trend, otherwise the additional trend is set to 0.
171      !!      A typical value of ahbt is 2000 m2/s (equivalent to
172      !!      a downslope velocity of 20 cm/s if the condition for slope
173      !!      convection is satified)
174      !!
175      !! ** Action  :   pt_rhs   increased by the bbl diffusive trend
176      !!
177      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
178      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
179      !!----------------------------------------------------------------------
180      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
181      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields
182      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend
183      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices
184      !
185      INTEGER  ::   ji, jj, jn   ! dummy loop indices
186      INTEGER  ::   ik           ! local integers
187      REAL(wp) ::   zbtr         ! local scalars
188      REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! workspace
189      !!----------------------------------------------------------------------
190      !
191      DO jn = 1, kjpt                                     ! tracer loop
192         !                                                ! ===========
193         DO_2D_11_11
194            ik = mbkt(ji,jj)                             ! bottom T-level index
195            zptb(ji,jj) = pt(ji,jj,ik,jn)                ! bottom before T and S
196         END_2D
197         !               
198         DO_2D_00_00
199            ik = mbkt(ji,jj)                            ! bottom T-level index
200            pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn)                                                  &
201               &                + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     &
202               &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     &
203               &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     &
204               &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  &
205               &                * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm)
206         END_2D
207         !                                                  ! ===========
208      END DO                                                ! end tracer
209      !                                                     ! ===========
210   END SUBROUTINE tra_bbl_dif
211
212
213   SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm )
214      !!----------------------------------------------------------------------
215      !!                  ***  ROUTINE trc_bbl  ***
216      !!
217      !! ** Purpose :   Compute the before passive tracer trend associated
218      !!     with the bottom boundary layer and add it to the general trend
219      !!     of tracer equations.
220      !! ** Method  :   advective bbl (nn_bbl_adv = 1 or 2) :
221      !!      nn_bbl_adv = 1   use of the ocean near bottom velocity as bbl velocity
222      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation i.e.
223      !!                       transport proportional to the along-slope density gradient
224      !!
225      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
226      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
227      !!----------------------------------------------------------------------
228      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers
229      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields
230      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend
231      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices
232      !
233      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
234      INTEGER  ::   iis , iid , ijs , ijd    ! local integers
235      INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       -
236      REAL(wp) ::   zbtr, ztra               ! local scalars
237      REAL(wp) ::   zu_bbl, zv_bbl           !   -      -
238      !!----------------------------------------------------------------------
239      !
240      !                                                          ! ===========
241      DO jn = 1, kjpt                                            ! tracer loop
242         !                                                       ! ===========
243         DO jj = 1, jpjm1
244            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west
245               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection
246                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf)
247                  iid  = ji + MAX( 0, mgrhu(ji,jj) )   ;   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
248                  ikud = mbku_d(ji,jj)                 ;   ikus = mbku(ji,jj)
249                  zu_bbl = ABS( utr_bbl(ji,jj) )
250                  !
251                  !                                               ! up  -slope T-point (shelf bottom point)
252                  zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm)
253                  ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr
254                  pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra
255                  !
256                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
257                     zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm)
258                     ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr
259                     pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra
260                  END DO
261                  !
262                  zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm)
263                  ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr
264                  pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra
265               ENDIF
266               !
267               IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection
268                  ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf)
269                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )     ;   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
270                  ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv(ji,jj)
271                  zv_bbl = ABS( vtr_bbl(ji,jj) )
272                  !
273                  ! up  -slope T-point (shelf bottom point)
274                  zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm)
275                  ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr
276                  pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra
277                  !
278                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
279                     zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm)
280                     ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr
281                     pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn)  + ztra
282                  END DO
283                  !                                               ! down-slope T-point (deep bottom point)
284                  zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm)
285                  ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr
286                  pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra
287               ENDIF
288            END DO
289            !
290         END DO
291         !                                                  ! ===========
292      END DO                                                ! end tracer
293      !                                                     ! ===========
294   END SUBROUTINE tra_bbl_adv
295
296
297   SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm )
298      !!----------------------------------------------------------------------
299      !!                  ***  ROUTINE bbl  ***
300      !!
301      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
302      !!                advection terms.
303      !!
304      !! ** Method  : * diffusive bbl (nn_bbl_ldf=1) :
305      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
306      !!      along bottom slope gradient) an additional lateral 2nd order
307      !!      diffusion along the bottom slope is added to the general
308      !!      tracer trend, otherwise the additional trend is set to 0.
309      !!      A typical value of ahbt is 2000 m2/s (equivalent to
310      !!      a downslope velocity of 20 cm/s if the condition for slope
311      !!      convection is satified)
312      !!              * advective bbl (nn_bbl_adv=1 or 2) :
313      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity
314      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation
315      !!        i.e. transport proportional to the along-slope density gradient
316      !!
317      !!      NB: the along slope density gradient is evaluated using the
318      !!      local density (i.e. referenced at a common local depth).
319      !!
320      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
321      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
322      !!----------------------------------------------------------------------
323      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index
324      INTEGER         , INTENT(in   ) ::   kit000   ! first time step index
325      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
326      INTEGER         , INTENT(in   ) ::   Kbb, Kmm ! ocean time level index
327      !
328      INTEGER  ::   ji, jj                    ! dummy loop indices
329      INTEGER  ::   ik                        ! local integers
330      INTEGER  ::   iis, iid, ikus, ikud      !   -       -
331      INTEGER  ::   ijs, ijd, ikvs, ikvd      !   -       -
332      REAL(wp) ::   za, zb, zgdrho            ! local scalars
333      REAL(wp) ::   zsign, zsigna, zgbbl      !   -      -
334      REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zts, zab         ! 3D workspace
335      REAL(wp), DIMENSION(jpi,jpj)        :: zub, zvb, zdep   ! 2D workspace
336      !!----------------------------------------------------------------------
337      !
338      IF( kt == kit000 )  THEN
339         IF(lwp)  WRITE(numout,*)
340         IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype
341         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~'
342      ENDIF
343      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity)
344      DO_2D_11_11
345         ik = mbkt(ji,jj)                             ! bottom T-level index
346         zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S
347         zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb)
348         !
349         zdep(ji,jj) = gdept(ji,jj,ik,Kmm)            ! bottom T-level reference depth
350         zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm)      ! bottom velocity
351         zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm)
352      END_2D
353      !
354      CALL eos_rab( zts, zdep, zab, Kmm )
355      !
356      !                                   !-------------------!
357      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
358         !                                !-------------------!
359         DO_2D_10_10
360            !                                                   ! i-direction
361            za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point
362            zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
363            !                                                         ! 2*masked bottom density gradient
364            zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
365               &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1)
366            !
367            zsign  = SIGN(  0.5_wp, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope )
368            ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff.
369            !
370            !                                                   ! j-direction
371            za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at v-point
372            zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
373            !                                                         ! 2*masked bottom density gradient
374            zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
375               &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1)
376            !
377            zsign = SIGN(  0.5_wp, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope )
378            ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj)
379         END_2D
380         !
381      ENDIF
382      !
383      !                                   !-------------------!
384      IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   !
385         !                                !-------------------!
386         SELECT CASE ( nn_bbl_adv )             !* bbl transport type
387         !
388         CASE( 1 )                                   != use of upper velocity
389            DO_2D_10_10
390               !                                                  ! i-direction
391               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
392               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
393               !                                                          ! 2*masked bottom density gradient
394               zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
395                         - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1)
396               !
397               zsign = SIGN(  0.5_wp, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope
398               zsigna= SIGN(  0.5_wp, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope
399               !
400               !                                                          ! bbl velocity
401               utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj)
402               !
403               !                                                  ! j-direction
404               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
405               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
406               !                                                          ! 2*masked bottom density gradient
407               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
408                  &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1)
409               zsign = SIGN(  0.5_wp, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope
410               zsigna= SIGN(  0.5_wp, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope
411               !
412               !                                                          ! bbl transport
413               vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj)
414            END_2D
415            !
416         CASE( 2 )                                 != bbl velocity = F( delta rho )
417            zgbbl = grav * rn_gambbl
418            DO_2D_10_10
419               !                                                  ! i-direction
420               ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
421               iid  = ji + MAX( 0, mgrhu(ji,jj) )
422               iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
423               !
424               ikud = mbku_d(ji,jj)
425               ikus = mbku(ji,jj)
426               !
427               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
428               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
429               !                                                          !   masked bottom density gradient
430               zgdrho = 0.5 * (  za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) )    &
431                  &            - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) )  ) * umask(ji,jj,1)
432               zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep
433               !
434               !                                                          ! bbl transport (down-slope direction)
435               utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) )
436               !
437               !                                                  ! j-direction
438               !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf)
439               ijd  = jj + MAX( 0, mgrhv(ji,jj) )
440               ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
441               !
442               ikvd = mbkv_d(ji,jj)
443               ikvs = mbkv(ji,jj)
444               !
445               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
446               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
447               !                                                          !   masked bottom density gradient
448               zgdrho = 0.5 * (  za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) )    &
449                  &            - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) )  ) * vmask(ji,jj,1)
450               zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep
451               !
452               !                                                          ! bbl transport (down-slope direction)
453               vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) )
454            END_2D
455         END SELECT
456         !
457      ENDIF
458      !
459   END SUBROUTINE bbl
460
461
462   SUBROUTINE tra_bbl_init
463      !!----------------------------------------------------------------------
464      !!                  ***  ROUTINE tra_bbl_init  ***
465      !!
466      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
467      !!
468      !! ** Method  :   Read the nambbl namelist and check the parameters
469      !!              called by nemo_init at the first timestep (kit000)
470      !!----------------------------------------------------------------------
471      INTEGER ::   ji, jj                      ! dummy loop indices
472      INTEGER ::   ii0, ii1, ij0, ij1, ios     ! local integer
473      REAL(wp), DIMENSION(jpi,jpj) ::   zmbku, zmbkv   ! workspace
474      !!
475      NAMELIST/nambbl/ ln_trabbl, nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
476      !!----------------------------------------------------------------------
477      !
478      READ  ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901)
479901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist' )
480      !
481      READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 )
482902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist' )
483      IF(lwm) WRITE ( numond, nambbl )
484      !
485      l_bbl = .TRUE.                 !* flag to compute bbl coef and transport
486      !
487      IF(lwp) THEN                   !* Parameter control and print
488         WRITE(numout,*)
489         WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation'
490         WRITE(numout,*) '~~~~~~~~~~~~'
491         WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
492         WRITE(numout,*) '          bottom boundary layer flag          ln_trabbl  = ', ln_trabbl
493      ENDIF
494      IF( .NOT.ln_trabbl )   RETURN
495      !
496      IF(lwp) THEN
497         WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
498         WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
499         WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
500         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
501      ENDIF
502      !
503      !                              ! allocate trabbl arrays
504      IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' )
505      !
506      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity'
507      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)'
508      !
509      !                             !* vertical index of  "deep" bottom u- and v-points
510      DO_2D_10_10
511         mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land
512         mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
513      END_2D
514      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
515      zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) 
516      CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp) 
517      mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ;  mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 )
518      !
519      !                             !* sign of grad(H) at u- and v-points; zero if grad(H) = 0
520      mgrhu(:,:) = 0   ;   mgrhv(:,:) = 0
521      DO_2D_10_10
522         IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
523            mgrhu(ji,jj) = INT(  SIGN( 1.0_wp, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
524         ENDIF
525         !
526         IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
527            mgrhv(ji,jj) = INT(  SIGN( 1.0_wp, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
528         ENDIF
529      END_2D
530      !
531      DO_2D_10_10
532         e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) )
533         e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) )
534      END_2D
535      CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp )      ! lateral boundary conditions
536      !
537      !                             !* masked diffusive flux coefficients
538      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1)
539      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1)
540      !
541   END SUBROUTINE tra_bbl_init
542
543   !!======================================================================
544END MODULE trabbl
Note: See TracBrowser for help on using the repository browser.