New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9057 – NEMO

Changeset 9057


Ignore:
Timestamp:
2017-12-14T16:34:32+01:00 (6 years ago)
Author:
jchanut
Message:

Clean merge with extra-ghost capability for AGRIF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r9031 r9057  
    3737   PRIVATE 
    3838 
    39    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
     39   PUBLIC   Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
     40   PUBLIC   Agrif_tra, Agrif_avm 
    4041   PUBLIC   interpun , interpvn 
    41    PUBLIC   interptsn, interpsshn 
     42   PUBLIC   interptsn, interpsshn, interpavm 
    4243   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    4344   PUBLIC   interpe3t, interpumsk, interpvmsk 
    44    PUBLIC   Agrif_avm, interpavm 
    45 >>>>>>> .merge-right.r9019 
    4645 
    4746   INTEGER ::   bdy_tinterp = 0 
    … …  
    8079      INTEGER ::   ji, jj, jk       ! dummy loop indices 
    8180      INTEGER ::   j1, j2, i1, i2 
     81      INTEGER ::   ibdy1, jbdy1, ibdy2, jbdy2 
    8282      REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb 
    8383      !!----------------------------------------------------------------------   
    … …  
    9696      i1 =  1   ;   i2 = jpi 
    9797      j1 =  1   ;   j2 = jpj 
    98       IF( nbondj == -1 .OR. nbondj == 2 )   j1 = 3 
    99       IF( nbondj == +1 .OR. nbondj == 2 )   j2 = nlcj-2 
    100       IF( nbondi == -1 .OR. nbondi == 2 )   i1 = 3 
    101       IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci-2 
    102  
     98      IF( nbondj == -1 .OR. nbondj == 2 )   j1 = 2 + nbghostcells 
     99      IF( nbondj == +1 .OR. nbondj == 2 )   j2 = nlcj - nbghostcells - 1 
     100      IF( nbondi == -1 .OR. nbondi == 2 )   i1 = 2 + nbghostcells  
     101      IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci - nbghostcells - 1 
     102 
     103      ! --- West --- ! 
    103104      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
     105         ibdy1 = 2 
     106         ibdy2 = 1+nbghostcells  
    104107         ! 
    105108         ! Smoothing 
    106109         ! --------- 
    107110         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    108             ua_b(2:1+nbghostcells,:) = 0._wp 
     111            ua_b(ibdy1:ibdy2,:) = 0._wp 
    109112            DO jk = 1, jpkm1 
    110113               DO jj = 1, jpj 
    111                   ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) + e3u_a(2:1+nbghostcells,jj,jk) * ua(2:1+nbghostcells,jj,jk) 
     114                  ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) 
    112115               END DO 
    113116            END DO 
    114117            DO jj = 1, jpj 
    115                ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) * r1_hu_a(2:1+nbghostcells,jj) 
    116             END DO 
    117          ENDIF 
    118          ! 
    119          ! Smoothing if only 1 ghostcell 
    120          ! ----------------------------- 
    121          IF( nbghostcells == 1 ) THEN 
     118               ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
     119            END DO 
     120         ENDIF 
     121         ! 
     122         IF( .NOT.lk_agrif_clp ) THEN 
    122123            DO jk=1,jpkm1                 ! Smooth 
    123124               DO jj=j1,j2 
    124                   ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 
    125                   ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
    126                END DO 
    127             END DO 
    128             ! 
    129             zub(2,:) = 0._wp              ! Correct transport 
     125                  ua(ibdy2,jj,jk) = 0.25_wp*(ua(ibdy2-1,jj,jk)+2._wp*ua(ibdy2,jj,jk)+ua(ibdy2+1,jj,jk)) 
     126                  ua(ibdy2,jj,jk) = ua(ibdy2,jj,jk) * umask(ibdy2,jj,jk) 
     127               END DO 
     128            END DO 
     129         ENDIF 
     130         ! 
     131         zub(ibdy1:ibdy2,:) = 0._wp              ! Correct transport 
     132         DO jk = 1, jpkm1 
     133            DO jj = 1, jpj 
     134               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk) 
     135            END DO 
     136         END DO 
     137         DO jj=1,jpj 
     138            zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
     139         END DO 
     140             
     141         DO jk = 1, jpkm1 
     142            DO jj = 1, jpj 
     143               ua(ibdy1:ibdy2,jj,jk) = (ua(ibdy1:ibdy2,jj,jk)+ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 
     144            END DO 
     145         END DO 
     146             
     147         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     148            zvb(ibdy1:ibdy2,:) = 0._wp 
    130149            DO jk = 1, jpkm1 
    131150               DO jj = 1, jpj 
    132                   zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
    133                END DO 
    134             END DO 
    135             DO jj=1,jpj 
    136                zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 
    137             END DO 
    138              
     151                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) 
     152               END DO 
     153            END DO 
     154            DO jj = 1, jpj 
     155               zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj) 
     156            END DO 
    139157            DO jk = 1, jpkm1 
    140158               DO jj = 1, jpj 
    141                   ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 
    142                END DO 
    143             END DO 
    144              
    145             IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    146                zvb(2,:) = 0._wp 
    147                DO jk = 1, jpkm1 
    148                   DO jj = 1, jpj 
    149                      zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 
    150                   END DO 
    151                END DO 
     159                  va(ibdy1:ibdy2,jj,jk) = (va(ibdy1:ibdy2,jj,jk)+va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 
     160               END DO 
     161            END DO 
     162         ENDIF 
     163         ! 
     164      ENDIF 
     165 
     166      ! --- East --- ! 
     167      IF( nbondi ==  1 .OR. nbondi == 2 ) THEN 
     168         ibdy1 = nlci-1-nbghostcells 
     169         ibdy2 = nlci-2  
     170         ! 
     171         ! Smoothing 
     172         ! --------- 
     173         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     174            ua_b(ibdy1:ibdy2,:) = 0._wp 
     175            DO jk = 1, jpkm1 
    152176               DO jj = 1, jpj 
    153                   zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 
    154                END DO 
    155                DO jk = 1, jpkm1 
    156                   DO jj = 1, jpj 
    157                      va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 
    158                   END DO 
    159                END DO 
    160             ENDIF 
    161             ! 
    162          ENDIF 
    163          ! 
    164          ! Mask domain edges: 
    165          !------------------- 
    166 !         DO jk = 1, jpkm1 
    167 !            DO jj = 1, jpj 
    168 !               ua(1,jj,jk) = 0._wp 
    169 !               va(1,jj,jk) = 0._wp 
    170 !            END DO 
    171 !         END DO 
    172          ! 
    173       ENDIF 
    174  
    175       ! --- East --- ! 
    176       IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    177  
    178          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    179             ua_b(nlci-nbghostcells-1:nlci-2,:) = 0._wp 
    180             DO jk=1,jpkm1 
    181                DO jj=1,jpj 
    182                   ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) + e3u_a(nlci-nbghostcells-1:nlci-2,jj,jk)  & 
    183                      &                                                                         * ua(nlci-nbghostcells-1:nlci-2,jj,jk) 
    184                END DO 
    185             END DO 
    186             DO jj=1,jpj 
    187                ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) * r1_hu_a(nlci-nbghostcells-1:nlci-2,jj)  
    188             END DO 
    189          ENDIF 
    190          ! 
    191          ! Smoothing if only 1 ghostcell 
    192          ! ----------------------------- 
    193          IF( nbghostcells == 1 ) THEN 
    194             DO jk = 1, jpkm1              ! Smooth 
    195                DO jj = j1, j2 
    196                   ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      & 
    197                      &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 
    198                END DO 
    199             END DO 
    200          ENDIF 
    201          zub(nlci-2,:) = 0._wp        ! Correct transport 
     177                  ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) 
     178               END DO 
     179            END DO 
     180            DO jj = 1, jpj 
     181               ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
     182            END DO 
     183         ENDIF 
     184         ! 
     185         IF( .NOT.lk_agrif_clp ) THEN 
     186            DO jk=1,jpkm1                 ! Smooth 
     187               DO jj=j1,j2 
     188                  ua(ibdy1,jj,jk) = 0.25_wp*(ua(ibdy1-1,jj,jk)+2._wp*ua(ibdy1,jj,jk)+ua(ibdy1+1,jj,jk)) 
     189                  ua(ibdy1,jj,jk) = ua(ibdy1,jj,jk) * umask(ibdy1,jj,jk) 
     190               END DO 
     191            END DO 
     192         ENDIF 
     193         ! 
     194         zub(ibdy1:ibdy2,:) = 0._wp              ! Correct transport 
    202195         DO jk = 1, jpkm1 
    203196            DO jj = 1, jpj 
    204                zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
    205             END DO 
    206          END DO 
    207          DO jj = 1, jpj 
    208             zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 
    209          END DO 
    210  
     197               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk) 
     198            END DO 
     199         END DO 
     200         DO jj=1,jpj 
     201            zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
     202         END DO 
     203             
    211204         DO jk = 1, jpkm1 
    212205            DO jj = 1, jpj 
    213                ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 
    214             END DO 
    215          END DO 
    216          ! 
    217          ! Set tangential velocities to time splitting estimate 
    218          !----------------------------------------------------- 
    219          IF( ln_dynspg_ts ) THEN 
    220             zvb(nlci-1,:) = 0._wp 
     206               ua(ibdy1:ibdy2,jj,jk) = (ua(ibdy1:ibdy2,jj,jk)+ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 
     207            END DO 
     208         END DO 
     209             
     210         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     211            ibdy1 = ibdy1 + 1 
     212            ibdy2 = ibdy2 + 1  
     213            zvb(ibdy1:ibdy2,:) = 0._wp 
    221214            DO jk = 1, jpkm1 
    222215               DO jj = 1, jpj 
    223                   zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
     216                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) 
    224217               END DO 
    225218            END DO 
    226219            DO jj = 1, jpj 
    227                zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 
    228             END DO 
    229              
     220               zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj) 
     221            END DO 
    230222            DO jk = 1, jpkm1 
    231223               DO jj = 1, jpj 
    232                   ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 
    233                END DO 
    234             END DO 
    235             ! 
    236             IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    237                zvb(nlci-1,:) = 0._wp 
    238                DO jk = 1, jpkm1 
    239                   DO jj = 1, jpj 
    240                      zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 
    241                   END DO 
    242                END DO 
    243                DO jj=1,jpj 
    244                   zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 
    245                END DO 
    246                DO jk = 1, jpkm1 
    247                   DO jj = 1, jpj 
    248                      va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 
    249                   END DO 
    250                END DO 
    251             ENDIF 
    252             ! 
    253          ENDIF 
    254          ! 
    255          ! Mask domain edges: 
    256          !------------------- 
    257 !         DO jk = 1, jpkm1 
    258 !            DO jj = 1, jpj 
    259 !               ua(nlci-1,jj,jk) = 0._wp 
    260 !               va(nlci  ,jj,jk) = 0._wp 
    261 !            END DO 
    262 !         END DO 
     224                  va(ibdy1:ibdy2,jj,jk) = (va(ibdy1:ibdy2,jj,jk)+va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 
     225               END DO 
     226            END DO 
     227         ENDIF 
    263228         ! 
    264229      ENDIF 
    … …  
    266231      ! --- South --- ! 
    267232      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    268  
     233         jbdy1 = 2 
     234         jbdy2 = 1+nbghostcells  
     235         ! 
     236         ! Smoothing 
     237         ! --------- 
    269238         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    270             va_b(:,2:nbghostcells+1) = 0._wp 
     239            va_b(:,jbdy1:jbdy2) = 0._wp 
    271240            DO jk = 1, jpkm1 
    272241               DO ji = 1, jpi 
    273                   va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) + e3v_a(ji,2:nbghostcells+1,jk) * va(ji,2:nbghostcells+1,jk) 
     242                  va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) 
    274243               END DO 
    275244            END DO 
    276245            DO ji=1,jpi 
    277                va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) * r1_hv_a(ji,2:nbghostcells+1) 
    278             END DO 
    279          ENDIF 
    280          ! 
    281          IF (.NOT.lk_agrif_clp) THEN 
     246               va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
     247            END DO 
     248         ENDIF 
     249         ! 
     250         IF ( .NOT.lk_agrif_clp ) THEN 
    282251            DO jk = 1, jpkm1              ! Smooth 
    283252               DO ji = i1, i2 
    284                   va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    & 
    285                      &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 
    286                END DO 
    287             END DO 
    288          ENDIF 
    289          ! 
    290          zvb(:,2) = 0._wp              ! Correct transport 
     253                  va(ji,jbdy2,jk) = 0.25_wp * vmask(ji,jbdy2,jk)    & 
     254                     &        * ( va(ji,jbdy2-1,jk) + 2._wp*va(ji,jbdy2,jk) + va(ji,jbdy2+1,jk) ) 
     255               END DO 
     256            END DO 
     257         ENDIF 
     258         ! 
     259         zvb(:,jbdy1:jbdy2) = 0._wp              ! Correct transport 
    291260         DO jk=1,jpkm1 
    292261            DO ji=1,jpi 
    293                zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 
    294             END DO 
     262               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     263            END DO 
     264         END DO 
     265         DO ji = 1, jpi 
     266            zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
     267         END DO 
     268         DO jk = 1, jpkm1 
    295269            DO ji = 1, jpi 
    296                zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 
    297             END DO 
     270               va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
     271            END DO 
     272         END DO 
     273             
     274         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     275            zub(:,2) = 0._wp 
    298276            DO jk = 1, jpkm1 
    299277               DO ji = 1, jpi 
    300                   va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 
    301                END DO 
    302             END DO 
    303              
    304             IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    305                zub(:,2) = 0._wp 
    306                DO jk = 1, jpkm1 
    307                   DO ji = 1, jpi 
    308                      zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 
    309                   END DO 
    310                END DO 
    311                DO ji = 1, jpi 
    312                   zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 
    313                END DO 
     278                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
     279               END DO 
     280            END DO 
     281            DO ji = 1, jpi 
     282               zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2) 
     283            END DO 
    314284                
    315                DO jk = 1, jpkm1 
    316                   DO ji = 1, jpi 
    317                      ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 
    318                   END DO 
    319                END DO 
    320             ENDIF 
    321             ! 
    322          ENDIF 
    323          ! 
    324          ! Mask domain edges: 
    325          !------------------- 
    326 !         DO jk = 1, jpkm1 
    327 !            DO ji = 1, jpi 
    328 !               ua(ji,1,jk) = 0._wp 
    329 !               va(ji,1,jk) = 0._wp 
    330 !            END DO 
    331 !         END DO 
    332          ! 
    333       ENDIF 
    334  
    335       ! --- North --- ! 
    336       IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    337          ! 
    338          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    339             va_b(:,nlcj-nbghostcells-1:nlcj-2) = 0._wp 
    340285            DO jk = 1, jpkm1 
    341286               DO ji = 1, jpi 
    342                   va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) + e3v_a(ji,nlcj-nbghostcells-1:nlcj-2,jk)  & 
    343                      &                                                                         * va(ji,nlcj-nbghostcells-1:nlcj-2,jk) 
    344                END DO 
    345             END DO 
    346             DO ji = 1, jpi 
    347                va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj-2) 
    348             END DO 
    349          ENDIF 
    350          ! 
    351          IF (.NOT.lk_agrif_clp) THEN 
     287                  ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
     288               END DO 
     289            END DO 
     290         ENDIF 
     291         ! 
     292      ENDIF 
     293 
     294      ! --- North --- ! 
     295      IF( nbondj ==  1 .OR. nbondj == 2 ) THEN 
     296         jbdy1 = nlcj-1-nbghostcells 
     297         jbdy2 = nlcj-2  
     298         ! 
     299         ! Smoothing 
     300         ! --------- 
     301         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     302            va_b(:,jbdy1:jbdy2) = 0._wp 
     303            DO jk = 1, jpkm1 
     304               DO ji = 1, jpi 
     305                  va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) 
     306               END DO 
     307            END DO 
     308            DO ji=1,jpi 
     309               va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
     310            END DO 
     311         ENDIF 
     312         ! 
     313         IF ( .NOT.lk_agrif_clp ) THEN 
    352314            DO jk = 1, jpkm1              ! Smooth 
    353315               DO ji = i1, i2 
    354                   va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   & 
    355                      &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 
    356                END DO 
    357             END DO 
    358          END IF 
    359          ! 
    360          zvb(:,nlcj-2) = 0._wp         ! Correct transport 
     316                  va(ji,jbdy1,jk) = 0.25_wp * vmask(ji,jbdy1,jk)    & 
     317                     &        * ( va(ji,jbdy1-1,jk) + 2._wp*va(ji,jbdy1,jk) + va(ji,jbdy1+1,jk) ) 
     318               END DO 
     319            END DO 
     320         ENDIF 
     321         ! 
     322         zvb(:,jbdy1:jbdy2) = 0._wp              ! Correct transport 
     323         DO jk=1,jpkm1 
     324            DO ji=1,jpi 
     325               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     326            END DO 
     327         END DO 
     328         DO ji = 1, jpi 
     329            zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
     330         END DO 
    361331         DO jk = 1, jpkm1 
    362332            DO ji = 1, jpi 
    363                zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
    364             END DO 
    365             DO ji = 1, jpi 
    366                zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 
    367             END DO 
     333               va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
     334            END DO 
     335         END DO 
     336             
     337         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     338            jbdy1 = jbdy1 + 1 
     339            jbdy2 = jbdy2 + 1  
     340            zub(:,2) = 0._wp 
    368341            DO jk = 1, jpkm1 
    369342               DO ji = 1, jpi 
    370                   va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 
    371                END DO 
    372             END DO 
    373             ! 
    374             IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    375                zub(:,nlcj-1) = 0._wp 
    376                DO jk = 1, jpkm1 
    377                   DO ji = 1, jpi 
    378                      zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 
    379                   END DO 
    380                END DO 
     343                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
     344               END DO 
     345            END DO 
     346            DO ji = 1, jpi 
     347               zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2) 
     348            END DO 
     349                
     350            DO jk = 1, jpkm1 
    381351               DO ji = 1, jpi 
    382                   zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 
    383                END DO 
    384                ! 
    385                DO jk = 1, jpkm1 
    386                   DO ji = 1, jpi 
    387                      ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 
    388                   END DO 
    389                END DO 
    390             ENDIF 
    391             ! 
    392          ENDIF 
    393          ! 
    394          ! Mask domain edges: 
    395          !------------------- 
    396 !         DO jk = 1, jpkm1 
    397 !            DO ji = 1, jpi 
    398 !               ua(ji,nlcj  ,jk) = 0._wp 
    399 !               va(ji,nlcj-1,jk) = 0._wp 
    400 !            END DO 
    401 !         END DO 
     352                  ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
     353               END DO 
     354            END DO 
     355         ENDIF 
    402356         ! 
    403357      ENDIF 
    … …  
    416370      ! 
    417371      IF( Agrif_Root() )   RETURN 
    418       !! clem ghost 
     372      ! 
    419373      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    420374         DO jj=1,jpj 
    … …  
    515469      INTEGER, INTENT(in) ::   kt 
    516470      ! 
    517       INTEGER  :: ji, jj, indx 
    518       INTEGER :: ji, jj 
     471      INTEGER  :: ji, jj, indx, indy 
    519472      !!----------------------------------------------------------------------   
    520473      ! 
    … …  
    549502      ! --- South --- ! 
    550503      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    551          indx = 1+nbghostcells 
    552          DO jj = 2, indx 
     504         indy = 1+nbghostcells 
     505         DO jj = 2, indy 
    553506            DO ji = 1, jpi 
    554                ssha(ji,indx) = hbdy_s(ji) 
     507               ssha(ji,indy) = hbdy_s(ji) 
    555508            ENDDO 
    556509         ENDDO 
    … …  
    559512      ! --- North --- ! 
    560513      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    561          indx = nlcj-nbghostcells 
     514         indy = nlcj-nbghostcells 
    562515         DO jj = indx, nlcj-1 
    563516            DO ji = 1, jpi 
    564                ssha(ji,indx) = hbdy_n(ji) 
     517               ssha(ji,indy) = hbdy_n(ji) 
    565518            ENDDO 
    566519         ENDDO 
    … …  
    709662# endif 
    710663         ! 
    711          IF( nbghostcells > 1 ) THEN  ! no smoothing 
     664         IF( lk_agrif_clp ) THEN  ! Clamped bcs 
    712665            tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab_child(i1:i2,j1:j2,k1:k2,n1:n2) 
    713666         ELSE                         ! smoothing 
    … …  
    727680            !  
    728681            ! Remove CORNERS 
    729             IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
    730             IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
    731             IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
    732             IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
     682            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells 
     683            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1 
     684            IF((nbondi == -1).OR.(nbondi == 2)) imin = 1 + nbghostcells 
     685            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1       
    733686            ! 
    734687            IF( eastern_side ) THEN 
    … …  
    856809         !! clem ghost 
    857810         IF(western_side)  hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1) 
    858          IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) !clem previously i1 
    859          IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1 
     811         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 
     812         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1)  
    860813         IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
    861814      ENDIF 
    … …  
    10691022            ztcoeff = 1 
    10701023         ENDIF 
    1071          !! clem ghost    
     1024         !    
    10721025         IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)   
    1073          IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1  
    1074          IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 
     1026         IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
     1027         IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) 
    10751028         IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    10761029         !             
    … …  
    11231076         !! clem ghost 
    11241077         IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)   
    1125          IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1   
    1126          IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 
     1078         IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)    
     1079         IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) 
    11271080         IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    11281081         !             
    … …  
    11711124         !! clem ghost 
    11721125         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i2,j1:j2)   
    1173          IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1  
    1174          IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 
     1126         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
     1127         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) 
    11751128         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    11761129      ENDIF 
    … …  
    12131166         ! 
    12141167         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i2,j1:j2)   
    1215          IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1  
    1216          IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1  
     1168         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
     1169         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) 
    12171170         IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    12181171      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.