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

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

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