Changeset 8129


Ignore:
Timestamp:
2017-06-02T16:08:12+02:00 (3 years ago)
Author:
clem
Message:

make those things work: ghostcells>1 + nn_ice(child)=0 + fix timing

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

Legend:

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

    r7761 r8129  
    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) 
     
    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 
    156157 
    157158      !!----------------------------------------------------------------------- 
     
    233234!         ! Remove corners 
    234235!         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 
     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 
    239245! 
    240246!         ! smoothed fields 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90

    r7761 r8129  
    5656      IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 
    5757                                                                                                                           ! i.e. update only at the parent time step 
     58      IF( nn_ice == 0 ) RETURN   ! clem2017: do not update if child domain does not have ice 
     59      ! 
    5860      Agrif_UseSpecialValueInUpdate = .TRUE. 
    5961      Agrif_SpecialValueFineGrid = -9999. 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r7646 r8129  
    3535   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
    3636   PUBLIC   interpun, interpvn 
    37    PUBLIC   interptsn,  interpsshn 
     37   PUBLIC   interptsn, interpsshn 
    3838   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b 
    3939   PUBLIC   interpe3t, interpumsk, interpvmsk 
     
    100100      IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci-2 
    101101 
     102      ! --- West --- ! 
    102103      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    103104         ! 
    104          ! Smoothing 
    105          ! --------- 
    106105         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    107             ua_b(2,:) = 0._wp 
     106            ua_b(1:1+nbghostcells,:) = 0._wp 
    108107            DO jk = 1, jpkm1 
    109108               DO jj = 1, jpj 
    110                   ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
     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) 
    111110               END DO 
    112111            END DO 
    113112            DO jj = 1, jpj 
    114                ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj)             
    115             END DO 
    116          ENDIF 
    117          ! 
    118          DO jk=1,jpkm1                 ! Smooth 
    119             DO jj=j1,j2 
    120                ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 
    121                ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
    122             END DO 
    123          END DO 
    124          ! 
    125          zub(2,:) = 0._wp              ! Correct transport 
    126          DO jk = 1, jpkm1 
    127             DO jj = 1, jpj 
    128                zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
    129             END DO 
    130          END DO 
    131          DO jj=1,jpj 
    132             zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 
    133          END DO 
    134  
    135          DO jk=1,jpkm1 
    136             DO jj=1,jpj 
    137                ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 
    138             END DO 
    139          END DO 
    140  
    141          ! Set tangential velocities to time splitting estimate 
    142          !----------------------------------------------------- 
    143          IF( ln_dynspg_ts ) THEN 
    144             zvb(2,:) = 0._wp 
     113               ua_b(1:1+nbghostcells,jj) = ua_b(1:1+nbghostcells,jj) * r1_hu_a(1:1+nbghostcells,jj)             
     114            END DO 
     115         ENDIF 
     116         ! 
     117         ! Smoothing if only 1 ghostcell 
     118         ! ----------------------------- 
     119         IF( nbghostcells == 1 ) THEN 
     120            DO jk=1,jpkm1                 ! Smooth 
     121               DO jj=j1,j2 
     122                  ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 
     123                  ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
     124               END DO 
     125            END DO 
     126            ! 
     127            zub(2,:) = 0._wp              ! Correct transport 
    145128            DO jk = 1, jpkm1 
    146129               DO jj = 1, jpj 
    147                   zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 
    148                END DO 
    149             END DO 
    150             DO jj = 1, jpj 
    151                zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 
    152             END DO 
     130                  zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
     131               END DO 
     132            END DO 
     133            DO jj=1,jpj 
     134               zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 
     135            END DO 
     136             
     137            DO jk=1,jpkm1 
     138               DO jj=1,jpj 
     139                  ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 
     140               END DO 
     141            END DO 
     142             
     143            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     144               zvb(2,:) = 0._wp 
     145               DO jk = 1, jpkm1 
     146                  DO jj = 1, jpj 
     147                     zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 
     148                  END DO 
     149               END DO 
     150               DO jj = 1, jpj 
     151                  zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 
     152               END DO 
     153               DO jk = 1, jpkm1 
     154                  DO jj = 1, jpj 
     155                     va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 
     156                  END DO 
     157               END DO 
     158            ENDIF 
     159            ! 
     160         ENDIF 
     161         ! 
     162      ENDIF 
     163 
     164      ! --- East --- ! 
     165      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
     166 
     167         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     168            ua_b(nlci-nbghostcells-1:nlci,:) = 0._wp 
     169            DO jk=1,jpkm1 
     170               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) 
     173               END DO 
     174            END DO 
     175            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)             
     177            END DO 
     178         ENDIF 
     179         ! 
     180         ! Smoothing if only 1 ghostcell 
     181         ! ----------------------------- 
     182         IF( nbghostcells == 1 ) THEN 
     183            DO jk = 1, jpkm1              ! Smooth 
     184               DO jj = j1, j2 
     185                  ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      & 
     186                     &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 
     187               END DO 
     188            END DO 
     189             
     190            zub(nlci-2,:) = 0._wp        ! Correct transport 
    153191            DO jk = 1, jpkm1 
    154192               DO jj = 1, jpj 
    155                   va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 
    156                END DO 
    157             END DO 
    158          ENDIF 
    159          ! 
    160          ! Mask domain edges: 
    161          !------------------- 
    162          DO jk = 1, jpkm1 
     193                  zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
     194               END DO 
     195            END DO 
    163196            DO jj = 1, jpj 
    164                ua(1,jj,jk) = 0._wp 
    165                va(1,jj,jk) = 0._wp 
    166             END DO 
    167          END DO          
    168          ! 
    169       ENDIF 
    170  
    171       IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    172  
    173          ! Smoothing 
    174          ! --------- 
    175          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    176             ua_b(nlci-2,:) = 0._wp 
    177             DO jk=1,jpkm1 
    178                DO jj=1,jpj 
    179                   ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
    180                END DO 
    181             END DO 
    182             DO jj=1,jpj 
    183                ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj)             
    184             END DO 
    185          ENDIF 
    186  
    187          DO jk = 1, jpkm1              ! Smooth 
    188             DO jj = j1, j2 
    189                ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      & 
    190                   &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 
    191             END DO 
    192          END DO 
    193  
    194          zub(nlci-2,:) = 0._wp        ! Correct transport 
    195          DO jk = 1, jpkm1 
    196             DO jj = 1, jpj 
    197                zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
    198             END DO 
    199          END DO 
    200          DO jj = 1, jpj 
    201             zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 
    202          END DO 
    203  
    204          DO jk = 1, jpkm1 
    205             DO jj = 1, jpj 
    206                ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 
    207             END DO 
    208          END DO 
    209          ! 
    210          ! Set tangential velocities to time splitting estimate 
    211          !----------------------------------------------------- 
    212          IF( ln_dynspg_ts ) THEN 
    213             zvb(nlci-1,:) = 0._wp 
     197               zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 
     198            END DO 
     199             
    214200            DO jk = 1, jpkm1 
    215201               DO jj = 1, jpj 
    216                   zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 
    217                END DO 
    218             END DO 
    219             DO jj=1,jpj 
    220                zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 
    221             END DO 
    222             DO jk = 1, jpkm1 
    223                DO jj = 1, jpj 
    224                   va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 
    225                END DO 
    226             END DO 
    227          ENDIF 
    228          ! 
    229          ! Mask domain edges: 
    230          !------------------- 
    231          DO jk = 1, jpkm1 
    232             DO jj = 1, jpj 
    233                ua(nlci-1,jj,jk) = 0._wp 
    234                va(nlci  ,jj,jk) = 0._wp 
    235             END DO 
    236          END DO  
    237          ! 
    238       ENDIF 
    239  
     202                  ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 
     203               END DO 
     204            END DO 
     205            ! 
     206            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     207               zvb(nlci-1,:) = 0._wp 
     208               DO jk = 1, jpkm1 
     209                  DO jj = 1, jpj 
     210                     zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 
     211                  END DO 
     212               END DO 
     213               DO jj=1,jpj 
     214                  zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 
     215               END DO 
     216               DO jk = 1, jpkm1 
     217                  DO jj = 1, jpj 
     218                     va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 
     219                  END DO 
     220               END DO 
     221            ENDIF 
     222            ! 
     223         ENDIF 
     224         ! 
     225      ENDIF 
     226 
     227      ! --- South --- ! 
    240228      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    241229 
    242          ! Smoothing 
    243          ! --------- 
    244230         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    245             va_b(:,2) = 0._wp 
     231            va_b(:,1:nbghostcells+1) = 0._wp 
    246232            DO jk = 1, jpkm1 
    247233               DO ji = 1, jpi 
    248                   va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) 
     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) 
    249235               END DO 
    250236            END DO 
    251237            DO ji=1,jpi 
    252                va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2)             
    253             END DO 
    254          ENDIF 
    255          ! 
    256          DO jk = 1, jpkm1              ! Smooth 
    257             DO ji = i1, i2 
    258                va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    & 
    259                   &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 
    260             END DO 
    261          END DO 
    262          ! 
    263          zvb(:,2) = 0._wp              ! Correct transport 
    264          DO jk=1,jpkm1 
    265             DO ji=1,jpi 
    266                zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 
    267             END DO 
    268          END DO 
    269          DO ji = 1, jpi 
    270             zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 
    271          END DO 
    272          DO jk = 1, jpkm1 
     238               va_b(ji,1:nbghostcells+1) = va_b(ji,1:nbghostcells+1) * r1_hv_a(ji,1:nbghostcells+1)             
     239            END DO 
     240         ENDIF 
     241         ! 
     242         ! Smoothing if only 1 ghostcell 
     243         ! ----------------------------- 
     244         IF( nbghostcells == 1 ) THEN 
     245            DO jk = 1, jpkm1              ! Smooth 
     246               DO ji = i1, i2 
     247                  va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    & 
     248                     &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 
     249               END DO 
     250            END DO 
     251            ! 
     252            zvb(:,2) = 0._wp              ! Correct transport 
     253            DO jk=1,jpkm1 
     254               DO ji=1,jpi 
     255                  zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 
     256               END DO 
     257            END DO 
    273258            DO ji = 1, jpi 
    274                va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 
    275             END DO 
    276          END DO 
    277  
    278          ! Set tangential velocities to time splitting estimate 
    279          !----------------------------------------------------- 
    280          IF( ln_dynspg_ts ) THEN 
    281             zub(:,2) = 0._wp 
     259               zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 
     260            END DO 
    282261            DO jk = 1, jpkm1 
    283262               DO ji = 1, jpi 
    284                   zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 
    285                END DO 
    286             END DO 
    287             DO ji = 1, jpi 
    288                zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 
    289             END DO 
    290  
     263                  va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 
     264               END DO 
     265            END DO 
     266             
     267            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     268               zub(:,2) = 0._wp 
     269               DO jk = 1, jpkm1 
     270                  DO ji = 1, jpi 
     271                     zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 
     272                  END DO 
     273               END DO 
     274               DO ji = 1, jpi 
     275                  zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 
     276               END DO 
     277                
     278               DO jk = 1, jpkm1 
     279                  DO ji = 1, jpi 
     280                     ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 
     281                  END DO 
     282               END DO 
     283            ENDIF 
     284            ! 
     285         ENDIF 
     286         ! 
     287      ENDIF 
     288 
     289      ! --- North --- ! 
     290      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
     291         ! 
     292         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     293            va_b(:,nlcj-nbghostcells-1:nlcj) = 0._wp 
    291294            DO jk = 1, jpkm1 
    292295               DO ji = 1, jpi 
    293                   ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 
    294                END DO 
    295             END DO 
    296          ENDIF 
    297  
    298          ! Mask domain edges: 
    299          !------------------- 
    300          DO jk = 1, jpkm1 
     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) 
     298               END DO 
     299            END DO 
    301300            DO ji = 1, jpi 
    302                ua(ji,1,jk) = 0._wp 
    303                va(ji,1,jk) = 0._wp 
    304             END DO 
    305          END DO  
    306  
    307       ENDIF 
    308  
    309       IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    310          ! 
    311          ! Smoothing 
    312          ! --------- 
    313          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    314             va_b(:,nlcj-2) = 0._wp 
     301               va_b(ji,nlcj-nbghostcells-1:nlcj) = va_b(ji,nlcj-nbghostcells-1:nlcj) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj)             
     302            END DO 
     303         ENDIF 
     304         ! 
     305         ! Smoothing if only 1 ghostcell 
     306         ! ----------------------------- 
     307         IF( nbghostcells == 1 ) THEN 
     308            DO jk = 1, jpkm1              ! Smooth 
     309               DO ji = i1, i2 
     310                  va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   & 
     311                     &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 
     312               END DO 
     313            END DO 
     314            ! 
     315            zvb(:,nlcj-2) = 0._wp         ! Correct transport 
    315316            DO jk = 1, jpkm1 
    316317               DO ji = 1, jpi 
    317                   va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) 
     318                  zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
    318319               END DO 
    319320            END DO 
    320321            DO ji = 1, jpi 
    321                va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)             
    322             END DO 
    323          ENDIF 
    324          ! 
    325          DO jk = 1, jpkm1              ! Smooth 
    326             DO ji = i1, i2 
    327                va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   & 
    328                   &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 
    329             END DO 
    330          END DO 
    331          ! 
    332          zvb(:,nlcj-2) = 0._wp         ! Correct transport 
    333          DO jk = 1, jpkm1 
    334             DO ji = 1, jpi 
    335                zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
    336             END DO 
    337          END DO 
    338          DO ji = 1, jpi 
    339             zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 
    340          END DO 
    341          DO jk = 1, jpkm1 
    342             DO ji = 1, jpi 
    343                va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 
    344             END DO 
    345          END DO 
    346          ! 
    347          ! Set tangential velocities to time splitting estimate 
    348          !----------------------------------------------------- 
    349          IF( ln_dynspg_ts ) THEN 
    350             zub(:,nlcj-1) = 0._wp 
     322               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 
     323            END DO 
    351324            DO jk = 1, jpkm1 
    352325               DO ji = 1, jpi 
    353                   zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 
    354                END DO 
    355             END DO 
    356             DO ji = 1, jpi 
    357                zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 
    358             END DO 
    359             ! 
    360             DO jk = 1, jpkm1 
     326                  va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 
     327               END DO 
     328            END DO 
     329            ! 
     330            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     331               zub(:,nlcj-1) = 0._wp 
     332               DO jk = 1, jpkm1 
     333                  DO ji = 1, jpi 
     334                     zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 
     335                  END DO 
     336               END DO 
    361337               DO ji = 1, jpi 
    362                   ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 
    363                END DO 
    364             END DO 
    365          ENDIF 
    366          ! 
    367          ! Mask domain edges: 
    368          !------------------- 
    369          DO jk = 1, jpkm1 
    370             DO ji = 1, jpi 
    371                ua(ji,nlcj  ,jk) = 0._wp 
    372                va(ji,nlcj-1,jk) = 0._wp 
    373             END DO 
    374          END DO  
     338                  zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 
     339               END DO 
     340               ! 
     341               DO jk = 1, jpkm1 
     342                  DO ji = 1, jpi 
     343                     ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 
     344                  END DO 
     345               END DO 
     346            ENDIF 
     347            ! 
     348         ENDIF 
    375349         ! 
    376350      ENDIF 
     
    392366      ! 
    393367      IF( Agrif_Root() )   RETURN 
    394       ! 
     368      !! clem ghost 
    395369      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    396370         DO jj=1,jpj 
    397             va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj) 
     371            va_e(1:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(1:nbghostcells+1,jj) 
    398372            ! Specified fluxes: 
    399             ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj) 
    400             ! Characteristics method: 
     373            ua_e(1:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(1:nbghostcells+1,jj) 
     374            ! Characteristics method (only if ghostcells=1): 
    401375            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
    402376            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 
     
    406380      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    407381         DO jj=1,jpj 
    408             va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj) 
     382            va_e(nlci-nbghostcells:nlci,jj)     = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci,jj) 
    409383            ! Specified fluxes: 
    410             ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj) 
    411             ! Characteristics method: 
     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): 
    412386            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
    413387            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 
     
    417391      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    418392         DO ji=1,jpi 
    419             ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2) 
     393            ua_e(ji,1:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,1:nbghostcells+1) 
    420394            ! Specified fluxes: 
    421             va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2) 
    422             ! Characteristics method: 
     395            va_e(ji,1:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,1:nbghostcells+1) 
     396            ! Characteristics method (only if ghostcells=1): 
    423397            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
    424398            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 
     
    428402      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    429403         DO ji=1,jpi 
    430             ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1) 
     404            ua_e(ji,nlcj-nbghostcells:nlcj)     = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj) 
    431405            ! Specified fluxes: 
    432             va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2) 
    433             ! Characteristics method: 
     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): 
    434408            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
    435409            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 
     
    476450      ! 
    477451      IF( ll_int_cons ) THEN  ! Conservative interpolation 
    478          ! orders matters here !!!!!! 
     452         ! order matters here !!!!!! 
    479453         CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 
    480454         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
     
    504478      !!----------------------------------------------------------------------   
    505479      INTEGER, INTENT(in) ::   kt 
    506       !! 
     480      ! 
     481      INTEGER  :: ji, jj, indx 
    507482      !!----------------------------------------------------------------------   
    508483      ! 
    509484      IF( Agrif_Root() )   RETURN 
    510       ! 
     485      !! clem ghost 
     486      ! --- West --- ! 
    511487      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    512          ssha(2,:)=ssha(3,:) 
    513          sshn(2,:)=sshn(3,:) 
    514       ENDIF 
    515       ! 
     488         indx = 1+nbghostcells 
     489         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) 
     493            ENDDO 
     494         ENDDO 
     495      ENDIF 
     496      ! 
     497      ! --- East --- ! 
    516498      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    517          ssha(nlci-1,:)=ssha(nlci-2,:) 
    518          sshn(nlci-1,:)=sshn(nlci-2,:) 
    519       ENDIF 
    520       ! 
     499         indx = nlci-nbghostcells 
     500         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) 
     504            ENDDO 
     505         ENDDO 
     506      ENDIF 
     507      ! 
     508      ! --- South --- ! 
    521509      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    522          ssha(:,2)=ssha(:,3) 
    523          sshn(:,2)=sshn(:,3) 
    524       ENDIF 
    525       ! 
     510         indx = 1+nbghostcells 
     511         DO jj = 1, indx 
     512            DO ji = 1, jpi 
     513               ssha(ji,jj)=ssha(ji,indx+1) 
     514               sshn(ji,jj)=sshn(ji,indx+1) 
     515            ENDDO 
     516         ENDDO 
     517      ENDIF 
     518      ! 
     519      ! --- North --- ! 
    526520      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    527          ssha(:,nlcj-1)=ssha(:,nlcj-2) 
    528          sshn(:,nlcj-1)=sshn(:,nlcj-2) 
     521         indx = nlcj-nbghostcells 
     522         DO jj = indx, nlcj 
     523            DO ji = 1, jpi 
     524               ssha(ji,jj)=ssha(ji,indx-1) 
     525               sshn(ji,jj)=sshn(ji,indx-1) 
     526            ENDDO 
     527         ENDDO 
    529528      ENDIF 
    530529      ! 
     
    538537      INTEGER, INTENT(in) ::   jn 
    539538      !! 
    540       INTEGER :: ji,jj 
    541       !!----------------------------------------------------------------------   
    542       ! 
     539      INTEGER :: ji, jj 
     540      !!----------------------------------------------------------------------   
     541      !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 
    543542      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    544543         DO jj = 1, jpj 
    545             ssha_e(2,jj) = hbdy_w(jj) 
     544            ssha_e(1:nbghostcells+1,jj) = hbdy_w(jj) 
    546545         END DO 
    547546      ENDIF 
     
    549548      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    550549         DO jj = 1, jpj 
    551             ssha_e(nlci-1,jj) = hbdy_e(jj) 
     550            ssha_e(nlci-nbghostcells:nlci,jj) = hbdy_e(jj) 
    552551         END DO 
    553552      ENDIF 
     
    555554      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    556555         DO ji = 1, jpi 
    557             ssha_e(ji,2) = hbdy_s(ji) 
     556            ssha_e(ji,1:nbghostcells+1) = hbdy_s(ji) 
    558557         END DO 
    559558      ENDIF 
     
    561560      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    562561         DO ji = 1, jpi 
    563             ssha_e(ji,nlcj-1) = hbdy_n(ji) 
     562            ssha_e(ji,nlcj-nbghostcells:nlcj) = hbdy_n(ji) 
    564563         END DO 
    565564      ENDIF 
     
    601600      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    602601      INTEGER  ::   imin, imax, jmin, jmax 
    603       REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
    604       REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
     602      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7 
    605603      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
    606604      !!---------------------------------------------------------------------- 
     
    610608      ELSE 
    611609         ! 
    612          western_side  = (nb == 1).AND.(ndir == 1) 
    613          eastern_side  = (nb == 1).AND.(ndir == 2) 
    614          southern_side = (nb == 2).AND.(ndir == 1) 
    615          northern_side = (nb == 2).AND.(ndir == 2) 
    616          ! 
    617          zrhox = Agrif_Rhox() 
    618          !  
    619          zalpha1 = ( zrhox - 1. ) * 0.5 
    620          zalpha2 = 1. - zalpha1 
    621          !  
    622          zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
    623          zalpha4 = 1. - zalpha3 
    624          !  
    625          zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
    626          zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    627          zalpha5 = 1. - zalpha6 - zalpha7 
    628          ! 
    629          imin = i1 
    630          imax = i2 
    631          jmin = j1 
    632          jmax = j2 
    633          !  
    634          ! Remove CORNERS 
    635          IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
    636          IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
    637          IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
    638          IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
    639          ! 
    640          IF( eastern_side ) THEN 
    641             DO jn = 1, jpts 
    642                tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
    643                DO jk = 1, jpkm1 
    644                   DO jj = jmin,jmax 
    645                      IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 
    646                         tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    647                      ELSE 
    648                         tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    649                         IF( un(nlci-2,jj,jk) > 0._wp ) THEN 
    650                            tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) &  
    651                                  + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     610         IF( nbghostcells > 1 ) THEN  ! no smoothing 
     611            tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 
     612         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) 
     616            ! 
     617            zrhox = Agrif_Rhox() 
     618            z1 = ( zrhox - 1. ) * 0.5 
     619            z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
     620            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     621            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
     622            ! 
     623            z2 = 1. - z1 
     624            z4 = 1. - z3 
     625            z5 = 1. - z6 - z7 
     626            ! 
     627            imin = i1 ; imax = i2 
     628            jmin = j1 ; jmax = j2 
     629            !  
     630            ! Remove CORNERS 
     631            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
     632            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
     633            IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
     634            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
     635            ! 
     636            IF( eastern_side ) THEN 
     637               DO jn = 1, jpts 
     638                  tsa(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
     639                  DO jk = 1, jpkm1 
     640                     DO jj = jmin,jmax 
     641                        IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 
     642                           tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     643                        ELSE 
     644                           tsa(nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     645                           IF( un(nlci-2,jj,jk) > 0._wp ) THEN 
     646                              tsa(nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) &  
     647                                                   + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     648                           ENDIF 
    652649                        ENDIF 
    653                      ENDIF 
     650                     END DO 
    654651                  END DO 
    655                END DO 
    656                tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 
    657             END DO 
    658          ENDIF 
    659          !  
    660          IF( northern_side ) THEN             
    661             DO jn = 1, jpts 
    662                tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
    663                DO jk = 1, jpkm1 
    664                   DO ji = imin,imax 
    665                      IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 
    666                         tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
    667                      ELSE 
    668                         tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
    669                         IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 
    670                            tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  & 
    671                                  + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     652                  tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 
     653               END DO 
     654            ENDIF 
     655            !  
     656            IF( northern_side ) THEN             
     657               DO jn = 1, jpts 
     658                  tsa(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
     659                  DO jk = 1, jpkm1 
     660                     DO ji = imin,imax 
     661                        IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 
     662                           tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     663                        ELSE 
     664                           tsa(ji,nlcj-1,jk,jn)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     665                           IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 
     666                              tsa(ji,nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn)  & 
     667                                                   + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     668                           ENDIF 
    672669                        ENDIF 
    673                      ENDIF 
     670                     END DO 
    674671                  END DO 
    675                END DO 
    676                tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 
    677             END DO 
    678          ENDIF 
    679          ! 
    680          IF( western_side ) THEN             
    681             DO jn = 1, jpts 
    682                tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 
    683                DO jk = 1, jpkm1 
    684                   DO jj = jmin,jmax 
    685                      IF( umask(2,jj,jk) == 0._wp ) THEN 
    686                         tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
    687                      ELSE 
    688                         tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
    689                         IF( un(2,jj,jk) < 0._wp ) THEN 
    690                            tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
     672                  tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 
     673               END DO 
     674            ENDIF 
     675            ! 
     676            IF( western_side ) THEN             
     677               DO jn = 1, jpts 
     678                  tsa(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 
     679                  DO jk = 1, jpkm1 
     680                     DO jj = jmin,jmax 
     681                        IF( umask(2,jj,jk) == 0._wp ) THEN 
     682                           tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
     683                        ELSE 
     684                           tsa(2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
     685                           IF( un(2,jj,jk) < 0._wp ) THEN 
     686                              tsa(2,jj,jk,jn)=(z6*tsa(3,jj,jk,jn)+z5*tsa(1,jj,jk,jn)+z7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
     687                           ENDIF 
    691688                        ENDIF 
    692                      ENDIF 
     689                     END DO 
    693690                  END DO 
    694                END DO 
    695                tsa(1,j1:j2,k1:k2,jn) = 0._wp 
    696             END DO 
    697          ENDIF 
    698          ! 
    699          IF( southern_side ) THEN            
    700             DO jn = 1, jpts 
    701                tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 
    702                DO jk = 1, jpk       
    703                   DO ji=imin,imax 
    704                      IF( vmask(ji,2,jk) == 0._wp ) THEN 
    705                         tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
    706                      ELSE 
    707                         tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
    708                         IF( vn(ji,2,jk) < 0._wp ) THEN 
    709                            tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
     691                  tsa(1,j1:j2,k1:k2,jn) = 0._wp 
     692               END DO 
     693            ENDIF 
     694            ! 
     695            IF( southern_side ) THEN            
     696               DO jn = 1, jpts 
     697                  tsa(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 
     698                  DO jk = 1, jpk       
     699                     DO ji=imin,imax 
     700                        IF( vmask(ji,2,jk) == 0._wp ) THEN 
     701                           tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
     702                        ELSE 
     703                           tsa(ji,2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
     704                           IF( vn(ji,2,jk) < 0._wp ) THEN 
     705                              tsa(ji,2,jk,jn)=(z6*tsa(ji,3,jk,jn)+z5*tsa(ji,1,jk,jn)+z7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
     706                           ENDIF 
    710707                        ENDIF 
    711                      ENDIF 
     708                     END DO 
    712709                  END DO 
    713                END DO 
    714                tsa(i1:i2,1,k1:k2,jn) = 0._wp 
    715             END DO 
    716          ENDIF 
    717          ! 
    718          ! Treatment of corners 
    719          !  
    720          ! East south 
    721          IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
    722             tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 
    723          ENDIF 
    724          ! East north 
    725          IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
    726             tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 
    727          ENDIF 
    728          ! West south 
    729          IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
    730             tsa(2,2,:,:) = ptab(2,2,:,:) 
    731          ENDIF 
    732          ! West north 
    733          IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
    734             tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 
    735          ENDIF 
    736          ! 
     710                  tsa(i1:i2,1,k1:k2,jn) = 0._wp 
     711               END DO 
     712            ENDIF 
     713            ! 
     714            ! Treatment of corners 
     715            IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2)))   tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)            ! East south 
     716            IF ((eastern_side).AND.((nbondj ==  1).OR.(nbondj == 2)))   tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)  ! East north 
     717            IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2)))   tsa(2,2,:,:) = ptab(2,2,:,:)                      ! West south 
     718            IF ((western_side).AND.((nbondj ==  1).OR.(nbondj == 2)))   tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)            ! West north 
     719            ! 
     720         ENDIF 
    737721      ENDIF 
    738722      ! 
     
    759743         southern_side = (nb == 2).AND.(ndir == 1) 
    760744         northern_side = (nb == 2).AND.(ndir == 2) 
    761          IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 
    762          IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 
    763          IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
    764          IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
     745         !! 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 
     748         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) 
    765750      ENDIF 
    766751      ! 
     
    854839         ELSEIF( bdy_tinterp == 2 ) THEN 
    855840            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    856                &               - zt0        * (       zt0 - 1._wp)**2._wp )  
    857  
     841               &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
    858842         ELSE 
    859843            ztcoeff = 1 
    860844         ENDIF 
    861          !    
    862          IF(western_side) THEN 
    863             ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    864          ENDIF 
    865          IF(eastern_side) THEN 
    866             ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    867          ENDIF 
    868          IF(southern_side) THEN 
    869             ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    870          ENDIF 
    871          IF(northern_side) THEN 
    872             ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    873          ENDIF 
     845         !! 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   
     848         IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 
     849         IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    874850         !             
    875851         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    876             IF(western_side) THEN 
    877                ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    878             ENDIF 
    879             IF(eastern_side) THEN 
    880                ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    881             ENDIF 
    882             IF(southern_side) THEN 
    883                ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    884             ENDIF 
    885             IF(northern_side) THEN 
    886                ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    887             ENDIF 
     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) 
     854            IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1) 
     855            IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    888856         ENDIF 
    889857      ENDIF 
     
    927895            ztcoeff = 1 
    928896         ENDIF 
    929          ! 
    930          IF(western_side) THEN 
    931             vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    932          ENDIF 
    933          IF(eastern_side) THEN 
    934             vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    935          ENDIF 
    936          IF(southern_side) THEN 
    937             vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
    938          ENDIF 
    939          IF(northern_side) THEN 
    940             vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    941          ENDIF 
     897         !! 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   
     900         IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 
     901         IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    942902         !             
    943903         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    944             IF(western_side) THEN 
    945                vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
    946                      &                                  * vmask(i1,j1:j2,1) 
    947             ENDIF 
    948             IF(eastern_side) THEN 
    949                vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
    950                      &                                  * vmask(i1,j1:j2,1) 
    951             ENDIF 
    952             IF(southern_side) THEN 
    953                vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
    954                      &                                  * vmask(i1:i2,j1,1) 
    955             ENDIF 
    956             IF(northern_side) THEN 
    957                vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
    958                      &                                  * vmask(i1:i2,j1,1) 
    959             ENDIF 
     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) 
     906            IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1) 
     907            IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 
    960908         ENDIF 
    961909      ENDIF 
     
    991939         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    & 
    992940            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    993          !  
     941         !! clem ghost 
    994942         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    995          IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
    996          IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     943         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i2,j1:j2) !clem previously i1   
     944         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 
    997945         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    998946      ENDIF 
     
    1031979         ! 
    1032980         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    1033          IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
    1034          IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     981         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i2,j1:j2) !clem previously i1   
     982         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1  
    1035983         IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    1036984      ENDIF 
     
    1050998      INTEGER :: ji, jj, jk 
    1051999      LOGICAL :: western_side, eastern_side, northern_side, southern_side 
    1052       REAL(wp) :: ztmpmsk       
    10531000      !!----------------------------------------------------------------------   
    10541001      !     
     
    10601007         southern_side = (nb == 2).AND.(ndir == 1) 
    10611008         northern_side = (nb == 2).AND.(ndir == 2) 
    1062  
     1009         ! 
    10631010         DO jk = k1, k2 
    10641011            DO jj = j1, j2 
    10651012               DO ji = i1, i2 
    1066                   ! Get velocity mask at boundary edge points: 
    1067                   IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1) 
    1068                   IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1) 
    1069                   IF( northern_side)   ztmpmsk = vmask(ji    ,nlcj-2,1) 
    1070                   IF( southern_side)   ztmpmsk = vmask(ji    ,2     ,1) 
    10711013                  ! 
    1072                   IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN 
     1014                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 
    10731015                     IF (western_side) THEN 
    10741016                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r7646 r8129  
    3434      !!   *** ROUTINE Agrif_Sponge_Tra *** 
    3535      !!--------------------------------------------- 
    36       REAL(wp) :: timecoeff 
     36      REAL(wp) :: zcoef 
    3737      !!--------------------------------------------- 
    3838      ! 
    3939#if defined SPONGE 
    40       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     40      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    4141 
    4242      CALL Agrif_Sponge 
     
    4545      tabspongedone_tsn = .FALSE. 
    4646 
    47       CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge) 
     47      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=zcoef,procname=interptsn_sponge) 
    4848 
    4949      Agrif_UseSpecialValue = .FALSE. 
     
    5757      !!   *** ROUTINE Agrif_Sponge_dyn *** 
    5858      !!--------------------------------------------- 
    59       REAL(wp) :: timecoeff 
     59      REAL(wp) :: zcoef 
    6060      !!--------------------------------------------- 
    6161 
    6262#if defined SPONGE 
    63       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     63      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    6464 
    6565      Agrif_SpecialValue=0. 
     
    6868      tabspongedone_u = .FALSE. 
    6969      tabspongedone_v = .FALSE.          
    70       CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge) 
     70      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=zcoef,procname=interpun_sponge) 
    7171 
    7272      tabspongedone_u = .FALSE. 
    7373      tabspongedone_v = .FALSE. 
    74       CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge) 
     74      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=zcoef,procname=interpvn_sponge) 
    7575 
    7676      Agrif_UseSpecialValue = .FALSE. 
     
    8484      !!   *** ROUTINE  Agrif_Sponge *** 
    8585      !!--------------------------------------------- 
    86       INTEGER  :: ji,jj,jk 
    87       INTEGER  :: ispongearea, ilci, ilcj 
    88       LOGICAL  :: ll_spdone 
    89       REAL(wp) :: z1spongearea, zramp 
    90       REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 
     86      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 
     87      ! 
     88      INTEGER  :: ji, jj, ind1, ind2 
     89      INTEGER  :: ispongearea 
     90      REAL(wp) :: z1_spongearea 
     91      !!--------------------------------------------- 
    9192 
    9293#if defined SPONGE || defined SPONGE_TOP 
    93       ll_spdone=.TRUE. 
    9494      IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 
    95          ! Define ramp from boundaries towards domain interior 
    96          ! at T-points 
     95         ! Define ramp from boundaries towards domain interior at T-points 
    9796         ! Store it in ztabramp 
    98          ll_spdone=.FALSE. 
    99  
    100          CALL wrk_alloc( jpi, jpj, ztabramp ) 
    10197 
    10298         ispongearea  = 2 + nn_sponge_len * Agrif_irhox() 
    103          ilci = nlci - ispongearea 
    104          ilcj = nlcj - ispongearea  
    105          z1spongearea = 1._wp / REAL( ispongearea - 2 ) 
    106  
     99         z1_spongearea = 1._wp / REAL( ispongearea - 1 ) 
     100          
    107101         ztabramp(:,:) = 0._wp 
    108102 
     103         ! --- West --- ! 
    109104         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
     105            ind1 = 1+nbghostcells 
     106            ind2 = 1+nbghostcells + (ispongearea-1) 
    110107            DO jj = 1, jpj 
    111                IF ( umask(2,jj,1) == 1._wp ) THEN 
    112                  DO ji = 2, ispongearea                   
    113                     ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea 
    114                  END DO 
    115                ENDIF 
     108               DO ji = ind1, ind2                   
     109                  ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 
     110               END DO 
    116111            ENDDO 
    117112         ENDIF 
    118113 
     114         ! --- East --- ! 
    119115         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
     116            ind1 = nlci - (1+nbghostcells) - (ispongearea-1) 
     117            ind2 = nlci - (1+nbghostcells) 
    120118            DO jj = 1, jpj 
    121                IF ( umask(nlci-2,jj,1) == 1._wp ) THEN 
    122                   DO ji = ilci+1,nlci-1 
    123                      zramp = (ji - (ilci+1) ) * z1spongearea 
    124                      ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 
    125                   ENDDO 
    126                ENDIF 
     119               DO ji = ind1, ind2 
     120                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) ) 
     121               ENDDO 
    127122            ENDDO 
    128123         ENDIF 
    129124 
     125         ! --- South --- ! 
    130126         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
    131             DO ji = 1, jpi 
    132                IF ( vmask(ji,2,1) == 1._wp ) THEN 
    133                   DO jj = 2, ispongearea 
    134                      zramp = ( ispongearea-jj ) * z1spongearea 
    135                      ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 
    136                   END DO 
    137                ENDIF 
     127            ind1 = 1+nbghostcells 
     128            ind2 = 1+nbghostcells + (ispongearea-1) 
     129            DO jj = ind1, ind2 
     130               DO ji = 1, jpi 
     131                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 
     132               END DO 
    138133            ENDDO 
    139134         ENDIF 
    140135 
     136         ! --- North --- ! 
    141137         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
    142             DO ji = 1, jpi 
    143                IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN 
    144                   DO jj = ilcj+1,nlcj-1 
    145                      zramp = (jj - (ilcj+1) ) * z1spongearea 
    146                      ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 
    147                   END DO 
    148                ENDIF 
     138            ind1 = nlcj - (1+nbghostcells) - (ispongearea-1) 
     139            ind2 = nlcj - (1+nbghostcells) 
     140            DO jj = ind1, ind2 
     141               DO ji = 1, jpi 
     142                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 
     143               END DO 
    149144            ENDDO 
    150145         ENDIF 
     
    158153         DO jj = 2, jpjm1 
    159154            DO ji = 2, jpim1   ! vector opt. 
    160                fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  )) 
    161                fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1)) 
    162             END DO 
    163          END DO 
    164  
     155               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
     156               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) 
     157            END DO 
     158         END DO 
    165159         CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions 
    166160         CALL lbc_lnk( fsaht_spv, 'V', 1. ) 
     161          
    167162         spongedoneT = .TRUE. 
    168163      ENDIF 
     
    179174            END DO 
    180175         END DO 
    181  
    182176         CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions 
    183177         CALL lbc_lnk( fsahm_spf, 'F', 1. ) 
     178          
    184179         spongedoneU = .TRUE. 
    185180      ENDIF 
    186       ! 
    187       IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp ) 
    188181      ! 
    189182#endif 
     
    205198      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 
    206199      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 
     200      !!---------------------------------------------     
    207201      ! 
    208202      IF( before ) THEN 
     
    327321 
    328322         jmax = j2-1 
    329          IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3) 
     323         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North 
    330324 
    331325         DO jj = j1+1, jmax 
     
    404398 
    405399         imax = i2-1 
    406          IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3) 
     400         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-nbghostcells-2)   ! East 
    407401 
    408402         DO jj = j1+1, j2 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r6140 r8129  
    5050      ! 
    5151      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    52       INTEGER :: imin, imax, jmin, jmax 
    53       REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
    54       REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
    55       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    56  
     52      INTEGER  ::  imin, imax, jmin, jmax 
     53      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7 
     54      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     55      !!----------------------------------------------------------------------- 
     56      ! 
    5757      IF (before) THEN          
    5858         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
    5959      ELSE 
    6060         ! 
    61          western_side  = (nb == 1).AND.(ndir == 1) 
    62          eastern_side  = (nb == 1).AND.(ndir == 2) 
    63          southern_side = (nb == 2).AND.(ndir == 1) 
    64          northern_side = (nb == 2).AND.(ndir == 2) 
    65          ! 
    66          zrhox = Agrif_Rhox() 
    67          !  
    68          zalpha1 = ( zrhox - 1. ) * 0.5 
    69          zalpha2 = 1. - zalpha1 
    70          !  
    71          zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
    72          zalpha4 = 1. - zalpha3 
    73          !  
    74          zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
    75          zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    76          zalpha5 = 1. - zalpha6 - zalpha7 
    77          ! 
    78          imin = i1 
    79          imax = i2 
    80          jmin = j1 
    81          jmax = j2 
    82          !  
    83          ! Remove CORNERS 
    84          IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
    85          IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
    86          IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
    87          IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
    88          ! 
    89          IF( eastern_side) THEN 
    90             DO jn = 1, jptra 
    91                tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
    92                DO jk = 1, jpkm1 
    93                   DO jj = jmin,jmax 
    94                      IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
    95                         tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    96                      ELSE 
    97                         tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    98                         IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
    99                            tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) &  
    100                                  + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     61         IF( nbghostcells > 1 ) THEN  ! no smoothing 
     62            tra(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 
     63         ELSE                         ! smoothing 
     64            ! 
     65            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
     66            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
     67            ! 
     68            zrhox = Agrif_Rhox() 
     69            z1 = ( zrhox - 1. ) * 0.5 
     70            z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
     71            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     72            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
     73            ! 
     74            z2 = 1. - z1 
     75            z4 = 1. - z3 
     76            z5 = 1. - z6 - z7 
     77            ! 
     78            imin = i1 ; imax = i2 
     79            jmin = j1 ; jmax = j2 
     80            !  
     81            ! Remove CORNERS 
     82            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
     83            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
     84            IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
     85            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
     86            ! 
     87            IF( eastern_side) THEN 
     88               DO jn = 1, jptra 
     89                  tra(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
     90                  DO jk = 1, jpkm1 
     91                     DO jj = jmin,jmax 
     92                        IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     93                           tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     94                        ELSE 
     95                           tra(nlci-1,jj,jk,jn)=(z4*tra(nlci,jj,jk,jn)+z3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     96                           IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     97                              tra(nlci-1,jj,jk,jn)=( z6*tra(nlci-2,jj,jk,jn)+z5*tra(nlci,jj,jk,jn) &  
     98                                                   + z7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     99                           ENDIF 
    101100                        ENDIF 
    102                      ENDIF 
     101                     END DO 
     102                  END DO 
     103               ENDDO 
     104            ENDIF 
     105            !  
     106            IF( northern_side ) THEN             
     107               DO jn = 1, jptra 
     108                  tra(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
     109                  DO jk = 1, jpkm1 
     110                     DO ji = imin,imax 
     111                        IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     112                           tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     113                        ELSE 
     114                           tra(ji,nlcj-1,jk,jn)=(z4*tra(ji,nlcj,jk,jn)+z3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     115                           IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     116                              tra(ji,nlcj-1,jk,jn)=( z6*tra(ji,nlcj-2,jk,jn)+z5*tra(ji,nlcj,jk,jn)  & 
     117                                                   + z7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     118                           ENDIF 
     119                        ENDIF 
     120                     END DO 
     121                  END DO 
     122               ENDDO 
     123            ENDIF 
     124            ! 
     125            IF( western_side) THEN             
     126               DO jn = 1, jptra 
     127                  tra(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 
     128                  DO jk = 1, jpkm1 
     129                     DO jj = jmin,jmax 
     130                        IF( umask(2,jj,jk) == 0.e0 ) THEN 
     131                           tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
     132                        ELSE 
     133                           tra(2,jj,jk,jn)=(z4*tra(1,jj,jk,jn)+z3*tra(3,jj,jk,jn))*tmask(2,jj,jk)         
     134                           IF( un(2,jj,jk) < 0.e0 ) THEN 
     135                              tra(2,jj,jk,jn)=(z6*tra(3,jj,jk,jn)+z5*tra(1,jj,jk,jn)+z7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
     136                           ENDIF 
     137                        ENDIF 
     138                     END DO 
    103139                  END DO 
    104140               END DO 
    105             ENDDO 
     141            ENDIF 
     142            ! 
     143            IF( southern_side ) THEN            
     144               DO jn = 1, jptra 
     145                  tra(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 
     146                  DO jk=1,jpk       
     147                     DO ji=imin,imax 
     148                        IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     149                           tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
     150                        ELSE 
     151                           tra(ji,2,jk,jn)=(z4*tra(ji,1,jk,jn)+z3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
     152                           IF( vn(ji,2,jk) < 0.e0 ) THEN 
     153                              tra(ji,2,jk,jn)=(z6*tra(ji,3,jk,jn)+z5*tra(ji,1,jk,jn)+z7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
     154                           ENDIF 
     155                        ENDIF 
     156                     END DO 
     157                  END DO 
     158               ENDDO 
     159            ENDIF 
     160            ! 
     161            ! Treatment of corners 
     162            IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2)))  tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)            ! East south 
     163            IF ((eastern_side).AND.((nbondj ==  1).OR.(nbondj == 2)))  tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)  ! East north 
     164            IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2)))  tra(2,2,:,:) = ptab(2,2,:,:)                      ! West south 
     165            IF ((western_side).AND.((nbondj ==  1).OR.(nbondj == 2)))  tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)            ! West north 
     166            ! 
    106167         ENDIF 
    107          !  
    108          IF( northern_side ) THEN             
    109             DO jn = 1, jptra 
    110                tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
    111                DO jk = 1, jpkm1 
    112                   DO ji = imin,imax 
    113                      IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
    114                         tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
    115                      ELSE 
    116                         tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
    117                         IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
    118                            tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  & 
    119                                  + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
    120                         ENDIF 
    121                      ENDIF 
    122                   END DO 
    123                END DO 
    124             ENDDO 
    125          ENDIF 
    126          ! 
    127          IF( western_side) THEN             
    128             DO jn = 1, jptra 
    129                tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 
    130                DO jk = 1, jpkm1 
    131                   DO jj = jmin,jmax 
    132                      IF( umask(2,jj,jk) == 0.e0 ) THEN 
    133                         tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
    134                      ELSE 
    135                         tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)         
    136                         IF( un(2,jj,jk) < 0.e0 ) THEN 
    137                            tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
    138                         ENDIF 
    139                      ENDIF 
    140                   END DO 
    141                END DO 
    142             END DO 
    143          ENDIF 
    144          ! 
    145          IF( southern_side ) THEN            
    146             DO jn = 1, jptra 
    147                tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 
    148                DO jk=1,jpk       
    149                   DO ji=imin,imax 
    150                      IF( vmask(ji,2,jk) == 0.e0 ) THEN 
    151                         tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
    152                      ELSE 
    153                         tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
    154                         IF( vn(ji,2,jk) < 0.e0 ) THEN 
    155                            tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
    156                         ENDIF 
    157                      ENDIF 
    158                   END DO 
    159                END DO 
    160             ENDDO 
    161          ENDIF 
    162          ! 
    163          ! Treatment of corners 
    164          !  
    165          ! East south 
    166          IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
    167             tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 
    168          ENDIF 
    169          ! East north 
    170          IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
    171             tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 
    172          ENDIF 
    173          ! West south 
    174          IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
    175             tra(2,2,:,:) = ptab(2,2,:,:) 
    176          ENDIF 
    177          ! West north 
    178          IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
    179             tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 
    180          ENDIF 
    181          ! 
    182168      ENDIF 
    183169      ! 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r7761 r8129  
    127127   !! 
    128128   IMPLICIT NONE 
     129   ! 
     130   INTEGER :: ind1, ind2, ind3 
    129131   !!---------------------------------------------------------------------- 
    130132 
    131133   ! 1. Declaration of the type of variable which have to be interpolated 
    132134   !--------------------------------------------------------------------- 
    133    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
    134    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
     135   !!clem ghost 
     136   ind1 =     nbghostcells 
     137   ind2 = 1 + nbghostcells 
     138   ind3 = 2 + nbghostcells 
     139   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
     140   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
     141   !!clem ghost 
    135142 
    136143   ! 2. Type of interpolation 
     
    141148   ! 3. Location of interpolation 
    142149   !----------------------------- 
    143    CALL Agrif_Set_bc(e1u_id,(/0,0/)) 
    144    CALL Agrif_Set_bc(e2v_id,(/0,0/)) 
     150   !!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/)) 
     153   !!clem ghost 
    145154 
    146155   ! 5. Update type 
     
    337346   !!---------------------------------------------------------------------- 
    338347   USE agrif_util 
    339    USE par_oce       !   ONLY : jpts 
     348   USE par_oce       !   ONLY : jpts and ghostcells 
    340349   USE oce 
    341350   USE agrif_oce 
    342351   !! 
    343352   IMPLICIT NONE 
     353   ! 
     354   INTEGER :: ind1, ind2, ind3 
    344355   !!---------------------------------------------------------------------- 
    345356 
    346357   ! 1. Declaration of the type of variable which have to be interpolated 
    347358   !--------------------------------------------------------------------- 
    348    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
    349    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
    350  
    351    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 
    352    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 
    353    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 
    354    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 
    355    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 
    356    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 
    357  
    358    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
    359    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
    360    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
    361  
    362    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
    363  
    364    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
    365    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
    366    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
    367    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
    368    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
    369    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
    370  
    371    CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     359   !!clem ghost 
     360   ind1 =     nbghostcells 
     361   ind2 = 1 + nbghostcells 
     362   ind3 = 2 + nbghostcells 
     363   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
     364   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
     365 
     366   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 
     367   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 
     368   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 
     369   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 
     370   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 
     371   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 
     372 
     373   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     374   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
     375   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
     376 
     377   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
     378 
     379   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
     380   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
     381   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
     382   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
     383   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
     384   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
     385 
     386   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
    372387 
    373388# if defined key_zdftke 
    374    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    375    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    376    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
     389   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
     390   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
     391   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
    377392# endif 
     393   !!clem ghost 
    378394 
    379395   ! 2. Type of interpolation 
     
    407423   ! 3. Location of interpolation 
    408424   !----------------------------- 
    409    CALL Agrif_Set_bc(tsn_id,(/0,1/)) 
    410    CALL Agrif_Set_bc(un_interp_id,(/0,1/)) 
    411    CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 
    412  
    413 !   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 
    414 !   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
    415 !   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
    416    CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     425   !!clem ghost 
     426   CALL Agrif_Set_bc(tsn_id,(/0,ind1/)) 
     427   CALL Agrif_Set_bc(un_interp_id,(/0,ind1/)) 
     428   CALL Agrif_Set_bc(vn_interp_id,(/0,ind1/)) 
     429 
     430   ! clem: previously set to /-,0/ 
     431   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9  
    417432   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    418433   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    419434 
    420    CALL Agrif_Set_bc(sshn_id,(/0,0/)) 
    421    CALL Agrif_Set_bc(unb_id ,(/0,0/)) 
    422    CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 
    423    CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 
    424    CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 
    425  
    426    CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9 
    427    CALL Agrif_Set_bc(umsk_id,(/0,0/)) 
    428    CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 
    429  
     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/)) 
     444 
     445   ! clem: previously set to /0,1/ 
    430446# if defined key_zdftke 
    431    CALL Agrif_Set_bc(avm_id ,(/0,1/)) 
     447   CALL Agrif_Set_bc(avm_id ,(/0,ind1/)) 
    432448# endif 
     449   !!clem ghost 
    433450 
    434451   ! 5. Update type 
     
    623640   USE Agrif_Util 
    624641   USE ice 
    625  
    626    IMPLICIT NONE 
     642   USE par_oce, ONLY : nbghostcells 
     643   ! 
     644   IMPLICIT NONE 
     645   ! 
     646   INTEGER :: ind1, ind2, ind3 
    627647   !!---------------------------------------------------------------------- 
    628648   ! 
     
    634654   !                            2,2 = two ghost lines 
    635655   !------------------------------------------------------------------------------------- 
    636    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 
    637    CALL agrif_declare_variable((/1,2/)    ,(/2,3/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   ) 
    638    CALL agrif_declare_variable((/2,1/)    ,(/3,2/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   ) 
     656   !!clem ghost 
     657   ind1 =     nbghostcells 
     658   ind2 = 1 + nbghostcells 
     659   ind3 = 2 + nbghostcells 
     660   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 
     661   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   ) 
     662   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   ) 
     663   !!clem ghost 
    639664 
    640665   ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
     
    646671   ! 3. Set location of interpolations 
    647672   !---------------------------------- 
    648    CALL Agrif_Set_bc(tra_ice_id,(/0,1/)) 
    649    CALL Agrif_Set_bc(u_ice_id  ,(/0,1/)) 
    650    CALL Agrif_Set_bc(v_ice_id  ,(/0,1/)) 
     673   !!clem ghost 
     674   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 
     675   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
     676   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
     677   !!clem ghost 
    651678 
    652679   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
     
    777804   !! 
    778805   IMPLICIT NONE 
     806   ! 
     807   INTEGER :: ind1, ind2, ind3 
    779808   !!---------------------------------------------------------------------- 
    780809 
    781810   ! 1. Declaration of the type of variable which have to be interpolated 
    782811   !--------------------------------------------------------------------- 
    783    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
    784    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
     812   !!clem ghost 
     813   ind1 =     nbghostcells 
     814   ind2 = 1 + nbghostcells 
     815   ind3 = 2 + nbghostcells 
     816   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
     817   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
    785818 
    786819   ! 2. Type of interpolation 
     
    791824   ! 3. Location of interpolation 
    792825   !----------------------------- 
    793    CALL Agrif_Set_bc(trn_id,(/0,1/)) 
    794 !   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/)) 
    795    CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     826   !!clem ghost 
     827   CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 
     828   !clem: previously set to /-,0/ 
     829   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,ind1/)) 
    796830 
    797831   ! 5. Update type 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r7753 r8129  
    10121012      CALL lim_wri_state_2( kt, id_i, nh_i ) 
    10131013#elif defined key_lim3 
    1014       CALL lim_wri_state( kt, id_i, nh_i ) 
     1014      IF( nn_ice == 3 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid 
     1015         CALL lim_wri_state( kt, id_i, nh_i ) 
     1016      ENDIF 
    10151017#else 
    10161018      CALL histend( id_i, snc4chunks=snc4set ) 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r7646 r8129  
    116116   END TYPE WGT 
    117117 
    118    INTEGER,     PARAMETER             ::   tot_wgts = 10 
     118   INTEGER,     PARAMETER             ::   tot_wgts = 20 
    119119   TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts 
    120120   INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7822 r8129  
    328328      IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization 
    329329      ! 
    330       IF( ln_isf      )   CALL sbc_isf_init               ! Compute iceshelves 
     330      IF( ln_isf      )   CALL sbc_isf_init            ! Compute iceshelves 
    331331      ! 
    332332                          CALL sbc_rnf_init            ! Runof initialization 
    333333      ! 
    334       IF( nn_ice == 3 )   CALL sbc_lim_init            ! LIM3 initialization 
    335       ! 
    336       IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )   ! CICE initialization 
     334      IF    ( lk_agrif .AND. nn_ice == 0 ) THEN 
     335                         IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_alloc : unable to allocate arrays' )  ! clem2017: allocate ice arrays in case agrif + lim + no-ice in child grid               
     336      ELSEIF(                nn_ice == 3 ) THEN   ;   CALL sbc_lim_init            ! LIM3 initialization 
     337      ELSEIF(                nn_ice == 4 ) THEN   ;   CALL cice_sbc_init( nsbc )   ! CICE initialization 
     338      ENDIF 
    337339      ! 
    338340      IF( ln_wave     )   CALL sbc_wave_init              ! surface wave initialisation 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r7761 r8129  
    206206      ! 
    207207#if defined key_agrif 
    208       IF( .NOT. Agrif_Root() ) THEN 
     208!!clem2017      IF( .NOT. Agrif_Root() ) THEN 
    209209                         CALL Agrif_ParentGrid_To_ChildGrid() 
    210210         IF( ln_diaobs ) CALL dia_obs_wri 
    211211         IF( nn_timing == 1 )   CALL timing_finalize 
    212212                                CALL Agrif_ChildGrid_To_ParentGrid() 
    213       ENDIF 
     213!!clem2017      ENDIF 
    214214#endif 
    215215      IF( nn_timing == 1 )   CALL timing_finalize 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/SAS_SRC/diawri.F90

    r7761 r8129  
    400400      CALL lim_wri_state_2( kt, id_i, nh_i ) 
    401401#elif defined key_lim3 
    402       CALL lim_wri_state( kt, id_i, nh_i ) 
     402      IF( nn_ice == 3 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid 
     403         CALL lim_wri_state( kt, id_i, nh_i ) 
     404      ENDIF 
    403405#else 
    404406      CALL histend( id_i, snc4chunks=snc4set ) 
  • branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r7761 r8129  
    134134      ! 
    135135#if defined key_agrif 
    136       IF( .NOT. Agrif_Root() ) THEN 
     136!!clem2017      IF( .NOT. Agrif_Root() ) THEN 
    137137         CALL Agrif_ParentGrid_To_ChildGrid() 
    138138         IF( nn_timing == 1 )   CALL timing_finalize 
    139139         CALL Agrif_ChildGrid_To_ParentGrid() 
    140       ENDIF 
     140!!clem2017      ENDIF 
    141141#endif 
    142142      IF( nn_timing == 1 )   CALL timing_finalize 
Note: See TracChangeset for help on using the changeset viewer.