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.
trcbbl.F90 in trunk/NEMO/TOP_SRC/TRP – NEMO

source: trunk/NEMO/TOP_SRC/TRP/trcbbl.F90 @ 719

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago

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