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 11967 for NEMO/branches/2019/ENHANCE-02_ISF_nemo_TEST_MERGE/src/OCE/DYN/sshwzv.F90 – NEMO

Ignore:
Timestamp:
2019-11-26T15:11:43+01:00 (4 years ago)
Author:
davestorkey
Message:

2019/ENHANCE-02_ISF_nemo_TEST_MERGE : Update to rev 11953.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo_TEST_MERGE/src/OCE/DYN/sshwzv.F90

    r11931 r11967  
    99   !!             -   !  2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module 
    1010   !!            3.3  !  2011-10  (M. Leclair) split former ssh_wzv routine and remove all vvl related work 
     11   !!            4.0  !  2018-12  (A. Coward) add mixed implicit/explicit advection 
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    287288      !!            :   wi      : now vertical velocity (for implicit treatment) 
    288289      !! 
    289       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
     290      !! Reference  : Shchepetkin, A. F. (2015): An adaptive, Courant-number-dependent 
     291      !!              implicit scheme for vertical advection in oceanic modeling.  
     292      !!              Ocean Modelling, 91, 38-69. 
    290293      !!---------------------------------------------------------------------- 
    291294      INTEGER, INTENT(in) ::   kt   ! time step 
    … …  
    294297      REAL(wp)             ::   zCu, zcff, z1_e3t                     ! local scalars 
    295298      REAL(wp) , PARAMETER ::   Cu_min = 0.15_wp                      ! local parameters 
    296       REAL(wp) , PARAMETER ::   Cu_max = 0.27                         ! local parameters 
     299      REAL(wp) , PARAMETER ::   Cu_max = 0.30_wp                      ! local parameters 
    297300      REAL(wp) , PARAMETER ::   Cu_cut = 2._wp*Cu_max - Cu_min        ! local parameters 
    298301      REAL(wp) , PARAMETER ::   Fcu    = 4._wp*Cu_max*(Cu_max-Cu_min) ! local parameters 
    … …  
    308311      ENDIF 
    309312      ! 
    310       ! 
    311       DO jk = 1, jpkm1            ! calculate Courant numbers 
    312          DO jj = 2, jpjm1 
    313             DO ji = 2, fs_jpim1   ! vector opt. 
    314                z1_e3t = 1._wp / e3t_n(ji,jj,jk) 
    315                Cu_adv(ji,jj,jk) = 2._wp * rdt * ( ( MAX( wn(ji,jj,jk) , 0._wp ) - MIN( wn(ji,jj,jk+1) , 0._wp ) )   &  ! 2*rdt and not r2dt (for restartability) 
    316                   &                             + ( MAX( e2u(ji  ,jj)*e3u_n(ji  ,jj,jk)*un(ji  ,jj,jk), 0._wp ) -   & 
    317                   &                                 MIN( e2u(ji-1,jj)*e3u_n(ji-1,jj,jk)*un(ji-1,jj,jk), 0._wp ) )   & 
    318                   &                               * r1_e1e2t(ji,jj)                                                 & 
    319                   &                             + ( MAX( e1v(ji,jj  )*e3v_n(ji,jj  ,jk)*vn(ji,jj  ,jk), 0._wp ) -   & 
    320                   &                                 MIN( e1v(ji,jj-1)*e3v_n(ji,jj-1,jk)*vn(ji,jj-1,jk), 0._wp ) )   & 
    321                   &                               * r1_e1e2t(ji,jj)                                                 & 
    322                   &                             ) * z1_e3t 
     313      ! Calculate Courant numbers 
     314      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
     315         DO jk = 1, jpkm1 
     316            DO jj = 2, jpjm1 
     317               DO ji = 2, fs_jpim1   ! vector opt. 
     318                  z1_e3t = 1._wp / e3t_n(ji,jj,jk) 
     319                  ! 2*rdt and not r2dt (for restartability) 
     320                  Cu_adv(ji,jj,jk) = 2._wp * rdt * ( ( MAX( wn(ji,jj,jk) , 0._wp ) - MIN( wn(ji,jj,jk+1) , 0._wp ) )                       &   
     321                     &                             + ( MAX( e2u(ji  ,jj)*e3u_n(ji  ,jj,jk)*un(ji  ,jj,jk) + un_td(ji  ,jj,jk), 0._wp ) -   & 
     322                     &                                 MIN( e2u(ji-1,jj)*e3u_n(ji-1,jj,jk)*un(ji-1,jj,jk) + un_td(ji-1,jj,jk), 0._wp ) )   & 
     323                     &                               * r1_e1e2t(ji,jj)                                                                     & 
     324                     &                             + ( MAX( e1v(ji,jj  )*e3v_n(ji,jj  ,jk)*vn(ji,jj  ,jk) + vn_td(ji,jj  ,jk), 0._wp ) -   & 
     325                     &                                 MIN( e1v(ji,jj-1)*e3v_n(ji,jj-1,jk)*vn(ji,jj-1,jk) + vn_td(ji,jj-1,jk), 0._wp ) )   & 
     326                     &                               * r1_e1e2t(ji,jj)                                                                     & 
     327                     &                             ) * z1_e3t 
     328               END DO 
    323329            END DO 
    324330         END DO 
    325       END DO 
     331      ELSE 
     332         DO jk = 1, jpkm1 
     333            DO jj = 2, jpjm1 
     334               DO ji = 2, fs_jpim1   ! vector opt. 
     335                  z1_e3t = 1._wp / e3t_n(ji,jj,jk) 
     336                  ! 2*rdt and not r2dt (for restartability) 
     337                  Cu_adv(ji,jj,jk) = 2._wp * rdt * ( ( MAX( wn(ji,jj,jk) , 0._wp ) - MIN( wn(ji,jj,jk+1) , 0._wp ) )   &  
     338                     &                             + ( MAX( e2u(ji  ,jj)*e3u_n(ji  ,jj,jk)*un(ji  ,jj,jk), 0._wp ) -   & 
     339                     &                                 MIN( e2u(ji-1,jj)*e3u_n(ji-1,jj,jk)*un(ji-1,jj,jk), 0._wp ) )   & 
     340                     &                               * r1_e1e2t(ji,jj)                                                 & 
     341                     &                             + ( MAX( e1v(ji,jj  )*e3v_n(ji,jj  ,jk)*vn(ji,jj  ,jk), 0._wp ) -   & 
     342                     &                                 MIN( e1v(ji,jj-1)*e3v_n(ji,jj-1,jk)*vn(ji,jj-1,jk), 0._wp ) )   & 
     343                     &                               * r1_e1e2t(ji,jj)                                                 & 
     344                     &                             ) * z1_e3t 
     345               END DO 
     346            END DO 
     347         END DO 
     348      ENDIF 
    326349      CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1. ) 
    327350      ! 
    … …  
    354377                  wn(ji,jj,jk) = ( 1._wp - zcff ) * wn(ji,jj,jk) 
    355378                  ! 
    356                   Cu_adv(ji,jj,jk) = zcff               ! Reuse array to output coefficient 
     379                  Cu_adv(ji,jj,jk) = zcff               ! Reuse array to output coefficient below and in stp_ctl 
    357380               END DO 
    358381            END DO 
    … …  
    361384      ELSE 
    362385         ! Fully explicit everywhere 
    363          Cu_adv(:,:,:) = 0._wp                          ! Reuse array to output coefficient 
     386         Cu_adv(:,:,:) = 0._wp                          ! Reuse array to output coefficient below and in stp_ctl 
    364387         wi    (:,:,:) = 0._wp 
    365388      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.