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 trunk/NEMO/OPA_SRC/TRA – NEMO

source: trunk/NEMO/OPA_SRC/TRA/trabbl.F90 @ 467

Last change on this file since 467 was 457, checked in by opalod, 18 years ago

nemo_v1_update_049:RB: reorganization of tracers part, remove traadv_cen2_atsk.h90 traldf_iso_zps.F90 trazdf_iso.F90 trazdf_iso_vopt.F90, change atsk routines to jki
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 22.4 KB
Line 
1MODULE trabbl
2   !!==============================================================================
3   !!                       ***  MODULE  trabbl  ***
4   !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
5   !!==============================================================================
6#if   defined key_trabbl_dif   ||   defined key_trabbl_adv   || defined key_esopa
7   !!----------------------------------------------------------------------
8   !!   'key_trabbl_dif'   or            diffusive bottom boundary layer
9   !!   'key_trabbl_adv'                 advective bottom boundary layer
10   !!----------------------------------------------------------------------
11   !!   tra_bbl_dif  : update the active tracer trends due to the bottom
12   !!                  boundary layer (diffusive only)
13   !!   tra_bbl_adv  : update the active tracer trends due to the bottom
14   !!                  boundary layer (advective and/or diffusive)
15   !!   tra_bbl_init : initialization, namlist read, parameters control
16   !!----------------------------------------------------------------------
17   !! * Modules used
18   USE oce                  ! ocean dynamics and active tracers
19   USE dom_oce              ! ocean space and time domain
20   USE trdmod_oce           ! ocean variables trends
21   USE in_out_manager       ! I/O manager
22   USE prtctl               ! Print control
23
24   IMPLICIT NONE
25   PRIVATE
26
27   !! * Routine accessibility
28   PUBLIC tra_bbl_dif    ! routine called by step.F90
29   PUBLIC tra_bbl_adv    ! routine called by step.F90
30
31   !! * Shared module variables
32   REAL(wp), PUBLIC ::            &  !!: * bbl namelist *
33      atrbbl = 1.e+3                  !: lateral coeff. for bottom boundary
34      !                               !  layer scheme (m2/s)
35# if defined key_trabbl_dif
36   LOGICAL, PUBLIC, PARAMETER ::   &  !:
37      lk_trabbl_dif = .TRUE.          !: diffusive bottom boundary layer flag
38# else
39   LOGICAL, PUBLIC, PARAMETER ::   &  !:
40      lk_trabbl_dif = .FALSE.         !: diffusive bottom boundary layer flag
41# endif
42
43# if defined key_trabbl_adv
44   LOGICAL, PUBLIC, PARAMETER ::    &  !:
45      lk_trabbl_adv = .TRUE.   !: advective bottom boundary layer flag
46   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
47       u_bbl, v_bbl,  &  !: velocity involved in exhanges in the advective BBL
48       w_bbl             !: vertical increment of velocity due to advective BBL
49       !                 !  only affect tracer vertical advection
50# else
51   LOGICAL, PUBLIC, PARAMETER ::    &  !:
52      lk_trabbl_adv = .FALSE.  !: advective bottom boundary layer flag
53# endif
54
55   !! * Module variables
56   INTEGER, DIMENSION(jpi,jpj) ::   &  !:
57      mbkt,           &   ! vertical index of the bottom ocean T-level
58      mbku, mbkv          ! vertical index of the bottom ocean U/V-level
59
60   !! * Substitutions
61#  include "domzgr_substitute.h90"
62#  include "vectopt_loop_substitute.h90"
63   !!----------------------------------------------------------------------
64   !!   OPA 9.0 , LOCEAN-IPSL (2005)
65   !! $Header$
66   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
67   !!----------------------------------------------------------------------
68
69CONTAINS
70
71   SUBROUTINE tra_bbl_dif( kt )
72      !!----------------------------------------------------------------------
73      !!                   ***  ROUTINE tra_bbl_dif  ***
74      !!
75      !! ** Purpose :   Compute the before tracer (t & s) trend associated
76      !!      with the bottom boundary layer and add it to the general trend
77      !!      of tracer equations. The bottom boundary layer is supposed to be
78      !!      a purely diffusive bottom boundary layer.
79      !!
80      !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad
81      !!      is an along bottom slope gradient) an additional lateral diffu-
82      !!      sive trend along the bottom slope is added to the general tracer
83      !!      trend, otherwise nothing is done.
84      !!      Second order operator (laplacian type) with variable coefficient
85      !!      computed as follow for temperature (idem on s):
86      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
87      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
88      !!      where ztb is a 2D array: the bottom ocean temperature and ahtb
89      !!      is a time and space varying diffusive coefficient defined by:
90      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
91      !!              = 0.       otherwise.
92      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
93      !!      is evaluated using the local density (i.e. referenced at the
94      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
95      !!      a downslope velocity of 20 cm/s if the condition for slope
96      !!      convection is satified)
97      !!      Add this before trend to the general trend (ta,sa) of the
98      !!      botton ocean tracer point:
99      !!         ta = ta + difft
100      !!
101      !! ** Action  : - update (ta,sa) at the bottom level with the bottom
102      !!                boundary layer trend
103      !!              - save the trends in tldfbbl/sldfbbl ('key_trdtra')
104      !!
105      !! References :
106      !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
107      !!
108      !! History :
109      !!   8.0  !  96-06  (L. Mortier)  Original code
110      !!   8.0  !  97-11  (G. Madec)  Optimization
111      !!   8.5  !  02-08  (G. Madec)  free form + modules
112      !!   9.0  !  04-08  (C. Talandier) New trends organization
113      !!----------------------------------------------------------------------
114      !! * Modules used     
115      USE oce, ONLY :    ztdta => ua,     & ! use ua as 3D workspace   
116                         ztdsa => va        ! use va as 3D workspace   
117      USE eosbn2 , ONLY : neos              ! type of equation of state
118
119      !! * Arguments
120      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
121
122      !! * Local declarations
123      INTEGER ::   ji, jj                   ! dummy loop indices
124      INTEGER ::   ik
125      INTEGER ::   ii0, ii1, ij0, ij1       ! temporary integers
126      INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers
127      REAL(wp) ::   ze3u, ze3v              ! temporary scalars
128      INTEGER ::   iku, ikv
129      REAL(wp) ::   &
130         zsign, zt, zs, zh, zalbet,      &  ! temporary scalars
131         zgdrho, zbtr, zta, zsa
132      REAL(wp), DIMENSION(jpi,jpj) ::    &
133        zki, zkj, zkw, zkx, zky, zkz,    &  ! temporary workspace arrays
134        ztnb, zsnb, zdep,                &
135        ztbb, zsbb, zahu, zahv
136      REAL(wp) ::   &
137         fsalbt, pft, pfs, pfh              ! statement function
138      !!----------------------------------------------------------------------
139      ! ratio alpha/beta
140      ! ================
141      !  fsalbt: ratio of thermal over saline expension coefficients
142      !       pft :  potential temperature in degrees celcius
143      !       pfs :  salinity anomaly (s-35) in psu
144      !       pfh :  depth in meters
145
146      fsalbt( pft, pfs, pfh ) =                                              &
147         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
148                                   - 0.203814e-03 ) * pft                    &
149                                   + 0.170907e-01 ) * pft                    &
150                                   + 0.665157e-01                            &
151         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
152         +  ( ( - 0.302285e-13 * pfh                                         &
153                - 0.251520e-11 * pfs                                         &
154                + 0.512857e-12 * pft * pft          ) * pfh                  &
155                                     - 0.164759e-06   * pfs                  &
156             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
157                                     + 0.380374e-04 ) * pfh   
158      !!----------------------------------------------------------------------
159
160      IF( kt == nit000 )   CALL tra_bbl_init
161
162      ! Save ta and sa trends
163      IF( l_trdtra )   THEN
164         ztdta(:,:,:) = ta(:,:,:) 
165         ztdsa(:,:,:) = sa(:,:,:) 
166      ENDIF
167
168      ! 0. 2D fields of bottom temperature and salinity, and bottom slope
169      ! -----------------------------------------------------------------
170      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
171
172#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
173      jj = 1
174      DO ji = 1, jpij   ! vector opt. (forced unrolling)
175#  else
176      DO jj = 1, jpj
177         DO ji = 1, jpi
178#  endif
179            ik = mbkt(ji,jj)                              ! index of the bottom ocean T-level
180            ztnb(ji,jj) = tn(ji,jj,ik) * tmask(ji,jj,1)   ! masked now T and S at ocean bottom
181            zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1)
182            ztbb(ji,jj) = tb(ji,jj,ik) * tmask(ji,jj,1)   ! masked before T and S at ocean bottom
183            zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1)
184            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level
185#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
186         END DO
187#  endif
188      END DO
189
190      IF( ln_zps ) THEN      ! partial steps correction
191# if defined key_vectopt_loop   &&   ! defined key_mpp_omp
192         jj = 1
193         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
194# else
195         DO jj = 1, jpjm1
196            DO ji = 1, jpim1
197# endif
198               iku1 = MAX( mbathy(ji+1,jj  )-1, 1 )
199               iku2 = MAX( mbathy(ji  ,jj  )-1, 1 )
200               ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 )
201               ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 )
202               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
203               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
204               zahu(ji,jj) = atrbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1)
205               zahv(ji,jj) = atrbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1)
206# if ! defined key_vectopt_loop   ||   defined key_mpp_omp
207            END DO
208# endif
209         END DO
210      ELSE                    ! z-coordinate - full steps or s-coordinate
211#   if defined key_vectopt_loop   &&   ! defined key_mpp_omp
212         jj = 1
213         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
214#   else
215         DO jj = 1, jpjm1
216            DO ji = 1, jpim1
217#   endif
218               iku = mbku(ji,jj)
219               ikv = mbkv(ji,jj)
220               zahu(ji,jj) = atrbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1)
221               zahv(ji,jj) = atrbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1)
222#   if ! defined key_vectopt_loop   ||   defined key_mpp_omp
223            END DO
224#   endif
225         END DO
226      ENDIF
227
228      ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
229      ! --------------------------------------------
230      ! Sign of the local density gradient along the i- and j-slopes
231      ! multiplied by the slope of the ocean bottom
232
233      SELECT CASE ( neos )
234
235      CASE ( 0   )               ! 0 :Jackett and McDougall (1994) formulation
236
237#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
238      jj = 1
239      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
240#  else
241      DO jj = 1, jpjm1
242         DO ji = 1, jpim1
243#  endif
244            ! temperature, salinity anomalie and depth
245            zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
246            zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
247            zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
248            ! masked ratio alpha/beta
249            zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1)
250            ! local density gradient along i-bathymetric slope
251            zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
252                   -          ( zsnb(ji+1,jj) - zsnb(ji,jj) )
253            ! sign of local i-gradient of density multiplied by the i-slope
254            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
255            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
256#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
257         END DO
258#  endif
259      END DO
260
261#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
262      jj = 1
263      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
264#  else
265      DO jj = 1, jpjm1
266         DO ji = 1, jpim1
267#  endif
268            ! temperature, salinity anomalie and depth
269            zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
270            zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
271            zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
272            ! masked ratio alpha/beta
273            zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1)
274            ! local density gradient along j-bathymetric slope
275            zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
276                   -          ( zsnb(ji,jj+1) - zsnb(ji,jj) )
277            ! sign of local j-gradient of density multiplied by the j-slope
278            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
279            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
280#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
281         END DO
282#  endif
283      END DO
284
285      CASE ( 1 )               ! Linear formulation function of temperature only
286                               !
287#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
288      jj = 1
289      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
290#  else
291      DO jj = 1, jpjm1
292         DO ji = 1, jpim1
293#  endif
294            ! local 'density/temperature' gradient along i-bathymetric slope
295            zgdrho =  ztnb(ji+1,jj) - ztnb(ji,jj) 
296            ! sign of local i-gradient of density multiplied by the i-slope
297            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
298            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
299#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
300         END DO
301#  endif
302      END DO
303
304#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
305      jj = 1
306      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
307#  else
308      DO jj = 1, jpjm1
309         DO ji = 1, jpim1
310#  endif
311            ! local density gradient along j-bathymetric slope
312            zgdrho =  ztnb(ji,jj+1) - ztnb(ji,jj) 
313            ! sign of local j-gradient of density multiplied by the j-slope
314            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
315            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
316#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
317         END DO
318#  endif
319      END DO
320
321      CASE ( 2 )               ! Linear formulation function of temperature and salinity
322
323         IF(lwp) WRITE(numout,cform_err)
324         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )'
325         IF(lwp) WRITE(numout,*) '          bbl not implented: easy to do it '
326         nstop = nstop + 1
327
328      CASE DEFAULT
329
330         IF(lwp) WRITE(numout,cform_err)
331         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
332         nstop = nstop + 1
333
334      END SELECT
335
336      ! 2. Additional second order diffusive trends
337      ! -------------------------------------------
338
339      ! first derivative (gradient)
340#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
341      jj = 1
342      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
343#  else
344      DO jj = 1, jpjm1
345         DO ji = 1, jpim1
346#  endif
347            zkx(ji,jj) = zki(ji,jj) * ( ztbb(ji+1,jj) - ztbb(ji,jj) )
348            zkz(ji,jj) = zki(ji,jj) * ( zsbb(ji+1,jj) - zsbb(ji,jj) )
349
350            zky(ji,jj) = zkj(ji,jj) * ( ztbb(ji,jj+1) - ztbb(ji,jj) )
351            zkw(ji,jj) = zkj(ji,jj) * ( zsbb(ji,jj+1) - zsbb(ji,jj) )
352#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
353         END DO
354#  endif
355      END DO
356
357      IF( cp_cfg == "orca" ) THEN
358
359         SELECT CASE ( jp_cfg )
360         !                                           ! =======================
361         CASE ( 2 )                                  !  ORCA_R2 configuration
362            !                                        ! =======================
363            ! Gibraltar enhancement of BBL
364            ij0 = 102   ;   ij1 = 102
365            ii0 = 139   ;   ii1 = 140 
366            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
367            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
368
369            ! Red Sea enhancement of BBL
370            ij0 =  88   ;   ij1 =  88
371            ii0 = 161   ;   ii1 = 162
372            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
373            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
374
375            !                                        ! =======================
376         CASE ( 4 )                                  !  ORCA_R4 configuration
377            !                                        ! =======================
378            ! Gibraltar enhancement of BBL
379            ij0 =  52   ;   ij1 =  52
380            ii0 =  70   ;   ii1 =  71 
381            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
382            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
383
384         END SELECT
385
386      ENDIF
387
388
389      ! second derivative (divergence) and add to the general tracer trend
390#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
391      jj = 1
392      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
393#  else
394      DO jj = 2, jpjm1
395         DO ji = 2, jpim1
396#  endif
397            ik = max( mbathy(ji,jj)-1, 1 )
398            zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) )
399            zta = (  zkx(ji,jj) - zkx(ji-1,jj  )    &
400                   + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr
401            zsa = (  zkz(ji,jj) - zkz(ji-1,jj  )    &
402                   + zkw(ji,jj) - zkw(ji  ,jj-1)  ) * zbtr
403            ta(ji,jj,ik) = ta(ji,jj,ik) + zta
404            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa
405#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
406         END DO
407#  endif
408      END DO
409
410      ! save the trends for diagnostic
411      ! BBL lateral diffusion tracers trends
412      IF( l_trdtra )   THEN
413#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp
414         jj = 1
415         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
416#  else
417         DO jj = 2, jpjm1
418            DO ji = 2, jpim1
419#  endif
420            ik = max( mbathy(ji,jj)-1, 1 )
421            tldfbbl(ji,jj) = ta(ji,jj,ik) - ztdta(ji,jj,ik)
422            sldfbbl(ji,jj) = sa(ji,jj,ik) - ztdsa(ji,jj,ik)
423#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp
424            END DO
425#  endif
426         END DO
427
428      ENDIF
429
430      IF(ln_ctl) THEN
431         CALL prt_ctl(tab3d_1=ta, clinfo1=' bbl  - Ta: ', mask1=tmask, &
432            &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra')
433      ENDIF
434
435   END SUBROUTINE tra_bbl_dif
436
437# if defined key_trabbl_adv
438   !!----------------------------------------------------------------------
439   !!   'key_trabbl_adv'                    advective bottom boundary layer
440   !!----------------------------------------------------------------------
441#  include "trabbl_adv.h90"
442# else
443   !!----------------------------------------------------------------------
444   !!   Default option :                 NO advective bottom boundary layer
445   !!----------------------------------------------------------------------
446   SUBROUTINE tra_bbl_adv (kt )              ! Empty routine
447      INTEGER, INTENT(in) :: kt
448      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt
449   END SUBROUTINE tra_bbl_adv
450# endif
451
452   SUBROUTINE tra_bbl_init
453      !!----------------------------------------------------------------------
454      !!                  ***  ROUTINE tra_bbl_init  ***
455      !!
456      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
457      !!
458      !! ** Method  :   Read the nambbl namelist and check the parameters
459      !!      called by tra_bbl at the first timestep (nit000)
460      !!
461      !! History :
462      !!    8.5  !  02-08  (G. Madec)  Original code
463      !!----------------------------------------------------------------------
464      !! * Local declarations
465      INTEGER ::   ji, jj      ! dummy loop indices
466      NAMELIST/nambbl/ atrbbl
467      !!----------------------------------------------------------------------
468
469      ! Read Namelist nambbl : bottom boundary layer scheme
470      ! --------------------
471      REWIND ( numnam )
472      READ   ( numnam, nambbl )
473
474
475      ! Parameter control and print
476      ! ---------------------------
477      IF(lwp) THEN
478         WRITE(numout,*)
479         WRITE(numout,*) 'tra_bbl_init : '
480         WRITE(numout,*) '~~~~~~~~~~~~'
481         IF (lk_trabbl_dif ) THEN
482            WRITE(numout,*) '               * Diffusive Bottom Boundary Layer'
483         ENDIF
484         IF( lk_trabbl_adv ) THEN
485            WRITE(numout,*) '               * Advective Bottom Boundary Layer'
486         ENDIF
487         WRITE(numout,*) '          Namelist nambbl : set bbl parameters'
488         WRITE(numout,*)
489         WRITE(numout,*) '          bottom boundary layer coef.    atrbbl = ', atrbbl
490         WRITE(numout,*)
491      ENDIF
492 
493      DO jj = 1, jpj
494         DO ji = 1, jpi
495            mbkt(ji,jj) = MAX( mbathy(ji,jj) - 1, 1 )   ! vertical index of the bottom ocean T-level
496         END DO
497      END DO
498      DO jj = 1, jpjm1
499         DO ji = 1, jpim1
500            mbku(ji,jj) = MAX( MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) - 1, 1 )
501            mbkv(ji,jj) = MAX( MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) ) - 1, 1 )
502         END DO
503      END DO
504!!bug ???
505!!bug Caution : define the vakue of mbku & mbkv everywhere!!! but lbc mpp lnk : pb when closed (0)
506
507# if defined key_trabbl_adv
508      ! initialisation of w_bbl to zero
509      w_bbl(:,:,:) = 0.e0   
510# endif
511
512   END SUBROUTINE tra_bbl_init
513
514#else
515   !!----------------------------------------------------------------------
516   !!   Dummy module :                      No bottom boundary layer scheme
517   !!----------------------------------------------------------------------
518   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .FALSE.   !: diff bbl flag
519   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE.   !: adv  bbl flag
520CONTAINS
521   SUBROUTINE tra_bbl_dif (kt )              ! Empty routine
522      INTEGER, INTENT(in) :: kt
523      WRITE(*,*) 'tra_bbl_dif: You should not have seen this print! error?', kt
524   END SUBROUTINE tra_bbl_dif
525   SUBROUTINE tra_bbl_adv (kt )              ! Empty routine
526      INTEGER, INTENT(in) :: kt
527      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt
528   END SUBROUTINE tra_bbl_adv
529#endif
530
531   !!======================================================================
532END MODULE trabbl
Note: See TracBrowser for help on using the repository browser.