Changeset 15026


Ignore:
Timestamp:
2021-06-18T18:22:11+02:00 (4 months ago)
Author:
smasson
Message:

trunk: missing part in [15014] for tests, #2693

Location:
NEMO/trunk/tests/ICE_RHEO/MY_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90

    r14433 r15026  
    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) 
     
    182180      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
    183181      ! 
     182      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00, zmsk15 
    184183      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
    185184      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
    186       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    187185 
    188186      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter 
     
    205203      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_eap: EAP sea-ice rheology' 
    206204      ! 
    207       IF( kt == nit000 )  THEN  
    208          ! 
    209          ! for diagnostics  
    210          ALLOCATE( aimsk00(jpi,jpj) ) 
    211          ! for convergence tests 
    212          IF( nn_rhg_chkcvg > 0 ) ALLOCATE( eap_res(jpi,jpj), aimsk15(jpi,jpj) ) 
    213       ENDIF 
    214       ! 
     205      ! for diagnostics and convergence tests 
    215206      DO_2D( 1, 1, 1, 1 ) 
    216          aimsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     207         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    217208      END_2D 
    218209      IF( nn_rhg_chkcvg > 0 ) THEN 
    219210         DO_2D( 1, 1, 1, 1 ) 
    220             aimsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     211            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    221212         END_2D 
    222213      ENDIF 
    223214      ! 
    224 !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
    225215      !------------------------------------------------------------------------------! 
    226216      ! 0) mask at F points for the ice 
    227217      !------------------------------------------------------------------------------! 
    228       ! ocean/land mask 
    229       DO_2D( 1, 0, 1, 0 ) 
    230          zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    231       END_2D 
    232       CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1._wp ) 
    233  
    234       ! Lateral boundary conditions on velocity (modify zfmask) 
    235       DO_2D( 0, 0, 0, 0 ) 
    236          IF( zfmask(ji,jj) == 0._wp ) THEN 
    237             zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    238                &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     218      IF( kt == nit000 ) THEN 
     219         ! ocean/land mask 
     220         ALLOCATE( fimask(jpi,jpj) ) 
     221         IF( rn_ishlat == 0._wp ) THEN 
     222            DO_2D( 0, 0, 0, 0 ) 
     223               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     224            END_2D 
     225         ELSE 
     226            DO_2D( 0, 0, 0, 0 ) 
     227               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     228               ! Lateral boundary conditions on velocity (modify fimask) 
     229               IF( fimask(ji,jj) == 0._wp ) THEN 
     230                  fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     231                     &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     232               ENDIF 
     233            END_2D 
    239234         ENDIF 
    240       END_2D 
    241       DO jj = 2, jpjm1 
    242          IF( zfmask(1,jj) == 0._wp ) THEN 
    243             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
    244          ENDIF 
    245          IF( zfmask(jpi,jj) == 0._wp ) THEN 
    246             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 
    247          ENDIF 
    248       END DO 
    249       DO ji = 2, jpim1 
    250          IF( zfmask(ji,1) == 0._wp ) THEN 
    251             zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    252          ENDIF 
    253          IF( zfmask(ji,jpj) == 0._wp ) THEN 
    254             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 
    255          ENDIF 
    256       END DO 
    257       CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1.0_wp ) 
     235         CALL lbc_lnk( 'icedyn_rhg_eap', fimask, 'F', 1.0_wp ) 
     236      ENDIF 
    258237 
    259238      !------------------------------------------------------------------------------! 
     
    405384            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)   & 
    406385               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    407                &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     386               &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    408387 
    409388         END_2D 
     
    782761 
    783762         ! convergence test 
    784          IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
     763         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 
    785764         ! 
    786765         !                                                ! ==================== ! 
     
    799778         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)   & 
    800779            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    801             &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     780            &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    802781 
    803782      END_2D 
     
    852831            &                            ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    853832         ! 
    854          CALL iom_put( 'utau_oi' , ztaux_oi * aimsk00 ) 
    855          CALL iom_put( 'vtau_oi' , ztauy_oi * aimsk00 ) 
    856          CALL iom_put( 'utau_ai' , ztaux_ai * aimsk00 ) 
    857          CALL iom_put( 'vtau_ai' , ztauy_ai * aimsk00 ) 
    858          CALL iom_put( 'utau_bi' , ztaux_bi * aimsk00 ) 
    859          CALL iom_put( 'vtau_bi' , ztauy_bi * aimsk00 ) 
     833         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 
     834         CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 ) 
     835         CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 ) 
     836         CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 ) 
     837         CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 ) 
     838         CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 ) 
    860839      ENDIF 
    861840 
    862841      ! --- divergence, shear and strength --- ! 
    863       IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * aimsk00 )   ! divergence 
    864       IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * aimsk00 )   ! shear 
    865       IF( iom_use('icedlt') )   CALL iom_put( 'icedlt' , pdelta_i * aimsk00 )   ! delta 
    866       IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * aimsk00 )   ! strength 
     842      IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence 
     843      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear 
     844      IF( iom_use('icedlt') )   CALL iom_put( 'icedlt' , pdelta_i * zmsk00 )   ! delta 
     845      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength 
    867846 
    868847      ! --- Stress tensor invariants (SIMIP diags) --- ! 
     
    889868         ! 
    890869         ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008) 
    891          IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * aimsk00(:,:) ) ! Normal stress 
    892          IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * aimsk00(:,:) ) ! Maximum shear stress 
     870         IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress 
     871         IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress 
    893872 
    894873         DEALLOCATE ( zsig_I, zsig_II ) 
     
    936915         CALL lbc_lnk( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp ) 
    937916 
    938          CALL iom_put( 'yield11', zyield11 * aimsk00 ) 
    939          CALL iom_put( 'yield22', zyield22 * aimsk00 ) 
    940          CALL iom_put( 'yield12', zyield12 * aimsk00 ) 
     917         CALL iom_put( 'yield11', zyield11 * zmsk00 ) 
     918         CALL iom_put( 'yield22', zyield22 * zmsk00 ) 
     919         CALL iom_put( 'yield12', zyield12 * zmsk00 ) 
    941920      ENDIF 
    942921 
     
    944923      IF( iom_use('aniso') ) THEN 
    945924         CALL lbc_lnk( 'icedyn_rhg_eap', paniso_11, 'T', 1.0_wp ) 
    946          CALL iom_put( 'aniso' , paniso_11 * aimsk00 ) 
     925         CALL iom_put( 'aniso' , paniso_11 * zmsk00 ) 
    947926      ENDIF 
    948927 
     
    955934            &                              zfU, 'U', -1.0_wp,   zfV, 'V', -1.0_wp ) 
    956935 
    957          CALL iom_put( 'dssh_dx' , zspgU * aimsk00 )   ! Sea-surface tilt term in force balance (x) 
    958          CALL iom_put( 'dssh_dy' , zspgV * aimsk00 )   ! Sea-surface tilt term in force balance (y) 
    959          CALL iom_put( 'corstrx' , zCorU * aimsk00 )   ! Coriolis force term in force balance (x) 
    960          CALL iom_put( 'corstry' , zCorV * aimsk00 )   ! Coriolis force term in force balance (y) 
    961          CALL iom_put( 'intstrx' , zfU   * aimsk00 )   ! Internal force term in force balance (x) 
    962          CALL iom_put( 'intstry' , zfV   * aimsk00 )   ! Internal force term in force balance (y) 
     936         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x) 
     937         CALL iom_put( 'dssh_dy' , zspgV * zmsk00 )   ! Sea-surface tilt term in force balance (y) 
     938         CALL iom_put( 'corstrx' , zCorU * zmsk00 )   ! Coriolis force term in force balance (x) 
     939         CALL iom_put( 'corstry' , zCorV * zmsk00 )   ! Coriolis force term in force balance (y) 
     940         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x) 
     941         CALL iom_put( 'intstry' , zfV   * zmsk00 )   ! Internal force term in force balance (y) 
    963942      ENDIF 
    964943 
     
    971950         DO_2D( 0, 0, 0, 0 ) 
    972951            ! 2D ice mass, snow mass, area transport arrays (X, Y) 
    973             zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * aimsk00(ji,jj) 
    974             zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * aimsk00(ji,jj) 
     952            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
     953            zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 
    975954 
    976955            zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 
     
    1006985            IF( ln_aEVP ) THEN   ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
    1007986               CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 
    1008                   &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * aimsk15(:,:) ) 
     987                  &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 
    1009988            ELSE                 ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
    1010989               CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 
    1011                   &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * aimsk15(:,:) ) 
     990                  &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 
    1012991            ENDIF 
    1013992         ENDIF 
     
    1017996 
    1018997 
    1019    SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     998   SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 
    1020999      !!---------------------------------------------------------------------- 
    10211000      !!                    ***  ROUTINE rhg_cvg_eap  *** 
     
    10321011      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
    10331012      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     1013      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pmsk15 
    10341014      !! 
    10351015      INTEGER           ::   it, idtime, istatus 
     
    10661046         zresm = 0._wp 
    10671047      ELSE 
    1068          DO_2D( 1, 1, 1, 1 ) 
    1069             eap_res(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
    1070                &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * aimsk15(ji,jj) 
     1048         zresm = 0._wp 
     1049         DO_2D( 0, 0, 0, 0 ) 
    10711050            ! cut of the boundary of the box (forced velocities) 
    1072             IF (mjg(jj)<=30 .or. mjg(jj)>970 .or. mig(ji)<=30 .or. mig(ji)>970) THEN 
    1073                eap_res(ji,jj) = 0._wp 
    1074             END IF 
     1051            IF (mjg0(jj)>30 .AND. mjg0(jj)<=970 .AND. mig0(ji)>30 .AND. mig0(ji)<=970) THEN 
     1052               zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     1053                  &                     ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 
     1054            ENDIF 
    10751055         END_2D 
    1076  
    1077          zresm = MAXVAL( eap_res ) 
    10781056         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
    10791057      ENDIF 
  • NEMO/trunk/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90

    r14433 r15026  
    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) 
     
    163162      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
    164163      ! 
     164      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00, zmsk15 
    165165      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
    166166      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
    167       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    168167 
    169168      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter 
     
    187186      ! 
    188187      ! for diagnostics and convergence tests 
    189       ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
    190188      DO_2D( 1, 1, 1, 1 ) 
    191189         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    192          zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    193190      END_2D 
    194       ! 
    195       !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
     191      IF( nn_rhg_chkcvg > 0 ) THEN 
     192         DO_2D( 1, 1, 1, 1 ) 
     193            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     194         END_2D 
     195      ENDIF 
     196      ! 
    196197      !------------------------------------------------------------------------------! 
    197198      ! 0) mask at F points for the ice 
    198199      !------------------------------------------------------------------------------! 
    199       ! ocean/land mask 
    200       DO_2D( 1, 0, 1, 0 ) 
    201          zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    202       END_2D 
    203       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 
    204  
    205       ! Lateral boundary conditions on velocity (modify zfmask) 
    206       DO_2D( 0, 0, 0, 0 ) 
    207          IF( zfmask(ji,jj) == 0._wp ) THEN 
    208             zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    209                &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     200      IF( kt == nit000 ) THEN 
     201         ! ocean/land mask 
     202         ALLOCATE( fimask(jpi,jpj) ) 
     203         IF( rn_ishlat == 0._wp ) THEN 
     204            DO_2D( 0, 0, 0, 0 ) 
     205               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     206            END_2D 
     207         ELSE 
     208            DO_2D( 0, 0, 0, 0 ) 
     209               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     210               ! Lateral boundary conditions on velocity (modify fimask) 
     211               IF( fimask(ji,jj) == 0._wp ) THEN 
     212                  fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     213                     &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     214               ENDIF 
     215            END_2D 
    210216         ENDIF 
    211       END_2D 
    212       DO jj = 2, jpjm1 
    213          IF( zfmask(1,jj) == 0._wp ) THEN 
    214             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
    215          ENDIF 
    216          IF( zfmask(jpi,jj) == 0._wp ) THEN 
    217             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 
    218         ENDIF 
    219       END DO 
    220       DO ji = 2, jpim1 
    221          IF( zfmask(ji,1) == 0._wp ) THEN 
    222             zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    223          ENDIF 
    224          IF( zfmask(ji,jpj) == 0._wp ) THEN 
    225             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 
    226          ENDIF 
    227       END DO 
    228       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 
    229  
     217         CALL lbc_lnk( 'icedyn_rhg_evp', fimask, 'F', 1._wp ) 
     218      ENDIF 
    230219      !------------------------------------------------------------------------------! 
    231220      ! 1) define some variables and initialize arrays 
     
    371360            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)   & 
    372361               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    373                &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     362               &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    374363 
    375364         END_2D 
     
    722711 
    723712         ! convergence test 
    724          IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
     713         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 
    725714         ! 
    726715         !                                                ! ==================== ! 
     
    737726         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)   & 
    738727            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    739             &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     728            &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    740729 
    741730      END_2D 
     
    932921            ENDIF 
    933922         ENDIF 
    934       ENDIF       
    935       ! 
    936       DEALLOCATE( zmsk00, zmsk15 ) 
     923      ENDIF 
    937924      ! 
    938925   END SUBROUTINE ice_dyn_rhg_evp 
    939926 
    940927 
    941    SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     928   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 
    942929      !!---------------------------------------------------------------------- 
    943930      !!                    ***  ROUTINE rhg_cvg  *** 
     
    954941      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
    955942      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     943      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pmsk15 
    956944      !! 
    957945      INTEGER           ::   it, idtime, istatus 
     
    959947      REAL(wp)          ::   zresm           ! local real  
    960948      CHARACTER(len=20) ::   clname 
    961       REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence 
    962949      !!---------------------------------------------------------------------- 
    963950 
     
    989976         zresm = 0._wp 
    990977      ELSE 
    991          DO_2D( 1, 1, 1, 1 ) 
    992             zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
    993                &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 
     978         zresm = 0._wp 
     979         DO_2D( 0, 0, 0, 0 ) 
     980            ! cut of the boundary of the box (forced velocities) 
     981            IF (mjg0(jj)>30 .AND. mjg0(jj)<=970 .AND. mig0(ji)>30 .AND. mig0(ji)<=970) THEN 
     982               zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     983                  &                     ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 
     984            ENDIF 
    994985         END_2D 
    995  
    996          ! cut of the boundary of the box (forced velocities) 
    997          IF (mjg(jj)<=30 .or. mjg(jj)>970 .or. mig(ji)<=30 .or. mig(ji)>970) THEN 
    998             zres(ji,jj) = 0._wp 
    999          END IF 
    1000  
    1001          zresm = MAXVAL( zres ) 
    1002986         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
    1003987      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.