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 13540 for NEMO/branches/2020/r12377_ticket2386/src/OCE/TRA/trabbl.F90 – NEMO

Ignore:
Timestamp:
2020-09-29T12:41:06+02:00 (3 years ago)
Author:
andmirek
Message:

Ticket #2386: update to latest trunk

Location:
NEMO/branches/2020/r12377_ticket2386
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/r12377_ticket2386

    • 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_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13507        sette 
  • NEMO/branches/2020/r12377_ticket2386/src/OCE/TRA/trabbl.F90

    r12377 r13540  
    6868   !! * Substitutions 
    6969#  include "do_loop_substitute.h90" 
     70#  include "domzgr_substitute.h90" 
    7071   !!---------------------------------------------------------------------- 
    7172   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    125126            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    126127         ! lateral boundary conditions ; just need for outputs 
    127          CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. ) 
     128         CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp ) 
    128129         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef 
    129130         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef 
     
    138139            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    139140         ! lateral boundary conditions ; just need for outputs 
    140          CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. ) 
     141         CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 
    141142         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
    142143         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
     
    191192      DO jn = 1, kjpt                                     ! tracer loop 
    192193         !                                                ! =========== 
    193          DO_2D_11_11 
     194         DO_2D( 1, 1, 1, 1 ) 
    194195            ik = mbkt(ji,jj)                             ! bottom T-level index 
    195196            zptb(ji,jj) = pt(ji,jj,ik,jn)                ! bottom before T and S 
    196197         END_2D 
    197198         !                
    198          DO_2D_00_00 
     199         DO_2D( 0, 0, 0, 0 )                               ! Compute the trend 
    199200            ik = mbkt(ji,jj)                            ! bottom T-level index 
    200201            pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn)                                                  & 
     
    342343      ENDIF 
    343344      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity) 
    344       DO_2D_11_11 
     345      DO_2D( 1, 1, 1, 1 ) 
    345346         ik = mbkt(ji,jj)                             ! bottom T-level index 
    346347         zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S 
     
    357358      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   ! 
    358359         !                                !-------------------! 
    359          DO_2D_10_10 
     360         DO_2D( 1, 0, 1, 0 )                   ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 
    360361            !                                                   ! i-direction 
    361362            za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point 
     
    365366               &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
    366367            ! 
    367             zsign  = SIGN(  0.5, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
     368            zsign  = SIGN(  0.5_wp, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
    368369            ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff. 
    369370            ! 
     
    375376               &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
    376377            ! 
    377             zsign = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
     378            zsign = SIGN(  0.5_wp, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
    378379            ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 
    379380         END_2D 
     
    387388         ! 
    388389         CASE( 1 )                                   != use of upper velocity 
    389             DO_2D_10_10 
     390            DO_2D( 1, 0, 1, 0 )                              ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0 
    390391               !                                                  ! i-direction 
    391392               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
     
    395396                         - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
    396397               ! 
    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 
     398               zsign = SIGN(  0.5_wp, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope 
     399               zsigna= SIGN(  0.5_wp, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope 
    399400               ! 
    400401               !                                                          ! bbl velocity 
     
    407408               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
    408409                  &      - 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 
     410               zsign = SIGN(  0.5_wp, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope 
     411               zsigna= SIGN(  0.5_wp, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope 
    411412               ! 
    412413               !                                                          ! bbl transport 
     
    416417         CASE( 2 )                                 != bbl velocity = F( delta rho ) 
    417418            zgbbl = grav * rn_gambbl 
    418             DO_2D_10_10 
     419            DO_2D( 1, 0, 1, 0 )                         ! criteria: rho_up > rho_down 
    419420               !                                                  ! i-direction 
    420421               ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf) 
     
    504505      IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' ) 
    505506      ! 
    506       IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity' 
    507       IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)' 
     507      IF(lwp) THEN 
     508         IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity' 
     509         IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)' 
     510      ENDIF 
    508511      ! 
    509512      !                             !* vertical index of  "deep" bottom u- and v-points 
    510       DO_2D_10_10 
     513      DO_2D( 1, 0, 1, 0 )                 ! (the "shelf" bottom k-indices are mbku and mbkv) 
    511514         mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land 
    512515         mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  ) 
     
    514517      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    515518      zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp )   
    516       CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1., zmbkv,'V',1.)  
     519      CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp)  
    517520      mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ;  mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 
    518521      ! 
    519522      !                             !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 
    520523      mgrhu(:,:) = 0   ;   mgrhv(:,:) = 0 
    521       DO_2D_10_10 
     524      DO_2D( 1, 0, 1, 0 ) 
    522525         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)) )  ) 
     526            mgrhu(ji,jj) = INT(  SIGN( 1.0_wp, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    524527         ENDIF 
    525528         ! 
    526529         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)) )  ) 
     530            mgrhv(ji,jj) = INT(  SIGN( 1.0_wp, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    528531         ENDIF 
    529532      END_2D 
    530533      ! 
    531       DO_2D_10_10 
     534      DO_2D( 1, 0, 1, 0 )           !* bbl thickness at u- (v-) point; minimum of top & bottom e3u_0 (e3v_0) 
    532535         e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) ) 
    533536         e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 
    534537      END_2D 
    535       CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1. , e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions 
     538      CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp )      ! lateral boundary conditions 
    536539      ! 
    537540      !                             !* masked diffusive flux coefficients 
Note: See TracChangeset for help on using the changeset viewer.