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 15049 – NEMO

Changeset 15049


Ignore:
Timestamp:
2021-06-23T18:17:30+02:00 (3 years ago)
Author:
clem
Message:

adapt ice advection and rheology to nn_hls=2. Number of mpi communications are reduced. I also changed lbc_lnk routine to be able to do lbc on 30 variables at once.

Location:
NEMO/trunk/src/ICE
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/src/ICE/icedyn_adv_pra.F90

    r15037 r15049  
    268268            &                          , sxxice, 'T', 1._wp, syyice, 'T',  1._wp, sxyice, 'T',  1._wp  & 
    269269            &                          , z0snw , 'T', 1._wp, sxsn  , 'T', -1._wp, sysn  , 'T', -1._wp  & ! snw volume 
    270             &                          , sxxsn , 'T', 1._wp, syysn , 'T',  1._wp, sxysn , 'T',  1._wp  ) 
    271          CALL lbc_lnk( 'icedyn_adv_pra', z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp  & ! ice salinity 
     270            &                          , sxxsn , 'T', 1._wp, syysn , 'T',  1._wp, sxysn , 'T',  1._wp  & 
     271            &                          , z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp  & ! ice salinity 
    272272            &                          , sxxsal, 'T', 1._wp, syysal, 'T',  1._wp, sxysal, 'T',  1._wp  & 
    273273            &                          , z0ai  , 'T', 1._wp, sxa   , 'T', -1._wp, sya   , 'T', -1._wp  & ! ice concentration 
    274             &                          , sxxa  , 'T', 1._wp, syya  , 'T',  1._wp, sxya  , 'T',  1._wp  ) 
    275          CALL lbc_lnk( 'icedyn_adv_pra', z0oi  , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp  & ! ice age 
     274            &                          , sxxa  , 'T', 1._wp, syya  , 'T',  1._wp, sxya  , 'T',  1._wp  & 
     275            &                          , z0oi  , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp  & ! ice age 
    276276            &                          , sxxage, 'T', 1._wp, syyage, 'T',  1._wp, sxyage, 'T',  1._wp  ) 
    277277         CALL lbc_lnk( 'icedyn_adv_pra', z0es  , 'T', 1._wp, sxc0  , 'T', -1._wp, syc0  , 'T', -1._wp  & ! snw enthalpy 
    … …  
    280280            &                          , sxxe  , 'T', 1._wp, syye  , 'T',  1._wp, sxye  , 'T',  1._wp  ) 
    281281         IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    282             CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
    283                &                          , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
    284                &                          , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
    285                &                          , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  ) 
    286             IF ( ln_pnd_lids ) THEN 
    287                CALL lbc_lnk( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp  & ! melt pond lid volume 
    288                   &                          , sxxvl,'T', 1._wp, syyvl,'T',  1._wp, sxyvl,'T',  1._wp  ) 
     282            IF( ln_pnd_lids ) THEN 
     283               CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
     284                  &                          , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
     285                  &                          , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
     286                  &                          , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  & 
     287                  &                          , z0vl , 'T', 1._wp, sxvl , 'T', -1._wp, syvl , 'T', -1._wp  & ! melt pond lid volume 
     288                  &                          , sxxvl, 'T', 1._wp, syyvl, 'T',  1._wp, sxyvl, 'T',  1._wp  ) 
     289            ELSE 
     290               CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
     291                  &                          , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
     292                  &                          , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
     293                  &                          , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  ) 
    289294            ENDIF 
    290295         ENDIF 
    … …  
    766771      ! 
    767772      DO jl = 1, jpl 
    768          DO_2D( 1, 1, 1, 1 ) 
     773         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    769774            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    770775               ! 
    … …  
    813818      !                                           ! -- check e_i/v_i -- ! 
    814819      DO jl = 1, jpl 
    815          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     820         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    816821            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    817822               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    827832      !                                           ! -- check e_s/v_s -- ! 
    828833      DO jl = 1, jpl 
    829          DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     834         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 
    830835            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
    831836               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    870875      ! -- check snow load -- ! 
    871876      DO jl = 1, jpl 
    872          DO_2D( 1, 1, 1, 1 ) 
     877         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    873878            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    874879               ! 
    … …  
    11961201         END_2D 
    11971202      END DO 
    1198        
    11991203   END SUBROUTINE icemax3D 
    1200           
     1204 
    12011205   SUBROUTINE icemax4D( pice , pmax ) 
    12021206      !!--------------------------------------------------------------------- 
    … …  
    12371241         END DO 
    12381242      END DO 
    1239  
    12401243   END SUBROUTINE icemax4D 
    12411244 

  • NEMO/trunk/src/ICE/icedyn_adv_umx.F90

    r15037 r15049  
    164164      ! 
    165165      ! --- define velocity for advection: u*grad(H) --- ! 
    166       DO_2D( 0, 0, 0, 0 ) 
     166      DO_2D( nn_hls-1, nn_hls, nn_hls, nn_hls ) 
    167167         IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp 
    168168         ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj) 
    169169         ELSE                                                      ;   zcu_box(ji,jj) = pu_ice(ji  ,jj) 
    170170         ENDIF 
    171  
     171      END_2D 
     172      DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls ) 
    172173         IF    ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp 
    173174         ELSEIF( pv_ice(ji,jj)                   >  0._wp ) THEN   ;   zcv_box(ji,jj) = pv_ice(ji,jj-1) 
    … …  
    204205            IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 
    205206            DO jl = 1, jpl 
    206                DO_2D( 1, 0, 1, 0 ) 
     207               DO_2D( 1, 0, nn_hls, nn_hls ) 
    207208                  zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 
    208209                  IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0 
    209210                  ELSE                         ;   imsk_small(ji,jj,jl) = 1   ;   ENDIF 
     211               END_2D 
     212               DO_2D( nn_hls, nn_hls, 1, 0 ) 
    210213                  zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 
    211214                  IF( zvi_cen < epsi06) THEN   ;   jmsk_small(ji,jj,jl) = 0 
    … …  
    583586         ! 
    584587         DO jl = 1, jpl 
    585             DO_2D( 1, 0, 1, 0 ) 
     588            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    586589               pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
    587590               pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    … …  
    594597            ! 
    595598            DO jl = 1, jpl              !-- flux in x-direction 
    596                DO_2D( 1, 0, 1, 1 ) 
     599               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls ) 
    597600                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
    598601               END_2D 
    … …  
    600603            ! 
    601604            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    602                DO_2D( 0, 0, 1, 1 ) 
     605               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls ) 
    603606                  ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              & 
    604607                     &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    609612            ! 
    610613            DO jl = 1, jpl              !-- flux in y-direction 
    611                DO_2D( 0, 0, 1, 0 ) 
     614               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 
    612615                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 
    613616               END_2D 
    … …  
    617620            ! 
    618621            DO jl = 1, jpl              !-- flux in y-direction 
    619                DO_2D( 1, 1, 1, 0 ) 
     622               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 ) 
    620623                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    621624               END_2D 
    … …  
    623626            ! 
    624627            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    625                DO_2D( 1, 1, 0, 0 ) 
     628               DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 ) 
    626629                  ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  & 
    627630                     &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    632635            ! 
    633636            DO jl = 1, jpl              !-- flux in x-direction 
    634                DO_2D( 1, 0, 0, 0 ) 
     637               DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    635638                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 
    636639               END_2D 
    … …  
    642645      ! 
    643646      DO jl = 1, jpl                    !-- after tracer with upstream scheme 
    644          DO_2D( 0, 0, 0, 0 ) 
     647         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    645648            ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   & 
    646649               &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) & 
    … …  
    651654         END_2D 
    652655      END DO 
    653       CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1.0_wp ) 
     656      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1.0_wp ) 
    654657 
    655658   END SUBROUTINE upstream 
    … …  
    681684         ! 
    682685         DO jl = 1, jpl 
    683             DO_2D( 1, 0, 1, 1 ) 
     686            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls ) 
    684687               pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) ) 
    685688            END_2D 
    686             DO_2D( 1, 1, 1, 0 ) 
     689            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 ) 
    687690               pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) ) 
    688691            END_2D 
    … …  
    701704            ! 
    702705            DO jl = 1, jpl              !-- flux in x-direction 
    703                DO_2D( 1, 0, 1, 1 ) 
     706               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls ) 
    704707                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
    705708               END_2D 
    … …  
    708711 
    709712            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    710                DO_2D( 0, 0, 1, 1 ) 
     713               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls ) 
    711714                  ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              & 
    712715                     &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    717720 
    718721            DO jl = 1, jpl              !-- flux in y-direction 
    719                DO_2D( 0, 0, 1, 0 ) 
     722               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 
    720723                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 
    721724               END_2D 
    … …  
    726729            ! 
    727730            DO jl = 1, jpl              !-- flux in y-direction 
    728                DO_2D( 1, 1, 1, 0 ) 
     731               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 ) 
    729732                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
    730733               END_2D 
    … …  
    733736            ! 
    734737            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    735                DO_2D( 1, 1, 0, 0 ) 
     738               DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 ) 
    736739                  ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  & 
    737740                     &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    742745            ! 
    743746            DO jl = 1, jpl              !-- flux in x-direction 
    744                DO_2D( 1, 0, 0, 0 ) 
     747               DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    745748                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 
    746749               END_2D 
    … …  
    785788         ! 
    786789         !                                                        !--  ultimate interpolation of pt at u-point  --! 
    787          CALL ultimate_x( pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho ) 
     790         CALL ultimate_x( nn_hls, pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho ) 
    788791         !                                                        !--  limiter in x --! 
    789792         IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 
    790793         !                                                        !--  advective form update in zpt  --! 
    791794         DO jl = 1, jpl 
    792             DO_2D( 0, 0, 0, 0 ) 
     795            DO_2D( 0, 0, nn_hls, nn_hls ) 
    793796               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) & 
    794797                  &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) & 
    … …  
    797800            END_2D 
    798801         END DO 
    799          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    800802         ! 
    801803         !                                                        !--  ultimate interpolation of pt at v-point  --! 
    802804         IF( ll_hoxy ) THEN 
    803             CALL ultimate_y( pamsk, kn_umx, pdt, zpt, pv, zt_v, pfv_ho ) 
     805            CALL ultimate_y( 0, pamsk, kn_umx, pdt, zpt, pv, zt_v, pfv_ho ) 
    804806         ELSE 
    805             CALL ultimate_y( pamsk, kn_umx, pdt, pt , pv, zt_v, pfv_ho ) 
     807            CALL ultimate_y( 0, pamsk, kn_umx, pdt, pt , pv, zt_v, pfv_ho ) 
    806808         ENDIF 
    807809         !                                                        !--  limiter in y --! 
    … …  
    812814         ! 
    813815         !                                                        !--  ultimate interpolation of pt at v-point  --! 
    814          CALL ultimate_y( pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho ) 
     816         CALL ultimate_y( nn_hls, pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho ) 
    815817         !                                                        !--  limiter in y --! 
    816818         IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 
    817819         !                                                        !--  advective form update in zpt  --! 
    818820         DO jl = 1, jpl 
    819             DO_2D( 0, 0, 0, 0 ) 
     821            DO_2D( nn_hls, nn_hls, 0, 0 ) 
    820822               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) & 
    821823                  &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) & 
    … …  
    824826            END_2D 
    825827         END DO 
    826          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    827828         ! 
    828829         !                                                        !--  ultimate interpolation of pt at u-point  --! 
    829830         IF( ll_hoxy ) THEN 
    830             CALL ultimate_x( pamsk, kn_umx, pdt, zpt, pu, zt_u, pfu_ho ) 
     831            CALL ultimate_x( 0, pamsk, kn_umx, pdt, zpt, pu, zt_u, pfu_ho ) 
    831832         ELSE 
    832             CALL ultimate_x( pamsk, kn_umx, pdt, pt , pu, zt_u, pfu_ho ) 
     833            CALL ultimate_x( 0, pamsk, kn_umx, pdt, pt , pu, zt_u, pfu_ho ) 
    833834         ENDIF 
    834835         !                                                        !--  limiter in x --! 
    … …  
    842843 
    843844 
    844    SUBROUTINE ultimate_x( pamsk, kn_umx, pdt, pt, pu, pt_u, pfu_ho ) 
     845   SUBROUTINE ultimate_x( kloop, pamsk, kn_umx, pdt, pt, pu, pt_u, pfu_ho ) 
    845846      !!--------------------------------------------------------------------- 
    846847      !!                    ***  ROUTINE ultimate_x  *** 
    … …  
    852853      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
    853854      !!---------------------------------------------------------------------- 
     855      INTEGER                         , INTENT(in   ) ::   kloop     ! either 0 or nn_hls depending on the order of the call 
    854856      REAL(wp)                        , INTENT(in   ) ::   pamsk     ! advection of concentration (1) or other tracers (0) 
    855857      INTEGER                         , INTENT(in   ) ::   kn_umx    ! order of the scheme (1-5=UM or 20=CEN2) 
    … …  
    867869      !                                                     !--  Laplacian in i-direction  --! 
    868870      DO jl = 1, jpl 
    869          DO_2D( 1, 0, 0, 0 )      ! First derivative (gradient) 
     871         DO_2D( nn_hls, nn_hls-1, kloop, kloop )      ! First derivative (gradient) 
    870872            ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
    871873         END_2D 
    872          DO_2D( 0, 0, 0, 0 )      ! Second derivative (Laplacian) 
     874         DO_2D( nn_hls-1, nn_hls-1, kloop, kloop )    ! Second derivative (Laplacian) 
    873875            ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
    874876         END_2D 
    875       END DO 
    876       CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) 
     877!!$         DO jj = 2, jpjm1         ! First derivative (gradient) 
     878!!$            DO ji = 1, jpim1 
     879!!$               ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
     880!!$            END DO 
     881!!$            !                     ! Second derivative (Laplacian) 
     882!!$            DO ji = 2, jpim1 
     883!!$               ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
     884!!$            END DO 
     885!!$         END DO 
     886      END DO 
     887      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) 
    877888      ! 
    878889      !                                                     !--  BiLaplacian in i-direction  --! 
    879890      DO jl = 1, jpl 
    880          DO_2D( 1, 0, 0, 0 )      ! Third derivative 
     891         DO_2D( 1, 0, kloop, kloop )                  ! Third derivative 
    881892            ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
    882893         END_2D 
    883          DO_2D( 0, 0, 0, 0 )      ! Fourth derivative 
    884                ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
    885          END_2D 
    886       END DO 
    887       CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) 
     894         DO_2D( 0, 0, kloop, kloop )                  ! Fourth derivative 
     895            ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
     896         END_2D 
     897!!$         DO jj = 2, jpjm1         ! Third derivative 
     898!!$            DO ji = 1, jpim1 
     899!!$               ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
     900!!$            END DO 
     901!!$            !                     ! Fourth derivative 
     902!!$            DO ji = 2, jpim1 
     903!!$               ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
     904!!$            END DO 
     905!!$         END DO 
     906      END DO 
    888907      ! 
    889908      ! 
    … …  
    893912         ! 
    894913         DO jl = 1, jpl 
    895             DO_2D( 1, 0, 0, 0 ) 
     914            DO_2D( 1, 0, kloop, kloop ) 
    896915               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    897916                  &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
    … …  
    902921         ! 
    903922         DO jl = 1, jpl 
    904             DO_2D( 1, 0, 0, 0 ) 
     923            DO_2D( 1, 0, kloop, kloop ) 
    905924               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    906925               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    … …  
    912931         ! 
    913932         DO jl = 1, jpl 
    914             DO_2D( 1, 0, 0, 0 ) 
     933            DO_2D( 1, 0, kloop, kloop ) 
    915934               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    916935               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    926945         ! 
    927946         DO jl = 1, jpl 
    928             DO_2D( 1, 0, 0, 0 ) 
     947            DO_2D( 1, 0, kloop, kloop ) 
    929948               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    930949               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    939958      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29) 
    940959         ! 
    941          DO jl = 1, jpl 
    942             DO_2D( 1, 0, 0, 0 ) 
     960         CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) 
     961         ! 
     962         DO jl = 1, jpl 
     963            DO_2D( 1, 0, kloop, kloop ) 
    943964               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    944965               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    961982      IF( ll_neg ) THEN 
    962983         DO jl = 1, jpl 
    963             DO_2D( 1, 0, 0, 0 ) 
     984            DO_2D( 1, 0, kloop, kloop ) 
    964985               IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    965986                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    … …  
    9791000 
    9801001 
    981    SUBROUTINE ultimate_y( pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho ) 
     1002   SUBROUTINE ultimate_y( kloop, pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho ) 
    9821003      !!--------------------------------------------------------------------- 
    9831004      !!                    ***  ROUTINE ultimate_y  *** 
    … …  
    9891010      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
    9901011      !!---------------------------------------------------------------------- 
     1012      INTEGER                         , INTENT(in   ) ::   kloop     ! either 0 or nn_hls depending on the order of the call 
    9911013      REAL(wp)                        , INTENT(in   ) ::   pamsk     ! advection of concentration (1) or other tracers (0) 
    9921014      INTEGER                         , INTENT(in   ) ::   kn_umx    ! order of the scheme (1-5=UM or 20=CEN2) 
    … …  
    10041026      !                                                     !--  Laplacian in j-direction  --! 
    10051027      DO jl = 1, jpl 
    1006          DO_2D( 0, 0, 1, 0 )         ! First derivative (gradient) 
     1028         DO_2D( kloop, kloop, nn_hls, nn_hls-1 )      ! First derivative (gradient) 
    10071029            ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    10081030         END_2D 
    1009          DO_2D( 0, 0, 0, 0 )         ! Second derivative (Laplacian) 
     1031         DO_2D( kloop, kloop, nn_hls-1, nn_hls-1 )    ! Second derivative (Laplacian) 
    10101032            ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    10111033         END_2D 
    10121034      END DO 
    1013       CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp ) 
     1035      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp ) 
    10141036      ! 
    10151037      !                                                     !--  BiLaplacian in j-direction  --! 
    10161038      DO jl = 1, jpl 
    1017          DO_2D( 0, 0, 1, 0 )         ! Third derivative 
     1039         DO_2D( kloop, kloop, 1, 0 )                  ! Third derivative 
    10181040            ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    10191041         END_2D 
    1020          DO_2D( 0, 0, 0, 0 )         ! Fourth derivative 
     1042         DO_2D( kloop, kloop, 0, 0 )                  ! Fourth derivative 
    10211043            ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    10221044         END_2D 
    10231045      END DO 
    1024       CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp ) 
    10251046      ! 
    10261047      ! 
    … …  
    10291050      CASE( 1 )                                                !==  1st order central TIM  ==! (Eq. 21) 
    10301051         DO jl = 1, jpl 
    1031             DO_2D( 0, 0, 1, 0 ) 
     1052            DO_2D( kloop, kloop, 1, 0 ) 
    10321053               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    10331054                  &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    … …  
    10371058      CASE( 2 )                                                !==  2nd order central TIM  ==! (Eq. 23) 
    10381059         DO jl = 1, jpl 
    1039             DO_2D( 0, 0, 1, 0 ) 
     1060            DO_2D( kloop, kloop, 1, 0 ) 
    10401061               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10411062               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    … …  
    10461067      CASE( 3 )                                                !==  3rd order central TIM  ==! (Eq. 24) 
    10471068         DO jl = 1, jpl 
    1048             DO_2D( 0, 0, 1, 0 ) 
     1069            DO_2D( kloop, kloop, 1, 0 ) 
    10491070               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10501071               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10591080      CASE( 4 )                                                !==  4th order central TIM  ==! (Eq. 27) 
    10601081         DO jl = 1, jpl 
    1061             DO_2D( 0, 0, 1, 0 ) 
     1082            DO_2D( kloop, kloop, 1, 0 ) 
    10621083               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10631084               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10711092         ! 
    10721093      CASE( 5 )                                                !==  5th order central TIM  ==! (Eq. 29) 
    1073          DO jl = 1, jpl 
    1074             DO_2D( 0, 0, 1, 0 ) 
     1094         ! 
     1095         CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp ) 
     1096         ! 
     1097         DO jl = 1, jpl 
     1098            DO_2D( kloop, kloop, 1, 0 ) 
    10751099               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10761100               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10931117      IF( ll_neg ) THEN 
    10941118         DO jl = 1, jpl 
    1095             DO_2D( 0, 0, 1, 0 ) 
     1119            DO_2D( kloop, kloop, 1, 0 ) 
    10961120               IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    10971121                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
    … …  
    12931317      ! 
    12941318      DO jl = 1, jpl 
    1295          DO_2D( 0, 0, 0, 0 ) 
     1319         DO_2D( nn_hls, nn_hls-1, 0, 0 ) 
    12961320            zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 
    12971321         END_2D 
    12981322      END DO 
    1299       CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp)   ! lateral boundary cond. 
    1300  
    1301       DO jl = 1, jpl 
    1302          DO_2D( 0, 0, 0, 0 ) 
     1323      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp)   ! lateral boundary cond. 
     1324 
     1325      DO jl = 1, jpl 
     1326         DO_2D( nn_hls-1, 0, 0, 0 ) 
    13031327            uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 
    13041328 
    … …  
    13611385         END_2D 
    13621386      END DO 
    1363       CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp)   ! lateral boundary cond. 
     1387      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp)   ! lateral boundary cond. 
    13641388      ! 
    13651389   END SUBROUTINE limiter_x 
    … …  
    13841408      ! 
    13851409      DO jl = 1, jpl 
    1386          DO_2D( 0, 0, 0, 0 ) 
     1410         DO_2D( 0, 0, nn_hls, nn_hls-1 ) 
    13871411            zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 
    13881412         END_2D 
    13891413      END DO 
    1390       CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.0_wp)   ! lateral boundary cond. 
    1391  
    1392       DO jl = 1, jpl 
    1393          DO_2D( 0, 0, 0, 0 ) 
     1414      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.0_wp)   ! lateral boundary cond. 
     1415 
     1416      DO jl = 1, jpl 
     1417         DO_2D( 0, 0, nn_hls-1, 0 ) 
    13941418            vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 
    13951419 
    … …  
    14531477         END_2D 
    14541478      END DO 
    1455       CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.0_wp)   ! lateral boundary cond. 
     1479      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.0_wp)   ! lateral boundary cond. 
    14561480      ! 
    14571481   END SUBROUTINE limiter_y 
    … …  
    14881512      ! 
    14891513      DO jl = 1, jpl 
    1490          DO_2D( 1, 1, 1, 1 ) 
     1514         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    14911515            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    14921516               ! 
    … …  
    15351559      !                                           ! -- check e_i/v_i -- ! 
    15361560      DO jl = 1, jpl 
    1537          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     1561         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    15381562            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    15391563               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    15491573      !                                           ! -- check e_s/v_s -- ! 
    15501574      DO jl = 1, jpl 
    1551          DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     1575         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 
    15521576            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
    15531577               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    15921616      ! -- check snow load -- ! 
    15931617      DO jl = 1, jpl 
    1594          DO_2D( 1, 1, 1, 1 ) 
     1618         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    15951619            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    15961620               ! 
    … …  
    16491673         END_2D 
    16501674      END DO 
    1651  
    16521675   END SUBROUTINE icemax3D 
    16531676 
    … …  
    16901713         END DO 
    16911714      END DO 
    1692        
    16931715   END SUBROUTINE icemax4D 
    16941716 

  • NEMO/trunk/src/ICE/icedyn_rhg_evp.F90

    r15014 r15049  
    184184      ! 
    185185      ! for diagnostics and convergence tests 
    186       DO_2D( 1, 1, 1, 1 ) 
     186      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    187187         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    188188      END_2D 
    189189      IF( nn_rhg_chkcvg > 0 ) THEN 
    190          DO_2D( 1, 1, 1, 1 ) 
     190         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    191191            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    192192         END_2D 
    … …  
    259259      zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 
    260260 
    261       DO_2D( 0, 0, 0, 0 ) 
     261      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     262         zm1          = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) )  ! Ice/snow mass at U-V points 
     263         zmf  (ji,jj) = zm1 * ff_t(ji,jj)                            ! Coriolis at T points (m*f) 
     264         zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin )                   ! dt/m at T points (for alpha and beta coefficients) 
     265      END_2D 
     266       
     267      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    262268 
    263269         ! ice fraction at U-V points 
    … …  
    276282         u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 
    277283 
    278          ! Coriolis at T points (m*f) 
    279          zmf(ji,jj)      = zm1 * ff_t(ji,jj) 
    280  
    281          ! dt/m at T points (for alpha and beta coefficients) 
    282          zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin ) 
    283  
    284284         ! m/dt 
    285285         zmU_t(ji,jj)    = zmassU * z1_dtevp 
    … …  
    305305 
    306306      END_2D 
    307       CALL lbc_lnk( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
    308307      ! 
    309308      !                                  !== Landfast ice parameterization ==! 
    310309      ! 
    311310      IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016 
    312          DO_2D( 0, 0, 0, 0 ) 
     311         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    313312            ! ice thickness at U-V points 
    314313            zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    … …  
    327326         ! 
    328327      ELSE                               !-- no landfast 
    329          DO_2D( 0, 0, 0, 0 ) 
     328         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    330329            ztaux_base(ji,jj) = 0._wp 
    331330            ztauy_base(ji,jj) = 0._wp 
    … …  
    351350 
    352351         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    353          DO_2D( 1, 0, 1, 0 ) 
     352         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    354353 
    355354            ! shear at F points 
    … …  
    386385 
    387386         ! P/delta at T points 
    388          DO_2D( 1, 1, 1, 1 ) 
     387         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    389388            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) 
    390389         END_2D 
    391390 
    392          DO_2D( 0, 1, 0, 1 )   ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 
     391         DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls )   ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 
    393392 
    394393            ! divergence at T points (duplication to avoid communications) 
    … …  
    425424         ! Save beta at T-points for further computations 
    426425         IF( ln_aEVP ) THEN 
    427             DO_2D( 1, 1, 1, 1 ) 
     426            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    428427               zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
    429428            END_2D 
    430429         ENDIF 
    431430 
    432          DO_2D( 1, 0, 1, 0 ) 
     431         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    433432 
    434433            ! alpha for aEVP 
    … …  
    450449 
    451450         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
    452          DO_2D( 0, 0, 0, 0 ) 
     451         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    453452            !                   !--- U points 
    454453            zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             & 
    … …  
    478477         IF( MOD(jter,2) == 0 ) THEN ! even iterations 
    479478            ! 
    480             DO_2D( 0, 0, 0, 0 ) 
     479            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    481480               !                 !--- tau_io/(v_oce - v_ice) 
    482481               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
    … …  
    522521               ENDIF 
    523522            END_2D 
    524             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    525             ! 
    526 #if defined key_agrif 
    527 !!            CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
    528             CALL agrif_interp_ice( 'V' ) 
    529 #endif 
    530             IF( ln_bdy )   CALL bdy_ice_dyn( 'V' ) 
     523            IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    531524            ! 
    532525            DO_2D( 0, 0, 0, 0 ) 
    … …  
    574567               ENDIF 
    575568            END_2D 
    576             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    577             ! 
    578 #if defined key_agrif 
    579 !!            CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
    580             CALL agrif_interp_ice( 'U' ) 
    581 #endif 
    582             IF( ln_bdy )   CALL bdy_ice_dyn( 'U' ) 
     569            IF( nn_hls == 1 ) THEN   ;   CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
     570            ELSE                     ;   CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
     571            ENDIF 
    583572            ! 
    584573         ELSE ! odd iterations 
    585574            ! 
    586             DO_2D( 0, 0, 0, 0 ) 
     575            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    587576               !                 !--- tau_io/(u_oce - u_ice) 
    588577               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
    … …  
    628617               ENDIF 
    629618            END_2D 
    630             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    631             ! 
    632 #if defined key_agrif 
    633 !!            CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
    634             CALL agrif_interp_ice( 'U' ) 
    635 #endif 
    636             IF( ln_bdy )   CALL bdy_ice_dyn( 'U' ) 
     619            IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    637620            ! 
    638621            DO_2D( 0, 0, 0, 0 ) 
    … …  
    680663               ENDIF 
    681664            END_2D 
    682             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    683             ! 
    684 #if defined key_agrif 
    685 !!            CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
    686             CALL agrif_interp_ice( 'V' ) 
    687 #endif 
    688             IF( ln_bdy )   CALL bdy_ice_dyn( 'V' ) 
     665            IF( nn_hls == 1 ) THEN   ;   CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
     666            ELSE                     ;   CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
     667            ENDIF 
    689668            ! 
    690669         ENDIF 
    691  
     670         ! 
     671#if defined key_agrif 
     672!!       CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
     673!!       CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
     674         CALL agrif_interp_ice( 'U' ) 
     675         CALL agrif_interp_ice( 'V' ) 
     676#endif 
     677         IF( ln_bdy )   CALL bdy_ice_dyn( 'U' ) 
     678         IF( ln_bdy )   CALL bdy_ice_dyn( 'V' ) 
     679         ! 
    692680         ! convergence test 
    693681         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 
    … …  
    701689      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 
    702690      !------------------------------------------------------------------------------! 
    703       DO_2D( 1, 0, 1, 0 ) 
     691      DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    704692 
    705693         ! shear at F points 
    … …  
    777765         ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 
    778766         ! 
    779          DO_2D( 1, 1, 1, 1 ) 
     767         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    780768 
    781769            ! Ice stresses 
    … …  
    810798         ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 
    811799         ! 
    812          DO_2D( 1, 1, 1, 1 ) 
     800         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    813801 
    814802            ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates 
Note: See TracChangeset for help on using the changeset viewer.