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

Last change on this file since 941 was 941, checked in by cetlod, 16 years ago

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