Changeset 8189


Ignore:
Timestamp:
2017-06-19T17:16:00+02:00 (3 years ago)
Author:
clem
Message:

bug fixes for ghostcells>1

Location:
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO
Files:
7 edited

Legend:

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

    r8129 r8189  
    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 
     
    154154      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7 
    155155      LOGICAL  ::   western_side, eastern_side, northern_side, southern_side 
    156       INTEGER  ::   ind1, ind2, ind3 
    157156 
    158157      !!----------------------------------------------------------------------- 
    159158      ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 
    160159      ! and it is ok since we conserve tracers (same as in the ocean). 
    161       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)) ) 
    162161      
    163162      IF( before ) THEN  ! parent grid 
    164163         jm = 1 
    165164         DO jl = 1, jpl 
    166             ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    167             ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    168             ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    169             ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 
    170             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 
    171171            DO jk = 1, nlay_s 
    172172               ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
     
    178178          
    179179         DO jk = k1, k2 
    180             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 
    181181         ENDDO 
    182182          
    183183      ELSE               ! child grid 
    184 !! ==> The easiest interpolation is the following commented lines 
    185          jm = 1 
    186          DO jl = 1, jpl 
    187             a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    188             v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    189             v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    190             smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    191             oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    192             DO jk = 1, nlay_s 
    193                e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    194             ENDDO 
    195             DO jk = 1, nlay_i 
    196                e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    197             ENDDO 
    198          ENDDO 
    199  
    200 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 
    201 !!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 
    202 !!        clem: for some reason (I don't know why), the following lines do not work  
    203 !!              with mpp (or in realistic configurations?). It makes the model crash 
    204 !         ! record ztab 
    205 !         jm = 1 
    206 !         DO jl = 1, jpl 
    207 !            ztab(:,:,jm) = a_i  (:,:,jl) ; jm = jm + 1 
    208 !            ztab(:,:,jm) = v_i  (:,:,jl) ; jm = jm + 1 
    209 !            ztab(:,:,jm) = v_s  (:,:,jl) ; jm = jm + 1 
    210 !            ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1 
    211 !            ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1 
    212 !            DO jk = 1, nlay_s 
    213 !               ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1 
    214 !            ENDDO 
    215 !            DO jk = 1, nlay_i 
    216 !               ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1 
    217 !            ENDDO 
    218 !         ENDDO 
    219 !         ! 
    220 !         ! borders of the domain 
    221 !         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
    222 !         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
    223 !         ! 
    224 !         ! spatial smoothing 
    225 !         zrhox = Agrif_Rhox() 
    226 !         z1 =      ( zrhox - 1. ) * 0.5  
    227 !         z3 =      ( zrhox - 1. ) / ( zrhox + 1. ) 
    228 !         z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
    229 !         z7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    230 !         z2 = 1. - z1 
    231 !         z4 = 1. - z3 
    232 !         z5 = 1. - z6 - z7 
    233 !         ! 
    234 !         ! Remove corners 
    235 !         imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2 
    236 !         !!clem2017 ghost 
    237 !         ind1 =     nbghostcells 
    238 !         ind2 = 1 + nbghostcells 
    239 !         ind3 = 2 + nbghostcells 
    240 !         IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = ind3 
    241 !         IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-ind2 
    242 !         IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = ind3 
    243 !         IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-ind2 
    244 !         !!clem2017 ghost 
    245 ! 
    246 !         ! smoothed fields 
    247 !         IF( eastern_side ) THEN 
    248 !            ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 
    249 !            DO jj = jmin, jmax 
    250 !               rswitch = 0. 
    251 !               IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 
    252 !               ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  & 
    253 !                  &                +      umask(nlci-2,jj,1)   *  & 
    254 !                  &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  & 
    255 !                  &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 
    256 !               ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 
    257 !            END DO 
    258 !         ENDIF 
    259 !         !  
    260 !         IF( northern_side ) THEN 
    261 !            ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 
    262 !            DO ji = imin, imax 
    263 !               rswitch = 0. 
    264 !               IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 
    265 !               ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  & 
    266 !                  &                +      vmask(ji,nlcj-2,1)   *  & 
    267 !                  &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) & 
    268 !                  &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 
    269 !               ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 
    270 !            END DO 
    271 !         END IF 
    272 !         ! 
    273 !         IF( western_side) THEN 
    274 !            ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 
    275 !            DO jj = jmin, jmax 
    276 !               rswitch = 0. 
    277 !               IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 
    278 !               ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  & 
    279 !                  &           +      umask(2,jj,1)   *   & 
    280 !                  &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 
    281 !                  &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 
    282 !               ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 
    283 !            END DO 
    284 !         ENDIF 
    285 !         ! 
    286 !         IF( southern_side ) THEN 
    287 !            ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 
    288 !            DO ji = imin, imax 
    289 !               rswitch = 0. 
    290 !               IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 
    291 !               ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  & 
    292 !                  &           +      vmask(ji,2,1)   *  & 
    293 !                  &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 
    294 !                  &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 
    295 !               ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 
    296 !            END DO 
    297 !         END IF 
    298 !         ! 
    299 !         ! Treatment of corners 
    300 !         IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south 
    301 !         IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 
    302 !         IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south 
    303 !         IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north 
    304 ! 
    305 !         ! retrieve ice tracers 
    306 !         jm = 1 
    307 !         DO jl = 1, jpl 
    308 !            a_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    309 !            v_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    310 !            v_s  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    311 !            smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    312 !            oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    313 !            DO jk = 1, nlay_s 
    314 !               e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    315 !            ENDDO 
    316 !            DO jk = 1, nlay_i 
    317 !               e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    318 !            ENDDO 
    319 !         ENDDO 
    320         
     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          
    321349         ! integrated values 
    322350         vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) 
     
    325353         et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
    326354         et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
    327  
     355          
    328356      ENDIF 
     357 
     358      DEALLOCATE( ztab ) 
    329359       
    330       DEALLOCATE( ztab ) 
    331360      ! 
    332361   END SUBROUTINE interp_tra_ice 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90

    r8129 r8189  
    5858      IF( nn_ice == 0 ) RETURN   ! clem2017: do not update if child domain does not have ice 
    5959      ! 
     60      Agrif_SpecialValueFineGrid = -9999. 
    6061      Agrif_UseSpecialValueInUpdate = .TRUE. 
    61       Agrif_SpecialValueFineGrid = -9999. 
    6262# if defined TWO_WAY 
    6363      IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps 
     
    7272      ENDIF 
    7373# endif 
     74      Agrif_SpecialValueFineGrid = 0. 
    7475      Agrif_UseSpecialValueInUpdate = .FALSE. 
    7576      ! 
     
    9091      LOGICAL , INTENT(in) :: before 
    9192      !! 
    92       INTEGER  :: jk, jl, jm 
     93      INTEGER  :: ji, jj, jk, jl, jm 
    9394      !!----------------------------------------------------------------------- 
    9495      ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean). 
     
    9697         jm = 1 
    9798         DO jl = 1, jpl 
    98             ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    99             ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    100             ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    101             ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1 
    102             ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1 
     99            ptab(i1:i2,j1:j2,jm  ) = a_i  (i1:i2,j1:j2,jl) 
     100            ptab(i1:i2,j1:j2,jm+1) = v_i  (i1:i2,j1:j2,jl) 
     101            ptab(i1:i2,j1:j2,jm+2) = v_s  (i1:i2,j1:j2,jl) 
     102            ptab(i1:i2,j1:j2,jm+3) = smv_i(i1:i2,j1:j2,jl) 
     103            ptab(i1:i2,j1:j2,jm+4) = oa_i (i1:i2,j1:j2,jl) 
     104            jm = jm + 5 
    103105            DO jk = 1, nlay_s 
    104                ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
     106               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    105107            ENDDO 
    106108            DO jk = 1, nlay_i 
    107                ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
     109               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    108110            ENDDO 
    109111         ENDDO 
    110  
     112         ! 
    111113         DO jk = k1, k2 
    112             WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999. 
     114            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid  
    113115         ENDDO 
    114                    
     116         ! 
    115117      ELSE 
     118         ! 
    116119         jm = 1 
    117120         DO jl = 1, jpl 
    118             a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    119             v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    120             v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    121             smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    122             oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
     121            ! 
     122            DO jj = j1, j2 
     123               DO ji = i1, i2 
     124                  IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN 
     125                     a_i  (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1) 
     126                     v_i  (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 
     127                     v_s  (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 
     128                     smv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 
     129                     oa_i (ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 
     130                  ENDIF 
     131               ENDDO 
     132            ENDDO 
     133            jm = jm + 5 
     134            ! 
    123135            DO jk = 1, nlay_s 
    124                e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    125             ENDDO 
     136               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 
     137                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     138               ENDWHERE 
     139               jm = jm + 1 
     140            ENDDO 
     141            ! 
    126142            DO jk = 1, nlay_i 
    127                e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    128             ENDDO 
     143               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 
     144                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     145               ENDWHERE 
     146               jm = jm + 1 
     147            ENDDO 
     148            ! 
    129149         ENDDO 
    130  
     150         ! 
    131151         ! integrated values 
    132152         vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) 
     
    156176         zrhoy = Agrif_Rhoy() 
    157177         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 
    158          WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     178         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid 
    159179      ELSE 
    160          u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 
     180         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 
     181            u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 
     182         ENDWHERE 
    161183      ENDIF 
    162184      !  
     
    179201         zrhox = Agrif_Rhox() 
    180202         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 
    181          WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     203         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid 
    182204      ELSE 
    183          v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 
     205         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 
     206            v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 
     207         ENDWHERE 
    184208      ENDIF 
    185209      ! 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r8129 r8189  
    104104         ! 
    105105         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    106             ua_b(1:1+nbghostcells,:) = 0._wp 
     106            ua_b(2:1+nbghostcells,:) = 0._wp 
    107107            DO jk = 1, jpkm1 
    108108               DO jj = 1, jpj 
    109                   ua_b(1:1+nbghostcells,jj) = ua_b(1:1+nbghostcells,jj) + e3u_a(1:1+nbghostcells,jj,jk) * ua(1:1+nbghostcells,jj,jk) 
     109                  ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) + e3u_a(2:1+nbghostcells,jj,jk) * ua(2:1+nbghostcells,jj,jk) 
    110110               END DO 
    111111            END DO 
    112112            DO jj = 1, jpj 
    113                ua_b(1:1+nbghostcells,jj) = ua_b(1:1+nbghostcells,jj) * r1_hu_a(1:1+nbghostcells,jj)             
     113               ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) * r1_hu_a(2:1+nbghostcells,jj) 
    114114            END DO 
    115115         ENDIF 
     
    166166 
    167167         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    168             ua_b(nlci-nbghostcells-1:nlci,:) = 0._wp 
     168            ua_b(nlci-nbghostcells-1:nlci-2,:) = 0._wp 
    169169            DO jk=1,jpkm1 
    170170               DO jj=1,jpj 
    171                   ua_b(nlci-nbghostcells-1:nlci,jj) = ua_b(nlci-nbghostcells-1:nlci,jj) + e3u_a(nlci-nbghostcells-1:nlci,jj,jk)  & 
    172                      &                                                                     * ua(nlci-nbghostcells-1:nlci,jj,jk) 
     171                  ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) + e3u_a(nlci-nbghostcells-1:nlci-2,jj,jk)  & 
     172                     &                                                                         * ua(nlci-nbghostcells-1:nlci-2,jj,jk) 
    173173               END DO 
    174174            END DO 
    175175            DO jj=1,jpj 
    176                ua_b(nlci-nbghostcells-1:nlci,jj) = ua_b(nlci-nbghostcells-1:nlci,jj) * r1_hu_a(nlci-nbghostcells-1:nlci,jj)             
     176               ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) * r1_hu_a(nlci-nbghostcells-1:nlci-2,jj)  
    177177            END DO 
    178178         ENDIF 
     
    229229 
    230230         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    231             va_b(:,1:nbghostcells+1) = 0._wp 
     231            va_b(:,2:nbghostcells+1) = 0._wp 
    232232            DO jk = 1, jpkm1 
    233233               DO ji = 1, jpi 
    234                   va_b(ji,1:nbghostcells+1) = va_b(ji,1:nbghostcells+1) + e3v_a(ji,1:nbghostcells+1,jk) * va(ji,1:nbghostcells+1,jk) 
     234                  va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) + e3v_a(ji,2:nbghostcells+1,jk) * va(ji,2:nbghostcells+1,jk) 
    235235               END DO 
    236236            END DO 
    237237            DO ji=1,jpi 
    238                va_b(ji,1:nbghostcells+1) = va_b(ji,1:nbghostcells+1) * r1_hv_a(ji,1:nbghostcells+1)             
     238               va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) * r1_hv_a(ji,2:nbghostcells+1) 
    239239            END DO 
    240240         ENDIF 
     
    291291         ! 
    292292         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    293             va_b(:,nlcj-nbghostcells-1:nlcj) = 0._wp 
     293            va_b(:,nlcj-nbghostcells-1:nlcj-2) = 0._wp 
    294294            DO jk = 1, jpkm1 
    295295               DO ji = 1, jpi 
    296                   va_b(ji,nlcj-nbghostcells-1:nlcj) = va_b(ji,nlcj-nbghostcells-1:nlcj) + e3v_a(ji,nlcj-nbghostcells-1:nlcj,jk)  & 
    297                      &                                                                     * va(ji,nlcj-nbghostcells-1:nlcj,jk) 
     296                  va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) + e3v_a(ji,nlcj-nbghostcells-1:nlcj-2,jk)  & 
     297                     &                                                                         * va(ji,nlcj-nbghostcells-1:nlcj-2,jk) 
    298298               END DO 
    299299            END DO 
    300300            DO ji = 1, jpi 
    301                va_b(ji,nlcj-nbghostcells-1:nlcj) = va_b(ji,nlcj-nbghostcells-1:nlcj) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj)             
     301               va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj-2) 
    302302            END DO 
    303303         ENDIF 
     
    369369      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    370370         DO jj=1,jpj 
    371             va_e(1:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(1:nbghostcells+1,jj) 
    372             ! Specified fluxes: 
    373             ua_e(1:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(1:nbghostcells+1,jj) 
    374             ! Characteristics method (only if ghostcells=1): 
    375             !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
    376             !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 
     371            IF( vmask(2,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     372               va_e(2:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(2:nbghostcells+1,jj) 
     373               ! Specified fluxes: 
     374               ua_e(2:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(2:nbghostcells+1,jj) 
     375               ! Characteristics method (only if ghostcells=1): 
     376               !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
     377               !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 
     378            ENDIF 
    377379         END DO 
    378380      ENDIF 
     
    380382      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    381383         DO jj=1,jpj 
    382             va_e(nlci-nbghostcells:nlci,jj)     = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci,jj) 
    383             ! Specified fluxes: 
    384             ua_e(nlci-nbghostcells-1:nlci-1,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-1,jj) 
    385             ! Characteristics method (only if ghostcells=1): 
    386             !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
    387             !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 
     384            IF( vmask(nlci-1,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     385               va_e(nlci-nbghostcells:nlci-1,jj)   = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci-1,jj) 
     386               ! Specified fluxes: 
     387               ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj) 
     388               ! Characteristics method (only if ghostcells=1): 
     389               !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
     390               !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 
     391            ENDIF 
    388392         END DO 
    389393      ENDIF 
     
    391395      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    392396         DO ji=1,jpi 
    393             ua_e(ji,1:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,1:nbghostcells+1) 
    394             ! Specified fluxes: 
    395             va_e(ji,1:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,1:nbghostcells+1) 
    396             ! Characteristics method (only if ghostcells=1): 
    397             !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
    398             !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 
     397            IF( umask(ji,2,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     398               ua_e(ji,2:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,2:nbghostcells+1) 
     399               ! Specified fluxes: 
     400               va_e(ji,2:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,2:nbghostcells+1) 
     401               ! Characteristics method (only if ghostcells=1): 
     402               !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
     403               !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 
     404            ENDIF 
    399405         END DO 
    400406      ENDIF 
     
    402408      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    403409         DO ji=1,jpi 
    404             ua_e(ji,nlcj-nbghostcells:nlcj)     = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj) 
    405             ! Specified fluxes: 
    406             va_e(ji,nlcj-nbghostcells-1:nlcj-1) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-1) 
    407             ! Characteristics method (only if ghostcells=1): 
    408             !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
    409             !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 
     410            IF( umask(ji,nlcj-1,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     411               ua_e(ji,nlcj-nbghostcells:nlcj-1)   = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj-1) 
     412               ! Specified fluxes: 
     413               va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2) 
     414               ! Characteristics method (only if ghostcells=1): 
     415               !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
     416               !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 
     417            ENDIF 
    410418         END DO 
    411419      ENDIF 
     
    488496         indx = 1+nbghostcells 
    489497         DO jj = 1, jpj 
    490             DO ji = 1, indx 
    491                ssha(ji,jj)=ssha(indx+1,jj) 
    492                sshn(ji,jj)=sshn(indx+1,jj) 
     498            DO ji = 2, indx 
     499               IF( tmask(2,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     500                  ssha(ji,jj)=ssha(indx+1,jj) 
     501                  sshn(ji,jj)=sshn(indx+1,jj) 
     502               ENDIF 
    493503            ENDDO 
    494504         ENDDO 
     
    499509         indx = nlci-nbghostcells 
    500510         DO jj = 1, jpj 
    501             DO ji = indx, nlci 
    502                ssha(ji,jj)=ssha(indx-1,jj) 
    503                sshn(ji,jj)=sshn(indx-1,jj) 
     511            DO ji = indx, nlci-1 
     512               IF( tmask(nlci-1,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     513                  ssha(ji,jj)=ssha(indx-1,jj) 
     514                  sshn(ji,jj)=sshn(indx-1,jj) 
     515               ENDIF 
    504516            ENDDO 
    505517         ENDDO 
     
    509521      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    510522         indx = 1+nbghostcells 
    511          DO jj = 1, indx 
     523         DO jj = 2, indx 
    512524            DO ji = 1, jpi 
    513                ssha(ji,jj)=ssha(ji,indx+1) 
    514                sshn(ji,jj)=sshn(ji,indx+1) 
     525               IF( tmask(ji,2,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     526                  ssha(ji,jj)=ssha(ji,indx+1) 
     527                  sshn(ji,jj)=sshn(ji,indx+1) 
     528               ENDIF 
    515529            ENDDO 
    516530         ENDDO 
     
    520534      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    521535         indx = nlcj-nbghostcells 
    522          DO jj = indx, nlcj 
     536         DO jj = indx, nlcj-1 
    523537            DO ji = 1, jpi 
    524                ssha(ji,jj)=ssha(ji,indx-1) 
    525                sshn(ji,jj)=sshn(ji,indx-1) 
     538               IF( tmask(ji,nlcj-1,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     539                  ssha(ji,jj)=ssha(ji,indx-1) 
     540                  sshn(ji,jj)=sshn(ji,indx-1) 
     541               ENDIF 
    526542            ENDDO 
    527543         ENDDO 
     
    542558      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    543559         DO jj = 1, jpj 
    544             ssha_e(1:nbghostcells+1,jj) = hbdy_w(jj) 
     560            IF( tmask(2,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     561               ssha_e(2:nbghostcells+1,jj) = hbdy_w(jj) 
     562            ENDIF 
    545563         END DO 
    546564      ENDIF 
     
    548566      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    549567         DO jj = 1, jpj 
    550             ssha_e(nlci-nbghostcells:nlci,jj) = hbdy_e(jj) 
     568            IF( tmask(nlci-1,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     569               ssha_e(nlci-nbghostcells:nlci-1,jj) = hbdy_e(jj) 
     570            ENDIF 
    551571         END DO 
    552572      ENDIF 
     
    554574      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    555575         DO ji = 1, jpi 
    556             ssha_e(ji,1:nbghostcells+1) = hbdy_s(ji) 
     576            IF( tmask(ji,2,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     577               ssha_e(ji,2:nbghostcells+1) = hbdy_s(ji) 
     578            ENDIF 
    557579         END DO 
    558580      ENDIF 
     
    560582      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    561583         DO ji = 1, jpi 
    562             ssha_e(ji,nlcj-nbghostcells:nlcj) = hbdy_n(ji) 
     584            IF( tmask(ji,nlcj-1,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 
     585               ssha_e(ji,nlcj-nbghostcells:nlcj-1) = hbdy_n(ji) 
     586            ENDIF 
    563587         END DO 
    564588      ENDIF 
     
    608632      ELSE 
    609633         ! 
     634         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
     635         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
     636         ! 
    610637         IF( nbghostcells > 1 ) THEN  ! no smoothing 
    611638            tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 
    612639         ELSE                         ! smoothing 
    613             ! 
    614             western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
    615             southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
    616640            ! 
    617641            zrhox = Agrif_Rhox() 
     
    744768         northern_side = (nb == 2).AND.(ndir == 2) 
    745769         !! clem ghost 
    746          IF(western_side)  hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i1,j1:j2,1) 
    747          IF(eastern_side)  hbdy_e(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1) !clem previously i1 
     770         IF(western_side)  hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1) 
     771         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) !clem previously i1 
    748772         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1 
    749          IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j1,1) 
     773         IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
    750774      ENDIF 
    751775      ! 
     
    844868         ENDIF 
    845869         !! clem ghost    
    846          IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    847          IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i2,j1:j2) !clem previously i1   
     870         IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)   
     871         IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1   
    848872         IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 
    849873         IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    850874         !             
    851875         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    852             IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    853             IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1) 
     876            IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1) 
     877            IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    854878            IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1) 
    855879            IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
     
    896920         ENDIF 
    897921         !! clem ghost 
    898          IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    899          IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i2,j1:j2) !clem previously i1   
     922         IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)   
     923         IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1   
    900924         IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 
    901925         IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    902926         !             
    903927         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    904             IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 
    905             IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1) 
     928            IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1) 
     929            IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 
    906930            IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1) 
    907931            IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 
     
    940964            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    941965         !! clem ghost 
    942          IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    943          IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i2,j1:j2) !clem previously i1   
     966         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i2,j1:j2)   
     967         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1   
    944968         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 
    945969         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
     
    9781002            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    9791003         ! 
    980          IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    981          IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i2,j1:j2) !clem previously i1   
     1004         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i2,j1:j2)   
     1005         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1   
    9821006         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1  
    9831007         IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r8129 r8189  
    149149   !----------------------------- 
    150150   !!clem ghost (previously set to /0,0/) 
    151    CALL Agrif_Set_bc(e1u_id,(/0,ind1/)) 
    152    CALL Agrif_Set_bc(e2v_id,(/0,ind1/)) 
     151   CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
     152   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
    153153   !!clem ghost 
    154154 
     
    433433   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    434434 
    435    CALL Agrif_Set_bc(sshn_id,(/0,ind1/)) 
    436    CALL Agrif_Set_bc(unb_id ,(/0,ind1/)) 
    437    CALL Agrif_Set_bc(vnb_id ,(/0,ind1/)) 
    438    CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1/)) 
    439    CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1/)) 
    440  
    441    CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1/))   ! if west and rhox=3 and ghost=1: column 1 to 9 
    442    CALL Agrif_Set_bc(umsk_id,(/0,ind1/)) 
    443    CALL Agrif_Set_bc(vmsk_id,(/0,ind1/)) 
     435   CALL Agrif_Set_bc(sshn_id,(/0,ind1-1/)) 
     436   CALL Agrif_Set_bc(unb_id ,(/0,ind1-1/)) 
     437   CALL Agrif_Set_bc(vnb_id ,(/0,ind1-1/)) 
     438   CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1-1/)) 
     439   CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1-1/)) 
     440 
     441   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1-1/))   ! if west and rhox=3 and ghost=1: column 2 to 9 
     442   CALL Agrif_Set_bc(umsk_id,(/0,ind1-1/)) 
     443   CALL Agrif_Set_bc(vmsk_id,(/0,ind1-1/)) 
    444444 
    445445   ! clem: previously set to /0,1/ 
     
    827827   CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 
    828828   !clem: previously set to /-,0/ 
    829    CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,ind1/)) 
     829   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    830830 
    831831   ! 5. Update type 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r7753 r8189  
    8282            END DO   
    8383         END DO   
    84          IF( .NOT. AGRIF_Root() ) THEN 
    85             IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn(nlci-1,   :  ,jk) = 0._wp      ! east 
    86             IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(  2   ,   :  ,jk) = 0._wp      ! west 
    87             IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(  :   ,nlcj-1,jk) = 0._wp      ! north 
    88             IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(  :   ,  2   ,jk) = 0._wp      ! south 
    89          ENDIF 
    9084      END DO 
     85      IF( .NOT. Agrif_Root() ) THEN 
     86         IF( nbondi == -1 .OR. nbondi == 2 )   hdivn( 2:nbghostcells+1,:        ,:) = 0._wp      ! west 
     87         IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east 
     88         IF( nbondj == -1 .OR. nbondj == 2 )   hdivn( :,2:nbghostcells+1        ,:) = 0._wp      ! south 
     89         IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north 
     90      ENDIF 
    9191      ! 
    9292      IF( ln_rnf )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field) 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r7831 r8189  
    686686            IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    687687               DO jj=1,jpj 
    688                   zwx(2,jj) = ubdy_w(jj) * e2u(2,jj) 
     688                  zwx(2:nbghostcells+1,jj) = ubdy_w(jj) * e2u(2:nbghostcells+1,jj) 
    689689               END DO 
    690690            ENDIF 
    691691            IF((nbondi ==  1).OR.(nbondi == 2)) THEN 
    692692               DO jj=1,jpj 
    693                   zwx(nlci-2,jj) = ubdy_e(jj) * e2u(nlci-2,jj) 
     693                  zwx(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * e2u(nlci-nbghostcells-1:nlci-2,jj) 
    694694               END DO 
    695695            ENDIF 
    696696            IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    697697               DO ji=1,jpi 
    698                   zwy(ji,2) = vbdy_s(ji) * e1v(ji,2) 
     698                  zwy(ji,2:nbghostcells+1) = vbdy_s(ji) * e1v(ji,2:nbghostcells+1) 
    699699               END DO 
    700700            ENDIF 
    701701            IF((nbondj ==  1).OR.(nbondj == 2)) THEN 
    702702               DO ji=1,jpi 
    703                   zwy(ji,nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-2) 
     703                  zwy(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-nbghostcells-1:nlcj-2) 
    704704               END DO 
    705705            ENDIF 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r7864 r8189  
    152152      END DO 
    153153      ! 
    154       IF( .NOT. AGRIF_Root() ) THEN 
    155          IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh(nlci-1,   :  ,:) = 0._wp      ! east 
    156          IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh(  2   ,   :  ,:) = 0._wp      ! west 
    157          IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh(  :   ,nlcj-1,:) = 0._wp      ! north 
    158          IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh(  :   ,  2   ,:) = 0._wp      ! south 
     154      IF( .NOT. Agrif_Root() ) THEN 
     155         IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh( 2:nbghostcells+1,:        ,:) = 0._wp      ! west 
     156         IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east 
     157         IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh( :,2:nbghostcells+1        ,:) = 0._wp      ! south 
     158         IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north 
    159159      ENDIF 
    160160      ! 
Note: See TracChangeset for help on using the changeset viewer.