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 8226 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90 – NEMO

Ignore:
Timestamp:
2017-06-28T10:02:58+02:00 (7 years ago)
Author:
clem
Message:

merge with dev_r8127_AGRIF_LIM3_GHOST@r8189 and dev_r8126_ROBUST08_no_ghost@r8196

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90

    r7761 r8226  
    5252      !!----------------------------------------------------------------------- 
    5353      ! 
    54       IF( Agrif_Root() )  RETURN 
     54      IF( Agrif_Root() .OR. nn_ice==0 )  RETURN   ! clem2017: do not interpolate if inside Parent domain or if child domain does not have ice 
    5555      ! 
    5656      SELECT CASE(cd_type) 
     
    9090      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 
    9191      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 
    92       !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
     92      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
    9393      !!----------------------------------------------------------------------- 
    9494      INTEGER , INTENT(in) :: i1, i2, j1, j2 
     
    101101      IF( before ) THEN  ! parent grid 
    102102         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice_b(i1:i2,j1:j2) 
    103          WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     103         WHERE( umask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2) = Agrif_SpecialValue 
    104104      ELSE               ! child grid 
    105105         zrhoy = Agrif_Rhoy() 
    106          u_ice(i1:i2,j1:j2) = ptab(:,:) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1) 
     106         u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1) 
    107107      ENDIF 
    108108      ! 
     
    116116      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 
    117117      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 
    118       !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
     118      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
    119119      !!-----------------------------------------------------------------------       
    120120      INTEGER , INTENT(in) :: i1, i2, j1, j2 
     
    127127      IF( before ) THEN  ! parent grid 
    128128         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice_b(i1:i2,j1:j2) 
    129          WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     129         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2) = Agrif_SpecialValue 
    130130      ELSE               ! child grid 
    131131         zrhox = Agrif_Rhox() 
    132          v_ice(i1:i2,j1:j2) = ptab(:,:) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1) 
     132         v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1) 
    133133      ENDIF 
    134134      ! 
     
    142142      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 
    143143      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 
    144       !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
     144      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
    145145      !!----------------------------------------------------------------------- 
    146146      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     
    158158      ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 
    159159      ! and it is ok since we conserve tracers (same as in the ocean). 
    160       ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) ) 
     160      ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) ) 
    161161      
    162162      IF( before ) THEN  ! parent grid 
    163163         jm = 1 
    164164         DO jl = 1, jpl 
    165             ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    166             ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    167             ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    168             ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 
    169             ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 
     165            ptab(i1:i2,j1:j2,jm  ) = a_i_b  (i1:i2,j1:j2,jl) 
     166            ptab(i1:i2,j1:j2,jm+1) = v_i_b  (i1:i2,j1:j2,jl) 
     167            ptab(i1:i2,j1:j2,jm+2) = v_s_b  (i1:i2,j1:j2,jl) 
     168            ptab(i1:i2,j1:j2,jm+3) = smv_i_b(i1:i2,j1:j2,jl) 
     169            ptab(i1:i2,j1:j2,jm+4) = oa_i_b (i1:i2,j1:j2,jl) 
     170            jm = jm + 5 
    170171            DO jk = 1, nlay_s 
    171172               ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
     
    177178          
    178179         DO jk = k1, k2 
    179             WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = -9999. 
     180            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue 
    180181         ENDDO 
    181182          
    182183      ELSE               ! child grid 
    183 !! ==> The easiest interpolation is the following commented lines 
    184          jm = 1 
    185          DO jl = 1, jpl 
    186             a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    187             v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    188             v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    189             smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    190             oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    191             DO jk = 1, nlay_s 
    192                e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    193             ENDDO 
    194             DO jk = 1, nlay_i 
    195                e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    196             ENDDO 
    197          ENDDO 
    198  
    199 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 
    200 !!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 
    201 !!        clem: for some reason (I don't know why), the following lines do not work  
    202 !!              with mpp (or in realistic configurations?). It makes the model crash 
    203 !         ! record ztab 
    204 !         jm = 1 
    205 !         DO jl = 1, jpl 
    206 !            ztab(:,:,jm) = a_i  (:,:,jl) ; jm = jm + 1 
    207 !            ztab(:,:,jm) = v_i  (:,:,jl) ; jm = jm + 1 
    208 !            ztab(:,:,jm) = v_s  (:,:,jl) ; jm = jm + 1 
    209 !            ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1 
    210 !            ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1 
    211 !            DO jk = 1, nlay_s 
    212 !               ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1 
    213 !            ENDDO 
    214 !            DO jk = 1, nlay_i 
    215 !               ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1 
    216 !            ENDDO 
    217 !         ENDDO 
    218 !         ! 
    219 !         ! borders of the domain 
    220 !         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
    221 !         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
    222 !         ! 
    223 !         ! spatial smoothing 
    224 !         zrhox = Agrif_Rhox() 
    225 !         z1 =      ( zrhox - 1. ) * 0.5  
    226 !         z3 =      ( zrhox - 1. ) / ( zrhox + 1. ) 
    227 !         z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
    228 !         z7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    229 !         z2 = 1. - z1 
    230 !         z4 = 1. - z3 
    231 !         z5 = 1. - z6 - z7 
    232 !         ! 
    233 !         ! Remove corners 
    234 !         imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2 
    235 !         IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3 
    236 !         IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2 
    237 !         IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3 
    238 !         IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2 
    239 ! 
    240 !         ! smoothed fields 
    241 !         IF( eastern_side ) THEN 
    242 !            ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 
    243 !            DO jj = jmin, jmax 
    244 !               rswitch = 0. 
    245 !               IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 
    246 !               ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  & 
    247 !                  &                +      umask(nlci-2,jj,1)   *  & 
    248 !                  &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  & 
    249 !                  &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 
    250 !               ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 
    251 !            END DO 
    252 !         ENDIF 
    253 !         !  
    254 !         IF( northern_side ) THEN 
    255 !            ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 
    256 !            DO ji = imin, imax 
    257 !               rswitch = 0. 
    258 !               IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 
    259 !               ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  & 
    260 !                  &                +      vmask(ji,nlcj-2,1)   *  & 
    261 !                  &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) & 
    262 !                  &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 
    263 !               ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 
    264 !            END DO 
    265 !         END IF 
    266 !         ! 
    267 !         IF( western_side) THEN 
    268 !            ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 
    269 !            DO jj = jmin, jmax 
    270 !               rswitch = 0. 
    271 !               IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 
    272 !               ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  & 
    273 !                  &           +      umask(2,jj,1)   *   & 
    274 !                  &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 
    275 !                  &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 
    276 !               ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 
    277 !            END DO 
    278 !         ENDIF 
    279 !         ! 
    280 !         IF( southern_side ) THEN 
    281 !            ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 
    282 !            DO ji = imin, imax 
    283 !               rswitch = 0. 
    284 !               IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 
    285 !               ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  & 
    286 !                  &           +      vmask(ji,2,1)   *  & 
    287 !                  &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 
    288 !                  &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 
    289 !               ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 
    290 !            END DO 
    291 !         END IF 
    292 !         ! 
    293 !         ! Treatment of corners 
    294 !         IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south 
    295 !         IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 
    296 !         IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south 
    297 !         IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north 
    298 ! 
    299 !         ! retrieve ice tracers 
    300 !         jm = 1 
    301 !         DO jl = 1, jpl 
    302 !            a_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    303 !            v_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    304 !            v_s  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    305 !            smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    306 !            oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    307 !            DO jk = 1, nlay_s 
    308 !               e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    309 !            ENDDO 
    310 !            DO jk = 1, nlay_i 
    311 !               e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    312 !            ENDDO 
    313 !         ENDDO 
    314         
     184 
     185         IF( nbghostcells > 1 ) THEN 
     186            !! ==> The easiest interpolation is the following lines 
     187 
     188            jm = 1 
     189            DO jl = 1, jpl 
     190               ! 
     191               DO jj = j1, j2 
     192                  DO ji = i1, i2 
     193                     a_i  (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1) 
     194                     v_i  (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 
     195                     v_s  (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 
     196                     smv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 
     197                     oa_i (ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 
     198                  ENDDO 
     199               ENDDO 
     200               jm = jm + 5 
     201               ! 
     202               DO jk = 1, nlay_s 
     203                  e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 
     204                  jm = jm + 1 
     205               ENDDO 
     206               ! 
     207               DO jk = 1, nlay_i 
     208                  e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 
     209                  jm = jm + 1 
     210               ENDDO 
     211               ! 
     212            ENDDO 
     213             
     214         ELSE 
     215            !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 
     216            !!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 
     217            !!        clem: for some reason (I don't know why), the following lines do not work  
     218            !!              with mpp (or in realistic configurations?). It makes the model crash 
     219            !      I think there is an issue with Agrif_SpecialValue here (not taken into account properly) 
     220            ! record ztab 
     221            jm = 1 
     222            DO jl = 1, jpl 
     223               ztab(:,:,jm  ) = a_i  (:,:,jl) 
     224               ztab(:,:,jm+1) = v_i  (:,:,jl) 
     225               ztab(:,:,jm+2) = v_s  (:,:,jl) 
     226               ztab(:,:,jm+3) = smv_i(:,:,jl) 
     227               ztab(:,:,jm+4) = oa_i (:,:,jl) 
     228               jm = jm + 5 
     229               DO jk = 1, nlay_s 
     230                  ztab(:,:,jm) = e_s(:,:,jk,jl) 
     231                  jm = jm + 1 
     232               ENDDO 
     233               DO jk = 1, nlay_i 
     234                  ztab(:,:,jm) = e_i(:,:,jk,jl) 
     235                  jm = jm + 1 
     236               ENDDO 
     237               ! 
     238            ENDDO 
     239            ! 
     240            ! borders of the domain 
     241            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
     242            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
     243            ! 
     244            ! spatial smoothing 
     245            zrhox = Agrif_Rhox() 
     246            z1 =      ( zrhox - 1. ) * 0.5  
     247            z3 =      ( zrhox - 1. ) / ( zrhox + 1. ) 
     248            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     249            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
     250            z2 = 1. - z1 
     251            z4 = 1. - z3 
     252            z5 = 1. - z6 - z7 
     253            ! 
     254            ! Remove corners 
     255            imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2 
     256            IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3 
     257            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2 
     258            IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3 
     259            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2 
     260 
     261            ! smoothed fields 
     262            IF( eastern_side ) THEN 
     263               ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 
     264               DO jj = jmin, jmax 
     265                  rswitch = 0. 
     266                  IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 
     267                  ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  & 
     268                     &                +      umask(nlci-2,jj,1)   *  & 
     269                     &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  & 
     270                     &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 
     271                  ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 
     272               END DO 
     273            ENDIF 
     274            !  
     275            IF( northern_side ) THEN 
     276               ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 
     277               DO ji = imin, imax 
     278                  rswitch = 0. 
     279                  IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 
     280                  ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  & 
     281                     &                +      vmask(ji,nlcj-2,1)   *  & 
     282                     &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) & 
     283                     &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 
     284                  ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 
     285               END DO 
     286            END IF 
     287            ! 
     288            IF( western_side) THEN 
     289               ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 
     290               DO jj = jmin, jmax 
     291                  rswitch = 0. 
     292                  IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 
     293                  ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  & 
     294                     &           +      umask(2,jj,1)   *   & 
     295                     &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 
     296                     &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 
     297                  ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 
     298               END DO 
     299            ENDIF 
     300            ! 
     301            IF( southern_side ) THEN 
     302               ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 
     303               DO ji = imin, imax 
     304                  rswitch = 0. 
     305                  IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 
     306                  ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  & 
     307                     &           +      vmask(ji,2,1)   *  & 
     308                     &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 
     309                     &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 
     310                  ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 
     311               END DO 
     312            END IF 
     313            ! 
     314            ! Treatment of corners 
     315            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south 
     316            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 
     317            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south 
     318            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north 
     319             
     320            ! retrieve ice tracers 
     321            jm = 1 
     322            DO jl = 1, jpl 
     323               ! 
     324               DO jj = j1, j2 
     325                  DO ji = i1, i2 
     326                     a_i  (ji,jj,jl) = ztab(ji,jj,jm  ) * tmask(ji,jj,1) 
     327                     v_i  (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1) 
     328                     v_s  (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1) 
     329                     smv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1) 
     330                     oa_i (ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1) 
     331                  ENDDO 
     332               ENDDO 
     333               jm = jm + 5 
     334               ! 
     335               DO jk = 1, nlay_s 
     336                  e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     337                  jm = jm + 1 
     338               ENDDO 
     339               ! 
     340               DO jk = 1, nlay_i 
     341                  e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     342                  jm = jm + 1 
     343               ENDDO 
     344               ! 
     345            ENDDO 
     346           
     347         ENDIF  ! nbghostcells=1 
     348          
    315349         ! integrated values 
    316350         vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) 
     
    319353         et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
    320354         et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
    321  
     355          
    322356      ENDIF 
     357 
     358      DEALLOCATE( ztab ) 
    323359       
    324       DEALLOCATE( ztab ) 
    325360      ! 
    326361   END SUBROUTINE interp_tra_ice 
Note: See TracChangeset for help on using the changeset viewer.