Changeset 10030


Ignore:
Timestamp:
2018-08-03T10:18:16+02:00 (2 years ago)
Author:
gm
Message:

#1911 (ENHANCE-04): RK3 branch - step II.3 remove e3uw_$ e3vw_$, except e3.w_0 and use only after e3 in dyn/trazdf

Location:
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/iceistate.F90

    r10009 r10030  
    421421            ! 
    422422            !                             !* BEFORE fields :  
    423             CALL ssh2e3_before               ! set:      hu , hv , r1_hu, r1_hv  
    424             !                                    !  e3t, e3w, e3u, e3uw, e3v, e3vw 
     423            CALL ssh2e3_before               ! set:       hu,  hv, r1_hu, r1_hv  
     424            !                                    !  e3t, e3u, e3v, e3w 
    425425            ! 
    426426            !                             !* NOW fields :  
    427             CALL ssh2e3_now                  ! set: ht , hu , hv , r1_hu, r1_hv 
    428             !                                !      e3t, e3w, e3u, e3uw, e3v, e3vw, e3f 
     427            CALL ssh2e3_now                  ! set:  ht,  hu,  hv, r1_hu, r1_hv 
     428            !                                !      e3t, e3u, e3v, e3w  , e3f 
    429429            !                                !      gdept_n, gdepw_n, gde3w_n 
    430430         ENDIF 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/NST/agrif_oce_update.F90

    r10010 r10030  
    258258      e3u_a(:,:,:) = e3u_n(:,:,:) 
    259259      e3v_a(:,:,:) = e3v_n(:,:,:) 
    260 !      ua(:,:,:) = e3u_b(:,:,:) 
    261 !      va(:,:,:) = e3v_b(:,:,:) 
    262       hu_a(:,:) = hu_n(:,:) 
    263       hv_a(:,:) = hv_n(:,:) 
    264  
     260      hu_a (:,:)   = hu_n (:,:) 
     261      hv_a (:,:)   = hv_n (:,:) 
     262      ! 
    265263      !                          !* NOW fields :  
    266       CALL ssh2e3_now                  ! set: ht , hu , hv , r1_hu, r1_hv 
    267       !                                !      e3t, e3w, e3u, e3uw, e3v, e3vw, e3f   (from 1 to jpkm1) 
    268       !                                !      gdept_n, gdepw_n, gde3w_n 
     264      CALL ssh2e3_now                  ! set:  ht,  hu,  hv, r1_hu, r1_hv 
     265      !                                !      e3t, e3u, e3v, e3f               (from 1 to jpkm1) 
     266      !                                !      e3w, gdept_n, gdepw_n, gde3w_n   (from 1 to jpk  ) 
    269267 
    270268      !                          !* BEFORE fields :  
    271269      IF (.NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN 
    272270         ! 
    273          CALL ssh2e3_before               ! set:      hu , hv , r1_hu, r1_hv  
    274          !                                !      e3t, e3w, e3u, e3uw, e3v, e3vw        (from 1 to jpkm1) 
    275          ! 
     271         CALL ssh2e3_before               ! set:       hu,  hv, r1_hu, r1_hv  
     272         !                                !      e3t, e3u, e3v                 (from 1 to jpkm1) 
     273         !                                !      e3w                           (from 1 to jpk  ) 
    276274      ENDIF 
    277275      ! 
     
    304302               DO jj = j1, j2 
    305303                  DO ji = i1, i2 
    306                      tabres(ji,jj,jk,jn) = (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 
    307                                            * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp 
     304                     tabres(ji,jj,jk,jn) =  tmask(ji,jj,jk)    * (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) )  & 
     305                                         + (tmask(ji,jj,jk)-1) * 999._wp 
    308306                  END DO 
    309307               END DO 
     
    313311            DO jj = j1, j2 
    314312               DO ji = i1, i2 
    315                   tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) & 
    316                                            + (tmask(ji,jj,jk)-1)*999._wp 
     313                  tabres(ji,jj,jk,n2) =  tmask(ji,jj,jk)    * e3t_n(ji,jj,jk)  & 
     314                     &                + (tmask(ji,jj,jk)-1) * 999._wp 
    317315               END DO 
    318316            END DO 
     
    352350 
    353351         IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN       ! Add asselin part 
    354  
    355 !!gm         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    356352            DO jn = n1, n2-1 
    357353               DO jk = 1, jpk 
     
    416412         END DO 
    417413!< jc tmp 
    418          IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN 
    419 !!gm         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    420             ! Add asselin part 
     414         IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN    ! Add asselin part 
    421415            DO jn = 1,jpts 
    422416               DO jk = k1, k2 
     
    447441         ! 
    448442         IF ( l_1st_euler .AND. Agrif_Nb_Step() == 0 ) THEN 
    449 !!gm         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    450443            tsb(i1:i2,j1:j2,k1:k2,1:jpts)  = tsn(i1:i2,j1:j2,k1:k2,1:jpts) 
    451444         ENDIF 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/dom_oce.F90

    r10023 r10030  
    135135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    136136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b ,   e3w_n ,  e3w_a   !: w- vert. scale factor [m] 
    137    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    138    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
     137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0                                !: uw-vert. scale factor [m] 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0                                !: vw-vert. scale factor [m] 
    139139   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
    140140 
     
    270270         &      e3t(jpi,jpj,jpk,Nt) , e3u(jpi,jpj,jpk,Nt) , e3v(jpi,jpj,jpk,Nt) ,                                          & 
    271271         !                                                          ! 
    272          &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) ,         & 
    273          &      e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,         &                
    274          &      e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) ,     STAT=ierr(5) )                        
     272         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) ,     STAT=ierr(5) )                        
    275273         ! 
    276274      ALLOCATE( ht_0(jpi,jpj)    , hu_0(jpi,jpj)   , hv_0(jpi,jpj)    , hf_0(jpi,jpj)    ,                     & 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domain.F90

    r10023 r10030  
    170170                                 gde3w_n = gde3w_0   !        ---          ! grid-points 
    171171         !                   !                       !                     !                                               
    172           e3t_b =   e3t_0   ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    !  scale  
    173           e3u_b =   e3u_0   ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    ! factors 
    174           e3v_b =   e3v_0   ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    ! 
     172           e3t_b =   e3t_0   ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    !  scale  
     173           e3u_b =   e3u_0   ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    ! factors 
     174           e3v_b =   e3v_0   ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    ! 
    175175                                   e3f_n =   e3f_0   !        ---          ! 
    176           e3w_b  =   e3w_0   ;     e3w_n =   e3w_0   !        ---          ! 
    177          e3uw_b  =  e3uw_0   ;    e3uw_n =  e3uw_0   !        ---          ! 
    178          e3vw_b  =  e3vw_0   ;    e3vw_n =  e3vw_0   !        ---          ! 
     176           e3w_b =   e3w_0   ;     e3w_n =   e3w_0   !        ---          ! 
    179177         !                   ! 
    180178                                    ht_n =    ht_0   !                     ! water column 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domvvl.F90

    r10023 r10030  
    144144      CALL ssh2e3_before               ! set:      hu , hv , r1_hu, r1_hv  
    145145      !                                !      e3t, e3u , e3v              (from 1 to jpkm1) 
    146       !                                !      e3w, e3uw, e3vw             (from 1 to jpk  ) 
    147       !                                !      gdept, gdepw                (from 1 to jpk  ) 
     146      !                                !      e3w, gdept, gdepw           (from 1 to jpk  ) 
    148147      ! 
    149148      !                                ! set jpk level one to the e3._0 values 
     
    153152      CALL ssh2e3_now                  ! set: ht , hu , hv , r1_hu, r1_hv 
    154153      !                                !      e3t, e3u , e3v, e3f         (from 1 to jpkm1) 
    155       !                                !      e3w, e3uw, e3vw             (from 1 to jpk  ) 
    156       !                                !      gdept, gdepw, gde3w         (from 1 to jpk  ) 
     154      !                                !      e3w, gdept, gdepw, gde3w    (from 1 to jpk  ) 
    157155      ! 
    158156      !                                ! set one for all last level to the e3._0 value 
    159       e3t_n(:,:,jpk) = e3t_0(:,:,jpk)  ;   e3u_n(:,:,jpk) =  e3u_0(:,:,jpk)  ;   e3v_n(:,:,jpk) =  e3v_0(:,:,jpk) 
    160       e3f_n(:,:,jpk) = e3f_0(:,:,jpk) 
     157      e3t_n(:,:,jpk) = e3t_0(:,:,jpk)  ;   e3u_n(:,:,jpk) =  e3u_0(:,:,jpk) 
     158      e3f_n(:,:,jpk) = e3f_0(:,:,jpk)  ;   e3v_n(:,:,jpk) =  e3v_0(:,:,jpk) 
    161159      ! 
    162160      !                          !* AFTER fields : (last level for OPA, 3D required for AGRIF initialisation) 
     
    215213      !     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    216214      !     e3w_0 ,   e3w_b ,   e3w_n ,  e3w_a   !: w- vert. scale factor [m] 
    217       !    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    218       !    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
    219215      !     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
    220216      ! 
     
    332328      ! - JC - hu_b, hv_b, hur_b, hvr_b also 
    333329      ! 
    334       ! - GM - to be updated :   e3f_n,  e3w_n , e3uw_n , e3vw_n  
    335       !                                  e3w_b , e3uw_b , e3vw_b 
     330      ! - GM - to be updated :   e3f_n   ,  e3w_n  , e3w_b 
    336331      !                          gdept_n , gdepw_n , gde3w_n 
    337332      !                          ht_n 
     
    356351      ! 
    357352      !                    !==  before  ==! 
    358       !                                            !* ssh at u- and v-points) 
    359       DO jj = 2, jpjm1   ;   DO ji = 2, jpim1 
    360          zsshu_h(ji,jj) = 0.5_wp  * ( ssh(ji,jj,Nbb) + ssh(ji+1,jj  ,Nbb) ) * ssumask(ji,jj) 
    361          zsshv_h(ji,jj) = 0.5_wp  * ( ssh(ji,jj,Nbb) + ssh(ji  ,jj+1,Nbb) ) * ssvmask(ji,jj) 
    362       END DO             ;   END DO       
    363       CALL lbc_lnk_multi( zsshu_h(:,:),'U', 1._wp , zsshv_h(:,:),'V', 1._wp ) 
    364       ! 
    365       !                                            !*  e3w_b , e3uw_b , e3vw_b 
     353      !                                            !*  e3w_b 
    366354      zssht_h(:,:) = ssh    (:,:,Nbb) * r1_ht_0(:,:)     ! w-point 
    367       zsshu_h(:,:) = zsshu_h(:,:)     * r1_hu_0(:,:)     ! uw-point 
    368       zsshv_h(:,:) = zsshv_h(:,:)     * r1_hv_0(:,:)     ! vw-point 
    369       DO jk = 1, jpkm1 
    370           e3w_b(:,:,jk) =  e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 
    371          e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 
    372          e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 
     355      ! 
     356      e3w_b(:,:,1) =  e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) *  tmask(:,:,1) ) 
     357      DO jk = 2, jpk 
     358         e3w_b(:,:,jk) =  e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) ,  tmask(:,:,jk) ) ) 
    373359      END DO 
    374360      !  
     
    388374      !       
    389375      !                    !==   now    ==! 
    390       !                                            !* ssh at u- and v-points) 
    391       DO jj = 1, jpjm1   ;   DO ji = 1, jpim1            ! start from 1 for f-point 
    392          zsshu_h(ji,jj) = 0.50_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji+1,jj  ,Nnn) ) * ssumask(ji,jj) 
    393          zsshv_h(ji,jj) = 0.50_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji  ,jj+1,Nnn) ) * ssvmask(ji,jj) 
    394          zsshf_h(ji,jj) = 0.25_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji  ,jj+1,Nnn)   &  
    395             &                       + ssh(ji+1,jj,Nnn) + ssh(ji+1,jj+1,Nnn) ) * ssfmask(ji,jj) 
    396       END DO             ;   END DO       
    397       CALL lbc_lnk_multi( zsshu_h(:,:),'U', 1._wp , zsshv_h(:,:),'V', 1._wp , zsshf_h(:,:),'F', 1._wp )       
    398       ! 
    399       !                                            !* e3w_n , e3uw_n , e3vw_n, e3f_n  
    400       zssht_h(:,:) = ssh    (:,:,Nnn) * r1_ht_0(:,:)     ! t- & w-point 
    401       zsshu_h(:,:) = zsshu_h(:,:)     * r1_hu_0(:,:)     ! uw-point 
    402       zsshv_h(:,:) = zsshv_h(:,:)     * r1_hv_0(:,:)     ! vw-point 
    403       zsshf_h(:,:) = zsshf_h(:,:)     * r1_hf_0(:,:)     ! f-point 
     376      !                                            !* ssh at f-points 
     377      DO jj = 1, jpjm1 
     378         DO ji = 1, jpim1            ! start from 1 for f-point 
     379            zsshf_h(ji,jj) = 0.25_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji  ,jj+1,Nnn)   &  
     380               &                       + ssh(ji+1,jj,Nnn) + ssh(ji+1,jj+1,Nnn) ) * ssfmask(ji,jj) 
     381         END DO 
     382      END DO       
     383      CALL lbc_lnk( zsshf_h(:,:),'F', 1._wp )       
     384      ! 
     385      !                                            !* e3f_n  
     386      zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:)     ! f-point 
     387      ! 
    404388      DO jk = 1, jpkm1 
    405          e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,jk) ) 
    406          e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,jk) ) 
    407           e3f_n(:,:,jk) =  e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) *  fmask(:,:,jk) ) 
     389          e3f_n(:,:,jk) =  e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 
    408390      END DO       
    409       !  
    410       zssht_h(:,:) = 1._wp + zssht_h(:,:)          !* gdept , gdepw , gde3w 
     391      ! 
     392      !                                            !* gdept_n , gdepw_n , gde3w_n 
     393      zssht_h(:,:) = 1._wp + ssh(:,:,Nnn) * r1_ht_0(:,:)  
    411394      ! 
    412395      IF( ln_isfcav ) THEN    ! ISF cavities : ssh scaling not applied over the iceshelf thickness  
     
    633616      !     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    634617      !     e3w_0 ,   e3w_b ,   e3w_n ,  e3w_a   !: w- vert. scale factor [m] 
    635       !    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    636       !    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
    637618      !     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
    638619      ! 
     
    658639      ! 
    659640      !                             !==  ssh at u- and v-points  ==! 
    660       ! 
    661       DO jj = 1, jpjm1                    ! start from 1 due to f-point 
    662          DO ji = 1, jpim1 
     641      DO jj = 1, jpjm1 
     642         DO ji = 1, jpim1                 ! start from 1 due to f-point 
    663643            zsshu_h(ji,jj) = 0.50_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji+1,jj  ,Nnn) ) * ssumask(ji,jj) 
    664644            zsshv_h(ji,jj) = 0.50_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji  ,jj+1,Nnn) ) * ssvmask(ji,jj) 
     
    670650      ! 
    671651      !                             !==  ht, hu and hv  == !   (and their inverse) 
    672       ! 
    673652      ht_n   (:,:) = ht_0(:,:) +  ssh   (:,:,Nnn) 
    674653      hu_n   (:,:) = hu_0(:,:) + zsshu_h(:,:) 
     
    678657      !       
    679658      !                             !==  ssh / h  factor at t-, u- ,v- & f-points  ==! 
    680       ! 
    681659      zssht_h(:,:) =  ssh   (:,:,Nnn) * r1_ht_0(:,:) 
    682660      zsshu_h(:,:) = zsshu_h(:,:)     * r1_hu_0(:,:) 
     
    684662      zsshf_h(:,:) = zsshf_h(:,:)     * r1_hf_0(:,:) 
    685663      ! 
    686       !                             !==  e3t  ,  e3u  ,  e3v  ,  e3f  ==! 
    687       !       
     664      !                             !==  e3t  ,  e3u  ,  e3v  ,  e3f  ,  e3w  ==! 
    688665      DO jk = 1, jpkm1 
    689666          e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 
     
    692669          e3f_n(:,:,jk) =  e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 
    693670      END DO 
    694       !       
    695       !                             !==  e3w  ,  e3uw  ,  e3vw  ==! 
    696       ! 
    697        e3w_n(:,:,1) =  e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) *  tmask(:,:,1) ) 
    698       e3uw_n(:,:,1) = e3uw_0(:,:,1) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,1) ) 
    699       e3vw_n(:,:,1) = e3vw_0(:,:,1) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,1) ) 
     671      e3w_n(:,:,1) = e3w_0(:,:,1) * (  1._wp + zssht_h(:,:) *  tmask(:,:,1)  ) 
    700672      DO jk = 2, jpk 
    701           e3w_n(:,:,jk) =  e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX(  tmask(:,:,jk-1) ,  tmask(:,:,jk) ) ) 
    702          e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * MAX( wumask(:,:,jk-1) , wumask(:,:,jk) ) ) 
    703          e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * MAX( wvmask(:,:,jk-1) , wvmask(:,:,jk) ) ) 
     673         e3w_n(:,:,jk) = e3w_0(:,:,jk) * (  1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) )  ) 
    704674      END DO 
    705675      ! 
     
    733703      !     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    734704      !     e3w_0 ,   e3w_b ,   e3w_n ,  e3w_a   !: w- vert. scale factor [m] 
    735       !    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    736       !    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
    737705      !     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
    738706      ! 
     
    778746      zsshv_h(:,:) = zsshv_h(:,:)     * r1_hv_0(:,:) 
    779747      ! 
    780       !                             !==  e3t  ,  e3u  ,  e3v  ==! 
    781       !       
     748      !                             !==  e3t  ,  e3u  ,  e3v ,  e3w  ==! 
    782749      DO jk = 1, jpkm1 
    783750          e3t_b(:,:,jk) =  e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 
     
    785752          e3v_b(:,:,jk) =  e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 
    786753      END DO 
    787       !       
    788       !                             !==  e3w  ,  e3uw  ,  e3vw  ==! 
    789       ! 
    790        e3w_b(:,:,1) =  e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) *  tmask(:,:,1) ) 
    791       e3uw_b(:,:,1) = e3uw_0(:,:,1) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,1) ) 
    792       e3vw_b(:,:,1) = e3vw_0(:,:,1) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,1) ) 
     754      e3w_b(:,:,1) = e3w_0(:,:,1) * (  1._wp + zssht_h(:,:) *  tmask(:,:,1)  ) 
    793755      DO jk = 2, jpk 
    794           e3w_b(:,:,jk) =  e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX(  tmask(:,:,jk-1) ,  tmask(:,:,jk) ) ) 
    795          e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * MAX( wumask(:,:,jk-1) , wumask(:,:,jk) ) ) 
    796          e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * MAX( wvmask(:,:,jk-1) , wvmask(:,:,jk) ) ) 
     756         e3w_b(:,:,jk) = e3w_0(:,:,jk) * (  1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) )  ) 
    797757      END DO 
    798758      !    
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domvvl_RK3.F90

    r10023 r10030  
    144144      CALL ssh2e3_before               ! set:      hu , hv , r1_hu, r1_hv  
    145145      !                                !      e3t, e3u , e3v              (from 1 to jpkm1) 
    146       !                                !      e3w, e3uw, e3vw             (from 1 to jpk  ) 
    147       !                                !      gdept, gdepw                (from 1 to jpk  ) 
     146      !                                !      e3w, gdept, gdepw           (from 1 to jpk  ) 
    148147      ! 
    149148      !                                ! set jpk level one to the e3._0 values 
     
    153152      CALL ssh2e3_now                  ! set: ht , hu , hv , r1_hu, r1_hv 
    154153      !                                !      e3t, e3u , e3v, e3f         (from 1 to jpkm1) 
    155       !                                !      e3w, e3uw, e3vw             (from 1 to jpk  ) 
    156       !                                !      gdept, gdepw, gde3w         (from 1 to jpk  ) 
     154      !                                !      e3w, gdept, gdepw, gde3w    (from 1 to jpk  ) 
    157155      ! 
    158156      !                                ! set one for all last level to the e3._0 value 
     
    215213      !     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    216214      !     e3w_0 ,   e3w_b ,   e3w_n ,  e3w_a   !: w- vert. scale factor [m] 
    217       !    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    218       !    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
     215      !    e3uw_0                                !: uw-vert. scale factor [m] 
     216      !    e3vw_0                                !: vw-vert. scale factor [m] 
    219217      !     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
    220218      ! 
     
    332330      ! - JC - hu_b, hv_b, hur_b, hvr_b also 
    333331      ! 
    334       ! - GM - to be updated :   e3f_n,  e3w_n , e3uw_n , e3vw_n  
    335       !                                  e3w_b , e3uw_b , e3vw_b 
     332      ! - GM - to be updated :   e3f_n   ,  e3w_n  , e3w_b 
    336333      !                          gdept_n , gdepw_n , gde3w_n 
    337334      !                          ht_n 
     
    356353      ! 
    357354      !                    !==  before  ==! 
    358       !                                            !* ssh at u- and v-points) 
    359       DO jj = 2, jpjm1   ;   DO ji = 2, jpim1 
    360          zsshu_h(ji,jj) = 0.5_wp  * ( ssh(ji,jj,Nbb) + ssh(ji+1,jj  ,Nbb) ) * ssumask(ji,jj) 
    361          zsshv_h(ji,jj) = 0.5_wp  * ( ssh(ji,jj,Nbb) + ssh(ji  ,jj+1,Nbb) ) * ssvmask(ji,jj) 
    362       END DO             ;   END DO       
    363       CALL lbc_lnk_multi( zsshu_h(:,:),'U', 1._wp , zsshv_h(:,:),'V', 1._wp ) 
    364       ! 
    365       !                                            !*  e3w_b , e3uw_b , e3vw_b 
     355      !                                            !*  e3w_b 
    366356      zssht_h(:,:) = ssh    (:,:,Nbb) * r1_ht_0(:,:)     ! w-point 
    367       zsshu_h(:,:) = zsshu_h(:,:)     * r1_hu_0(:,:)     ! uw-point 
    368       zsshv_h(:,:) = zsshv_h(:,:)     * r1_hv_0(:,:)     ! vw-point 
    369       DO jk = 1, jpkm1 
    370           e3w_b(:,:,jk) =  e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 
    371          e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 
    372          e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 
     357      ! 
     358      e3w_b(:,:,1) =  e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) *  tmask(:,:,1) ) 
     359      DO jk = 2, jpk 
     360         e3w_b(:,:,jk) =  e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) ,  tmask(:,:,jk) ) ) 
    373361      END DO 
    374362      !  
     
    388376      !       
    389377      !                    !==   now    ==! 
    390       !                                            !* ssh at u- and v-points) 
    391       DO jj = 1, jpjm1   ;   DO ji = 1, jpim1            ! start from 1 for f-point 
    392          zsshu_h(ji,jj) = 0.50_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji+1,jj  ,Nnn) ) * ssumask(ji,jj) 
    393          zsshv_h(ji,jj) = 0.50_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji  ,jj+1,Nnn) ) * ssvmask(ji,jj) 
    394          zsshf_h(ji,jj) = 0.25_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji  ,jj+1,Nnn)   &  
    395             &                       + ssh(ji+1,jj,Nnn) + ssh(ji+1,jj+1,Nnn) ) * ssfmask(ji,jj) 
    396       END DO             ;   END DO       
    397       CALL lbc_lnk_multi( zsshu_h(:,:),'U', 1._wp , zsshv_h(:,:),'V', 1._wp , zsshf_h(:,:),'F', 1._wp )       
    398       ! 
    399       !                                            !* e3w_n , e3uw_n , e3vw_n, e3f_n  
    400       zssht_h(:,:) = ssh    (:,:,Nnn) * r1_ht_0(:,:)     ! t- & w-point 
    401       zsshu_h(:,:) = zsshu_h(:,:)     * r1_hu_0(:,:)     ! uw-point 
    402       zsshv_h(:,:) = zsshv_h(:,:)     * r1_hv_0(:,:)     ! vw-point 
    403       zsshf_h(:,:) = zsshf_h(:,:)     * r1_hf_0(:,:)     ! f-point 
     378      !                                            !* ssh at f-points 
     379      DO jj = 1, jpjm1 
     380         DO ji = 1, jpim1            ! start from 1 for f-point 
     381            zsshf_h(ji,jj) = 0.25_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji  ,jj+1,Nnn)   &  
     382               &                       + ssh(ji+1,jj,Nnn) + ssh(ji+1,jj+1,Nnn) ) * ssfmask(ji,jj) 
     383         END DO 
     384      END DO       
     385      CALL lbc_lnk( zsshf_h(:,:),'F', 1._wp )       
     386      ! 
     387      !                                            !* e3f_n  
     388      zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:)     ! f-point 
     389      ! 
    404390      DO jk = 1, jpkm1 
    405          e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,jk) ) 
    406          e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,jk) ) 
    407           e3f_n(:,:,jk) =  e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) *  fmask(:,:,jk) ) 
     391          e3f_n(:,:,jk) =  e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 
    408392      END DO       
    409       !  
    410       zssht_h(:,:) = 1._wp + zssht_h(:,:)          !* gdept , gdepw , gde3w 
     393      ! 
     394      !                                            !* gdept_n , gdepw_n , gde3w_n 
     395      zssht_h(:,:) = 1._wp + ssh(:,:,Nnn) * r1_ht_0(:,:)  
    411396      ! 
    412397      IF( ln_isfcav ) THEN    ! ISF cavities : ssh scaling not applied over the iceshelf thickness  
     
    633618      !     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    634619      !     e3w_0 ,   e3w_b ,   e3w_n ,  e3w_a   !: w- vert. scale factor [m] 
    635       !    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    636       !    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
     620      !    e3uw_0                                !: uw-vert. scale factor [m] 
     621      !    e3vw_0                                !: vw-vert. scale factor [m] 
    637622      !     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
    638623      ! 
     
    658643      ! 
    659644      !                             !==  ssh at u- and v-points  ==! 
    660       ! 
    661       DO jj = 1, jpjm1                    ! start from 1 due to f-point 
    662          DO ji = 1, jpim1 
     645      DO jj = 1, jpjm1 
     646         DO ji = 1, jpim1                 ! start from 1 due to f-point 
    663647            zsshu_h(ji,jj) = 0.50_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji+1,jj  ,Nnn) ) * ssumask(ji,jj) 
    664648            zsshv_h(ji,jj) = 0.50_wp * ( ssh(ji  ,jj,Nnn) + ssh(ji  ,jj+1,Nnn) ) * ssvmask(ji,jj) 
     
    670654      ! 
    671655      !                             !==  ht, hu and hv  == !   (and their inverse) 
    672       ! 
    673656      ht_n   (:,:) = ht_0(:,:) +  ssh   (:,:,Nnn) 
    674657      hu_n   (:,:) = hu_0(:,:) + zsshu_h(:,:) 
     
    678661      !       
    679662      !                             !==  ssh / h  factor at t-, u- ,v- & f-points  ==! 
    680       ! 
    681663      zssht_h(:,:) =  ssh   (:,:,Nnn) * r1_ht_0(:,:) 
    682664      zsshu_h(:,:) = zsshu_h(:,:)     * r1_hu_0(:,:) 
     
    684666      zsshf_h(:,:) = zsshf_h(:,:)     * r1_hf_0(:,:) 
    685667      ! 
    686       !                             !==  e3t  ,  e3u  ,  e3v  ,  e3f  ==! 
    687       !       
     668      !                             !==  e3t  ,  e3u  ,  e3v  ,  e3f  ,  e3w  ==! 
    688669      DO jk = 1, jpkm1 
    689670          e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 
     
    692673          e3f_n(:,:,jk) =  e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 
    693674      END DO 
    694       !       
    695       !                             !==  e3w  ,  e3uw  ,  e3vw  ==! 
    696       ! 
    697        e3w_n(:,:,1) =  e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) *  tmask(:,:,1) ) 
    698       e3uw_n(:,:,1) = e3uw_0(:,:,1) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,1) ) 
    699       e3vw_n(:,:,1) = e3vw_0(:,:,1) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,1) ) 
     675      e3w_n(:,:,1) = e3w_0(:,:,1) * (  1._wp + zssht_h(:,:) *  tmask(:,:,1)  ) 
    700676      DO jk = 2, jpk 
    701           e3w_n(:,:,jk) =  e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX(  tmask(:,:,jk-1) ,  tmask(:,:,jk) ) ) 
    702          e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * MAX( wumask(:,:,jk-1) , wumask(:,:,jk) ) ) 
    703          e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * MAX( wvmask(:,:,jk-1) , wvmask(:,:,jk) ) ) 
     677         e3w_n(:,:,jk) = e3w_0(:,:,jk) * (  1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) )  ) 
    704678      END DO 
    705679      ! 
     
    733707      !     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    734708      !     e3w_0 ,   e3w_b ,   e3w_n ,  e3w_a   !: w- vert. scale factor [m] 
    735       !    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    736       !    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
     709      !    e3uw_0                                !: uw-vert. scale factor [m] 
     710      !    e3vw_0                                !: vw-vert. scale factor [m] 
    737711      !     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
    738712      ! 
     
    778752      zsshv_h(:,:) = zsshv_h(:,:)     * r1_hv_0(:,:) 
    779753      ! 
    780       !                             !==  e3t  ,  e3u  ,  e3v  ==! 
    781       !       
     754      !                             !==  e3t  ,  e3u  ,  e3v ,  e3w  ==! 
    782755      DO jk = 1, jpkm1 
    783756          e3t_b(:,:,jk) =  e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 
     
    785758          e3v_b(:,:,jk) =  e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 
    786759      END DO 
    787       !       
    788       !                             !==  e3w  ,  e3uw  ,  e3vw  ==! 
    789       ! 
    790        e3w_b(:,:,1) =  e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) *  tmask(:,:,1) ) 
    791       e3uw_b(:,:,1) = e3uw_0(:,:,1) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,1) ) 
    792       e3vw_b(:,:,1) = e3vw_0(:,:,1) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,1) ) 
     760      e3w_b(:,:,1) = e3w_0(:,:,1) * (  1._wp + zssht_h(:,:) *  tmask(:,:,1)  ) 
    793761      DO jk = 2, jpk 
    794           e3w_b(:,:,jk) =  e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX(  tmask(:,:,jk-1) ,  tmask(:,:,jk) ) ) 
    795          e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * MAX( wumask(:,:,jk-1) , wumask(:,:,jk) ) ) 
    796          e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * MAX( wvmask(:,:,jk-1) , wvmask(:,:,jk) ) ) 
     762         e3w_b(:,:,jk) = e3w_0(:,:,jk) * (  1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) )  ) 
    797763      END DO 
    798764      !    
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/iscplrst.F90

    r10023 r10030  
    102102      e3v_b (:,:,:) = e3v_n (:,:,:) 
    103103      ! 
    104       e3uw_b (:,:,:) = e3uw_n (:,:,:) 
    105       e3vw_b (:,:,:) = e3vw_n (:,:,:) 
    106104      gdept_b(:,:,:) = gdept_n(:,:,:) 
    107105      gdepw_b(:,:,:) = gdepw_n(:,:,:) 
     
    206204         CALL ssh2e3_now                  ! set: ht , hu , hv , r1_hu, r1_hv 
    207205         !                                !      e3t, e3u , e3v, e3f         (from 1 to jpkm1) 
    208          !                                !      e3w, e3uw, e3vw             (from 1 to jpk  ) 
    209          !                                !      gdept, gdepw, gde3w         (from 1 to jpk  ) 
     206         !                                !      e3w, gdept, gdepw, gde3w    (from 1 to jpk  ) 
    210207         ! 
    211208 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynzdf.F90

    r10001 r10030  
    3636 
    3737   PUBLIC   dyn_zdf   !  routine called by step.F90 
    38  
    39    REAL(wp) ::  r_vvl     ! non-linear free surface indicator: =0 if ln_linssh=T, =1 otherwise  
    4038 
    4139   !! * Substitutions 
     
    7068      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7169      ! 
    72       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    73       INTEGER  ::   iku, ikv              ! local integers 
    74       REAL(wp) ::   zzwi, ze3ua, z2dt_2   ! local scalars 
    75       REAL(wp) ::   zzws, ze3va           !   -      - 
     70      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     71      INTEGER  ::   iku, ikv      ! local integers 
     72      REAL(wp) ::   zzwi, zDt_2   ! local scalars 
     73      REAL(wp) ::   zzws          !   -      - 
    7674      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwd, zws   ! 3D workspace  
    7775      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv    !  -      - 
     76      REAL(wp)                     ::   ze3uw_A , ze3uw_Ap1   ! local real 
     77      REAL(wp)                     ::   ze3vw_A , ze3vw_Ap1   ! local real 
     78      REAL(wp), DIMENSION(jpi,jpj) ::   zsshu_hA, zsshv_hA    ! 2D workspace 
    7879      !!--------------------------------------------------------------------- 
    7980      ! 
     
    8485         IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator' 
    8586         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
    86          ! 
    87          If( ln_linssh ) THEN   ;    r_vvl = 0._wp    ! non-linear free surface indicator 
    88          ELSE                   ;    r_vvl = 1._wp 
    89          ENDIF 
    90       ENDIF 
    91       ! 
    92       z2dt_2 = rDt * 0.5_wp        !* =rn_Dt except in 1st Euler time step where it is equal to rn_Dt/2 
     87      ENDIF 
     88      ! 
     89      zDt_2 = rDt * 0.5_wp          !* =rn_Dt except in 1st Euler time step where it is equal to rn_Dt/2 
    9390      ! 
    9491      ! 
     
    131128               iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    132129               ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    133                ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 
    134                ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 
    135                ua(ji,jj,iku) = ua(ji,jj,iku) + z2dt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua 
    136                va(ji,jj,ikv) = va(ji,jj,ikv) + z2dt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va 
     130               ua(ji,jj,iku) = ua(ji,jj,iku) + zDt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / e3u_a(ji,jj,iku) 
     131               va(ji,jj,ikv) = va(ji,jj,ikv) + zDt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / e3v_a(ji,jj,ikv) 
    137132            END DO 
    138133         END DO 
     
    142137                  iku = miku(ji,jj)         ! top ocean level at u- and v-points  
    143138                  ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points) 
    144                   ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 
    145                   ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 
    146                   ua(ji,jj,iku) = ua(ji,jj,iku) + z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua 
    147                   va(ji,jj,ikv) = va(ji,jj,ikv) + z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va 
     139                  ua(ji,jj,iku) = ua(ji,jj,iku) + zDt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / e3u_a(ji,jj,iku) 
     140                  va(ji,jj,ikv) = va(ji,jj,ikv) + zDt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / e3v_a(ji,jj,ikv) 
    148141               END DO 
    149142            END DO 
     
    153146      !              !==  Vertical diffusion on u  ==! 
    154147      ! 
     148      !                          !*  multiplicative factors on e3uw(Naa) and e3vw(Naa) 
     149      ! 
     150      IF( ln_linssh ) THEN             !--  linear ssh case  
     151         DO jj = 1, jpjm1 
     152            DO ji = 1, jpim1 
     153               zsshu_hA(ji,jj) = 0._wp       ! no time variation in e3 
     154               zsshv_hA(ji,jj) = 0._wp 
     155            END DO 
     156         END DO 
     157      ELSE                             !--  Non linear ssh case 
     158         DO jj = 1, jpjm1 
     159            DO ji = 1, jpim1 
     160               zsshu_hA(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji+1,jj  ,Naa) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 
     161               zsshv_hA(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji  ,jj+1,Naa) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 
     162            END DO 
     163         END DO 
     164      ENDIF 
     165 
     166 
     167 
     168 
     169 
    155170      SELECT CASE( nldf_dyn )    !* Matrix construction 
    156171      ! 
     
    159174            DO jj = 2, jpjm1  
    160175               DO ji = fs_2, fs_jpim1   ! vector opt. 
    161                   ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at T-point 
    162                   zzwi = - rDt * ( 0.5 * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) + akzu(ji,jj,jk  ) )   & 
    163                      &            / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
    164                   zzws = - rDt * ( 0.5 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) + akzu(ji,jj,jk+1) )   & 
    165                      &            / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
     176!!gm Note that below, since ze3uw_A is used in a expression masked by wumask,  
     177!!      one can remove wumask from its expression   (same for ze3uw_Ap1 
     178                  ze3uw_A   = e3uw_0(ji,jj,jk  ) * ( 1._wp + zsshu_hA(ji,jj) * wumask(ji,jj,jk  ) ) 
     179                  ze3uw_Ap1 = e3uw_0(ji,jj,jk+1) * ( 1._wp + zsshu_hA(ji,jj) * wumask(ji,jj,jk+1) ) 
     180                  ! 
     181                  zzwi = - rDt * ( 0.5 * (   avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) +   akzu(ji,jj,jk  ) )   & 
     182                     &                 / ( e3u_a(ji  ,jj,jk  ) * ze3uw_A         ) * wumask(ji,jj,jk  ) 
     183                  zzws = - rDt * ( 0.5 * (   avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) +   akzu(ji,jj,jk+1) )   & 
     184                     &                 / ( e3u_a(ji  ,jj,jk  ) * ze3uw_Ap1       ) * wumask(ji,jj,jk+1) 
    166185                  zwi(ji,jj,jk) = zzwi 
    167186                  zws(ji,jj,jk) = zzws 
     
    174193            DO jj = 2, jpjm1  
    175194               DO ji = fs_2, fs_jpim1   ! vector opt. 
    176                   ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at T-point 
    177                   zzwi = - z2dt_2 * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
    178                   zzws = - z2dt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
     195!!gm Note that below, since ze3uw_A is used in a expression masked by wumask,  
     196!!      one can remove wumask from its expression   (same for ze3uw_Ap1 
     197                  ze3uw_A   = e3uw_0(ji,jj,jk  ) * ( 1._wp + zsshu_hA(ji,jj) * wumask(ji,jj,jk  ) ) 
     198                  ze3uw_Ap1 = e3uw_0(ji,jj,jk+1) * ( 1._wp + zsshu_hA(ji,jj) * wumask(ji,jj,jk+1) ) 
     199                  ! 
     200                  zzwi = - zDt_2 * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( e3u_a(ji,jj,jk) * ze3uw_A   ) * wumask(ji,jj,jk  ) 
     201                  zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( e3u_a(ji,jj,jk) * ze3uw_Ap1 ) * wumask(ji,jj,jk+1) 
    179202                  zwi(ji,jj,jk) = zzwi 
    180203                  zws(ji,jj,jk) = zzws 
     
    202225            DO ji = 2, jpim1 
    203226               iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points 
    204                ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point 
    205                zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 
     227               zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_a(ji,jj,iku) 
    206228            END DO 
    207229         END DO 
     
    211233                  !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed 
    212234                  iku = miku(ji,jj)       ! ocean top level at u- and v-points  
    213                   ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point 
    214                   zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua 
     235                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_a(ji,jj,iku) 
    215236               END DO 
    216237            END DO 
     
    243264      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    244265         DO ji = fs_2, fs_jpim1   ! vector opt. 
    245             ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)  
    246             ua(ji,jj,1) = ua(ji,jj,1) + z2dt_2 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( ze3ua * rho0 ) * umask(ji,jj,1) 
     266            ua(ji,jj,1) = ua(ji,jj,1) + zDt_2 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_a(ji,jj,1) * rho0 ) * umask(ji,jj,1) 
    247267         END DO 
    248268      END DO 
     
    276296            DO jj = 2, jpjm1    
    277297               DO ji = fs_2, fs_jpim1   ! vector opt. 
    278                   ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point 
    279                   zzwi = - rDt * ( 0.5 * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) + akzv(ji,jj,jk  ) )   & 
    280                      &            / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
    281                   zzws = - rDt * ( 0.5 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) + akzv(ji,jj,jk+1) )   & 
    282                      &            / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
     298                  ze3vw_A   = e3vw_0(ji,jj,jk  ) * ( 1._wp + zsshv_hA(ji,jj) * wvmask(ji,jj,jk  ) ) 
     299                  ze3vw_Ap1 = e3vw_0(ji,jj,jk+1) * ( 1._wp + zsshv_hA(ji,jj) * wvmask(ji,jj,jk+1) ) 
     300                  ! 
     301                  zzwi = - rDt * ( 0.5 * (   avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) +   akzv(ji,jj,jk  ) )   & 
     302                     &                 / ( e3v_a(ji,jj  ,jk  ) * ze3vw_A         ) * wvmask(ji,jj,jk  ) 
     303                  zzws = - rDt * ( 0.5 * (   avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) +   akzv(ji,jj,jk+1) )   & 
     304                     &                 / ( e3v_a(ji,jj  ,jk  ) * ze3vw_Ap1       ) * wvmask(ji,jj,jk+1) 
    283305                  zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk  ) 
    284306                  zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) 
     
    291313            DO jj = 2, jpjm1    
    292314               DO ji = fs_2, fs_jpim1   ! vector opt. 
    293                   ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point 
    294                   zzwi = - z2dt_2 * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
    295                   zzws = - z2dt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
     315                  ze3vw_A   = e3vw_0(ji,jj,jk  ) * ( 1._wp + zsshv_hA(ji,jj) * wvmask(ji,jj,jk  ) ) 
     316                  ze3vw_Ap1 = e3vw_0(ji,jj,jk+1) * ( 1._wp + zsshv_hA(ji,jj) * wvmask(ji,jj,jk+1) ) 
     317                  ! 
     318                  zzwi = - zDt_2 * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( e3v_a(ji,jj,jk) * ze3vw_A   ) * wvmask(ji,jj,jk  ) 
     319                  zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( e3v_a(ji,jj,jk) * ze3vw_Ap1 ) * wvmask(ji,jj,jk+1) 
    296320                  zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk  ) 
    297321                  zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) 
     
    318342            DO ji = 2, jpim1 
    319343               ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points) 
    320                ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point 
    321                zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - z2dt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va            
     344               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - zDt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_a(ji,jj,ikv)            
    322345            END DO 
    323346         END DO 
     
    326349               DO ji = 2, jpim1 
    327350                  ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points) 
    328                   ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point 
    329                   zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va 
     351                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3v_a(ji,jj,ikv) 
    330352               END DO 
    331353            END DO 
     
    358380      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    359381         DO ji = fs_2, fs_jpim1   ! vector opt.           
    360             ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)  
    361             va(ji,jj,1) = va(ji,jj,1) + z2dt_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( ze3va * rho0 ) * vmask(ji,jj,1) 
     382            va(ji,jj,1) = va(ji,jj,1) + zDt_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_a(ji,jj,1) * rho0 ) * vmask(ji,jj,1) 
    362383         END DO 
    363384      END DO 
     
    402423   END SUBROUTINE dyn_zdf 
    403424 
    404 !!gm currently not used : just for memory to be able to add dissipation trend through vertical mixing 
    405  
    406    SUBROUTINE zdf_trd( ptrdu, ptrdv ,kt ) 
    407       !!---------------------------------------------------------------------- 
    408       !!                  ***  ROUTINE zdf_trd  *** 
    409       !! 
    410       !! ** Purpose :   compute the trend due to the vert. momentum diffusion 
    411       !!              together with the Leap-Frog time stepping using an  
    412       !!              implicit scheme. 
    413       !! 
    414       !! ** Method  :  - Leap-Frog time stepping on all trends but the vertical mixing 
    415       !!         ua =         ub + 2*dt *       ua             vector form or linear free surf. 
    416       !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise 
    417       !!               - update the after velocity with the implicit vertical mixing. 
    418       !!      This requires to solver the following system:  
    419       !!         ua = ua + 1/e3u_a dk+1[ mi(avm) / e3uw_a dk[ua] ] 
    420       !!      with the following surface/top/bottom boundary condition: 
    421       !!      surface: wind stress input (averaged over kt-1/2 & kt+1/2) 
    422       !!      top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfdrg.F90) 
    423       !! 
    424       !! ** Action :   (ua,va)   after velocity  
    425       !!--------------------------------------------------------------------- 
    426       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   ptrdu, ptrdv   ! 3D work arrays use for zdf trends diag 
    427       INTEGER , INTENT(in   )                         ::   kt             ! ocean time-step index 
    428       ! 
    429       INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    430       REAL(wp) ::   zzz              ! local scalar 
    431       REAL(wp) ::   zavmu, zavmum1   !   -      - 
    432       REAL(wp) ::   zavmv, zavmvm1   !   -      - 
    433       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   z2d    !  -      - 
    434       !!--------------------------------------------------------------------- 
    435       ! 
    436       CALL lbc_lnk_multi( ua, 'U', -1., va, 'V', -1. )   ! apply lateral boundary condition on (ua,va) 
    437       ! 
    438       ! 
    439       !                 !==  momentum trend due to vertical diffusion  ==! 
    440       ! 
    441       IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity 
    442          ptrdu(:,:,:) = (              ua(:,:,:) -              ub(:,:,:) )                * r1_Dt - ptrdu(:,:,:) 
    443          ptrdv(:,:,:) = (              va(:,:,:) -              vb(:,:,:) )                * r1_Dt - ptrdv(:,:,:) 
    444       ELSE                                      ! applied on thickness weighted velocity 
    445          ptrdu(:,:,:) = ( e3u_a(:,:,:)*ua(:,:,:) - e3u_b(:,:,:)*ub(:,:,:) ) / e3u_n(:,:,:) * r1_Dt - ptrdu(:,:,:) 
    446          ptrdv(:,:,:) = ( e3v_a(:,:,:)*va(:,:,:) - e3v_b(:,:,:)*vb(:,:,:) ) / e3v_n(:,:,:) * r1_Dt - ptrdv(:,:,:) 
    447       ENDIF 
    448       CALL trd_dyn( ptrdu, ptrdv, jpdyn_zdf, kt ) 
    449       ! 
    450       ! 
    451       !                 !==  KE dissipation trend due to vertical diffusion  ==! 
    452       ! 
    453       IF( iom_use( 'dispkevfo' ) ) THEN   ! ocean kinetic energy dissipation per unit area 
    454          !                                ! due to v friction (v=vertical)  
    455          !                                ! see NEMO_book appendix C, §C.8 (N.B. here averaged at t-points) 
    456          !                                ! Note that formally, in a Leap-Frog environment, the shear**2 should be the product of  
    457          !                                ! now by before shears, i.e. the source term of TKE (local positivity is not ensured). 
    458          !                                ! Note also that now e3 scale factors are used as after one are not computed ! 
    459          ! 
    460          ALLOCATE( z2d(jpi,jpj) ) 
    461          z2d(:,:) = 0._wp 
    462          DO jk = 1, jpkm1 
    463             DO jj = 2, jpjm1 
    464                DO ji = 2, jpim1 
    465                   zavmu   = 0.5 * ( avm(ji+1,jj,jk) + avm(ji  ,jj,jk) ) 
    466                   zavmum1 = 0.5 * ( avm(ji  ,jj,jk) + avm(ji-1,jj,jk) ) 
    467                   zavmv   = 0.5 * ( avm(ji,jj+1,jk) + avm(ji,jj  ,jk) ) 
    468                   zavmvm1 = 0.5 * ( avm(ji,jj  ,jk) + avm(ji,jj-1,jk) ) 
    469                 
    470                   z2d(ji,jj) = z2d(ji,jj)  +  (                                                                                  & 
    471                      &   zavmu   * ( ua(ji  ,jj,jk-1) - ua(ji  ,jj,jk) )**2 / e3uw_n(ji  ,jj,jk) * wumask(ji  ,jj,jk)   & 
    472                      & + zavmum1 * ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) )**2 / e3uw_n(ji-1,jj,jk) * wumask(ji-1,jj,jk)   & 
    473                      & + zavmv   * ( va(ji,jj  ,jk-1) - va(ji,jj  ,jk) )**2 / e3vw_n(ji,jj  ,jk) * wvmask(ji,jj  ,jk)   & 
    474                      & + zavmvm1 * ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) )**2 / e3vw_n(ji,jj-1,jk) * wvmask(ji,jj-1,jk)   & 
    475                      &                        ) 
    476 !!gm --- This trends is in fact properly computed in zdf_sh2 but with a backward shift of one time-step  ===>>> use it ? 
    477 !!                                                                                     No since in zdfshé only kz tke (or gls) is used 
    478 !! 
    479 !!gm --- formally, as done below, in a Leap-Frog environment, the shear**2 should be the product of 
    480 !!gm     now by before shears, i.e. the source term of TKE (local positivity is not ensured). 
    481 !!       CAUTION: requires to compute e3uw_a and e3vw_a !!! 
    482 !                  z2d(ji,jj) = z2d(ji,jj)  + (                                                                                 & 
    483 !                     &    avmu(ji  ,jj,jk) * ( un(ji  ,jj,jk-1) - un(ji  ,jj,jk) ) / e3uw_n(ji  ,jj,jk)                        & 
    484 !                     &                     * ( ua(ji  ,jj,jk-1) - ua(ji  ,jj,jk) ) / e3uw_a(ji  ,jj,jk) * wumask(ji  ,jj,jk)   & 
    485 !                     &  + avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) / e3uw_n(ji-1,jj,jk)                        & 
    486 !                     &                       ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) ) / e3uw_a(ji-1,jj,jk) * wumask(ji-1,jj,jk)   & 
    487 !                     &  + avmv(ji,jj  ,jk) * ( vn(ji,jj  ,jk-1) - vn(ji,jj  ,jk) ) / e3vw_n(ji,jj  ,jk)                        & 
    488 !                     &                       ( va(ji,jj  ,jk-1) - va(ji,jj  ,jk) ) / e3vw_a(ji,jj  ,jk) * wvmask(ji,jj  ,jk)   & 
    489 !                     &  + avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) / e3vw_n(ji,jj-1,jk)                        & 
    490 !                     &                       ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) ) / e3vw_a(ji,jj-1,jk) * wvmask(ji,jj-1,jk)   & 
    491 !                     &                       ) 
    492 !!gm end 
    493                END DO 
    494             END DO 
    495          END DO 
    496          zzz= - 0.5_wp* rho0           ! caution sign minus here 
    497          z2d(:,:) = zzz * z2d(:,:)  
    498          CALL lbc_lnk( z2d,'T', 1. ) 
    499          CALL iom_put( 'dispkevfo', z2d ) 
    500          DEALLOCATE( z2d ) 
    501       ENDIF 
    502       ! 
    503    END SUBROUTINE zdf_trd 
    504     
    505 !!gm end not used 
    506  
    507425   !!============================================================================== 
    508426END MODULE dynzdf 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trazdf.F90

    r10001 r10030  
    112112      !! 
    113113      !! ** Method  :  The vertical diffusion of a tracer ,t , is given by: 
    114       !!          difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) ) 
     114      !!          difft = dz( avt dz(t) ) = 1/e3t(Naa) dk+1( avt/e3w(Naa) dk(t) ) 
    115115      !!      It is computed using a backward time scheme (t=after field) 
    116116      !!      which provide directly the after tracer field. 
     
    175175               DO jj = 2, jpjm1 
    176176                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    177 !!gm BUG   here e3w_a  should be used !!!!!   but then should be added in the system  
    178                      zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  ) 
    179                      zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 
     177                     zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_a(ji,jj,jk  ) 
     178                     zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_a(ji,jj,jk+1) 
    180179                     zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    181180                 END DO 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfosm.F90

    r9939 r10030  
    247247      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zviscos ! viscosity 
    248248      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdiffut ! t-diffusivity 
     249       
     250      REAL(wp)                     ::   ze3uw_BN, ze3vw_BN   ! use for e3uw, e3vw computation 
     251      REAL(wp), DIMENSION(jpi,jpj) ::   zsshu_hB, zsshv_hB   ! at Before and Now time-step 
     252      REAL(wp), DIMENSION(jpi,jpj) ::   zsshu_hN, zsshv_hN    
    249253 
    250254      ! For debugging 
     
    12351239 
    12361240! KPP-style Ri# mixing 
    1237        IF( ln_kpprimix) THEN 
    1238           DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
    1239              DO jj = 1, jpjm1 
    1240                 DO ji = 1, jpim1   ! vector opt. 
    1241                    z3du(ji,jj,jk) = 0.5 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   & 
    1242                         &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) * wumask(ji,jj,jk) & 
    1243                         &                 / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 
    1244                    z3dv(ji,jj,jk) = 0.5 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   & 
    1245                         &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) * wvmask(ji,jj,jk) & 
    1246                         &                 / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 
     1241      IF( ln_kpprimix) THEN 
     1242         !  
     1243         IF( ln_linssh ) THEN      !==      linear ssh case  ==! 
     1244            DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
     1245               DO jj = 1, jpjm1 
     1246                  DO ji = 1, jpim1   ! vector opt. 
     1247                     ze3uw_BN = e3uw_0(ji,jj,jk) * e3uw_0(ji,jj,jk) 
     1248                     ze3vw_BN = e3vw_0(ji,jj,jk) * e3vw_0(ji,jj,jk) 
     1249                     z3du(ji,jj,jk) = 0.5 * (  un(ji,jj,jk-1) -  un(ji,jj,jk) )            & 
     1250                        &                 * (  ub(ji,jj,jk-1) -  ub(ji,jj,jk) ) / ze3uw_BN * wumask(ji,jj,jk) 
     1251                     z3dv(ji,jj,jk) = 0.5 * (  vn(ji,jj,jk-1) -  vn(ji,jj,jk) )            & 
     1252                        &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj,jk) ) / ze3vw_BN * wvmask(ji,jj,jk) 
     1253                   END DO 
    12471254                END DO 
    1248              END DO 
    1249           END DO 
    1250       ! 
     1255            END DO 
     1256         ELSE                       !==  Non linear ssh case  ==! 
     1257            DO jj = 1, jpjm1 
     1258               DO ji = 1, jpim1 
     1259                  zsshu_hB(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji+1,jj  ,Nbb) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 
     1260                  zsshv_hB(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji  ,jj+1,Nbb) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 
     1261                  zsshu_hN(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nnn) + ssh(ji+1,jj  ,Nnn) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 
     1262                  zsshv_hN(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nnn) + ssh(ji  ,jj+1,Nnn) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 
     1263               END DO 
     1264            END DO 
     1265            ! 
     1266            DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
     1267               DO jj = 1, jpjm1 
     1268                  DO ji = 1, jpim1   ! vector opt. 
     1269                     ze3uw_BN = e3uw_0(ji,jj,jk) * e3uw_0(ji,jj,jk) * ( 1._wp + zsshu_hB(ji,jj) * wumask(ji,jj,jk) )   & 
     1270                        &                                           * ( 1._wp + zsshu_hN(ji,jj) * wumask(ji,jj,jk) ) 
     1271                     ze3vw_BN = e3vw_0(ji,jj,jk) * e3vw_0(ji,jj,jk) * ( 1._wp + zsshu_hB(ji,jj) * wvmask(ji,jj,jk) )   & 
     1272                        &                                           * ( 1._wp + zsshu_hN(ji,jj) * wvmask(ji,jj,jk) ) 
     1273                     z3du(ji,jj,jk) = 0.5 * (  un(ji,jj,jk-1) -  un(ji,jj,jk) )            & 
     1274                        &                 * (  ub(ji,jj,jk-1) -  ub(ji,jj,jk) ) / ze3uw_BN * wumask(ji,jj,jk) 
     1275                     z3dv(ji,jj,jk) = 0.5 * (  vn(ji,jj,jk-1) -  vn(ji,jj,jk) )            & 
     1276                        &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj,jk) ) / ze3vw_BN * wvmask(ji,jj,jk) 
     1277                   END DO 
     1278                END DO 
     1279            END DO 
     1280         ENDIF 
     1281         ! 
    12511282         DO jk = 2, jpkm1 
    12521283            DO jj = 2, jpjm1 
     
    12621293                END DO 
    12631294             END DO 
    1264           END DO 
    1265  
    1266           DO jj = 2, jpjm1 
    1267              DO ji = 2, jpim1 
    1268                 DO jk = ibld(ji,jj) + 1, jpkm1 
    1269                    zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
    1270                    zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
    1271                 END DO 
    1272              END DO 
    1273           END DO 
    1274  
     1295         END DO 
     1296         ! 
     1297         DO jj = 2, jpjm1 
     1298            DO ji = 2, jpim1 
     1299               DO jk = ibld(ji,jj) + 1, jpkm1 
     1300                  zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
     1301                  zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
     1302               END DO 
     1303            END DO 
     1304         END DO 
     1305         ! 
    12751306       END IF ! ln_kpprimix = .true. 
    12761307 
     
    17081739         DO jj = 2, jpjm1 
    17091740            DO ji = 2, jpim1 
    1710                ua(ji,jj,jk) =  ua(ji,jj,jk)                      & 
    1711                   &                 - (  ghamu(ji,jj,jk  )  & 
    1712                   &                    - ghamu(ji,jj,jk+1) ) / e3u_n(ji,jj,jk) 
    1713                va(ji,jj,jk) =  va(ji,jj,jk)                      & 
    1714                   &                 - (  ghamv(ji,jj,jk  )  & 
    1715                   &                    - ghamv(ji,jj,jk+1) ) / e3v_n(ji,jj,jk) 
     1741               ua(ji,jj,jk) = ua(ji,jj,jk) - (  ghamu(ji,jj,jk) - ghamu(ji,jj,jk+1) ) / e3u_n(ji,jj,jk) 
     1742               va(ji,jj,jk) = va(ji,jj,jk) - (  ghamv(ji,jj,jk) - ghamv(ji,jj,jk+1) ) / e3v_n(ji,jj,jk) 
    17161743            END DO 
    17171744         END DO 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfphy.F90

    r9598 r10030  
    246246      ! 
    247247      IF( l_zdfsh2 )   &         !* shear production at w-points (energy conserving form) 
    248          CALL zdf_sh2( ub, vb, un, vn, avm_k,   &     ! <<== in 
    249             &                           zsh2    )     ! ==>> out : shear production 
     248         CALL zdf_sh2( ssh, ub, vb, un, vn, avm_k,   &     ! <<== in 
     249            &                                zsh2    )     ! ==>> out : shear production 
    250250      ! 
    251251      SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfsh2.F90

    r9598 r10030  
    66   !! History :   -   !  2014-10  (A. Barthelemy, G. Madec)  original code 
    77   !!   NEMO     4.0  !  2017-04  (G. Madec)  remove u-,v-pts avm 
     8   !!            5.0  !  2018-08  (G. Madec)  local calculation of e3uw e3vw 
    89   !!---------------------------------------------------------------------- 
    910 
     
    2829CONTAINS 
    2930 
    30    SUBROUTINE zdf_sh2( pub, pvb, pun, pvn, p_avm, p_sh2  )  
     31   SUBROUTINE zdf_sh2( pssh, pub, pvb, pun, pvn, p_avm, p_sh2  )  
    3132      !!---------------------------------------------------------------------- 
    3233      !!                   ***  ROUTINE zdf_sh2  *** 
     
    4748      !! References :   Bruchard, OM 2002 
    4849      !! --------------------------------------------------------------------- 
     50      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   pssh                 ! sea surface height 
    4951      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   pub, pvb, pun, pvn   ! before, now horizontal velocities 
    5052      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points) 
    5153      REAL(wp), DIMENSION(:,:,:) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points) 
    5254      ! 
    53       INTEGER  ::   ji, jj, jk   ! dummy loop arguments 
    54       REAL(wp), DIMENSION(jpi,jpj) ::   zsh2u, zsh2v   ! 2D workspace 
     55      INTEGER ::   ji, jj, jk           ! dummy loop arguments 
     56      REAL(wp)::   ze3uw_BN, ze3vw_BN   ! local real 
     57      REAL(wp), DIMENSION(jpi,jpj) ::   zsh2u   , zsh2v     ! 2D workspace 
     58      REAL(wp), DIMENSION(jpi,jpj) ::   zsshu_hB, zsshv_hB  ! 2D workspace 
     59      REAL(wp), DIMENSION(jpi,jpj) ::   zsshu_hN, zsshv_hN 
    5560      !!-------------------------------------------------------------------- 
    5661      ! 
    57       DO jk = 2, jpkm1 
    58          DO jj = 1, jpjm1        !* 2 x shear production at uw- and vw-points (energy conserving form) 
     62      IF( ln_linssh ) THEN       !==  linear ssh case  ==! 
     63         DO jk = 2, jpkm1 
     64            DO jj = 1, jpjm1        !* 2 x shear production at uw- and vw-points (energy conserving form) 
     65               DO ji = 1, jpim1 
     66                  ze3uw_BN = e3uw_0(ji,jj,jk) * e3uw_0(ji,jj,jk) 
     67                  ze3vw_BN = e3vw_0(ji,jj,jk) * e3vw_0(ji,jj,jk) 
     68                  ! 
     69                  zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) )            & 
     70                     &         * (   pun(ji,jj,jk-1) -   pun(ji,jj,jk) )            & 
     71                     &         * (   pub(ji,jj,jk-1) -   pub(ji,jj,jk) ) / ze3uw_BN * wumask(ji,jj,jk) 
     72                  zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) )            & 
     73                     &         * (   pvn(ji,jj,jk-1) -   pvn(ji,jj,jk) )            & 
     74                     &         * (   pvb(ji,jj,jk-1) -   pvb(ji,jj,jk) ) / ze3vw_BN * wvmask(ji,jj,jk) 
     75               END DO 
     76            END DO 
     77            DO jj = 2, jpjm1        !* shear production at w-point 
     78               DO ji = 2, jpim1           ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
     79                  p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 
     80                     &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   ) 
     81               END DO 
     82            END DO 
     83         END DO  
     84         ! 
     85      ELSE                       !==  Non linear ssh case  ==! 
     86         DO jj = 1, jpjm1 
    5987            DO ji = 1, jpim1 
    60                zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
    61                   &         * (   pun(ji,jj,jk-1) -   pun(ji,jj,jk) ) & 
    62                   &         * (   pub(ji,jj,jk-1) -   pub(ji,jj,jk) ) / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) * wumask(ji,jj,jk) 
    63                zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 
    64                   &         * (   pvn(ji,jj,jk-1) -   pvn(ji,jj,jk) ) & 
    65                   &         * (   pvb(ji,jj,jk-1) -   pvb(ji,jj,jk) ) / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) * wvmask(ji,jj,jk) 
     88               zsshu_hB(ji,jj) = 0.5_wp * ( pssh(ji,jj,Nbb) + pssh(ji+1,jj  ,Nbb) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 
     89               zsshv_hB(ji,jj) = 0.5_wp * ( pssh(ji,jj,Nbb) + pssh(ji  ,jj+1,Nbb) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 
     90               zsshu_hN(ji,jj) = 0.5_wp * ( pssh(ji,jj,Nnn) + pssh(ji+1,jj  ,Nnn) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 
     91               zsshv_hN(ji,jj) = 0.5_wp * ( pssh(ji,jj,Nnn) + pssh(ji  ,jj+1,Nnn) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 
    6692            END DO 
    6793         END DO 
    68          DO jj = 2, jpjm1        !* shear production at w-point 
    69             DO ji = 2, jpim1           ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
    70                p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 
    71                   &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   ) 
     94         ! 
     95         DO jk = 2, jpkm1 
     96            DO jj = 1, jpjm1        !* 2 x shear production at uw- and vw-points (energy conserving form) 
     97               DO ji = 1, jpim1 
     98                  ze3uw_BN = e3uw_0(ji,jj,jk) * e3uw_0(ji,jj,jk) * ( 1._wp + zsshu_hB(ji,jj) * wumask(ji,jj,jk) )   & 
     99                     &                                           * ( 1._wp + zsshu_hN(ji,jj) * wumask(ji,jj,jk) ) 
     100                  ze3vw_BN = e3vw_0(ji,jj,jk) * e3vw_0(ji,jj,jk) * ( 1._wp + zsshu_hB(ji,jj) * wvmask(ji,jj,jk) )   & 
     101                     &                                           * ( 1._wp + zsshu_hN(ji,jj) * wvmask(ji,jj,jk) ) 
     102                  zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
     103                     &         * (   pun(ji,jj,jk-1) -   pun(ji,jj,jk) ) & 
     104                     &         * (   pub(ji,jj,jk-1) -   pub(ji,jj,jk) ) / ze3uw_BN * wumask(ji,jj,jk) 
     105                  zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 
     106                     &         * (   pvn(ji,jj,jk-1) -   pvn(ji,jj,jk) ) & 
     107                     &         * (   pvb(ji,jj,jk-1) -   pvb(ji,jj,jk) ) / ze3vw_BN * wvmask(ji,jj,jk) 
     108               END DO 
    72109            END DO 
    73          END DO 
    74       END DO  
     110            DO jj = 2, jpjm1        !* shear production at w-point 
     111               DO ji = 2, jpim1           ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
     112                  p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 
     113                     &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   ) 
     114               END DO 
     115            END DO 
     116         END DO  
     117      ENDIF 
    75118      ! 
    76119   END SUBROUTINE zdf_sh2 
  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OFF/dtadyn.F90

    r10009 r10030  
    332332         ! 
    333333         !                          !* BEFORE fields :  
    334          CALL ssh2e3_before               ! set:      hu , hv , r1_hu, r1_hv  
    335          !                                !      e3t, e3w, e3u, e3uw, e3v, e3vw        (from 1 to jpkm1) 
     334         CALL ssh2e3_before               ! set:       hu,  hv, r1_hu, r1_hv  
     335         !                                !      e3t, e3u, e3v,            (from 1 to jpkm1) 
     336         !                                !      e3w,                      (from 1 to jpk  ) 
    336337         ! 
    337338         !                                ! set jpk level one to the e3._0 values 
    338          e3t_b(:,:,jpk) = e3t_0(:,:,jpk)  ;   e3u_b(:,:,jpk) =  e3w_0(:,:,jpk)  ;   e3v_b(:,:,jpk) =  e3v_0(:,:,jpk) 
    339          e3w_b(:,:,jpk) = e3w_0(:,:,jpk)  ;  e3uw_b(:,:,jpk) = e3uw_0(:,:,jpk)  ;  e3vw_b(:,:,jpk) = e3vw_0(:,:,jpk) 
     339         e3t_b(:,:,jpk) = e3t_0(:,:,jpk)  ;  e3u_b(:,:,jpk) = e3u_0(:,:,jpk) 
     340                                             e3v_b(:,:,jpk) = e3v_0(:,:,jpk) 
    340341         ! 
    341342         !                          !* NOW fields :  
    342          CALL ssh2e3_now                  ! set: ht , hu , hv , r1_hu, r1_hv 
    343          !                                !      e3t, e3w, e3u, e3uw, e3v, e3vw, e3f   (from 1 to jpkm1) 
    344          !                                !      gdept_n, gdepw_n, gde3w_n 
    345 !!gm issue?   gdept_n, gdepw_n, gde3w_n never defined at jpk 
     343         CALL ssh2e3_now                  ! set:  ht,  hu,  hv, r1_hu, r1_hv 
     344         !                                !      e3t, e3u, e3v , e3f              (from 1 to jpkm1) 
     345         !                                !      e3w, gdept_n, gdepw_n, gde3w_n   (from 1 to jpk  ) 
    346346         ! 
    347347         !                                ! set one for all last level to the e3._0 value 
    348          e3t_n(:,:,jpk) = e3t_0(:,:,jpk)  ;   e3u_n(:,:,jpk) =  e3w_0(:,:,jpk)  ;   e3v_n(:,:,jpk) =  e3v_0(:,:,jpk) 
    349          e3w_n(:,:,jpk) = e3w_0(:,:,jpk)  ;  e3uw_n(:,:,jpk) = e3uw_0(:,:,jpk)  ;  e3vw_n(:,:,jpk) = e3vw_0(:,:,jpk) 
    350          e3f_n(:,:,jpk) = e3f_0(:,:,jpk) 
     348         e3t_n(:,:,jpk) = e3t_0(:,:,jpk)  ;  e3u_n(:,:,jpk) = e3u_0(:,:,jpk) 
     349         e3f_n(:,:,jpk) = e3f_0(:,:,jpk)  ;  e3v_n(:,:,jpk) = e3v_0(:,:,jpk) 
    351350         ! 
    352351         !                          !* AFTER fields : (last level for OPA, 3D required for AGRIF initialisation) 
    353          e3t_a(:,:,:) = e3t_n(:,:,:)   ;   e3u_a(:,:,:) = e3u_n(:,:,:)   ;   e3v_a(:,:,:) = e3v_n(:,:,:) 
     352         e3t_a(:,:,:) = e3t_n(:,:,:)   ;   e3u_a(:,:,:) = e3u_n(:,:,:) 
     353         e3w_a(:,:,:) = e3w_n(:,:,:)   ;   e3v_a(:,:,:) = e3v_n(:,:,:) 
    354354         ! 
    355355      ENDIF 
     
    370370                  END DO 
    371371                  nk_rnf(ji,jj) = jk 
    372                ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
    373                ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
     372               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;   nk_rnf(ji,jj) = 1 
     373               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;   nk_rnf(ji,jj) = mbkt(ji,jj) 
    374374               ELSE 
    375375                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
Note: See TracChangeset for help on using the changeset viewer.