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 13461 for NEMO/trunk/src/OCE – NEMO

Changeset 13461 for NEMO/trunk/src/OCE


Ignore:
Timestamp:
2020-09-14T09:19:33+02:00 (4 years ago)
Author:
smasson
Message:

trunk: merge r4.0-HEAD 13263:13278 into the trunk, see #2523

Location:
NEMO/trunk/src/OCE
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/DOM/dommsk.F90

    r13305 r13461  
    9292      INTEGER  ::   iktop, ikbot   !   -       - 
    9393      INTEGER  ::   ios, inum 
    94       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    9594      !! 
    9695      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
     
    195194      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
    196195         ! 
    197          ALLOCATE( zwf(jpi,jpj) ) 
    198          ! 
    199196         DO jk = 1, jpk 
    200             zwf(:,:) = fmask(:,:,jk)          
    201197            DO_2D( 0, 0, 0, 0 ) 
    202198               IF( fmask(ji,jj,jk) == 0._wp ) THEN 
    203                   fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),  & 
    204                      &                                           zwf(ji-1,jj), zwf(ji,jj-1)  ) ) 
     199                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 
     200                     &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 
    205201               ENDIF 
    206202            END_2D 
    207203            DO jj = 2, jpjm1 
    208204               IF( fmask(1,jj,jk) == 0._wp ) THEN 
    209                   fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     205                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) ) 
    210206               ENDIF 
    211207               IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
    212                   fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     208                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) ) 
    213209               ENDIF 
    214210            END DO          
    215211            DO ji = 2, jpim1 
    216212               IF( fmask(ji,1,jk) == 0._wp ) THEN 
    217                   fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     213                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) ) 
    218214               ENDIF 
    219215               IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
    220                   fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     216                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) ) 
    221217               ENDIF 
    222218            END DO 
    223219         END DO 
    224          ! 
    225          DEALLOCATE( zwf ) 
    226220         ! 
    227221         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
  • NEMO/trunk/src/OCE/SBC/sbccpl.F90

    r13295 r13461  
    698698         ! Change first letter to couple with atmosphere if already coupled OPA 
    699699         ! this is nedeed as each variable name used in the namcouple must be unique: 
    700          ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 
     700         ! for example O_Runoff received by OPA from SAS and therefore S_Runoff received by SAS from the Atmosphere 
    701701         DO jn = 1, jprcv 
    702702            IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
  • NEMO/trunk/src/OCE/ZDF/zdfdrg.F90

    r13295 r13461  
    4141 
    4242   !                                 !!* Namelist namdrg: nature of drag coefficient namelist * 
    43    LOGICAL          ::   ln_OFF       ! free-slip       : Cd = 0 
     43   LOGICAL , PUBLIC ::   ln_drg_OFF   ! free-slip       : Cd = 0 
    4444   LOGICAL          ::   ln_lin       !     linear  drag: Cd = Cd0_lin 
    4545   LOGICAL          ::   ln_non_lin   ! non-linear  drag: Cd = Cd0_nl |U| 
     
    226226      INTEGER   ::   ios, ioptio   ! local integers 
    227227      !! 
    228       NAMELIST/namdrg/ ln_OFF, ln_lin, ln_non_lin, ln_loglayer, ln_drgimp 
     228      NAMELIST/namdrg/ ln_drg_OFF, ln_lin, ln_non_lin, ln_loglayer, ln_drgimp 
    229229      !!---------------------------------------------------------------------- 
    230230      ! 
     
    242242         WRITE(numout,*) '~~~~~~~~~~~~' 
    243243         WRITE(numout,*) '   Namelist namdrg : top/bottom friction choices' 
    244          WRITE(numout,*) '      free-slip       : Cd = 0                  ln_OFF      = ', ln_OFF  
     244         WRITE(numout,*) '      free-slip       : Cd = 0                  ln_drg_OFF  = ', ln_drg_OFF  
    245245         WRITE(numout,*) '      linear  drag    : Cd = Cd0                ln_lin      = ', ln_lin 
    246246         WRITE(numout,*) '      non-linear  drag: Cd = Cd0_nl |U|         ln_non_lin  = ', ln_non_lin 
     
    250250      ! 
    251251      ioptio = 0                       ! set ndrg and control check 
    252       IF( ln_OFF      ) THEN   ;   ndrg = np_OFF        ;   ioptio = ioptio + 1   ;   ENDIF 
     252      IF( ln_drg_OFF  ) THEN   ;   ndrg = np_OFF        ;   ioptio = ioptio + 1   ;   ENDIF 
    253253      IF( ln_lin      ) THEN   ;   ndrg = np_lin        ;   ioptio = ioptio + 1   ;   ENDIF 
    254254      IF( ln_non_lin  ) THEN   ;   ndrg = np_non_lin    ;   ioptio = ioptio + 1   ;   ENDIF 
  • NEMO/trunk/src/OCE/ZDF/zdfgls.F90

    r13295 r13461  
    1919   USE dom_oce        ! ocean space and time domain 
    2020   USE domvvl         ! ocean space and time domain : variable volume layer 
     21   USE zdfdrg  , ONLY : ln_drg_OFF            ! top/bottom free-slip flag 
    2122   USE zdfdrg  , ONLY : r_z0_top , r_z0_bot   ! top/bottom roughness 
    2223   USE zdfdrg  , ONLY : rCdU_top , rCdU_bot   ! top/bottom friction 
     
    169170      ! Compute surface, top and bottom friction at T-points 
    170171      DO_2D( 0, 0, 0, 0 ) 
    171          ! 
    172          ! surface friction 
    173          ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1) 
    174          !    
    175 !!gm Rq we may add here r_ke0(_top/_bot) ?  ==>> think about that... 
    176        ! bottom friction (explicit before friction) 
    177        zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    178        zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0) 
    179        ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2  & 
    180           &                                         + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2  ) 
     172         ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1)   ! surface friction 
    181173      END_2D 
    182       IF( ln_isfcav ) THEN       !top friction 
    183          DO_2D( 0, 0, 0, 0 ) 
    184             zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    185             zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0) 
    186             ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2  & 
    187                &                                         + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2  ) 
     174      ! 
     175      !!gm Rq we may add here r_ke0(_top/_bot) ?  ==>> think about that... 
     176      !     
     177      IF( .NOT.ln_drg_OFF ) THEN   !== top/bottom friction   (explicit before friction) 
     178         DO_2D( 0, 0, 0, 0 )       ! bottom friction (explicit before friction) 
     179            zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
     180            zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0) 
     181            ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2  & 
     182               &                                         + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2  ) 
    188183         END_2D 
     184         IF( ln_isfcav ) THEN 
     185            DO_2D( 0, 0, 0, 0 )    ! top friction 
     186               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
     187               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0) 
     188               ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2  & 
     189                  &                                         + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2  ) 
     190            END_2D 
     191         ENDIF 
    189192      ENDIF 
    190193    
  • NEMO/trunk/src/OCE/ZDF/zdftke.F90

    r13295 r13461  
    2828   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    2929   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only  
    30    !!             -   !  2017-05  (G. Madec)  add top/bottom friction as boundary condition (ln_drg) 
     30   !!             -   !  2017-05  (G. Madec)  add top/bottom friction as boundary condition 
    3131   !!---------------------------------------------------------------------- 
    3232 
     
    7979   REAL(wp) ::   rn_emin0  ! surface minimum value of tke   [m2/s2] 
    8080   REAL(wp) ::   rn_bshear ! background shear (>0) currently a numerical threshold (do not change it) 
    81    LOGICAL  ::   ln_drg    ! top/bottom friction forcing flag  
    8281   INTEGER  ::   nn_etau   ! type of depth penetration of surface tke (=0/1/2/3) 
    8382   INTEGER  ::      nn_htau   ! type of tke profile of penetration (=0/1) 
     
    236235      ! Note that stress averaged is done using an wet-only calculation of u and v at t-point like in zdfsh2 
    237236      ! 
    238       IF( ln_drg ) THEN       !== friction used as top/bottom boundary condition on TKE 
    239          ! 
    240          DO_2D( 0, 0, 0, 0 ) 
     237      IF( .NOT.ln_drg_OFF ) THEN    !== friction used as top/bottom boundary condition on TKE 
     238         ! 
     239         DO_2D( 0, 0, 0, 0 )        ! bottom friction 
    241240            zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    242241            zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 
     
    246245            en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 
    247246         END_2D 
    248          IF( ln_isfcav ) THEN       ! top friction 
    249             DO_2D( 0, 0, 0, 0 ) 
     247         IF( ln_isfcav ) THEN 
     248            DO_2D( 0, 0, 0, 0 )     ! top friction 
    250249               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    251250               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 
     
    610609         &                 rn_emin0, rn_bshear, nn_mxl   , ln_mxl0  ,  & 
    611610         &                 rn_mxl0 , nn_mxlice, rn_mxlice,             & 
    612          &                 nn_pdl  , ln_drg   , ln_lc    , rn_lc,      & 
     611         &                 nn_pdl  , ln_lc    , rn_lc    ,             & 
    613612         &                 nn_etau , nn_htau  , rn_efr   , rn_eice   
    614613      !!---------------------------------------------------------------------- 
     
    643642         ENDIF          
    644643         WRITE(numout,*) '         surface  mixing length minimum value        rn_mxl0   = ', rn_mxl0 
    645          WRITE(numout,*) '      top/bottom friction forcing flag            ln_drg    = ', ln_drg 
    646644         WRITE(numout,*) '      Langmuir cells parametrization              ln_lc     = ', ln_lc 
    647645         WRITE(numout,*) '         coef to compute vertical velocity of LC     rn_lc  = ', rn_lc 
     
    651649         WRITE(numout,*) '          below sea-ice:  =0 ON                      rn_eice   = ', rn_eice 
    652650         WRITE(numout,*) '          =4 OFF when ice fraction > 1/4   ' 
    653          IF( ln_drg ) THEN 
     651         IF( .NOT.ln_drg_OFF ) THEN 
    654652            WRITE(numout,*) 
    655653            WRITE(numout,*) '   Namelist namdrg_top/_bot:   used values:' 
Note: See TracChangeset for help on using the changeset viewer.