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 @ 428

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

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