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 13798 for NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN – NEMO

Ignore:
Timestamp:
2020-11-16T11:20:33+01:00 (4 years ago)
Author:
cetlod
Message:

dev_r13333_TOP-05_Ethe_Agrif : phasing with trunk at revision r13787

Location:
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif
Files:
16 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif

    • Property svn:externals
      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@13292        sette 
         10^/utils/CI/sette@13559        sette 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/divhor.F90

    r13295 r13798  
    7777      ENDIF 
    7878      ! 
    79       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    80          hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm)      & 
     79      DO_3D( 0, 0, 0, 0, 1, jpkm1 )                                    !==  Horizontal divergence  ==! 
     80         hdiv(ji,jj,jk) = (   e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm)      & 
    8181            &               - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm)      & 
    8282            &               + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm)      & 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynadv_cen2.F90

    r13295 r13798  
    7272         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
    7373         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    74          DO_2D( 1, 0, 1, 0 ) 
     74         DO_2D( 1, 0, 1, 0 )              ! horizontal momentum fluxes (at T- and F-point) 
    7575            zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) ) 
    7676            zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) 
     
    7878            zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) ) 
    7979         END_2D 
    80          DO_2D( 0, 0, 0, 0 ) 
     80         DO_2D( 0, 0, 0, 0 )              ! divergence of horizontal momentum fluxes 
    8181            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
    8282               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj)   & 
     
    9898      !                             !==  Vertical advection  ==! 
    9999      ! 
    100       DO_2D( 0, 0, 0, 0 ) 
     100      DO_2D( 0, 0, 0, 0 )                 ! surface/bottom advective fluxes set to zero 
    101101         zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(ji,jj,jpk) = 0._wp 
    102102         zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(ji,jj, 1 ) = 0._wp 
     
    109109      ENDIF 
    110110      DO jk = 2, jpkm1                    ! interior advective fluxes 
    111          DO_2D( 0, 1, 0, 1 ) 
     111         DO_2D( 0, 1, 0, 1 )                  ! 1/4 * Vertical transport 
    112112            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
    113113         END_2D 
     
    117117         END_2D 
    118118      END DO 
    119       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     119      DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! divergence of vertical momentum flux divergence 
    120120         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   & 
    121121            &                                      / e3u(ji,jj,jk,Kmm) 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynadv_ubs.F90

    r13295 r13798  
    108108         zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    109109         !             
    110          DO_2D( 0, 0, 0, 0 ) 
     110         DO_2D( 0, 0, 0, 0 )                       ! laplacian 
    111111            zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj  ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj  ,jk,Kbb) ) * umask(ji,jj,jk) 
    112112            zlv_vv(ji,jj,jk,1) = ( pvv (ji  ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji  ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk) 
     
    136136         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    137137         ! 
    138          DO_2D( 1, 0, 1, 0 ) 
     138         DO_2D( 1, 0, 1, 0 )                       ! horizontal momentum fluxes at T- and F-point 
    139139            zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) ) 
    140140            zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) ) 
     
    168168               &                * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) - gamma1 * zl_v ) 
    169169         END_2D 
    170          DO_2D( 0, 0, 0, 0 ) 
     170         DO_2D( 0, 0, 0, 0 )                       ! divergence of horizontal momentum fluxes 
    171171            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
    172172               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj)   & 
     
    187187      !                                      !  Vertical advection  ! 
    188188      !                                      ! ==================== ! 
    189       DO_2D( 0, 0, 0, 0 ) 
     189      DO_2D( 0, 0, 0, 0 )                          ! surface/bottom advective fluxes set to zero 
    190190         zfu_uw(ji,jj,jpk) = 0._wp 
    191191         zfv_vw(ji,jj,jpk) = 0._wp 
     
    208208         END_2D 
    209209      END DO 
    210       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     210      DO_3D( 0, 0, 0, 0, 1, jpkm1 )             ! divergence of vertical momentum flux divergence 
    211211         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   & 
    212212            &                                       / e3u(ji,jj,jk,Kmm) 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynatf.F90

    r13295 r13798  
    3434   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme 
    3535   USE domvvl         ! variable volume 
    36    USE bdy_oce   , ONLY: ln_bdy 
     36   USE bdy_oce , ONLY : ln_bdy 
    3737   USE bdydta         ! ocean open boundary conditions 
    3838   USE bdydyn         ! ocean open boundary conditions 
     
    5050   USE prtctl         ! Print control 
    5151   USE timing         ! Timing 
     52   USE zdfdrg ,  ONLY : ln_drgice_imp, rCdU_top 
    5253#if defined key_agrif 
    5354   USE agrif_oce_interp 
     
    120121      REAL(wp) ::   zve3a, zve3n, zve3b, z1_2dt   !   -      - 
    121122      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve, zwfld 
     123      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zutau, zvtau 
    122124      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3t_f, ze3u_f, ze3v_f, zua, zva  
    123125      !!---------------------------------------------------------------------- 
     
    321323      ENDIF 
    322324      ! 
     325      IF ( iom_use("utau") ) THEN 
     326         IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 
     327            ALLOCATE(zutau(jpi,jpj))  
     328            DO_2D( 0, 0, 0, 0 ) 
     329               jk = miku(ji,jj)  
     330               zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * puu(ji,jj,jk,Kaa) 
     331            END_2D 
     332            CALL iom_put(  "utau", zutau(:,:) ) 
     333            DEALLOCATE(zutau) 
     334         ELSE 
     335            CALL iom_put(  "utau", utau(:,:) ) 
     336         ENDIF 
     337      ENDIF 
     338      ! 
     339      IF ( iom_use("vtau") ) THEN 
     340         IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 
     341            ALLOCATE(zvtau(jpi,jpj)) 
     342            DO_2D( 0, 0, 0, 0 ) 
     343               jk = mikv(ji,jj) 
     344               zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * pvv(ji,jj,jk,Kaa) 
     345            END_2D 
     346            CALL iom_put(  "vtau", zvtau(:,:) ) 
     347            DEALLOCATE(zvtau) 
     348         ELSE 
     349            CALL iom_put(  "vtau", vtau(:,:) ) 
     350         ENDIF 
     351      ENDIF 
     352      ! 
    323353      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt  - puu(:,:,:,Kaa): ', mask1=umask,   & 
    324354         &                                  tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): '       , mask2=vmask ) 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynkeg.F90

    r13295 r13798  
    125125      END SELECT  
    126126      ! 
    127       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     127      DO_3D( 0, 0, 0, 0, 1, jpkm1 )       !==  grad( KE ) added to the general momentum trends  ==! 
    128128         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    129129         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynldf_iso.F90

    r13295 r13798  
    128128      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    129129         ! 
    130          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     130         DO_3D( 0, 0, 0, 0, 1, jpk )      ! set the slopes of iso-level 
    131131            uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    132132            vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
     
    268268         ! Second derivative (divergence) and add to the general trend 
    269269         ! ----------------------------------------------------------- 
    270          DO_2D( 0, 0, 0, 0 ) 
     270         DO_2D( 0, 0, 0, 0 )      !!gm Question vectop possible??? !!bug 
    271271            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (  ziut(ji+1,jj) - ziut(ji,jj  )    & 
    272272               &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj)   & 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynldf_lap_blp.F90

    r13295 r13798  
    8484         END_2D 
    8585         ! 
    86          DO_2D( 0, 0, 0, 0 ) 
     86         DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div ) 
    8787            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    8888               &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynspg.F90

    r13295 r13798  
    102102         IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==! 
    103103            zg_2 = grav * 0.5 
    104             DO_2D( 0, 0, 0, 0 ) 
     104            DO_2D( 0, 0, 0, 0 )                       ! gradient of Patm using inverse barometer ssh 
    105105               spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    & 
    106106                  &                                + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
     
    117117            CALL upd_tide(zt0step, Kmm) 
    118118            ! 
    119             DO_2D( 0, 0, 0, 0 ) 
     119            DO_2D( 0, 0, 0, 0 )                      ! add tide potential forcing 
    120120               spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
    121121               spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
     
    124124            IF (ln_scal_load) THEN 
    125125               zld = rn_scal_load * grav 
    126                DO_2D( 0, 0, 0, 0 ) 
     126               DO_2D( 0, 0, 0, 0 )                   ! add scalar approximation for load potential 
    127127                  spgu(ji,jj) = spgu(ji,jj) + zld * ( pssh(ji+1,jj,Kmm) - pssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 
    128128                  spgv(ji,jj) = spgv(ji,jj) + zld * ( pssh(ji,jj+1,Kmm) - pssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 
     
    143143         ENDIF 
    144144         ! 
    145          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     145         DO_3D( 0, 0, 0, 0, 1, jpkm1 )       !== Add all terms to the general trend 
    146146            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 
    147147            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynspg_exp.F90

    r13295 r13798  
    7474      IF( ln_linssh ) THEN          !* linear free surface : add the surface pressure gradient trend 
    7575         ! 
    76          DO_2D( 0, 0, 0, 0 ) 
     76         DO_2D( 0, 0, 0, 0 )                 ! now surface pressure gradient 
    7777            spgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 
    7878            spgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 
    7979         END_2D 
    8080         ! 
    81          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     81         DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! Add it to the general trend 
    8282            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 
    8383            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynspg_ts.F90

    r13295 r13798  
    264264         IF( ln_wd_il ) THEN                       ! W/D : limiter applied to spgspg 
    265265            CALL wad_spg( pssh(:,:,Kmm), zcpx, zcpy )          ! Calculating W/D gravity filters, zcpx and zcpy 
    266             DO_2D( 0, 0, 0, 0 ) 
     266            DO_2D( 0, 0, 0, 0 )                                ! SPG with the application of W/D gravity filters 
    267267               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( pssh(ji+1,jj  ,Kmm) - pssh(ji  ,jj ,Kmm) )   & 
    268268                  &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth 
     
    279279      ENDIF 
    280280      ! 
    281       DO_2D( 0, 0, 0, 0 ) 
     281      DO_2D( 0, 0, 0, 0 )                          ! Remove coriolis term (and possibly spg) from barotropic trend 
    282282          zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 
    283283          zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) 
     
    475475            ! 
    476476            !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk) 
    477             DO_2D( 1, 1, 1, 0 ) 
     477            DO_2D( 1, 1, 1, 0 )   ! not jpi-column 
    478478               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        & 
    479479                    &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
    480480                    &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
    481481            END_2D 
    482             DO_2D( 1, 0, 1, 1 ) 
     482            DO_2D( 1, 0, 1, 1 )   ! not jpj-row 
    483483               zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        & 
    484484                    &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
     
    917917               CALL iom_get( numror, jpdom_auto, 'ub2_i_b'  , ub2_i_b(:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )    
    918918               CALL iom_get( numror, jpdom_auto, 'vb2_i_b'  , vb2_i_b(:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios ) 
     919            ELSE 
     920               ub2_i_b(:,:) = 0._wp   ;   vb2_i_b(:,:) = 0._wp   ! used in the 1st update of agrif 
    919921            ENDIF 
    920922#endif 
     
    922924            IF(lwp) WRITE(numout,*) 
    923925            IF(lwp) WRITE(numout,*) '   ==>>>   start from rest: set barotropic values to 0' 
    924             ub2_b (:,:) = 0._wp   ;   vb2_b (:,:) = 0._wp   ! used in the 1st interpol of agrif 
    925             un_adv(:,:) = 0._wp   ;   vn_adv(:,:) = 0._wp   ! used in the 1st interpol of agrif 
    926             un_bf (:,:) = 0._wp   ;   vn_bf (:,:) = 0._wp   ! used in the 1st update   of agrif 
     926            ub2_b  (:,:) = 0._wp   ;   vb2_b (:,:) = 0._wp   ! used in the 1st interpol of agrif 
     927            un_adv (:,:) = 0._wp   ;   vn_adv (:,:) = 0._wp   ! used in the 1st interpol of agrif 
     928            un_bf  (:,:) = 0._wp   ;   vn_bf (:,:) = 0._wp   ! used in the 1st update   of agrif 
    927929#if defined key_agrif 
    928             IF ( .NOT.Agrif_Root() ) THEN 
    929                ub2_i_b(:,:) = 0._wp   ;   vb2_i_b(:,:) = 0._wp   ! used in the 1st update of agrif 
    930             ENDIF 
     930            ub2_i_b(:,:) = 0._wp   ;   vb2_i_b(:,:) = 0._wp   ! used in the 1st update of agrif 
    931931#endif 
    932932         ENDIF 
     
    13081308      !!---------------------------------------------------------------------- 
    13091309      ! 
    1310       DO_2D( 1, 1, 1, 0 ) 
     1310      DO_2D( 1, 1, 1, 0 )   ! not jpi-column 
    13111311         IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj)  
    13121312         ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)   
     
    13161316      END_2D 
    13171317      ! 
    1318       DO_2D( 1, 0, 1, 1 ) 
     1318      DO_2D( 1, 0, 1, 1 )   ! not jpj-row 
    13191319         IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  ) 
    13201320         ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)   
     
    14051405      !                    !==  Set the barotropic drag coef.  ==! 
    14061406      ! 
    1407       IF( ln_isfcav ) THEN          ! top+bottom friction (ocean cavities) 
     1407      IF( ln_isfcav.OR.ln_drgice_imp ) THEN          ! top+bottom friction (ocean cavities) 
    14081408          
    14091409         DO_2D( 0, 0, 0, 0 ) 
     
    14561456      !                    !==  TOP stress contribution from baroclinic velocities  ==!   (no W/D case) 
    14571457      ! 
    1458       IF( ln_isfcav ) THEN 
     1458      IF( ln_isfcav.OR.ln_drgice_imp ) THEN 
    14591459         ! 
    14601460         IF( ln_bt_fw ) THEN                ! FORWARD integration: use NOW top baroclinic velocity 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynvor.F90

    r13295 r13798  
    217217      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    218218      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars 
    219       REAL(wp), DIMENSION(jpi,jpj)     ::   zwx, zwy, zwt   ! 2D workspace 
    220       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz             ! 3D workspace 
     219      REAL(wp), DIMENSION(jpi,jpj)       ::   zwx, zwy, zwt   ! 2D workspace 
     220      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz             ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 
    221221      !!---------------------------------------------------------------------- 
    222222      ! 
     
    246246      CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    247247         DO jk = 1, jpkm1                                 ! Horizontal slab 
    248             DO_2D( 1, 0, 1, 0 ) 
     248            DO_2D( 1, 0, 1, 0 )                          ! relative vorticity 
    249249               zwz(ji,jj,jk) = (   e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)   & 
    250250                  &              - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)   ) * r1_e1e2f(ji,jj) 
     
    533533      REAL(wp) ::   zua, zva     ! local scalars 
    534534      REAL(wp) ::   zmsk, ze3f   ! local scalars 
    535       REAL(wp), DIMENSION(jpi,jpj)     ::   zwx , zwy , z1_e3f 
    536       REAL(wp), DIMENSION(jpi,jpj)     ::   ztnw, ztne, ztsw, ztse 
    537       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz 
     535      REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy , z1_e3f 
     536      REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse 
     537      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined 
    538538      !!---------------------------------------------------------------------- 
    539539      ! 
     
    677677      REAL(wp) ::   zua, zva       ! local scalars 
    678678      REAL(wp) ::   zmsk, z1_e3t   ! local scalars 
    679       REAL(wp), DIMENSION(jpi,jpj)     ::   zwx , zwy  
    680       REAL(wp), DIMENSION(jpi,jpj)     ::   ztnw, ztne, ztsw, ztse 
    681       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz 
     679      REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy  
     680      REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse 
     681      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined 
    682682      !!---------------------------------------------------------------------- 
    683683      ! 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynzad.F90

    r13295 r13798  
    7171      ENDIF 
    7272 
    73       IF( l_trddyn )   THEN         ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends 
     73      IF( l_trddyn )   THEN           ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends 
    7474         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
    7575         ztrdu(:,:,:) = puu(:,:,:,Krhs)  
     
    7777      ENDIF 
    7878       
    79       DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical 
    80          DO_2D( 0, 1, 0, 1 ) 
     79      DO jk = 2, jpkm1                ! Vertical momentum advection at level w and u- and v- vertical 
     80         DO_2D( 0, 1, 0, 1 )              ! vertical fluxes 
    8181            zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
    8282         END_2D 
    83          DO_2D( 0, 0, 0, 0 ) 
     83         DO_2D( 0, 0, 0, 0 )              ! vertical momentum advection at w-point 
    8484            zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) ) 
    8585            zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( pvv(ji,jj,jk-1,Kmm) - pvv(ji,jj,jk,Kmm) ) 
     
    9595      END_2D 
    9696      ! 
    97       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     97      DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! Vertical momentum advection at u- and v-points 
    9898         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   & 
    9999            &                                      / e3u(ji,jj,jk,Kmm) 
     
    102102      END_3D 
    103103 
    104       IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic 
     104      IF( l_trddyn ) THEN             ! save the vertical advection trends for diagnostic 
    105105         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
    106106         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
     
    108108         DEALLOCATE( ztrdu, ztrdv )  
    109109      ENDIF 
    110       !                             ! Control print 
     110      !                               ! Control print 
    111111      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' zad  - Ua: ', mask1=umask,   & 
    112112         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/dynzdf.F90

    r13295 r13798  
    131131            pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - vv_b(ji,jj,Kaa) ) * vmask(ji,jj,jk) 
    132132         END_3D 
    133          DO_2D( 0, 0, 0, 0 ) 
     133         DO_2D( 0, 0, 0, 0 )      ! Add bottom/top stress due to barotropic component only 
    134134            iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    135135            ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
     
    141141            pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va 
    142142         END_2D 
    143          IF( ln_isfcav ) THEN    ! Ocean cavities (ISF) 
     143         IF( ln_isfcav.OR.ln_drgice_imp ) THEN    ! Ocean cavities (ISF) 
    144144            DO_2D( 0, 0, 0, 0 ) 
    145145               iku = miku(ji,jj)         ! top ocean level at u- and v-points  
     
    190190            END_3D 
    191191         END SELECT 
    192          DO_2D( 0, 0, 0, 0 ) 
     192         DO_2D( 0, 0, 0, 0 )     !* Surface boundary conditions 
    193193            zwi(ji,jj,1) = 0._wp 
    194194            ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm)    & 
     
    227227            END_3D 
    228228         END SELECT 
    229          DO_2D( 0, 0, 0, 0 ) 
     229         DO_2D( 0, 0, 0, 0 )     !* Surface boundary conditions 
    230230            zwi(ji,jj,1) = 0._wp 
    231231            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 
     
    247247            zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 
    248248         END_2D 
    249          IF ( ln_isfcav ) THEN   ! top friction (always implicit) 
     249         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN   ! top friction (always implicit) 
    250250            DO_2D( 0, 0, 0, 0 ) 
    251251               !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed 
     
    273273      !----------------------------------------------------------------------- 
    274274      ! 
    275       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     275      DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
    276276         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 
    277277      END_3D 
    278278      ! 
    279       DO_2D( 0, 0, 0, 0 ) 
     279      DO_2D( 0, 0, 0, 0 )             !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    280280         ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm)    & 
    281281            &             + r_vvl   * e3u(ji,jj,1,Kaa)  
     
    287287      END_3D 
    288288      ! 
    289       DO_2D( 0, 0, 0, 0 ) 
     289      DO_2D( 0, 0, 0, 0 )             !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==! 
    290290         puu(ji,jj,jpkm1,Kaa) = puu(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 
    291291      END_2D 
     
    329329            END_3D 
    330330         END SELECT 
    331          DO_2D( 0, 0, 0, 0 ) 
     331         DO_2D( 0, 0, 0, 0 )   !* Surface boundary conditions 
    332332            zwi(ji,jj,1) = 0._wp 
    333333            ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm)    & 
     
    366366            END_3D 
    367367         END SELECT 
    368          DO_2D( 0, 0, 0, 0 ) 
     368         DO_2D( 0, 0, 0, 0 )        !* Surface boundary conditions 
    369369            zwi(ji,jj,1) = 0._wp 
    370370            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 
     
    385385            zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va            
    386386         END_2D 
    387          IF ( ln_isfcav ) THEN 
     387         IF ( ln_isfcav.OR.ln_drgice_imp ) THEN 
    388388            DO_2D( 0, 0, 0, 0 ) 
    389389               ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points) 
     
    410410      !----------------------------------------------------------------------- 
    411411      ! 
    412       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     412      DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
    413413         zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 
    414414      END_3D 
    415415      ! 
    416       DO_2D( 0, 0, 0, 0 ) 
     416      DO_2D( 0, 0, 0, 0 )             !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    417417         ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm)    & 
    418418            &             + r_vvl   * e3v(ji,jj,1,Kaa)  
     
    424424      END_3D 
    425425      ! 
    426       DO_2D( 0, 0, 0, 0 ) 
     426      DO_2D( 0, 0, 0, 0 )             !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==! 
    427427         pvv(ji,jj,jpkm1,Kaa) = pvv(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 
    428428      END_2D 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/sshwzv.F90

    r13295 r13798  
    203203      ELSE                                            !==  Quasi-Eulerian vertical coordinate  ==!   ('key_qco') 
    204204         !                                            !==========================================! 
    205          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
     205         DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence 
    206206            pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)                 & 
    207207               &                            + r1_Dt * (  e3t(:,:,jk,Kaa)        & 
     
    393393      ! 
    394394      IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN       ! Quick check if any breaches anywhere 
    395          DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 
     395         DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 )             ! or scan Courant criterion and partition ! w where necessary 
    396396            ! 
    397397            zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) ) 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/DYN/wet_dry.F90

    r13295 r13798  
    5757   REAL(wp), PUBLIC  ::   ssh_ref     !: height of z=0 with respect to the geoid;  
    5858 
    59    LOGICAL,  PUBLIC  ::   ll_wd       !: Wetting/drying activation switch if either ln_wd_il or ln_wd_dl 
     59   LOGICAL,  PUBLIC  ::   ll_wd = .FALSE. !: Wetting/drying activation switch (ln_wd_il or ln_wd_dl) <- default def if wad_init not called 
    6060 
    6161   PUBLIC   wad_init                  ! initialisation routine called by step.F90 
     
    111111 
    112112      r_rn_wdmin1 = 1 / rn_wdmin1 
    113       ll_wd = .FALSE. 
    114113      IF( ln_wd_il .OR. ln_wd_dl ) THEN 
    115114         ll_wd = .TRUE. 
     
    307306      zwdlmtv(:,:) = 1._wp 
    308307      ! 
    309       DO_2D( 0, 1, 0, 1 ) 
     308      DO_2D( 0, 1, 0, 1 )      ! Horizontal Flux in u and v direction 
    310309         ! 
    311310         IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells 
Note: See TracChangeset for help on using the changeset viewer.