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 403 for trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90 – NEMO

Ignore:
Timestamp:
2006-03-20T16:45:14+01:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_bugfix_022 : CT :

  • bug correction for the BBL advection
  • remove the diffusive part in trabbl_adv.h90
  • additional code was added for the case of neos=1.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90

    r349 r403  
    5454      !! * Modules used 
    5555      USE lbclnk           ! ocean lateral boundary conditions (or mpp link) 
     56      USE eosbn2 
    5657 
    5758      !! * Arguments 
    … …  
    137138      END DO 
    138139#endif 
    139   
     140 
    140141      ! boundary conditions on zunb and zvnb   (changed sign) 
    141142       CALL lbc_lnk( zunb, 'U', -1. )   ;   CALL lbc_lnk( zvnb, 'V', -1. ) 
    142143 
    143       ! Conditional diffusion along the slope in the bottom boundary layer 
    144  
    145 #if defined key_trcbbl_dif 
    146 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
    147       jj = 1 
    148       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    149 # else 
    150       DO jj = 1, jpjm1 
    151          DO ji = 1, jpim1 
    152 # endif 
    153             iku = mbku(ji,jj) 
    154             ikv = mbkv(ji,jj) 
    155             zahu(ji,jj) = atrbbl*e2u(ji,jj)*fse3u(ji,jj,iku)/e1u(ji,jj) * umask(ji,jj,1) 
    156             zahv(ji,jj) = atrbbl*e1v(ji,jj)*fse3v(ji,jj,ikv)/e2v(ji,jj) * vmask(ji,jj,1) 
    157 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
    158          END DO 
    159 # endif 
    160       END DO 
    161 #endif 
    162144 
    163145 
    … …  
    216198      CASE ( 1 )               ! Linear formulation function of temperature only 
    217199 
    218          IF(lwp) WRITE(numout,cform_err) 
    219          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
    220          IF(lwp) WRITE(numout,*) '          bbl not implented: easy to do it ' 
    221          nstop = nstop + 1 
     200 
     201#  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     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            ! temperature, salinity anomalie and depth 
     209            zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
     210            zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
     211            zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
     212            ! masked ratio alpha/beta 
     213            ! local density gradient along i-bathymetric slope 
     214            zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 
     215            ! sign of local i-gradient of density multiplied by the i-slope 
     216            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     217            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
     218 
     219            zsigna= sign(0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) )) 
     220            zalphax(ji,jj)=(0.5-zsigna)*(0.5-zsign)*umask(ji,jj,1) 
     221#  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     222         END DO 
     223#  endif 
     224      END DO 
     225 
     226#  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     227      jj = 1 
     228      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     229#  else 
     230      DO jj = 1, jpjm1 
     231         DO ji = 1, jpim1 
     232#  endif 
     233            ! temperature, salinity anomalie and depth 
     234            zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
     235            zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
     236            zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
     237            ! masked ratio alpha/beta 
     238            ! local density gradient along j-bathymetric slope 
     239            zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 
     240            ! sign of local j-gradient of density multiplied by the j-slope 
     241            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     242            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
     243 
     244            zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     245            zalphay(ji,jj)=(0.5-zsigna)*(0.5-zsign)*vmask(ji,jj,1) 
     246#  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     247         END DO 
     248#  endif 
     249      END DO 
    222250 
    223251      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    224252 
    225          IF(lwp) WRITE(numout,cform_err) 
    226          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
    227          IF(lwp) WRITE(numout,*) '          bbl not implented: easy to do it ' 
    228          nstop = nstop + 1 
     253      DO jj = 1, jpjm1 
     254         DO ji = 1, fs_jpim1   ! vector opt. 
     255            ! local density gradient along i-bathymetric slope 
     256            zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
     257                     -  ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
     258            ! sign of local i-gradient of density multiplied by the i-slope 
     259            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     260 
     261            zsigna= sign(0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) )) 
     262            zalphax(ji,jj)=(0.5-zsigna)*(0.5-zsign)*umask(ji,jj,1) 
     263         END DO 
     264      END DO 
     265 
     266      DO jj = 1, jpjm1 
     267         DO ji = 1, fs_jpim1   ! vector opt. 
     268             ! local density gradient along j-bathymetric slope 
     269             zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
     270                    -    ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 
     271             ! sign of local j-gradient of density multiplied by the j-slope 
     272             zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     273 
     274             zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     275             zalphay(ji,jj)=(0.5-zsigna)*(0.5-zsign)*vmask(ji,jj,1) 
     276         END DO 
     277      END DO 
     278 
    229279 
    230280      CASE DEFAULT 
    … …  
    284334          END DO 
    285335 
    286 #if defined key_trcbbl_dif 
    287           ! 4. Additional second order diffusive trends 
    288           ! ------------------------------------------- 
    289            
    290           ! ... first derivative (gradient) 
    291           DO jj = 1, jpjm1 
    292              DO ji = 1, fs_jpim1   ! vertor opt.                
    293                 zkx(ji,jj) = zki(ji,jj)*( ztrb(ji+1,jj) - ztrb(ji,jj) ) 
    294                 zky(ji,jj) = zkj(ji,jj)*( ztrb(ji,jj+1) - ztrb(ji,jj) )                
    295              END DO 
    296           END DO 
    297            
    298           IF( cp_cfg == "orca" ) THEN    
    299              SELECT CASE ( jp_cfg ) 
    300                 !                                        ! ======================= 
    301              CASE ( 2 )                               !  ORCA_R2 configuration 
    302                 !                                     ! ======================= 
    303                 ! Gibraltar enhancement of BBL 
    304                 zkx( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zkx( mi0(139):mi1(140) , mj0(102):mj1(102) ) 
    305                 zky( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zky( mi0(139):mi1(140) , mj0(102):mj1(102) ) 
    306                  
    307                 ! Red Sea enhancement of BBL 
    308                 zkx( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zkx( mi0(161):mi1(162) , mj0(88):mj1(88) ) 
    309                 zky( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zky( mi0(161):mi1(162) , mj0(88):mj1(88) ) 
    310                  
    311                 !                                     ! ======================= 
    312              CASE ( 4 )                               !  ORCA_R4 configuration 
    313                 !                                     ! ======================= 
    314                 ! Gibraltar enhancement of BBL 
    315                 zkx( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zkx( mi0(70):mi1(71) , mj0(52):mj1(52) ) 
    316                 zky( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zky( mi0(70):mi1(71) , mj0(52):mj1(52) ) 
    317                  
    318              END SELECT 
    319               
    320           ENDIF 
    321  
    322           ! ... second derivative (divergence) and add to the general tracer trend 
    323            
    324 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
    325           jj = 1 
    326           DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    327 # else 
    328           DO jj = 2, jpjm1 
    329              DO ji = 2, jpim1 
    330 # endif 
    331                 ik = mbkt(ji,jj) 
    332                 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) ) 
    333                 ztra = (  zkx(ji,jj) - zkx(ji-1,jj  )   &  
    334                    &    + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr 
    335                 tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra 
    336 #if ! defined key_vectopt_loop   ||   defined key_autotasking 
    337              END DO 
    338 #endif 
    339           END DO 
    340  
    341 #endif 
    342      
    343336 
    344337          ! 5. Along sigma advective trend 
    … …  
    360353                zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztrb(ji  ,jj  )   & 
    361354                   &          +( zfui - ABS( zfui ) ) * ztrb(ji+1,jj  ) ) * 0.5 
    362                 zwy(ji,jj) = ( ( zfui + ABS( zfvj ) ) * ztrb(ji  ,jj  )   & 
    363                    &          +( zfui - ABS( zfvj ) ) * ztrb(ji  ,jj+1) ) * 0.5 
     355                zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztrb(ji  ,jj  )   & 
     356                   &          +( zfvj - ABS( zfvj ) ) * ztrb(ji  ,jj+1) ) * 0.5 
    364357#if ! defined key_vectopt_loop   ||   defined key_autotasking 
    365358             END DO 
    … …  
    378371                ztra = - zbtr * (  zwx(ji,jj) - zwx(ji-1,jj  )   & 
    379372                   &             + zwy(ji,jj) - zwy(ji  ,jj-1)  ) 
    380   
     373 
    381374                ! add it to the general tracer trends 
    382375                tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra 
Note: See TracChangeset for help on using the changeset viewer.