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 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90 – NEMO

Ignore:
Timestamp:
2014-12-15T17:42:49+01:00 (9 years ago)
Author:
timgraham
Message:

Merged branches/2014/dev_MERGE_2014 back onto the trunk as follows:

In the working copy of branch ran:
svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
1 conflict in LIM_SRC_3/limdiahsb.F90
Resolved by keeping the version from dev_MERGE_2014 branch
and commited at r4989

In working copy run:
svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2014/dev_MERGE_2014
to merge the branch into the trunk - no conflicts at this stage.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r4624 r4990  
    4141   REAL(wp), PUBLIC ::   rn_bfrien    ! local factor to enhance coefficient bfri (PUBLIC for TAM) 
    4242   LOGICAL , PUBLIC ::   ln_bfr2d     ! logical switch for 2D enhancement (PUBLIC for TAM) 
     43   REAL(wp), PUBLIC ::   rn_tfri1     ! top drag coefficient (linear case)  (PUBLIC for TAM) 
     44   REAL(wp), PUBLIC ::   rn_tfri2     ! top drag coefficient (non linear case) (PUBLIC for TAM) 
     45   REAL(wp), PUBLIC ::   rn_tfri2_max ! Maximum top drag coefficient (non linear case and ln_loglayer=T) (PUBLIC for TAM) 
     46   REAL(wp), PUBLIC ::   rn_tfeb2     ! background top turbulent kinetic energy  [m2/s2] (PUBLIC for TAM) 
     47   REAL(wp), PUBLIC ::   rn_tfrien    ! local factor to enhance coefficient tfri (PUBLIC for TAM) 
     48   LOGICAL , PUBLIC ::   ln_tfr2d     ! logical switch for 2D enhancement (PUBLIC for TAM) 
     49 
    4350   LOGICAL , PUBLIC ::   ln_loglayer  ! switch for log layer bfr coeff. (PUBLIC for TAM) 
    4451   REAL(wp), PUBLIC ::   rn_bfrz0     ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM) 
     52   REAL(wp), PUBLIC ::   rn_tfrz0     ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM) 
    4553   LOGICAL , PUBLIC ::   ln_bfrimp    ! logical switch for implicit bottom friction 
    46    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::  bfrcoef2d            ! 2D bottom drag coefficient (PUBLIC for TAM) 
     54   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::  bfrcoef2d, tfrcoef2d   ! 2D bottom/top drag coefficient (PUBLIC for TAM) 
    4755 
    4856   !! * Substitutions 
    … …  
    6068      !!                ***  FUNCTION zdf_bfr_alloc  *** 
    6169      !!---------------------------------------------------------------------- 
    62       ALLOCATE( bfrcoef2d(jpi,jpj), STAT=zdf_bfr_alloc ) 
     70      ALLOCATE( bfrcoef2d(jpi,jpj), tfrcoef2d(jpi,jpj), STAT=zdf_bfr_alloc ) 
    6371      ! 
    6472      IF( lk_mpp             )   CALL mpp_sum ( zdf_bfr_alloc ) 
    … …  
    8896      INTEGER  ::   ikbt, ikbu, ikbv             ! local integers 
    8997      REAL(wp) ::   zvu, zuv, zecu, zecv, ztmp   ! temporary scalars 
    90       REAL(wp), POINTER, DIMENSION(:,:) ::  zbfrt 
     98      REAL(wp), POINTER, DIMENSION(:,:) ::  zbfrt, ztfrt 
    9199      !!---------------------------------------------------------------------- 
    92100      ! 
    … …  
    101109      IF( nn_bfr == 2 ) THEN                 ! quadratic bottom friction only 
    102110         ! 
    103          CALL wrk_alloc( jpi, jpj, zbfrt ) 
     111         CALL wrk_alloc( jpi, jpj, zbfrt, ztfrt ) 
    104112 
    105113         IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient 
    106114 
    107 #  if defined key_vectopt_loop 
    108             DO jj = 1, 1 
    109 !CDIR NOVERRCHK 
    110                DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    111 #  else 
    112 !CDIR NOVERRCHK 
    113115            DO jj = 1, jpj 
    114 !CDIR NOVERRCHK 
    115116               DO ji = 1, jpi 
    116 #  endif 
    117117                  ikbt = mbkt(ji,jj) 
    118 ! JC: possible WAD implementation should modify line below if layers vanish 
     118!! JC: possible WAD implementation should modify line below if layers vanish 
    119119                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    120120                  zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) 
    121121                  zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max) 
     122! (ISF) 
     123                  ikbt = mikt(ji,jj) 
     124! JC: possible WAD implementation should modify line below if layers vanish 
     125                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
     126                  ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 
     127                  ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max) 
     128 
    122129               END DO 
    123130            END DO 
    … …  
    125132         ELSE 
    126133            zbfrt(:,:) = bfrcoef2d(:,:) 
    127          ENDIF 
    128  
    129 # if defined key_vectopt_loop 
    130          DO jj = 1, 1 
    131 !CDIR NOVERRCHK 
    132             DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    133 # else 
    134 !CDIR NOVERRCHK 
     134            ztfrt(:,:) = tfrcoef2d(:,:) 
     135         ENDIF 
     136 
    135137         DO jj = 2, jpjm1 
    136 !CDIR NOVERRCHK 
    137138            DO ji = 2, jpim1 
    138 # endif 
    139139               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
    140140               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    … …  
    150150               bfrua(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) ) * zecu 
    151151               bfrva(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) ) * zecv 
     152               ! 
     153               ! in case of 2 cell water column, we assume each cell feels the top and bottom friction 
     154               IF ( miku(ji,jj) + 2 .GE. mbku(ji,jj) ) THEN 
     155                  bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) )   & 
     156                               &            + ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) ) & 
     157                               &          * zecu * (1._wp - umask(ji,jj,1)) 
     158               END IF 
     159               IF ( mikv(ji,jj) + 2 .GE. mbkv(ji,jj) ) THEN 
     160                  bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) )   & 
     161                               &            + ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) ) & 
     162                               &          * zecv * (1._wp - vmask(ji,jj,1)) 
     163               END IF 
     164               ! (ISF) ======================================================================== 
     165               ikbu = miku(ji,jj)         ! ocean bottom level at u- and v-points  
     166               ikbv = mikv(ji,jj)         ! (deepest ocean u- and v-points) 
     167               ! 
     168               zvu  = 0.25 * (  vn(ji,jj  ,ikbu) + vn(ji+1,jj  ,ikbu)     & 
     169                  &           + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu)  ) 
     170               zuv  = 0.25 * (  un(ji,jj  ,ikbv) + un(ji-1,jj  ,ikbv)     & 
     171                  &           + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv)  ) 
     172               ! 
     173               zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 ) 
     174               zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 ) 
     175               ! 
     176               tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) * zecu * (1._wp - umask(ji,jj,1)) 
     177               tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1)) 
     178               ! (ISF) END ==================================================================== 
     179               ! in case of 2 cell water column, we assume each cell feels the top and bottom friction 
     180               IF ( miku(ji,jj) + 2 .GE. mbku(ji,jj) ) THEN 
     181                  tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) )   & 
     182                               &            + ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) ) ) & 
     183                               &          * zecu * (1._wp - umask(ji,jj,1)) 
     184               END IF 
     185               IF ( mikv(ji,jj) + 2 .GE. mbkv(ji,jj) ) THEN 
     186                  tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) )   & 
     187                               &            + ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) ) ) & 
     188                               &          * zecv * (1._wp - vmask(ji,jj,1)) 
     189               END IF 
    152190            END DO 
    153191         END DO 
    154  
    155192         ! 
    156193         CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition 
    … …  
    158195         IF(ln_ctl)   CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr  - u: ', mask1=umask,        & 
    159196            &                       tab2d_2=bfrva, clinfo2=       ' v: ', mask2=vmask,ovlap=1 ) 
    160          CALL wrk_dealloc( jpi,jpj,zbfrt ) 
     197         CALL wrk_dealloc( jpi,jpj,zbfrt, ztfrt ) 
    161198      ENDIF 
    162199      ! 
    … …  
    183220      INTEGER   ::   ios 
    184221      REAL(wp)  ::   zminbfr, zmaxbfr   ! temporary scalars 
     222      REAL(wp)  ::   zmintfr, zmaxtfr   ! temporary scalars 
    185223      REAL(wp)  ::   ztmp, zfru, zfrv   !    -         - 
    186224      !! 
    187225      NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfri2_max, rn_bfeb2, rn_bfrz0, ln_bfr2d, & 
    188                     &  rn_bfrien, ln_bfrimp, ln_loglayer 
     226                    &          rn_tfri1, rn_tfri2, rn_tfri2_max, rn_tfeb2, rn_tfrz0, ln_tfr2d, & 
     227                    &  rn_bfrien, rn_tfrien, ln_bfrimp, ln_loglayer 
    189228      !!---------------------------------------------------------------------- 
    190229      ! 
    … …  
    215254         bfrua(:,:) = 0.e0 
    216255         bfrva(:,:) = 0.e0 
     256         tfrua(:,:) = 0.e0 
     257         tfrva(:,:) = 0.e0 
    217258         ! 
    218259      CASE( 1 ) 
    219260         IF(lwp) WRITE(numout,*) '      linear botton friction' 
    220          IF(lwp) WRITE(numout,*) '      friction coef.   rn_bfri1  = ', rn_bfri1 
     261         IF(lwp) WRITE(numout,*) '      bottom friction coef.   rn_bfri1  = ', rn_bfri1 
    221262         IF( ln_bfr2d ) THEN 
    222263            IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_bfr2d  = ', ln_bfr2d 
    223264            IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien 
     265         ENDIF 
     266         IF(lwp) WRITE(numout,*) '      top    friction coef.   rn_bfri1  = ', rn_bfri1 
     267         IF( ln_tfr2d ) THEN 
     268            IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
     269            IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
    224270         ENDIF 
    225271         ! 
    … …  
    252298            IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien 
    253299         ENDIF 
     300         IF(lwp) WRITE(numout,*) '      quadratic top    friction' 
     301         IF(lwp) WRITE(numout,*) '      friction coef.   rn_bfri2  = ', rn_tfri2 
     302         IF(lwp) WRITE(numout,*) '      Max. coef. (log case)   rn_tfri2_max  = ', rn_tfri2_max 
     303         IF(lwp) WRITE(numout,*) '      background tke   rn_tfeb2  = ', rn_tfeb2 
     304         IF(lwp) WRITE(numout,*) '      log formulation   ln_tfr2d = ', ln_loglayer 
     305         IF(lwp) WRITE(numout,*) '      bottom roughness  rn_tfrz0 [m] = ', rn_tfrz0 
     306         IF( rn_tfrz0<=0.e0 ) THEN 
     307            WRITE(ctmp1,*) '      bottom roughness must be strictly positive' 
     308            CALL ctl_stop( ctmp1 ) 
     309         ENDIF 
     310         IF( ln_tfr2d ) THEN 
     311            IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
     312            IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
     313         ENDIF 
    254314         ! 
    255315         IF(ln_bfr2d) THEN 
    … …  
    265325         ! 
    266326         IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all 
    267 #  if defined key_vectopt_loop 
    268             DO jj = 1, 1 
    269 !CDIR NOVERRCHK 
    270                DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    271 #  else 
    272 !CDIR NOVERRCHK 
    273327            DO jj = 1, jpj 
    274 !CDIR NOVERRCHK 
    275328               DO ji = 1, jpi 
    276 #  endif 
    277329                  ikbt = mbkt(ji,jj) 
    278330                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    … …  
    308360      zminbfr =  1.e10_wp    ! initialise tracker for minimum of bottom friction coefficient 
    309361      zmaxbfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient 
    310       ! 
    311 #  if defined key_vectopt_loop 
    312       DO jj = 1, 1 
    313 !CDIR NOVERRCHK 
    314          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    315 #  else 
    316 !CDIR NOVERRCHK 
     362      zmintfr =  1.e10_wp    ! initialise tracker for minimum of bottom friction coefficient 
     363      zmaxtfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient 
     364      ! 
    317365      DO jj = 2, jpjm1 
    318 !CDIR NOVERRCHK 
    319366         DO ji = 2, jpim1 
    320 #  endif 
    321367             ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points 
    322368             ikbv = mbkv(ji,jj) 
    … …  
    352398         WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' V-points ' 
    353399         WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr 
     400         WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr 
    354401         WRITE(numout,*) ' Bottom friction coefficient will be reduced where necessary' 
    355402      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.