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.
Changeset 12377 for NEMO/trunk/src/OCE/TRA/trabbl.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/OCE/TRA/trabbl.F90

    r11536 r12377  
    6767 
    6868   !! * Substitutions 
    69 #  include "vectopt_loop_substitute.h90" 
     69#  include "do_loop_substitute.h90" 
    7070   !!---------------------------------------------------------------------- 
    7171   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8989 
    9090 
    91    SUBROUTINE tra_bbl( kt ) 
     91   SUBROUTINE tra_bbl( kt, Kbb, Kmm, pts, Krhs ) 
    9292      !!---------------------------------------------------------------------- 
    9393      !!                  ***  ROUTINE bbl  *** 
    … …  
    101101      !!              is added to the general tracer trend 
    102102      !!---------------------------------------------------------------------- 
    103       INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
     103      INTEGER,                                   INTENT(in   ) :: kt              ! ocean time-step 
     104      INTEGER,                                   INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
     105      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    104106      ! 
    105107      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
    … …  
    110112      IF( l_trdtra )   THEN                         !* Save the T-S input trends 
    111113         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    112          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    113          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    114       ENDIF 
    115  
    116       IF( l_bbl )   CALL bbl( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl) 
     114         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
     115         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
     116      ENDIF 
     117 
     118      IF( l_bbl )   CALL bbl( kt, nit000, 'TRA', Kbb, Kmm )   !* bbl coef. and transport (only if not already done in trcbbl) 
    117119 
    118120      IF( nn_bbl_ldf == 1 ) THEN                    !* Diffusive bbl 
    119121         ! 
    120          CALL tra_bbl_dif( tsb, tsa, jpts ) 
    121          IF( ln_ctl )  & 
    122          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
    123             &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     122         CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 
     123         IF( sn_cfctl%l_prtctl )  & 
     124         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
     125            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    124126         ! lateral boundary conditions ; just need for outputs 
    125127         CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. ) 
    … …  
    131133      IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl 
    132134         ! 
    133          CALL tra_bbl_adv( tsb, tsa, jpts ) 
    134          IF(ln_ctl)   & 
    135          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   & 
    136             &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     135         CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 
     136         IF(sn_cfctl%l_prtctl)   & 
     137         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   & 
     138            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    137139         ! lateral boundary conditions ; just need for outputs 
    138140         CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. ) 
    … …  
    143145 
    144146      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics 
    145          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    146          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    147          CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    148          CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
     147         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
     148         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
     149         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
     150         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    149151         DEALLOCATE( ztrdt, ztrds ) 
    150152      ENDIF 
    … …  
    155157 
    156158 
    157    SUBROUTINE tra_bbl_dif( ptb, pta, kjpt ) 
     159   SUBROUTINE tra_bbl_dif( pt, pt_rhs, kjpt, Kmm ) 
    158160      !!---------------------------------------------------------------------- 
    159161      !!                  ***  ROUTINE tra_bbl_dif  *** 
    … …  
    171173      !!      convection is satified) 
    172174      !! 
    173       !! ** Action  :   pta   increased by the bbl diffusive trend 
     175      !! ** Action  :   pt_rhs   increased by the bbl diffusive trend 
    174176      !! 
    175177      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    … …  
    177179      !!---------------------------------------------------------------------- 
    178180      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    179       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
    180       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
     181      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields 
     182      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
     183      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices 
    181184      ! 
    182185      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    … …  
    188191      DO jn = 1, kjpt                                     ! tracer loop 
    189192         !                                                ! =========== 
    190          DO jj = 1, jpj 
    191             DO ji = 1, jpi 
    192                ik = mbkt(ji,jj)                             ! bottom T-level index 
    193                zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S 
    194             END DO 
    195          END DO 
     193         DO_2D_11_11 
     194            ik = mbkt(ji,jj)                             ! bottom T-level index 
     195            zptb(ji,jj) = pt(ji,jj,ik,jn)                ! bottom before T and S 
     196         END_2D 
    196197         !                
    197          DO jj = 2, jpjm1                                    ! Compute the trend 
    198             DO ji = 2, jpim1 
    199                ik = mbkt(ji,jj)                            ! bottom T-level index 
    200                pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  & 
    201                   &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     & 
    202                   &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     & 
    203                   &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
    204                   &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
    205                   &             * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik) 
    206             END DO 
    207          END DO 
     198         DO_2D_00_00 
     199            ik = mbkt(ji,jj)                            ! bottom T-level index 
     200            pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn)                                                  & 
     201               &                + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     & 
     202               &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     & 
     203               &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
     204               &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
     205               &                * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm) 
     206         END_2D 
    208207         !                                                  ! =========== 
    209208      END DO                                                ! end tracer 
    … …  
    212211 
    213212 
    214    SUBROUTINE tra_bbl_adv( ptb, pta, kjpt ) 
     213   SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm ) 
    215214      !!---------------------------------------------------------------------- 
    216215      !!                  ***  ROUTINE trc_bbl  *** 
    … …  
    228227      !!---------------------------------------------------------------------- 
    229228      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    230       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
    231       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
     229      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! before and now tracer fields 
     230      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
     231      INTEGER                              , INTENT(in   ) ::   Kmm    ! time level indices 
    232232      ! 
    233233      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices 
    … …  
    250250                  ! 
    251251                  !                                               ! up  -slope T-point (shelf bottom point) 
    252                   zbtr = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus) 
    253                   ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
    254                   pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
     252                  zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 
     253                  ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 
     254                  pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 
    255255                  ! 
    256256                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    257                      zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk) 
    258                      ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 
    259                      pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
     257                     zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 
     258                     ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 
     259                     pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 
    260260                  END DO 
    261261                  ! 
    262                   zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud) 
    263                   ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
    264                   pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 
     262                  zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 
     263                  ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 
     264                  pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 
    265265               ENDIF 
    266266               ! 
    … …  
    272272                  ! 
    273273                  ! up  -slope T-point (shelf bottom point) 
    274                   zbtr = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs) 
    275                   ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
    276                   pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
     274                  zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 
     275                  ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 
     276                  pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 
    277277                  ! 
    278278                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    279                      zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk) 
    280                      ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 
    281                      pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra 
     279                     zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 
     280                     ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 
     281                     pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn)  + ztra 
    282282                  END DO 
    283283                  !                                               ! down-slope T-point (deep bottom point) 
    284                   zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd) 
    285                   ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 
    286                   pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 
     284                  zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 
     285                  ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 
     286                  pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 
    287287               ENDIF 
    288288            END DO 
    … …  
    295295 
    296296 
    297    SUBROUTINE bbl( kt, kit000, cdtype ) 
     297   SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm ) 
    298298      !!---------------------------------------------------------------------- 
    299299      !!                  ***  ROUTINE bbl  *** 
    … …  
    324324      INTEGER         , INTENT(in   ) ::   kit000   ! first time step index 
    325325      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
     326      INTEGER         , INTENT(in   ) ::   Kbb, Kmm ! ocean time level index 
    326327      ! 
    327328      INTEGER  ::   ji, jj                    ! dummy loop indices 
    … …  
    341342      ENDIF 
    342343      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity) 
    343       DO jj = 1, jpj 
    344          DO ji = 1, jpi 
    345             ik = mbkt(ji,jj)                             ! bottom T-level index 
    346             zts (ji,jj,jp_tem) = tsb(ji,jj,ik,jp_tem)    ! bottom before T and S 
    347             zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 
    348             ! 
    349             zdep(ji,jj) = gdept_n(ji,jj,ik)              ! bottom T-level reference depth 
    350             zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity 
    351             zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
    352          END DO 
    353       END DO 
    354       ! 
    355       CALL eos_rab( zts, zdep, zab ) 
     344      DO_2D_11_11 
     345         ik = mbkt(ji,jj)                             ! bottom T-level index 
     346         zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S 
     347         zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb) 
     348         ! 
     349         zdep(ji,jj) = gdept(ji,jj,ik,Kmm)            ! bottom T-level reference depth 
     350         zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm)      ! bottom velocity 
     351         zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm) 
     352      END_2D 
     353      ! 
     354      CALL eos_rab( zts, zdep, zab, Kmm ) 
    356355      ! 
    357356      !                                   !-------------------! 
    358357      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   ! 
    359358         !                                !-------------------! 
    360          DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 
    361             DO ji = 1, fs_jpim1   ! vector opt. 
    362                !                                                   ! i-direction 
    363                za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point 
    364                zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
    365                !                                                         ! 2*masked bottom density gradient 
    366                zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    & 
    367                   &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
    368                ! 
    369                zsign  = SIGN(  0.5, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
    370                ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff. 
    371                ! 
    372                !                                                   ! j-direction 
    373                za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at v-point 
    374                zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
    375                !                                                         ! 2*masked bottom density gradient 
    376                zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
    377                   &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
    378                ! 
    379                zsign = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
    380                ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 
    381             END DO 
    382          END DO 
     359         DO_2D_10_10 
     360            !                                                   ! i-direction 
     361            za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point 
     362            zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
     363            !                                                         ! 2*masked bottom density gradient 
     364            zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    & 
     365               &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
     366            ! 
     367            zsign  = SIGN(  0.5, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
     368            ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff. 
     369            ! 
     370            !                                                   ! j-direction 
     371            za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at v-point 
     372            zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
     373            !                                                         ! 2*masked bottom density gradient 
     374            zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
     375               &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
     376            ! 
     377            zsign = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
     378            ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 
     379         END_2D 
    383380         ! 
    384381      ENDIF 
    … …  
    390387         ! 
    391388         CASE( 1 )                                   != use of upper velocity 
    392             DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0 
    393                DO ji = 1, fs_jpim1   ! vector opt. 
    394                   !                                                  ! i-direction 
    395                   za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
    396                   zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
    397                   !                                                          ! 2*masked bottom density gradient  
    398                   zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    & 
    399                             - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
    400                   ! 
    401                   zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope 
    402                   zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope 
    403                   ! 
    404                   !                                                          ! bbl velocity 
    405                   utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj) 
    406                   ! 
    407                   !                                                  ! j-direction 
    408                   za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point 
    409                   zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
    410                   !                                                          ! 2*masked bottom density gradient 
    411                   zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
    412                      &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
    413                   zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope 
    414                   zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope 
    415                   ! 
    416                   !                                                          ! bbl transport 
    417                   vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj) 
    418                END DO 
    419             END DO 
     389            DO_2D_10_10 
     390               !                                                  ! i-direction 
     391               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
     392               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
     393               !                                                          ! 2*masked bottom density gradient  
     394               zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    & 
     395                         - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
     396               ! 
     397               zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope 
     398               zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope 
     399               ! 
     400               !                                                          ! bbl velocity 
     401               utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj) 
     402               ! 
     403               !                                                  ! j-direction 
     404               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point 
     405               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
     406               !                                                          ! 2*masked bottom density gradient 
     407               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
     408                  &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
     409               zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope 
     410               zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope 
     411               ! 
     412               !                                                          ! bbl transport 
     413               vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj) 
     414            END_2D 
    420415            ! 
    421416         CASE( 2 )                                 != bbl velocity = F( delta rho ) 
    422417            zgbbl = grav * rn_gambbl 
    423             DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down 
    424                DO ji = 1, fs_jpim1   ! vector opt. 
    425                   !                                                  ! i-direction 
    426                   ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf) 
    427                   iid  = ji + MAX( 0, mgrhu(ji,jj) ) 
    428                   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 
    429                   ! 
    430                   ikud = mbku_d(ji,jj) 
    431                   ikus = mbku(ji,jj) 
    432                   ! 
    433                   za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
    434                   zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
    435                   !                                                          !   masked bottom density gradient 
    436                   zgdrho = 0.5 * (  za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) )    & 
    437                      &            - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) )  ) * umask(ji,jj,1) 
    438                   zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep 
    439                   ! 
    440                   !                                                          ! bbl transport (down-slope direction) 
    441                   utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) ) 
    442                   ! 
    443                   !                                                  ! j-direction 
    444                   !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf) 
    445                   ijd  = jj + MAX( 0, mgrhv(ji,jj) ) 
    446                   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 
    447                   ! 
    448                   ikvd = mbkv_d(ji,jj) 
    449                   ikvs = mbkv(ji,jj) 
    450                   ! 
    451                   za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point 
    452                   zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
    453                   !                                                          !   masked bottom density gradient 
    454                   zgdrho = 0.5 * (  za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) )    & 
    455                      &            - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) )  ) * vmask(ji,jj,1) 
    456                   zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep 
    457                   ! 
    458                   !                                                          ! bbl transport (down-slope direction) 
    459                   vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) ) 
    460                END DO 
    461             END DO 
     418            DO_2D_10_10 
     419               !                                                  ! i-direction 
     420               ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf) 
     421               iid  = ji + MAX( 0, mgrhu(ji,jj) ) 
     422               iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 
     423               ! 
     424               ikud = mbku_d(ji,jj) 
     425               ikus = mbku(ji,jj) 
     426               ! 
     427               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
     428               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
     429               !                                                          !   masked bottom density gradient 
     430               zgdrho = 0.5 * (  za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) )    & 
     431                  &            - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) )  ) * umask(ji,jj,1) 
     432               zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep 
     433               ! 
     434               !                                                          ! bbl transport (down-slope direction) 
     435               utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) ) 
     436               ! 
     437               !                                                  ! j-direction 
     438               !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf) 
     439               ijd  = jj + MAX( 0, mgrhv(ji,jj) ) 
     440               ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 
     441               ! 
     442               ikvd = mbkv_d(ji,jj) 
     443               ikvs = mbkv(ji,jj) 
     444               ! 
     445               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point 
     446               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
     447               !                                                          !   masked bottom density gradient 
     448               zgdrho = 0.5 * (  za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) )    & 
     449                  &            - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) )  ) * vmask(ji,jj,1) 
     450               zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep 
     451               ! 
     452               !                                                          ! bbl transport (down-slope direction) 
     453               vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) ) 
     454            END_2D 
    462455         END SELECT 
    463456         ! 
    … …  
    483476      !!---------------------------------------------------------------------- 
    484477      ! 
    485       REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme 
    486478      READ  ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901) 
    487479901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist' ) 
    488480      ! 
    489       REWIND( numnam_cfg )              ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme 
    490481      READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 ) 
    491482902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist' ) 
    … …  
    517508      ! 
    518509      !                             !* vertical index of  "deep" bottom u- and v-points 
    519       DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv) 
    520          DO ji = 1, jpim1 
    521             mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land 
    522             mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  ) 
    523          END DO 
    524       END DO 
     510      DO_2D_10_10 
     511         mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land 
     512         mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  ) 
     513      END_2D 
    525514      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    526515      zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp )   
    … …  
    530519      !                             !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 
    531520      mgrhu(:,:) = 0   ;   mgrhv(:,:) = 0 
    532       DO jj = 1, jpjm1 
    533          DO ji = 1, jpim1 
    534             IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 
    535                mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    536             ENDIF 
    537             ! 
    538             IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 
    539                mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    540             ENDIF 
    541          END DO 
    542       END DO 
    543       ! 
    544       DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
    545          DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0) 
    546             e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) ) 
    547             e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 
    548          END DO 
    549       END DO 
     521      DO_2D_10_10 
     522         IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 
     523            mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     524         ENDIF 
     525         ! 
     526         IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 
     527            mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     528         ENDIF 
     529      END_2D 
     530      ! 
     531      DO_2D_10_10 
     532         e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) ) 
     533         e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 
     534      END_2D 
    550535      CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1. , e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions 
    551536      ! 
Note: See TracChangeset for help on using the changeset viewer.