Changeset 15014


Ignore:
Timestamp:
2021-06-17T19:02:04+02:00 (4 months ago)
Author:
smasson
Message:

trunk: simplify F point halo computation, #2693

Location:
NEMO/trunk/src
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/ICE/icedyn_rhg_eap.F90

    r14433 r15014  
    5858 
    5959   REAL(wp), DIMENSION(nx_yield, ny_yield, na_yield) ::   s11r, s12r, s22r, s11s, s12s, s22s 
    60  
    61    !! * Substitutions 
    62 #  include "do_loop_substitute.h90" 
    63 #  include "domzgr_substitute.h90" 
     60   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   fimask   ! mask at F points for the ice 
    6461 
    6562   !! for convergence tests 
    6663   INTEGER ::   ncvgid   ! netcdf file id 
    6764   INTEGER ::   nvarid   ! netcdf variable id 
    68    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   aimsk00 
    69    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   eap_res  , aimsk15 
     65 
     66   !! * Substitutions 
     67#  include "do_loop_substitute.h90" 
    7068   !!---------------------------------------------------------------------- 
    7169   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
     
    180178      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
    181179      ! 
     180      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00, zmsk15 
    182181      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
    183182      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
    184       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    185183 
    186184      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter 
     
    203201      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_eap: EAP sea-ice rheology' 
    204202      ! 
    205       IF( kt == nit000 )  THEN  
    206          ! 
    207          ! for diagnostics  
    208          ALLOCATE( aimsk00(jpi,jpj) ) 
    209          ! for convergence tests 
    210          IF( nn_rhg_chkcvg > 0 ) ALLOCATE( eap_res(jpi,jpj), aimsk15(jpi,jpj) ) 
    211       ENDIF 
    212       ! 
     203      ! for diagnostics and convergence tests 
    213204      DO_2D( 1, 1, 1, 1 ) 
    214          aimsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     205         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    215206      END_2D 
    216207      IF( nn_rhg_chkcvg > 0 ) THEN 
    217208         DO_2D( 1, 1, 1, 1 ) 
    218             aimsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     209            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    219210         END_2D 
    220211      ENDIF 
    221212      ! 
    222 !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
    223213      !------------------------------------------------------------------------------! 
    224214      ! 0) mask at F points for the ice 
    225215      !------------------------------------------------------------------------------! 
    226       ! ocean/land mask 
    227       DO_2D( 1, 0, 1, 0 ) 
    228          zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    229       END_2D 
    230       CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1._wp ) 
    231  
    232       ! Lateral boundary conditions on velocity (modify zfmask) 
    233       DO_2D( 0, 0, 0, 0 ) 
    234          IF( zfmask(ji,jj) == 0._wp ) THEN 
    235             zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    236                &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     216      IF( kt == nit000 ) THEN 
     217         ! ocean/land mask 
     218         ALLOCATE( fimask(jpi,jpj) ) 
     219         IF( rn_ishlat == 0._wp ) THEN 
     220            DO_2D( 0, 0, 0, 0 ) 
     221               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     222            END_2D 
     223         ELSE 
     224            DO_2D( 0, 0, 0, 0 ) 
     225               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     226               ! Lateral boundary conditions on velocity (modify fimask) 
     227               IF( fimask(ji,jj) == 0._wp ) THEN 
     228                  fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     229                     &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     230               ENDIF 
     231            END_2D 
    237232         ENDIF 
    238       END_2D 
    239       DO jj = 2, jpjm1 
    240          IF( zfmask(1,jj) == 0._wp ) THEN 
    241             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
    242          ENDIF 
    243          IF( zfmask(jpi,jj) == 0._wp ) THEN 
    244             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 
    245          ENDIF 
    246       END DO 
    247       DO ji = 2, jpim1 
    248          IF( zfmask(ji,1) == 0._wp ) THEN 
    249             zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    250          ENDIF 
    251          IF( zfmask(ji,jpj) == 0._wp ) THEN 
    252             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 
    253          ENDIF 
    254       END DO 
    255       CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1.0_wp ) 
     233         CALL lbc_lnk( 'icedyn_rhg_eap', fimask, 'F', 1.0_wp ) 
     234      ENDIF 
    256235 
    257236      !------------------------------------------------------------------------------! 
     
    401380            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    402381               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    403                &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     382               &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    404383 
    405384         END_2D 
     
    760739 
    761740         ! convergence test 
    762          IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
     741         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 
    763742         ! 
    764743         !                                                ! ==================== ! 
     
    777756         zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    778757            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    779             &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     758            &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    780759 
    781760      END_2D 
     
    830809            &                            ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    831810         ! 
    832          CALL iom_put( 'utau_oi' , ztaux_oi * aimsk00 ) 
    833          CALL iom_put( 'vtau_oi' , ztauy_oi * aimsk00 ) 
    834          CALL iom_put( 'utau_ai' , ztaux_ai * aimsk00 ) 
    835          CALL iom_put( 'vtau_ai' , ztauy_ai * aimsk00 ) 
    836          CALL iom_put( 'utau_bi' , ztaux_bi * aimsk00 ) 
    837          CALL iom_put( 'vtau_bi' , ztauy_bi * aimsk00 ) 
     811         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 
     812         CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 ) 
     813         CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 ) 
     814         CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 ) 
     815         CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 ) 
     816         CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 ) 
    838817      ENDIF 
    839818 
    840819      ! --- divergence, shear and strength --- ! 
    841       IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * aimsk00 )   ! divergence 
    842       IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * aimsk00 )   ! shear 
    843       IF( iom_use('icedlt') )   CALL iom_put( 'icedlt' , pdelta_i * aimsk00 )   ! delta 
    844       IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * aimsk00 )   ! strength 
     820      IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence 
     821      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear 
     822      IF( iom_use('icedlt') )   CALL iom_put( 'icedlt' , pdelta_i * zmsk00 )   ! delta 
     823      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength 
    845824 
    846825      ! --- Stress tensor invariants (SIMIP diags) --- ! 
     
    867846         ! 
    868847         ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008) 
    869          IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * aimsk00(:,:) ) ! Normal stress 
    870          IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * aimsk00(:,:) ) ! Maximum shear stress 
     848         IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress 
     849         IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress 
    871850 
    872851         DEALLOCATE ( zsig_I, zsig_II ) 
     
    914893         CALL lbc_lnk( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp ) 
    915894 
    916          CALL iom_put( 'yield11', zyield11 * aimsk00 ) 
    917          CALL iom_put( 'yield22', zyield22 * aimsk00 ) 
    918          CALL iom_put( 'yield12', zyield12 * aimsk00 ) 
     895         CALL iom_put( 'yield11', zyield11 * zmsk00 ) 
     896         CALL iom_put( 'yield22', zyield22 * zmsk00 ) 
     897         CALL iom_put( 'yield12', zyield12 * zmsk00 ) 
    919898      ENDIF 
    920899 
     
    922901      IF( iom_use('aniso') ) THEN 
    923902         CALL lbc_lnk( 'icedyn_rhg_eap', paniso_11, 'T', 1.0_wp ) 
    924          CALL iom_put( 'aniso' , paniso_11 * aimsk00 ) 
     903         CALL iom_put( 'aniso' , paniso_11 * zmsk00 ) 
    925904      ENDIF 
    926905 
     
    933912            &                              zfU, 'U', -1.0_wp,   zfV, 'V', -1.0_wp ) 
    934913 
    935          CALL iom_put( 'dssh_dx' , zspgU * aimsk00 )   ! Sea-surface tilt term in force balance (x) 
    936          CALL iom_put( 'dssh_dy' , zspgV * aimsk00 )   ! Sea-surface tilt term in force balance (y) 
    937          CALL iom_put( 'corstrx' , zCorU * aimsk00 )   ! Coriolis force term in force balance (x) 
    938          CALL iom_put( 'corstry' , zCorV * aimsk00 )   ! Coriolis force term in force balance (y) 
    939          CALL iom_put( 'intstrx' , zfU   * aimsk00 )   ! Internal force term in force balance (x) 
    940          CALL iom_put( 'intstry' , zfV   * aimsk00 )   ! Internal force term in force balance (y) 
     914         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x) 
     915         CALL iom_put( 'dssh_dy' , zspgV * zmsk00 )   ! Sea-surface tilt term in force balance (y) 
     916         CALL iom_put( 'corstrx' , zCorU * zmsk00 )   ! Coriolis force term in force balance (x) 
     917         CALL iom_put( 'corstry' , zCorV * zmsk00 )   ! Coriolis force term in force balance (y) 
     918         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x) 
     919         CALL iom_put( 'intstry' , zfV   * zmsk00 )   ! Internal force term in force balance (y) 
    941920      ENDIF 
    942921 
     
    949928         DO_2D( 0, 0, 0, 0 ) 
    950929            ! 2D ice mass, snow mass, area transport arrays (X, Y) 
    951             zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * aimsk00(ji,jj) 
    952             zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * aimsk00(ji,jj) 
     930            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
     931            zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 
    953932 
    954933            zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 
     
    984963            IF( ln_aEVP ) THEN   ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
    985964               CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 
    986                   &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * aimsk15(:,:) ) 
     965                  &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 
    987966            ELSE                 ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
    988967               CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 
    989                   &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * aimsk15(:,:) ) 
     968                  &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 
    990969            ENDIF 
    991970         ENDIF 
     
    995974 
    996975 
    997    SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     976   SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 
    998977      !!---------------------------------------------------------------------- 
    999978      !!                    ***  ROUTINE rhg_cvg_eap  *** 
     
    1010989      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
    1011990      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     991      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pmsk15 
    1012992      !! 
    1013993      INTEGER           ::   it, idtime, istatus 
     
    10441024         zresm = 0._wp 
    10451025      ELSE 
    1046          DO_2D( 1, 1, 1, 1 ) 
    1047             eap_res(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
    1048                &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * aimsk15(ji,jj) 
     1026         zresm = 0._wp 
     1027         DO_2D( 0, 0, 0, 0 ) 
     1028            zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     1029               &                     ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 
    10491030         END_2D 
    1050  
    1051          zresm = MAXVAL( eap_res ) 
    10521031         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
    10531032      ENDIF 
  • NEMO/trunk/src/ICE/icedyn_rhg_evp.F90

    r14433 r15014  
    4848   PUBLIC   rhg_evp_rst       ! called by icedyn_rhg.F90 
    4949 
    50    !! * Substitutions 
    51 #  include "do_loop_substitute.h90" 
    52 #  include "domzgr_substitute.h90" 
    53  
    5450   !! for convergence tests 
    5551   INTEGER ::   ncvgid   ! netcdf file id 
    5652   INTEGER ::   nvarid   ! netcdf variable id 
    57    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zmsk00, zmsk15 
     53   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   fimask   ! mask at F points for the ice 
     54 
     55   !! * Substitutions 
     56#  include "do_loop_substitute.h90" 
    5857   !!---------------------------------------------------------------------- 
    5958   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
     
    161160      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
    162161      ! 
     162      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00, zmsk15 
    163163      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
    164164      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
    165       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    166165 
    167166      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter 
     
    185184      ! 
    186185      ! for diagnostics and convergence tests 
    187       ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
    188186      DO_2D( 1, 1, 1, 1 ) 
    189187         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    190          zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    191188      END_2D 
    192       ! 
    193       !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
     189      IF( nn_rhg_chkcvg > 0 ) THEN 
     190         DO_2D( 1, 1, 1, 1 ) 
     191            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     192         END_2D 
     193      ENDIF 
     194      ! 
    194195      !------------------------------------------------------------------------------! 
    195196      ! 0) mask at F points for the ice 
    196197      !------------------------------------------------------------------------------! 
    197       ! ocean/land mask 
    198       DO_2D( 1, 0, 1, 0 ) 
    199          zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    200       END_2D 
    201       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp) 
    202  
    203       ! Lateral boundary conditions on velocity (modify zfmask) 
    204       DO_2D( 0, 0, 0, 0 ) 
    205          IF( zfmask(ji,jj) == 0._wp ) THEN 
    206             zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    207                &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     198      IF( kt == nit000 ) THEN 
     199         ! ocean/land mask 
     200         ALLOCATE( fimask(jpi,jpj) ) 
     201         IF( rn_ishlat == 0._wp ) THEN 
     202            DO_2D( 0, 0, 0, 0 ) 
     203               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     204            END_2D 
     205         ELSE 
     206            DO_2D( 0, 0, 0, 0 ) 
     207               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     208               ! Lateral boundary conditions on velocity (modify fimask) 
     209               IF( fimask(ji,jj) == 0._wp ) THEN 
     210                  fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     211                     &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     212               ENDIF 
     213            END_2D 
    208214         ENDIF 
    209       END_2D 
    210       DO jj = 2, jpjm1 
    211          IF( zfmask(1,jj) == 0._wp ) THEN 
    212             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
    213          ENDIF 
    214          IF( zfmask(jpi,jj) == 0._wp ) THEN 
    215             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 
    216         ENDIF 
    217       END DO 
    218       DO ji = 2, jpim1 
    219          IF( zfmask(ji,1) == 0._wp ) THEN 
    220             zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    221          ENDIF 
    222          IF( zfmask(ji,jpj) == 0._wp ) THEN 
    223             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 
    224          ENDIF 
    225       END DO 
    226       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 
    227  
     215         CALL lbc_lnk( 'icedyn_rhg_evp', fimask, 'F', 1._wp ) 
     216      ENDIF 
    228217      !------------------------------------------------------------------------------! 
    229218      ! 1) define some variables and initialize arrays 
     
    367356            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    368357               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    369                &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     358               &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    370359 
    371360         END_2D 
     
    702691 
    703692         ! convergence test 
    704          IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
     693         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 
    705694         ! 
    706695         !                                                ! ==================== ! 
     
    717706         zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    718707            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    719             &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     708            &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    720709 
    721710      END_2D 
     
    914903      ENDIF 
    915904      ! 
    916       DEALLOCATE( zmsk00, zmsk15 ) 
    917       ! 
    918905   END SUBROUTINE ice_dyn_rhg_evp 
    919906 
    920907 
    921    SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     908   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 
    922909      !!---------------------------------------------------------------------- 
    923910      !!                    ***  ROUTINE rhg_cvg  *** 
     
    934921      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
    935922      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     923      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pmsk15 
    936924      !! 
    937925      INTEGER           ::   it, idtime, istatus 
     
    939927      REAL(wp)          ::   zresm           ! local real 
    940928      CHARACTER(len=20) ::   clname 
    941       REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence 
    942929      !!---------------------------------------------------------------------- 
    943930 
     
    969956         zresm = 0._wp 
    970957      ELSE 
    971          DO_2D( 1, 1, 1, 1 ) 
    972             zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
    973                &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 
    974          END_2D 
    975          zresm = MAXVAL( zres ) 
     958         zresm = 0._wp 
     959         DO_2D( 0, 0, 0, 0 ) 
     960            zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     961               &                     ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 
     962         END_2D 
    976963         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
    977964      ENDIF 
  • NEMO/trunk/src/ICE/icedyn_rhg_vp.F90

    r14433 r15014  
    5959   INTEGER ::   nvarid_ures_xy, nvarid_vres_xy 
    6060 
    61    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zmsk00, zmsk15 
    62  
     61   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   fimask   ! mask at F points for the ice 
     62    
     63   !! * Substitutions 
     64#  include "do_loop_substitute.h90" 
    6365   !!---------------------------------------------------------------------- 
    6466   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
     
    158160      REAL(wp) ::   zAA3, zw, ztau, zuerr_max, zverr_max 
    159161      ! 
    160       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    161162      REAL(wp), DIMENSION(jpi,jpj) ::   za_iU  , za_iV                      ! ice fraction on U/V points 
    162163      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! Acceleration term contribution to RHS 
     
    197198!!!      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
    198199     ! 
     200      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00, zmsk15 
    199201      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! mask for lots of ice (1), little ice (0) 
    200202      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence (1), no ice (0) 
     
    238240       
    239241      ! for diagnostics and convergence tests 
    240       ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
    241       DO jj = 1, jpj 
    242          DO ji = 1, jpi 
    243             zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     242      DO_2D( 1, 1, 1, 1 ) 
     243         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     244      END_2D 
     245      IF( nn_rhg_chkcvg > 0 ) THEN 
     246         DO_2D( 1, 1, 1, 1 ) 
    244247            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    245          END DO 
    246       END DO 
     248         END_2D 
     249      ENDIF 
    247250       
    248251      IF ( lp_zebra_vp ) THEN; nn_zebra_vp = 2 
     
    292295      ! -- F-mask       (code from EVP) 
    293296      !------------------------------ 
    294       ! MartinV:  
    295       ! In EVP routine, zfmask is applied on shear at F-points, in order to enforce the lateral boundary condition (no-slip, ..., free-slip) 
    296       ! I am not sure the same recipe applies here 
    297        
    298       ! - ocean/land mask 
    299       DO jj = 1, jpj - 1 
    300          DO ji = 1, jpi - 1 
    301             zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    302          END DO 
    303       END DO 
    304  
    305       ! Lateral boundary conditions on velocity (modify zfmask) 
    306       ! Can be computed once for all, at first time step, for all rheologies 
    307       DO jj = 2, jpj - 1 
    308          DO ji = 2, jpi - 1   ! vector opt. 
    309             IF( zfmask(ji,jj) == 0._wp ) THEN 
    310                zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    311                   &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
    312             ENDIF 
    313          END DO 
    314       END DO 
    315       DO jj = 2, jpj - 1 
    316          IF( zfmask(1,jj) == 0._wp ) THEN 
    317             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
     297      IF( kt == nit000 ) THEN 
     298         ! MartinV:  
     299         ! In EVP routine, fimask is applied on shear at F-points, in order to enforce the lateral boundary condition (no-slip, ..., free-slip) 
     300         ! I am not sure the same recipe applies here 
     301          
     302         ! - ocean/land mask 
     303         ALLOCATE( fimask(jpi,jpj) ) 
     304         IF( rn_ishlat == 0._wp ) THEN 
     305            DO_2D( 0, 0, 0, 0 ) 
     306               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     307            END_2D 
     308         ELSE 
     309            DO_2D( 0, 0, 0, 0 ) 
     310               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     311               ! Lateral boundary conditions on velocity (modify fimask) 
     312               IF( fimask(ji,jj) == 0._wp ) THEN 
     313                  fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     314                     &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     315               ENDIF 
     316            END_2D 
    318317         ENDIF 
    319          IF( zfmask(jpi,jj) == 0._wp ) THEN 
    320             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpi - 1,jj,1), umask(jpi,jj-1,1) ) ) 
    321         ENDIF 
    322       END DO 
    323       DO ji = 2, jpi - 1 
    324          IF( zfmask(ji,1) == 0._wp ) THEN 
    325             zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    326          ENDIF 
    327          IF( zfmask(ji,jpj) == 0._wp ) THEN 
    328             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpj - 1,1) ) ) 
    329          ENDIF 
    330       END DO 
    331        
    332       CALL lbc_lnk( 'icedyn_rhg_vp', zfmask, 'F', 1._wp ) 
     318          
     319         CALL lbc_lnk( 'icedyn_rhg_vp', fimask, 'F', 1._wp ) 
     320      ENDIF 
    333321       
    334322      !---------------------------------------------------------------------------------------------------------- 
     
    455443               zds(ji,jj) = ( ( zu_c(ji,jj+1) * r1_e1u(ji,jj+1) - zu_c(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    456444                  &         + ( zv_c(ji+1,jj) * r1_e2v(ji+1,jj) - zv_c(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    457                   &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     445                  &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    458446 
    459447            END DO 
     
    521509                
    522510               ! Temporary zef factor at F-point 
    523                zef(ji,jj)      = zp_deltastar_f * r1_e1e2f(ji,jj) * z1_ecc2 * zfmask(ji,jj) 
     511               zef(ji,jj)      = zp_deltastar_f * r1_e1e2f(ji,jj) * z1_ecc2 * fimask(ji,jj) 
    524512 
    525513            END DO 
     
    611599          
    612600         ! --- Stress contributions at f-points          
    613          ! MV NOTE: I applied zfmask on zds, by mimetism on EVP, but without deep understanding of what I was doing 
     601         ! MV NOTE: I applied fimask on zds, by mimetism on EVP, but without deep understanding of what I was doing 
    614602         ! My guess is that this is the way to enforce boundary conditions on strain rate tensor 
    615603 
     
    620608                
    621609               ! sig12 contribution to RHS of U equation at F-points  
    622                zs12_rhsu(ji,jj) = - zef(ji,jj)  * ( r1_e2v(ji+1,jj) * zv_c(ji+1,jj) - r1_e2v(ji,jj) * zv_c(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) * zfmask(ji,jj) 
     610               zs12_rhsu(ji,jj) = - zef(ji,jj)  * ( r1_e2v(ji+1,jj) * zv_c(ji+1,jj) - r1_e2v(ji,jj) * zv_c(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) * fimask(ji,jj) 
    623611                
    624612               ! sig12 contribution to RHS of V equation at F-points 
    625                zs12_rhsv(ji,jj) =   zef(ji,jj)  * ( r1_e1u(ji,jj+1) * zu_c(ji,jj+1) - r1_e1u(ji,jj) * zu_c(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) * zfmask(ji,jj) 
     613               zs12_rhsv(ji,jj) =   zef(ji,jj)  * ( r1_e1u(ji,jj+1) * zu_c(ji,jj+1) - r1_e1u(ji,jj) * zu_c(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) * fimask(ji,jj) 
    626614 
    627615            END DO 
     
    11811169            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    11821170               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    1183                &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     1171               &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    11841172 
    11851173         END DO 
     
    15011489      ENDIF 
    15021490 
    1503       DEALLOCATE( zmsk00, zmsk15 ) 
    1504  
    15051491   END SUBROUTINE ice_dyn_rhg_vp 
    15061492    
  • NEMO/trunk/src/OCE/BDY/bdyini.F90

    r14433 r15014  
    4444   INTEGER, DIMENSION(jp_nseg) ::   jpjnob, jpindt, jpinft, npckgn   ! 
    4545   INTEGER, DIMENSION(jp_nseg) ::   jpjsob, jpisdt, jpisft, npckgs   ! 
     46    
     47   !! * Substitutions 
     48#  include "do_loop_substitute.h90" 
    4649   !!---------------------------------------------------------------------- 
    4750   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    140143      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries 
    141144      !!----------------------------------------------------------------------       
     145      INTEGER  ::   ji, jj                                 ! dummy loop indices 
    142146      INTEGER  ::   ib_bdy, ii, ij, igrd, ib, ir, iseg     ! dummy loop indices 
    143147      INTEGER  ::   icount, icountr, icountr0, ibr_max     ! local integers 
     
    630634      ! For the flagu/flagv calculation below we require a version of fmask without 
    631635      ! the land boundary condition (shlat) included: 
    632       DO ij = 1, jpjm1 
    633          DO ii = 1, jpim1 
    634             zfmask(ii,ij) =  ztmask(ii,ij  ) * ztmask(ii+1,ij  )   & 
    635                &           * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 
    636          END DO 
    637       END DO 
     636      DO_2D( 0, 0, 0, 0 ) 
     637         zfmask(ji,jj) =  ztmask(ji,jj  ) * ztmask(ji+1,jj  )   & 
     638            &           * ztmask(ji,jj+1) * ztmask(ji+1,jj+1) 
     639      END_2D 
    638640      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 
    639641 
     
    646648 
    647649      ! Derive mask on U and V grid from mask on T grid 
    648       DO ij = 1, jpjm1 
    649          DO ii = 1, jpim1 
    650             bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1,ij  ) 
    651             bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
    652          END DO 
    653       END DO 
     650      DO_2D( 0, 0, 0, 0 ) 
     651            bdyumask(ji,jj) = bdytmask(ji,jj) * bdytmask(ji+1,jj  ) 
     652            bdyvmask(ji,jj) = bdytmask(ji,jj) * bdytmask(ji  ,jj+1)   
     653      END_2D 
    654654      CALL lbc_lnk( 'bdyini', bdyumask, 'U', 1.0_wp , bdyvmask, 'V', 1.0_wp )   ! Lateral boundary cond.  
    655655 
     
    687687 
    688688      ! Recompute zfmask 
    689       DO ij = 1, jpjm1 
    690          DO ii = 1, jpim1 
    691             zfmask(ii,ij) =  ztmask(ii,ij  ) * ztmask(ii+1,ij  )   & 
    692                &           * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 
    693          END DO 
    694       END DO 
     689      DO_2D( 0, 0, 0, 0 ) 
     690         zfmask(ji,jj) =  ztmask(ji,jj  ) * ztmask(ji+1,jj  )   & 
     691            &           * ztmask(ji,jj+1) * ztmask(ji+1,jj+1) 
     692      END_2D 
    695693      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 
    696694 
  • NEMO/trunk/src/OCE/DOM/domain.F90

    r14834 r15014  
    148148      END DO 
    149149      ! 
    150       DO jk = 1, jpkm1 
    151          hf_0(1:jpim1,:) = hf_0(1:jpim1,:) + e3f_0(1:jpim1,:,jk)*vmask(1:jpim1,:,jk)*vmask(2:jpi,:,jk) 
    152       END DO 
     150      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     151         hf_0(ji,jj) = hf_0(ji,jj) + e3f_0(ji,jj,jk)*vmask(ji,jj,jk)*vmask(ji+1,jj,jk) 
     152      END_3D 
    153153      CALL lbc_lnk('domain', hf_0, 'F', 1._wp) 
    154154      ! 
  • NEMO/trunk/src/OCE/DOM/dommsk.F90

    r14433 r15014  
    182182      ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 
    183183      IF( lk_SWE ) THEN      ! Shallow Water Eq. case : redefine ssfmask 
    184          DO_2D( 0,0, 0,0 ) 
     184         DO_2D( 0, 0, 0, 0 ) 
    185185            ssfmask(ji,jj) = MAX(  ssmask(ji,jj+1), ssmask(ji+1,jj+1),  &  
    186186               &                   ssmask(ji,jj  ), ssmask(ji+1,jj  )   ) 
     
    202202      ! Lateral boundary conditions on velocity (modify fmask) 
    203203      ! ---------------------------------------   
    204       IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
     204      IF( rn_shlat /= 0._wp ) THEN      ! Not free-slip lateral boundary condition 
    205205         ! 
    206          DO jk = 1, jpk 
    207             DO_2D( 0, 0, 0, 0 ) 
    208                IF( fmask(ji,jj,jk) == 0._wp ) THEN 
    209                   fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 
    210                      &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 
    211                ENDIF 
    212             END_2D 
    213             DO jj = 2, jpjm1 
    214                IF( fmask(1,jj,jk) == 0._wp ) THEN 
    215                   fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) ) 
    216                ENDIF 
    217                IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
    218                   fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) ) 
    219                ENDIF 
    220             END DO          
    221             DO ji = 2, jpim1 
    222                IF( fmask(ji,1,jk) == 0._wp ) THEN 
    223                   fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) ) 
    224                ENDIF 
    225                IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
    226                   fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) ) 
    227                ENDIF 
    228             END DO 
    229          END DO 
    230          ! 
     206         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     207            IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     208               fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 
     209                  &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 
     210            ENDIF 
     211         END_3D 
    231212         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
    232213         ! 
  • NEMO/trunk/src/OCE/DOM/domqco.F90

    r14834 r15014  
    184184         !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    185185 
    186       DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
     186      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    187187         ! round brackets added to fix the order of floating point operations 
    188188         ! needed to ensure halo 1 - halo 2 compatibility 
     
    197197!!st         ELSE                                      !- Flux Form   (simple averaging) 
    198198#else 
    199       DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     199      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    200200         ! round brackets added to fix the order of floating point operations 
    201201         ! needed to ensure halo 1 - halo 2 compatibility 
    202202         pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj  ) + pssh(ji+1,jj  ) ) & 
    203             &                     + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)  & 
     203            &                    + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)   & 
    204204            &                       )                                  & ! bracket for halo 1 - halo 2 compatibility 
    205205            &                    ) * r1_hf_0(ji,jj) 
  • NEMO/trunk/src/OCE/DOM/domvvl.F90

    r14834 r15014  
    713713         ! 
    714714      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean 
    715          DO_3D( 1, 0, 1, 0, 1, jpk ) 
     715         DO_3D( 0, 0, 0, 0, 1, jpk ) 
    716716            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
    717717               &                       *    r1_e1e2f(ji,jj)                                                  & 
  • NEMO/trunk/src/OCE/DOM/domzgr.F90

    r14433 r15014  
    340340      !                                    ! N.B.  top     k-index of W-level = mikt 
    341341      !                                    !       bottom  k-index of W-level = mbkt+1 
    342       DO_2D( 1, 0, 1, 0 ) 
     342      DO_2D( 0, 0, 0, 0 ) 
    343343         miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  ) 
    344344         mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  ) 
     
    349349      END_2D 
    350350      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk  
    351       zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp )   ;   miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    352       zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp )   ;   mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    353       zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp )   ;   mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    354       ! 
    355       zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp )   ;   mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    356       zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp )   ;   mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     351      DO_2D( 0, 0, 0, 0 ) 
     352         zk(ji,jj) = REAL( miku(ji,jj), wp ) 
     353      END_2D 
     354      CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) 
     355      miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     356 
     357      DO_2D( 0, 0, 0, 0 ) 
     358         zk(ji,jj) = REAL( mikv(ji,jj), wp ) 
     359      END_2D 
     360      CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) 
     361      mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     362       
     363      DO_2D( 0, 0, 0, 0 ) 
     364         zk(ji,jj) = REAL( mikf(ji,jj), wp ) 
     365      END_2D 
     366      CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp ) 
     367      mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     368      ! 
     369      DO_2D( 0, 0, 0, 0 ) 
     370         zk(ji,jj) = REAL( mbku(ji,jj), wp ) 
     371      END_2D 
     372      CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) 
     373      mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     374       
     375      DO_2D( 0, 0, 0, 0 ) 
     376         zk(ji,jj) = REAL( mbkv(ji,jj), wp ) 
     377      END_2D 
     378      CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) 
     379      mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    357380      ! 
    358381   END SUBROUTINE zgr_top_bot 
  • NEMO/trunk/src/OCE/LDF/ldfc1d_c2d.F90

    r14834 r15014  
    8080            pah1(:,:,jk) = pahs1(:,:) * (  zratio + zc * ( 1._wp + TANH( - ( gdept_0(:,:,jk) - zh ) * zw) )  ) 
    8181         END DO 
    82          DO_3DS( 1, 0, 1, 0, jpkm1, 1, -1 )  ! pah2 at F-point (zdep2 is an approximation in zps-coord.) 
     82         DO_3DS( 0, 0, 0, 0, jpkm1, 1, -1 )  ! pah2 at F-point (zdep2 is an approximation in zps-coord.) 
    8383            zdep2 = (  gdept_0(ji,jj+1,jk) + gdept_0(ji+1,jj+1,jk)   & 
    8484               &     + gdept_0(ji,jj  ,jk) + gdept_0(ji+1,jj  ,jk)  ) * r1_4 
     
    8888         ! 
    8989      CASE( 'TRA' )                     ! U- and V-points (zdep1 & 2 are an approximation in zps-coord.) 
    90          DO_3DS( 1, 0, 1, 0, jpkm1, 1, -1 ) 
     90         DO_3DS( 0, 0, 0, 0, jpkm1, 1, -1 ) 
    9191            zdep1 = (  gdept_0(ji,jj,jk) + gdept_0(ji+1,jj,jk)  ) * 0.5_wp 
    9292            zdep2 = (  gdept_0(ji,jj,jk) + gdept_0(ji,jj+1,jk)  ) * 0.5_wp 
  • NEMO/trunk/src/OCE/LDF/ldfdyn.F90

    r14433 r15014  
    385385                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb) 
    386386                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb) 
     387                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk,Kbb) * uu(ji  ,jj+1,jk,Kbb) + vv(ji+1,jj  ,jk,Kbb) * vv(ji+1,jj  ,jk,Kbb) 
    387388                  zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
    388389                  ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk)      ! 288= 12*12 * 2 
    389                END_2D 
    390                DO_2D( 1, 0, 1, 0 ) 
    391                   zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, Kbb) * uu(ji  ,jj+1,jk, Kbb) + vv(ji+1,jj  ,jk, Kbb) * vv(ji+1,jj  ,jk, Kbb) 
    392                   zu2pv2_ij    = uu(ji  ,jj  ,jk, Kbb) * uu(ji  ,jj  ,jk, Kbb) + vv(ji  ,jj  ,jk, Kbb) * vv(ji  ,jj  ,jk, Kbb) 
    393390                  zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
    394391                  ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax * fmask(ji,jj,jk)      ! 288= 12*12 * 2 
     
    400397                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb) 
    401398                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb) 
     399                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk,Kbb) * uu(ji  ,jj+1,jk,Kbb) + vv(ji+1,jj  ,jk,Kbb) * vv(ji+1,jj  ,jk,Kbb) 
    402400                  zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
    403401                  ahmt(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax  ) * zemax * tmask(ji,jj,jk) 
    404                END_2D 
    405                DO_2D( 1, 0, 1, 0 ) 
    406                   zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, Kbb) * uu(ji  ,jj+1,jk, Kbb) + vv(ji+1,jj  ,jk, Kbb) * vv(ji+1,jj  ,jk, Kbb) 
    407                   zu2pv2_ij    = uu(ji  ,jj  ,jk, Kbb) * uu(ji  ,jj  ,jk, Kbb) + vv(ji  ,jj  ,jk, Kbb) * vv(ji  ,jj  ,jk, Kbb) 
    408402                  zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
    409403                  ahmf(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax  ) * zemax * fmask(ji,jj,jk) 
     
    487481               DO_2D( 0, 0, 0, 0 ) 
    488482                  ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) ) 
    489                END_2D 
    490                DO_2D( 1, 0, 1, 0 ) 
    491483                  ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) ) 
    492484               END_2D 
Note: See TracChangeset for help on using the changeset viewer.