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 409 – NEMO

Changeset 409


Ignore:
Timestamp:
2006-03-20T17:46:01+01:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_bugfix_028 : CT : bug correction for the BBL advection

Location:
trunk/NEMO/OPA_SRC/TRA
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/TRA/trabbl.F90

    r258 r409  
    1616   !!---------------------------------------------------------------------- 
    1717   !! * Modules used 
    18    USE oce             ! ocean dynamics and active tracers 
    19    USE dom_oce         ! ocean space and time domain 
    20    USE trdmod_oce      ! ocean variables trends 
    21    USE in_out_manager  ! I/O manager 
    22    USE prtctl          ! Print control 
     18   USE oce                  ! ocean dynamics and active tracers 
     19   USE dom_oce              ! ocean space and time domain 
     20   USE trdmod_oce           ! ocean variables trends 
     21   USE eosbn2 , ONLY : neos ! type of equation of state 
     22   USE in_out_manager       ! I/O manager 
     23   USE prtctl               ! Print control 
    2324 
    2425   IMPLICIT NONE 
    … …  
    3031 
    3132   !! * Shared module variables 
     33   REAL(wp), PUBLIC ::            &  !!: * bbl namelist * 
     34      atrbbl = 1.e+3                  !: lateral coeff. for BBL scheme (m2/s) 
     35#if defined key_trabbl_dif 
    3236   LOGICAL, PUBLIC, PARAMETER ::   &  !: 
    3337      lk_trabbl_dif = .TRUE.          !: diffusive bottom boundary layer flag 
    34    REAL(wp), PUBLIC ::            &  !!: * bbl namelist * 
    35       atrbbl = 1.e+3                  !: lateral coeff. for bottom boundary  
    36       !                               !  layer scheme (m2/s) 
     38#else 
     39   LOGICAL, PUBLIC, PARAMETER ::   &  !: 
     40      lk_trabbl_dif = .FALSE.         !: diffusive bottom boundary layer flag 
     41#endif 
     42 
    3743# if defined key_trabbl_adv 
    3844   LOGICAL, PUBLIC, PARAMETER ::    &  !: 
    … …  
    228234      ! multiplied by the slope of the ocean bottom 
    229235 
     236      SELECT CASE ( neos ) 
     237 
     238      CASE ( 0   )               ! 0 :Jackett and McDougall (1994) formulation 
     239 
    230240#  if defined key_vectopt_loop   &&   ! defined key_autotasking 
    231241      jj = 1 
    … …  
    276286      END DO 
    277287 
     288      CASE ( 1 )               ! Linear formulation function of temperature only 
     289                               !  
     290#  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     291      jj = 1 
     292      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     293#  else 
     294      DO jj = 1, jpjm1 
     295         DO ji = 1, jpim1 
     296#  endif 
     297            ! local 'density/temperature' gradient along i-bathymetric slope 
     298            zgdrho =  ztnb(ji+1,jj) - ztnb(ji,jj)  
     299            ! sign of local i-gradient of density multiplied by the i-slope 
     300            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     301            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
     302#  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     303         END DO 
     304#  endif 
     305      END DO 
     306 
     307#  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     308      jj = 1 
     309      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     310#  else 
     311      DO jj = 1, jpjm1 
     312         DO ji = 1, jpim1 
     313#  endif 
     314            ! local density gradient along j-bathymetric slope 
     315            zgdrho =  ztnb(ji,jj+1) - ztnb(ji,jj)  
     316            ! sign of local j-gradient of density multiplied by the j-slope 
     317            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     318            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
     319#  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     320         END DO 
     321#  endif 
     322      END DO 
     323 
     324      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
     325 
     326         IF(lwp) WRITE(numout,cform_err) 
     327         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
     328         IF(lwp) WRITE(numout,*) '          bbl not implented: easy to do it ' 
     329         nstop = nstop + 1 
     330 
     331      CASE DEFAULT 
     332 
     333         IF(lwp) WRITE(numout,cform_err) 
     334         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos 
     335         nstop = nstop + 1 
     336 
     337      END SELECT 
    278338 
    279339      ! 2. Additional second order diffusive trends 
    … …  
    420480      IF(lwp) THEN 
    421481         WRITE(numout,*) 
    422          WRITE(numout,*) 'tra_bbl_init : * Diffusive Bottom Boundary Layer' 
     482         WRITE(numout,*) 'tra_bbl_init : ' 
    423483         WRITE(numout,*) '~~~~~~~~~~~~' 
     484         IF (lk_trabbl_dif ) THEN 
     485            WRITE(numout,*) '               * Diffusive Bottom Boundary Layer' 
     486         ENDIF  
    424487         IF( lk_trabbl_adv ) THEN 
    425488            WRITE(numout,*) '               * Advective Bottom Boundary Layer' 

  • trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90

    r258 r409  
    7373         zgdrho, zbtr, zta, zsa            !    "         "  
    7474      REAL(wp), DIMENSION(jpi,jpj) ::   & 
    75          zki, zkj, zkw, zkx, zky, zkz,  &  ! temporary workspace arrays 
    76          ztnb, zsnb, zdep, ztbb, zsbb,  &  !    "                  " 
     75         ztnb, zsnb, zdep, ztbb, zsbb,  &  ! temporary workspace arrays 
    7776         zahu, zahv                        !    "                  " 
    7877      REAL(wp), DIMENSION(jpi,jpj) ::   &  ! temporary workspace arrays 
    … …  
    160159       CALL lbc_lnk( zsnb, 'T', 1. )    ;   CALL lbc_lnk( zsbb, 'T', 1. ) 
    161160 
    162       ! Conditional diffusion along the slope in the bottom boundary layer 
    163  
    164 #if defined key_trabbl_dif 
    165 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
    166       jj = 1 
    167       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    168 # else 
    169       DO jj = 1, jpjm1 
    170          DO ji = 1, jpim1 
    171 # endif 
    172             iku = mbku(ji,jj) 
    173             ikv = mbkv(ji,jj) 
    174             zahu(ji,jj) = atrbbl*e2u(ji,jj)*fse3u(ji,jj,iku)/e1u(ji,jj) * umask(ji,jj,1) 
    175             zahv(ji,jj) = atrbbl*e1v(ji,jj)*fse3v(ji,jj,ikv)/e2v(ji,jj) * vmask(ji,jj,1) 
    176 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
    177          END DO 
    178 # endif 
    179       END DO 
    180 #endif 
    181  
    182  
    183161      ! 2. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0 
    184162      ! -------------------------------------------- 
    … …  
    204182      !   ... sign of local i-gradient of density multiplied by the i-slope 
    205183          zsign = sign( 0.5, -zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    206           zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    207184 
    208185          zsigna= sign(0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) )) 
    … …  
    225202      !   ... sign of local j-gradient of density multiplied by the j-slope 
    226203          zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    227           zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    228204 
    229205          zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    … …  
    234210 
    235211      CASE ( 1 )               ! Linear formulation function of temperature only 
    236  
    237          IF(lwp) WRITE(numout,cform_err) 
    238          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
    239          IF(lwp) WRITE(numout,*) '          bbl not implented: easy to do it ' 
    240          nstop = nstop + 1 
     212                               ! 
     213      DO jj = 1, jpjm1 
     214         DO ji = 1, jpim1 
     215            ! local 'density/temperature' gradient along i-bathymetric slope 
     216            zgdrho =  ztnb(ji+1,jj) - ztnb(ji,jj) 
     217            ! sign of local i-gradient of density multiplied by the i-slope 
     218            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     219 
     220            zsigna= sign(0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) )) 
     221            zalphax(ji,jj)=(0.5+zsigna)*(0.5-zsign)*umask(ji,jj,1) 
     222         END DO 
     223      END DO 
     224 
     225      DO jj = 1, jpjm1 
     226         DO ji = 1, jpim1 
     227            ! local density gradient along j-bathymetric slope 
     228            zgdrho =  ztnb(ji,jj+1) - ztnb(ji,jj) 
     229            ! sign of local j-gradient of density multiplied by the j-slope 
     230            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     231 
     232            zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     233            zalphay(ji,jj)=(0.5+zsigna)*(0.5-zsign)*vmask(ji,jj,1) 
     234         END DO 
     235      END DO 
    241236 
    242237      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    … …  
    285280      ! lateral boundary conditions on u_bbl and v_bbl   (changed sign) 
    286281       CALL lbc_lnk( u_bbl, 'U', -1. )   ;   CALL lbc_lnk( v_bbl, 'V', -1. ) 
    287  
    288  
    289  
    290 #if defined key_trabbl_dif 
    291       ! 4. Additional second order diffusive trends 
    292       ! ------------------------------------------- 
    293  
    294       ! ... first derivative (gradient) 
    295       DO jj = 1, jpjm1 
    296          DO ji = 1, fs_jpim1   ! vertor opt. 
    297             zkx(ji,jj) = zki(ji,jj)*( ztbb(ji+1,jj) - ztbb(ji,jj) ) 
    298             zkz(ji,jj) = zki(ji,jj)*( zsbb(ji+1,jj) - zsbb(ji,jj) ) 
    299  
    300             zky(ji,jj) = zkj(ji,jj)*( ztbb(ji,jj+1) - ztbb(ji,jj) ) 
    301             zkw(ji,jj) = zkj(ji,jj)*( zsbb(ji,jj+1) - zsbb(ji,jj) ) 
    302          END DO 
    303       END DO 
    304  
    305       IF( cp_cfg == "orca" ) THEN    
    306          SELECT CASE ( jp_cfg ) 
    307             !                                        ! ======================= 
    308             CASE ( 2 )                               !  ORCA_R2 configuration 
    309                !                                     ! ======================= 
    310                ! Gibraltar enhancement of BBL 
    311                zkx( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zkx( mi0(139):mi1(140) , mj0(102):mj1(102) ) 
    312                zky( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zky( mi0(139):mi1(140) , mj0(102):mj1(102) ) 
    313     
    314                ! Red Sea enhancement of BBL 
    315                zkx( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zkx( mi0(161):mi1(162) , mj0(88):mj1(88) ) 
    316                zky( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zky( mi0(161):mi1(162) , mj0(88):mj1(88) ) 
    317     
    318                !                                     ! ======================= 
    319             CASE ( 4 )                               !  ORCA_R4 configuration 
    320                !                                     ! ======================= 
    321                ! Gibraltar enhancement of BBL 
    322                zkx( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zkx( mi0(70):mi1(71) , mj0(52):mj1(52) ) 
    323                zky( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zky( mi0(70):mi1(71) , mj0(52):mj1(52) ) 
    324   
    325          END SELECT 
    326   
    327       ENDIF 
    328  
    329       ! ... second derivative (divergence) and add to the general tracer trend 
    330  
    331 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
    332       jj = 1 
    333       DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    334 # else 
    335       DO jj = 2, jpjm1 
    336          DO ji = 2, jpim1 
    337 # endif 
    338             ik = mbkt(ji,jj) 
    339             zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) ) 
    340             zta = (  zkx(ji,jj) - zkx(ji-1,jj  )   &  
    341                &   + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr 
    342             zsa = (  zkz(ji,jj) - zkz(ji-1,jj  )   & 
    343                &   + zkw(ji,jj) - zkw(ji  ,jj-1)  ) * zbtr 
    344             ta(ji,jj,ik) = ta(ji,jj,ik) + zta 
    345             sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 
    346 #if ! defined key_vectopt_loop   ||   defined key_autotasking 
    347          END DO 
    348 #endif 
    349       END DO 
    350  
    351       ! save the trends for diagnostic 
    352       ! BBL lateral diffusion tracers trends 
    353       IF( l_trdtra )   THEN 
    354 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
    355          jj = 1 
    356          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    357 #  else 
    358          DO jj = 2, jpjm1 
    359             DO ji = 2, jpim1 
    360 #  endif 
    361             ik = mbkt(ji,jj) 
    362             tldfbbl(ji,jj) = ta(ji,jj,ik) - ztdta(ji,jj,ik) 
    363             sldfbbl(ji,jj) = sa(ji,jj,ik) - ztdsa(ji,jj,ik) 
    364 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
    365             END DO 
    366 #  endif 
    367          END DO 
    368  
    369          ! save the new ta & sa trends 
    370          ztdta(:,:,:) = ta(:,:,:) 
    371          ztdsa(:,:,:) = sa(:,:,:) 
    372  
    373       ENDIF 
    374  
    375 #endif 
    376282 
    377283      ! 5. Along sigma advective trend 
    … …  
    398304            zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztbb(ji  ,jj  )   & 
    399305               &          +( zfui - ABS( zfui ) ) * ztbb(ji+1,jj  ) ) * 0.5 
    400             zwy(ji,jj) = ( ( zfui + ABS( zfvj ) ) * ztbb(ji  ,jj  )   & 
    401                &          +( zfui - ABS( zfvj ) ) * ztbb(ji  ,jj+1) ) * 0.5 
     306            zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztbb(ji  ,jj  )   & 
     307               &          +( zfvj - ABS( zfvj ) ) * ztbb(ji  ,jj+1) ) * 0.5 
    402308            zww(ji,jj) = ( ( zfui + ABS( zfui ) ) * zsbb(ji  ,jj  )   & 
    403309               &          +( zfui - ABS( zfui ) ) * zsbb(ji+1,jj  ) ) * 0.5 
    404             zwz(ji,jj) = ( ( zfui + ABS( zfvj ) ) * zsbb(ji  ,jj  )   & 
    405                &          +( zfui - ABS( zfvj ) ) * zsbb(ji  ,jj+1) ) * 0.5 
     310            zwz(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * zsbb(ji  ,jj  )   & 
     311               &          +( zfvj - ABS( zfvj ) ) * zsbb(ji  ,jj+1) ) * 0.5 
    406312#if ! defined key_vectopt_loop   ||   defined key_autotasking 
    407313         END DO 
    … …  
    462368      DO jk= 1, jpkm1 
    463369         DO jj=1, jpjm1 
    464             DO ji = 1, fs_jpim1   ! vertor opt. 
    465                zwu(ji,jj) = -e2u(ji,jj) * u_bbl(ji,jj,jk) 
    466                zwv(ji,jj) = -e1v(ji,jj) * v_bbl(ji,jj,jk) 
     370            DO ji = 1, fs_jpim1   ! vector opt. 
     371               zwu(ji,jj) = -e2u(ji,jj) * u_bbl(ji,jj,jk) * fse3u(ji,jj,jk) 
     372               zwv(ji,jj) = -e1v(ji,jj) * v_bbl(ji,jj,jk) * fse3v(ji,jj,jk) 
    467373            END DO 
    468374         END DO 
    … …  
    471377         DO jj = 2, jpjm1 
    472378            DO ji = fs_2, fs_jpim1   ! vector opt. 
    473                zbt = e1t(ji,jj) * e2t(ji,jj) 
     379               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    474380               zhdivn(ji,jj,jk) = (  zwu(ji,jj) - zwu(ji-1,jj  )   & 
    475381                                   + zwv(ji,jj) - zwv(ji  ,jj-1)  ) / zbt 
Note: See TracChangeset for help on using the changeset viewer.