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

Changeset 11219


Ignore:
Timestamp:
2019-07-05T14:07:17+02:00 (5 years ago)
Author:
jchanut
Message:

#2199
1) Define aditionnal arrays to correct the time interpolation of barotropic arrays in corners. Since multiple stages in the time interpolation are necessary, overlapping segments in corners give wrong results otherwise (corrects stage 2 in previous commit)..
2) Added subroutine to correct time extrapolated fluxes at bdy in time splitting routine (updates stage 3 in previous commit).
3) Completly remove non-specified open boundary case. Boundares are now exactly set from parent (no more filtering nor extrapolation for outgoing flows).
At this stage, use of nbondi, nbondj variables has been completly removed.

Location:
NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_oce.F90

    r11205 r11219  
    2626   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics 
    2727   LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry  
    28    LOGICAL , PUBLIC ::   lk_agrif_clp  = .FALSE.   !: Force clamped bcs 
    2928   !                                              !!! OLD namelist names 
    3029   REAL(wp), PUBLIC ::   visc_tra                  !: sponge coeff. for tracers 
    … …  
    4241   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u 
    4342   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v 
     43   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utint_stage 
     44   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtint_stage 
    4445   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities 
    4546   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities 
    … …  
    7980      ierr(:) = 0 
    8081      ! 
    81       ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),   & 
    82          &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),   & 
    83          &      tabspongedone_tsn(jpi,jpj),           & 
     82      ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),     & 
     83         &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),     & 
     84         &      tabspongedone_tsn(jpi,jpj),                 & 
     85         &      utint_stage(jpi,jpj), vtint_stage(jpi,jpj), & 
    8486# if defined key_top          
    8587         &      tabspongedone_trn(jpi,jpj),           & 

  • NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_oce_interp.F90

    r11205 r11219  
    3737   PRIVATE 
    3838 
    39    PUBLIC   Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
     39   PUBLIC   Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_dyn_ts_flux, Agrif_ssh_ts, Agrif_dta_ts 
    4040   PUBLIC   Agrif_tra, Agrif_avm 
    4141   PUBLIC   interpun , interpvn 
    … …  
    4343   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    4444   PUBLIC   interpe3t, interpumsk, interpvmsk 
    45  
    46    INTEGER ::   bdy_tinterp = 0 
    4745 
    4846#  include "vectopt_loop_substitute.h90" 
    … …  
    7876      ! 
    7977      INTEGER ::   ji, jj, jk       ! dummy loop indices 
    80       INTEGER ::   j1, j2, i1, i2 
    8178      INTEGER ::   ibdy1, jbdy1, ibdy2, jbdy2 
    8279      REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb 
    … …  
    9390      Agrif_UseSpecialValue = .FALSE. 
    9491      ! 
    95       ! prevent smoothing in ghost cells 
    96       i1 =  1   ;   i2 = nlci 
    97       j1 =  1   ;   j2 = nlcj 
    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  
    10392      ! --- West --- ! 
    104       IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    105          ibdy1 = 2 
    106          ibdy2 = 1+nbghostcells  
    107          ! 
    108          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    109             ua_b(ibdy1:ibdy2,:) = 0._wp 
     93      ibdy1 = 2 
     94      ibdy2 = 1+nbghostcells  
     95      ! 
     96      IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     97         DO ji = mi0(ibdy1), mi1(ibdy2) 
     98            ua_b(ji,:) = 0._wp 
     99 
    110100            DO jk = 1, jpkm1 
    111101               DO jj = 1, jpj 
    112                   ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &  
    113                       & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 
    114                END DO 
    115             END DO 
     102                  ua_b(ji,jj) = ua_b(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
     103               END DO 
     104            END DO 
     105 
    116106            DO jj = 1, jpj 
    117                ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
    118             END DO 
    119          ENDIF 
    120          ! 
    121          IF( .NOT.lk_agrif_clp ) THEN 
    122             DO jk=1,jpkm1              ! Smooth 
    123                DO jj=j1,j2 
    124                   ua(ibdy2,jj,jk) = 0.25_wp*(ua(ibdy2-1,jj,jk)+2._wp*ua(ibdy2,jj,jk)+ua(ibdy2+1,jj,jk)) 
    125                END DO 
    126             END DO 
    127          ENDIF 
    128          ! 
    129          zub(ibdy1:ibdy2,:) = 0._wp    ! Correct transport 
     107               ua_b(ji,jj) = ua_b(ji,jj) * r1_hu_a(ji,jj) 
     108            END DO 
     109         END DO 
     110      ENDIF 
     111      ! 
     112      DO ji = mi0(ibdy1), mi1(ibdy2) 
     113         zub(ji,:) = 0._wp    ! Correct transport 
    130114         DO jk = 1, jpkm1 
    131115            DO jj = 1, jpj 
    132                zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &  
    133                   & + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk)*umask(ibdy1:ibdy2,jj,jk) 
     116               zub(ji,jj) = zub(ji,jj) &  
     117                  & + e3u_a(ji,jj,jk)  * ua(ji,jj,jk)*umask(ji,jj,jk) 
    134118            END DO 
    135119         END DO 
    136120         DO jj=1,jpj 
    137             zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
     121            zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 
    138122         END DO 
    139123             
    140124         DO jk = 1, jpkm1 
    141125            DO jj = 1, jpj 
    142                ua(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) & 
    143                  & + ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk) 
    144             END DO 
    145          END DO 
     126               ua(ji,jj,jk) = ( ua(ji,jj,jk) + ua_b(ji,jj)-zub(ji,jj)) * umask(ji,jj,jk) 
     127            END DO 
     128         END DO 
     129      END DO 
    146130             
    147          IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    148             zvb(ibdy1:ibdy2,:) = 0._wp 
     131      IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     132         DO ji = mi0(ibdy1), mi1(ibdy2) 
     133            zvb(ji,:) = 0._wp 
    149134            DO jk = 1, jpkm1 
    150135               DO jj = 1, jpj 
    151                   zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) &  
    152                      & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 
     136                  zvb(ji,jj) = zvb(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
    153137               END DO 
    154138            END DO 
    155139            DO jj = 1, jpj 
    156                zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj) 
     140               zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 
    157141            END DO 
    158142            DO jk = 1, jpkm1 
    159143               DO jj = 1, jpj 
    160                   va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) &  
    161                     & + va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk) 
    162                END DO 
    163             END DO 
    164          ENDIF 
    165          ! 
    166          DO jk = 1, jpkm1              ! Mask domain edges 
    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  
     144                  va(ji,jj,jk) = ( va(ji,jj,jk) + va_b(ji,jj)-zvb(ji,jj))*vmask(ji,jj,jk) 
     145               END DO 
     146            END DO 
     147         END DO 
    172148      ENDIF 
    173149 
    174150      ! --- East --- ! 
    175       IF( nbondi ==  1 .OR. nbondi == 2 ) THEN 
    176          ibdy1 = nlci-1-nbghostcells 
    177          ibdy2 = nlci-2  
    178          ! 
    179          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    180             ua_b(ibdy1:ibdy2,:) = 0._wp 
     151      ibdy1 = jpiglo-1-nbghostcells 
     152      ibdy2 = jpiglo-2  
     153      ! 
     154      IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     155         DO ji = mi0(ibdy1), mi1(ibdy2) 
     156            ua_b(ji,:) = 0._wp 
    181157            DO jk = 1, jpkm1 
    182158               DO jj = 1, jpj 
    183                   ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &  
    184                       & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 
     159                  ua_b(ji,jj) = ua_b(ji,jj) &  
     160                      & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    185161               END DO 
    186162            END DO 
    187163            DO jj = 1, jpj 
    188                ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
    189             END DO 
    190          ENDIF 
    191          ! 
    192          IF( .NOT.lk_agrif_clp ) THEN 
    193             DO jk=1,jpkm1              ! Smooth 
    194                DO jj=j1,j2 
    195                   ua(ibdy1,jj,jk) = 0.25_wp*(ua(ibdy1-1,jj,jk)+2._wp*ua(ibdy1,jj,jk)+ua(ibdy1+1,jj,jk)) 
    196                END DO 
    197             END DO 
    198          ENDIF 
    199          ! 
    200          zub(ibdy1:ibdy2,:) = 0._wp    ! Correct transport 
     164               ua_b(ji,jj) = ua_b(ji,jj) * r1_hu_a(ji,jj) 
     165            END DO 
     166         END DO 
     167      ENDIF 
     168      ! 
     169      DO ji = mi0(ibdy1), mi1(ibdy2) 
     170         zub(ji,:) = 0._wp    ! Correct transport 
    201171         DO jk = 1, jpkm1 
    202172            DO jj = 1, jpj 
    203                zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &  
    204                   & + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 
     173               zub(ji,jj) = zub(ji,jj) &  
     174                  & + e3u_a(ji,jj,jk)  * ua(ji,jj,jk) * umask(ji,jj,jk) 
    205175            END DO 
    206176         END DO 
    207177         DO jj=1,jpj 
    208             zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
     178            zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 
    209179         END DO 
    210180             
    211181         DO jk = 1, jpkm1 
    212182            DO jj = 1, jpj 
    213                ua(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) &  
    214                  & + ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 
    215             END DO 
    216          END DO 
     183               ua(ji,jj,jk) = ( ua(ji,jj,jk) &  
     184                 & + ua_b(ji,jj)-zub(ji,jj))*umask(ji,jj,jk) 
     185            END DO 
     186         END DO 
     187      END DO 
    217188             
    218          IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    219             ibdy1 = ibdy1 + 1 
    220             ibdy2 = ibdy2 + 1  
    221             zvb(ibdy1:ibdy2,:) = 0._wp 
     189      IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     190         ibdy1 = jpiglo-nbghostcells 
     191         ibdy2 = jpiglo-1  
     192         DO ji = mi0(ibdy1), mi1(ibdy2) 
     193            zvb(ji,:) = 0._wp 
    222194            DO jk = 1, jpkm1 
    223195               DO jj = 1, jpj 
    224                   zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 
    225                      & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 
     196                  zvb(ji,jj) = zvb(ji,jj) & 
     197                     & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
    226198               END DO 
    227199            END DO 
    228200            DO jj = 1, jpj 
    229                zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj) 
     201               zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 
    230202            END DO 
    231203            DO jk = 1, jpkm1 
    232204               DO jj = 1, jpj 
    233                   va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) &  
    234                       & + va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 
    235                END DO 
    236             END DO 
    237          ENDIF 
    238          ! 
    239          DO jk = 1, jpkm1              ! Mask domain edges 
    240             DO jj = 1, jpj 
    241                ua(nlci-1,jj,jk) = 0._wp 
    242                va(nlci  ,jj,jk) = 0._wp 
    243             END DO 
    244          END DO  
     205                  va(ji,jj,jk) = ( va(ji,jj,jk) &  
     206                      & + va_b(ji,jj)-zvb(ji,jj)) * vmask(ji,jj,jk) 
     207               END DO 
     208            END DO 
     209         END DO 
    245210      ENDIF 
    246211 
    247212      ! --- South --- ! 
    248       IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    249          jbdy1 = 2 
    250          jbdy2 = 1+nbghostcells  
    251          ! 
    252          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    253             va_b(:,jbdy1:jbdy2) = 0._wp 
     213      jbdy1 = 2 
     214      jbdy2 = 1+nbghostcells  
     215      ! 
     216      IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     217         DO jj = mj0(jbdy1), mj1(jbdy2) 
     218            va_b(:,jj) = 0._wp 
    254219            DO jk = 1, jpkm1 
    255220               DO ji = 1, jpi 
    256                   va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &  
    257                       & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     221                  va_b(ji,jj) = va_b(ji,jj) &  
     222                      & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
    258223               END DO 
    259224            END DO 
    260225            DO ji=1,jpi 
    261                va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
    262             END DO 
    263          ENDIF 
    264          ! 
    265          IF ( .NOT.lk_agrif_clp ) THEN 
    266             DO jk = 1, jpkm1           ! Smooth 
    267                DO ji = i1, i2 
    268                   va(ji,jbdy2,jk) = 0.25_wp*(va(ji,jbdy2-1,jk)+2._wp*va(ji,jbdy2,jk)+va(ji,jbdy2+1,jk)) 
    269                END DO 
    270             END DO 
    271          ENDIF 
    272          ! 
    273          zvb(:,jbdy1:jbdy2) = 0._wp    ! Correct transport 
     226               va_b(ji,jj) = va_b(ji,jj) * r1_hv_a(ji,jj)      
     227            END DO 
     228         END DO 
     229      ENDIF 
     230      ! 
     231      DO jj = mj0(jbdy1), mj1(jbdy2) 
     232         zvb(:,jj) = 0._wp    ! Correct transport 
    274233         DO jk=1,jpkm1 
    275234            DO ji=1,jpi 
    276                zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &  
    277                   & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     235               zvb(ji,jj) = zvb(ji,jj) &  
     236                  & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
    278237            END DO 
    279238         END DO 
    280239         DO ji = 1, jpi 
    281             zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
     240            zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 
    282241         END DO 
    283242 
    284243         DO jk = 1, jpkm1 
    285244            DO ji = 1, jpi 
    286                va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) &  
    287                  & + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
    288             END DO 
    289          END DO 
     245               va(ji,jj,jk) = ( va(ji,jj,jk) &  
     246                 & + va_b(ji,jj) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     247            END DO 
     248         END DO 
     249      END DO 
    290250             
    291          IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    292             zub(:,jbdy1:jbdy2) = 0._wp 
     251      IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     252         DO jj = mj0(jbdy1), mj1(jbdy2) 
     253            zub(:,jj) = 0._wp 
    293254            DO jk = 1, jpkm1 
    294255               DO ji = 1, jpi 
    295                   zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &  
    296                      & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
     256                  zub(ji,jj) = zub(ji,jj) &  
     257                     & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    297258               END DO 
    298259            END DO 
    299260            DO ji = 1, jpi 
    300                zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2) 
     261               zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 
    301262            END DO 
    302263                
    303264            DO jk = 1, jpkm1 
    304265               DO ji = 1, jpi 
    305                   ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) &  
    306                     & + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
    307                END DO 
    308             END DO 
    309          ENDIF 
    310          ! 
    311          DO jk = 1, jpkm1              ! Mask domain edges 
    312             DO ji = 1, jpi 
    313                ua(ji,1,jk) = 0._wp 
    314                va(ji,1,jk) = 0._wp 
    315             END DO 
    316          END DO  
     266                  ua(ji,jj,jk) = ( ua(ji,jj,jk) &  
     267                    & + ua_b(ji,jj) - zub(ji,jj) ) * umask(ji,jj,jk) 
     268               END DO 
     269            END DO 
     270         END DO 
    317271      ENDIF 
    318272 
    319273      ! --- North --- ! 
    320       IF( nbondj ==  1 .OR. nbondj == 2 ) THEN 
    321          jbdy1 = nlcj-1-nbghostcells 
    322          jbdy2 = nlcj-2  
    323          ! 
    324          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    325             va_b(:,jbdy1:jbdy2) = 0._wp 
     274      jbdy1 = nlcj-1-nbghostcells 
     275      jbdy2 = nlcj-2  
     276      ! 
     277      IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     278         DO jj = mj0(jbdy1), mj1(jbdy2) 
     279            va_b(:,jj) = 0._wp 
    326280            DO jk = 1, jpkm1 
    327281               DO ji = 1, jpi 
    328                   va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &  
    329                       & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     282                  va_b(ji,jj) = va_b(ji,jj) &  
     283                      & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
    330284               END DO 
    331285            END DO 
    332286            DO ji=1,jpi 
    333                va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
    334             END DO 
    335          ENDIF 
    336          ! 
    337          IF ( .NOT.lk_agrif_clp ) THEN 
    338             DO jk = 1, jpkm1           ! Smooth 
    339                DO ji = i1, i2 
    340                   va(ji,jbdy1,jk) = 0.25_wp*(va(ji,jbdy1-1,jk)+2._wp*va(ji,jbdy1,jk)+va(ji,jbdy1+1,jk)) 
    341                END DO 
    342             END DO 
    343          ENDIF 
    344          ! 
    345          zvb(:,jbdy1:jbdy2) = 0._wp    ! Correct transport 
     287               va_b(ji,jj) = va_b(ji,jj) * r1_hv_a(ji,jj) 
     288            END DO 
     289         END DO 
     290      ENDIF 
     291      ! 
     292      DO jj = mj0(jbdy1), mj1(jbdy2) 
     293         zvb(:,jj) = 0._wp    ! Correct transport 
    346294         DO jk=1,jpkm1 
    347295            DO ji=1,jpi 
    348                zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &  
    349                   & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     296               zvb(ji,jj) = zvb(ji,jj) &  
     297                  & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
    350298            END DO 
    351299         END DO 
    352300         DO ji = 1, jpi 
    353             zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
     301            zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 
    354302         END DO 
    355303 
    356304         DO jk = 1, jpkm1 
    357305            DO ji = 1, jpi 
    358                va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) &  
    359                  & + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
    360             END DO 
    361          END DO 
     306               va(ji,jj,jk) = ( va(ji,jj,jk) &  
     307                 & + va_b(ji,jj) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     308            END DO 
     309         END DO 
     310      END DO 
    362311             
    363          IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    364             jbdy1 = jbdy1 + 1 
    365             jbdy2 = jbdy2 + 1  
    366             zub(:,jbdy1:jbdy2) = 0._wp 
     312      IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     313         jbdy1 = jbdy1 + 1 
     314         jbdy2 = jbdy2 + 1  
     315         DO jj = mj0(jbdy1), mj1(jbdy2) 
     316            zub(:,jj) = 0._wp 
    367317            DO jk = 1, jpkm1 
    368318               DO ji = 1, jpi 
    369                   zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &  
    370                      & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
     319                  zub(ji,jj) = zub(ji,jj) &  
     320                     & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    371321               END DO 
    372322            END DO 
    373323            DO ji = 1, jpi 
    374                zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2) 
     324               zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 
    375325            END DO 
    376326                
    377327            DO jk = 1, jpkm1 
    378328               DO ji = 1, jpi 
    379                   ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) &  
    380                     & + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
    381                END DO 
    382             END DO 
    383          ENDIF 
    384          ! 
    385          DO jk = 1, jpkm1              ! Mask domain edges 
    386             DO ji = 1, jpi 
    387                ua(ji,nlcj  ,jk) = 0._wp 
    388                va(ji,nlcj-1,jk) = 0._wp 
    389             END DO 
    390          END DO  
     329                  ua(ji,jj,jk) = ( ua(ji,jj,jk) &  
     330                    & + ua_b(ji,jj) - zub(ji,jj) ) * umask(ji,jj,jk) 
     331               END DO 
     332            END DO 
     333         END DO 
    391334      ENDIF 
    392335      ! 
    … …  
    412355         DO jj=1,jpj 
    413356            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    414             ! Specified fluxes: 
    415357            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    416358         END DO 
    417359      END DO 
    418       ! Characteristics method (only at boundary point): 
    419 !      istart = 2 
    420 !      iend   = 2 
    421 !      DO ji = mi0(istart), mi1(iend) 
    422 !         DO jj=1,jpj 
    423 !            ua_e(ji,jj) = 0.5_wp * ( ubdy(ji,jj) * hur_e(ji,jj) + ua_e(ji+1,jj) & 
    424 !                        &            - sqrt(grav * hur_e(ji,jj)) * (sshn_e(ji+1,jj) - hbdy(ji,jj)) ) 
    425 !         END DO 
    426 !      END DO 
    427360      ! 
    428361      !--- East ---! 
    … …  
    441374         END DO 
    442375      END DO 
    443       ! Characteristics method (only at boundary point): 
    444 !      istart = jpiglo-2 
    445 !      iend   = jpiglo-2 
    446 !      DO ji = mi0(istart), mi1(iend) 
    447 !         DO jj=1,jpj 
    448 !            ua_e(ji,jj) = 0.5_wp * ( ubdy(ji,jj) * hur_e(ji,jj) + ua_e(ji-1,jj) & 
    449 !                        &            + sqrt(grav * hur_e(ji,jj)) * (sshn_e(ji,jj) - hbdy(ji+1,jj)) ) 
    450 !         END DO 
    451 !      END DO 
    452376      ! 
    453377      !--- South ---! 
    … …  
    457381         DO ji=1,jpi 
    458382            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    459             ! Specified fluxes: 
    460383            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    461384         END DO 
    462385      END DO 
    463       ! Characteristics method (only at boundary point): 
    464 !      jstart = 2 
    465 !      jend   = 2 
    466 !      DO jj = mj0(jstart), mj1(jend) 
    467 !         DO ji=1,jpi 
    468 !            va_e(ji,jj) = 0.5_wp * ( vbdy(ji,jj) * hvr_e(ji,jj) + va_e(ji,jj+1) & 
    469 !                        &            - sqrt(grav * hvr_e(ji,jj)) * (sshn_e(ji,jj+1) - hbdy(ji,jj)) ) 
    470 !         END DO 
    471 !      END DO 
    472386      ! 
    473387      !--- North ---! 
    … …  
    486400         END DO 
    487401      END DO 
    488       ! Characteristics method (only at boundary point): 
    489 !      jstart = jpjglo-2 
    490 !      jend   = jpjglo-2 
    491 !      DO jj = mj0(jstart), mj1(jend) 
    492 !         DO ji=1,jpi 
    493 !            va_e(ji,jj) = 0.5_wp * ( vbdy(ji,jj) * hvr_e(ji,jj) + va_e(ji,jj-1) & 
    494 !                        &            + sqrt(grav * hvr_e(ji,jj)) * (sshn_e(ji,jj) - hbdy(ji,jj+1)) ) 
    495 !         END DO 
    496 !      END DO 
    497402      ! 
    498403   END SUBROUTINE Agrif_dyn_ts 
    499404 
     405   SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv ) 
     406      !!---------------------------------------------------------------------- 
     407      !!                  ***  ROUTINE Agrif_dyn_ts_flux  *** 
     408      !!----------------------------------------------------------------------   
     409      INTEGER, INTENT(in) ::   jn 
     410      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zu, zv 
     411      !! 
     412      INTEGER :: ji, jj 
     413      INTEGER :: istart, iend, jstart, jend 
     414      !!----------------------------------------------------------------------   
     415      ! 
     416      IF( Agrif_Root() )   RETURN 
     417      ! 
     418      !--- West ---! 
     419      istart = 2 
     420      iend   = nbghostcells+1 
     421      DO ji = mi0(istart), mi1(iend) 
     422         DO jj=1,jpj 
     423            zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     424            zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     425         END DO 
     426      END DO 
     427      ! 
     428      !--- East ---! 
     429      istart = jpiglo-nbghostcells 
     430      iend   = jpiglo-1 
     431      DO ji = mi0(istart), mi1(iend) 
     432         DO jj=1,jpj 
     433            zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     434         END DO 
     435      END DO 
     436      istart = jpiglo-nbghostcells-1 
     437      iend   = jpiglo-2 
     438      DO ji = mi0(istart), mi1(iend) 
     439         DO jj=1,jpj 
     440            zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     441         END DO 
     442      END DO 
     443      ! 
     444      !--- South ---! 
     445      jstart = 2 
     446      jend   = nbghostcells+1 
     447      DO jj = mj0(jstart), mj1(jend) 
     448         DO ji=1,jpi 
     449            zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     450            zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     451         END DO 
     452      END DO 
     453      ! 
     454      !--- North ---! 
     455      jstart = jpjglo-nbghostcells 
     456      jend   = jpjglo-1 
     457      DO jj = mj0(jstart), mj1(jend) 
     458         DO ji=1,jpi 
     459            zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     460         END DO 
     461      END DO 
     462      jstart = jpjglo-nbghostcells-1 
     463      jend   = jpjglo-2 
     464      DO jj = mj0(jstart), mj1(jend) 
     465         DO ji=1,jpi 
     466            zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     467         END DO 
     468      END DO 
     469      ! 
     470   END SUBROUTINE Agrif_dyn_ts_flux 
    500471 
    501472   SUBROUTINE Agrif_dta_ts( kt ) 
    … …  
    517488      ! 
    518489      ! Interpolate barotropic fluxes 
    519       Agrif_SpecialValue=0._wp 
     490      Agrif_SpecialValue = 0._wp 
    520491      Agrif_UseSpecialValue = ln_spc_dyn 
     492      ! 
     493      ! Set bdy time interpolation stage to 0 (latter incremented locally do deal with corners) 
     494      utint_stage(:,:) = 0 
     495      vtint_stage(:,:) = 0 
    521496      ! 
    522497      IF( ll_int_cons ) THEN  ! Conservative interpolation 
    523498         ! order matters here !!!!!! 
    524499         CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 
    525          CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
    526          bdy_tinterp = 1 
     500         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b )  
     501         ! 
    527502         CALL Agrif_Bc_variable( unb_id        , calledweight=1._wp, procname=interpunb  ) ! After 
    528503         CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  ) 
    529          bdy_tinterp = 2 
     504         ! 
    530505         CALL Agrif_Bc_variable( unb_id        , calledweight=0._wp, procname=interpunb  ) ! Before 
    531506         CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )          
    532507      ELSE ! Linear interpolation 
    533          bdy_tinterp = 0 
     508         ! 
    534509         ubdy(:,:) = 0._wp   ;   vbdy(:,:) = 0._wp  
    535510         CALL Agrif_Bc_variable( unb_id, procname=interpunb ) 
    … …  
    671646    
    672647 
    673    SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
     648   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    674649      !!---------------------------------------------------------------------- 
    675650      !!                  *** ROUTINE interptsn *** 
    … …  
    678653      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
    679654      LOGICAL                                     , INTENT(in   ) ::   before 
    680       INTEGER                                     , INTENT(in   ) ::   nb , ndir 
    681       ! 
    682       INTEGER  ::   ji, jj, jk, jn, iref, jref, ibdy, jbdy   ! dummy loop indices 
    683       INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out 
    684       REAL(wp) ::   zrho, z1, z2, z3, z4, z5, z6, z7 
    685       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     655      ! 
     656      INTEGER  ::   ji, jj, jk, jn  ! dummy loop indices 
     657      INTEGER  ::   N_in, N_out 
    686658      ! vertical interpolation: 
    687659      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child 
    … …  
    689661      REAL(wp), DIMENSION(k1:k2) :: h_in 
    690662      REAL(wp), DIMENSION(1:jpk) :: h_out 
    691       REAL(wp) :: h_diff 
    692663 
    693664      IF( before ) THEN          
    … …  
    713684      ELSE  
    714685 
    715          western_side  = (nb == 1).AND.(ndir == 1)   ;   eastern_side  = (nb == 1).AND.(ndir == 2) 
    716          southern_side = (nb == 2).AND.(ndir == 1)   ;   northern_side = (nb == 2).AND.(ndir == 2) 
    717  
    718686# if defined key_vertical               
    719687         DO jj=j1,j2 
    720688            DO ji=i1,i2 
    721                iref = ji 
    722                jref = jj 
    723                if(western_side) iref=MAX(2,ji) 
    724                if(eastern_side) iref=MIN(nlci-1,ji) 
    725                if(southern_side) jref=MAX(2,jj) 
    726                if(northern_side) jref=MIN(nlcj-1,jj) 
    727689               N_in = 0 
    728690               DO jk=k1,k2 !k2 = jpk of parent grid 
    … …  
    734696               N_out = 0 
    735697               DO jk=1,jpk ! jpk of child grid 
    736                   IF (tmask(iref,jref,jk) == 0) EXIT  
     698                  IF (tmask(ji,jj,jk) == 0) EXIT  
    737699                  N_out = N_out + 1 
    738                   h_out(jk) = e3t_n(iref,jref,jk) 
     700                  h_out(jk) = e3t_n(ji,jj,jk) 
    739701               ENDDO 
    740702               IF (N_in > 0) THEN 
    … …  
    753715         END DO 
    754716 
    755          IF ( .NOT.lk_agrif_clp ) THEN  
    756             ! 
    757             imin = i1 ; imax = i2 
    758             jmin = j1 ; jmax = j2 
    759             !  
    760             ! Remove CORNERS 
    761             IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells 
    762             IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1 
    763             IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells 
    764             IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1       
    765             ! 
    766             IF( eastern_side ) THEN 
    767                zrho = Agrif_Rhox() 
    768                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    769                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    770                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    771                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    772                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    773                ! 
    774                ibdy = nlci-nbghostcells 
    775                DO jn = 1, jpts 
    776                   tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
    777                   DO jk = 1, jpkm1 
    778                      DO jj = jmin,jmax 
    779                         IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN 
    780                            tsa(ibdy,jj,jk,jn) = tsa(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk) 
    781                         ELSE 
    782                            tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy+1,jj,jk,jn)+z3*tsa(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk) 
    783                            IF( un(ibdy-1,jj,jk) > 0._wp ) THEN 
    784                               tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy-1,jj,jk,jn)+z5*tsa(ibdy+1,jj,jk,jn) &  
    785                                                  + z7*tsa(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
    786                            ENDIF 
    787                         ENDIF 
    788                      END DO 
    789                   END DO 
    790                   ! Restore ghost points: 
    791                   tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 
    792                END DO 
    793             ENDIF 
    794             !  
    795             IF( northern_side ) THEN 
    796                zrho = Agrif_Rhoy() 
    797                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    798                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    799                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    800                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    801                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    802                ! 
    803                jbdy = nlcj-nbghostcells          
    804                DO jn = 1, jpts 
    805                   tsa(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
    806                   DO jk = 1, jpkm1 
    807                      DO ji = imin,imax 
    808                         IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN 
    809                            tsa(ji,jbdy,jk,jn) = tsa(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk) 
    810                         ELSE 
    811                            tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy+1,jk,jn)+z3*tsa(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)         
    812                            IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN 
    813                               tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy-1,jk,jn)+z5*tsa(ji,jbdy+1,jk,jn)  & 
    814                                                  + z7*tsa(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk) 
    815                            ENDIF 
    816                         ENDIF 
    817                      END DO 
    818                   END DO 
    819                   ! Restore ghost points: 
    820                   tsa(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 
    821                END DO 
    822             ENDIF 
    823             ! 
    824             IF( western_side ) THEN 
    825                zrho = Agrif_Rhox() 
    826                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    827                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    828                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    829                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    830                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    831                !     
    832                ibdy = 1+nbghostcells        
    833                DO jn = 1, jpts 
    834                   tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
    835                   DO jk = 1, jpkm1 
    836                      DO jj = jmin,jmax 
    837                         IF( umask(ibdy,jj,jk) == 0._wp ) THEN 
    838                            tsa(ibdy,jj,jk,jn) = tsa(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk) 
    839                         ELSE 
    840                            tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy-1,jj,jk,jn)+z3*tsa(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)         
    841                            IF( un(ibdy,jj,jk) < 0._wp ) THEN 
    842                               tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy-1,jj,jk,jn) & 
    843                                                  + z7*tsa(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
    844                            ENDIF 
    845                         ENDIF 
    846                      END DO 
    847                   END DO 
    848                   ! Restore ghost points: 
    849                   tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 
    850                END DO 
    851             ENDIF 
    852             ! 
    853             IF( southern_side ) THEN 
    854                zrho = Agrif_Rhoy() 
    855                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    856                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    857                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    858                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    859                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    860                !   
    861                jbdy=1+nbghostcells         
    862                DO jn = 1, jpts 
    863                   tsa(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
    864                   DO jk = 1, jpkm1       
    865                      DO ji = imin,imax 
    866                         IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 
    867                            tsa(ji,jbdy,jk,jn)=tsa(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) 
    868                         ELSE 
    869                            tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy-1,jk,jn)+z3*tsa(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk) 
    870                            IF( vn(ji,jbdy,jk) < 0._wp ) THEN 
    871                               tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy-1,jk,jn) &  
    872                                                  + z7*tsa(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk) 
    873                            ENDIF 
    874                         ENDIF 
    875                      END DO 
    876                   END DO 
    877                   ! Restore ghost points: 
    878                   tsa(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 
    879                END DO 
    880             ENDIF 
    881             ! 
    882          ENDIF 
    883717      ENDIF 
    884718      ! 
    … …  
    1092926         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
    1093927         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
    1094          ! Polynomial interpolation coefficients: 
    1095          IF( bdy_tinterp == 1 ) THEN 
    1096             ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    1097                &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    1098          ELSEIF( bdy_tinterp == 2 ) THEN 
    1099             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    1100                &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
    1101          ELSE 
    1102             ztcoeff = 1 
    1103          ENDIF 
    1104          !    
    1105          ubdy(i1:i2,j1:j2) = ubdy(i1:i2,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 
    1106          !             
    1107          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    1108             ubdy(i1:i2,j1:j2) = ubdy(i1:i2,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 
    1109          ENDIF 
    1110       ENDIF 
     928         !  
     929         DO ji = i1, i2 
     930            DO jj = j1, j2 
     931               IF    ( utint_stage(ji,jj) == 1  ) THEN 
     932                  ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
     933                     &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
     934               ELSEIF( utint_stage(ji,jj) == 2  ) THEN 
     935                  ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
     936                     &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
     937               ELSEIF( utint_stage(ji,jj) == 0  ) THEN                 
     938                  ztcoeff = 1._wp 
     939               ELSE 
     940                  ztcoeff = 0._wp 
     941               ENDIF 
     942               !    
     943               ubdy(ji,jj) = ubdy(ji,jj) + ztcoeff * ptab(ji,jj) 
     944               !             
     945               IF (( utint_stage(ji,jj) == 2 ).OR.( utint_stage(ji,jj) == 0 )) THEN 
     946                  ubdy(ji,jj) = ubdy(ji,jj) / (zrhoy*e2u(ji,jj)) * umask(ji,jj,1) 
     947                  utint_stage(ji,jj) = 3 
     948               ELSE 
     949                  utint_stage(ji,jj) = utint_stage(ji,jj) + 1 
     950               ENDIF 
     951            END DO 
     952         END DO 
     953      END IF 
    1111954      !  
    1112955   END SUBROUTINE interpunb 
    … …  
    1132975         ! Time indexes bounds for integration 
    1133976         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
    1134          zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
    1135          IF( bdy_tinterp == 1 ) THEN 
    1136             ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    1137                &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    1138          ELSEIF( bdy_tinterp == 2 ) THEN 
    1139             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    1140                &               - zt0        * (       zt0 - 1._wp)**2._wp )  
    1141          ELSE 
    1142             ztcoeff = 1 
    1143          ENDIF 
    1144          vbdy(i1:i2,j1:j2) = vbdy(i1:i2,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 
    1145          !             
    1146          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    1147             vbdy(i1:i2,j1:j2) = vbdy(i1:i2,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 
    1148          ENDIF             
     977         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot  
     978         !      
     979         DO ji = i1, i2 
     980            DO jj = j1, j2 
     981               IF    ( vtint_stage(ji,jj) == 1  ) THEN 
     982                  ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
     983                     &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
     984               ELSEIF( vtint_stage(ji,jj) == 2  ) THEN 
     985                  ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
     986                     &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
     987               ELSEIF( vtint_stage(ji,jj) == 0  ) THEN                 
     988                  ztcoeff = 1._wp 
     989               ELSE 
     990                  ztcoeff = 0._wp 
     991               ENDIF 
     992               !    
     993               vbdy(ji,jj) = vbdy(ji,jj) + ztcoeff * ptab(ji,jj) 
     994               !             
     995               IF (( vtint_stage(ji,jj) == 2 ).OR.( vtint_stage(ji,jj) == 0 )) THEN 
     996                  vbdy(ji,jj) = vbdy(ji,jj) / (zrhox*e1v(ji,jj)) * vmask(ji,jj,1) 
     997                  vtint_stage(ji,jj) = 3 
     998               ELSE 
     999                  vtint_stage(ji,jj) = vtint_stage(ji,jj) + 1 
     1000               ENDIF 
     1001            END DO 
     1002         END DO           
    11491003      ENDIF 
    11501004      ! 
    … …  
    11791033         ! 
    11801034         ubdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2)  
     1035         ! 
     1036         ! Update interpolation stage: 
     1037         utint_stage(i1:i2,j1:j2) = 1 
    11811038      ENDIF 
    11821039      !  
    … …  
    11931050      ! 
    11941051      INTEGER ::   ji,jj 
    1195       REAL(wp) ::   zrhot, zt0, zt1,zat 
     1052      REAL(wp) ::   zrhot, zt0, zt1, zat 
    11961053      !!----------------------------------------------------------------------   
    11971054      ! 
    … …  
    12121069         ! 
    12131070         vbdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2) 
     1071         ! 
     1072         ! update interpolation stage: 
     1073         vtint_stage(i1:i2,j1:j2) = 1 
    12141074      ENDIF 
    12151075      !       

  • NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_top_interp.F90

    r10068 r11219  
    9090      ELSE  
    9191 
     92# if defined key_vertical 
    9293         western_side  = (nb == 1).AND.(ndir == 1)   ;   eastern_side  = (nb == 1).AND.(ndir == 2) 
    9394         southern_side = (nb == 2).AND.(ndir == 1)   ;   northern_side = (nb == 2).AND.(ndir == 2) 
    9495 
    95 # if defined key_vertical               
    9696         DO jj=j1,j2 
    9797            DO ji=i1,i2 
    … …  
    130130         END DO 
    131131 
    132          IF ( .NOT.lk_agrif_clp ) THEN  
    133             ! 
    134             imin = i1 ; imax = i2 
    135             jmin = j1 ; jmax = j2 
    136             !  
    137             ! Remove CORNERS 
    138             IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells 
    139             IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1 
    140             IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells 
    141             IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1       
    142             ! 
    143             IF( eastern_side ) THEN 
    144                zrho = Agrif_Rhox() 
    145                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    146                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    147                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    148                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    149                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    150                ! 
    151                ibdy = nlci-nbghostcells 
    152                DO jn = 1, jptra 
    153                   tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
    154                   DO jk = 1, jpkm1 
    155                      DO jj = jmin,jmax 
    156                         IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN 
    157                            tra(ibdy,jj,jk,jn) = tra(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk) 
    158                         ELSE 
    159                            tra(ibdy,jj,jk,jn)=(z4*tra(ibdy+1,jj,jk,jn)+z3*tra(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk) 
    160                            IF( un(ibdy-1,jj,jk) > 0._wp ) THEN 
    161                               tra(ibdy,jj,jk,jn)=( z6*tra(ibdy-1,jj,jk,jn)+z5*tra(ibdy+1,jj,jk,jn) &  
    162                                                  + z7*tra(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
    163                            ENDIF 
    164                         ENDIF 
    165                      END DO 
    166                   END DO 
    167                   ! Restore ghost points: 
    168                   tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 
    169                END DO 
    170             ENDIF 
    171             !  
    172             IF( northern_side ) THEN 
    173                zrho = Agrif_Rhoy() 
    174                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    175                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    176                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    177                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    178                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    179                ! 
    180                jbdy = nlcj-nbghostcells          
    181                DO jn = 1, jptra 
    182                   tra(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
    183                   DO jk = 1, jpkm1 
    184                      DO ji = imin,imax 
    185                         IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN 
    186                            tra(ji,jbdy,jk,jn) = tra(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk) 
    187                         ELSE 
    188                            tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy+1,jk,jn)+z3*tra(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)         
    189                            IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN 
    190                               tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy-1,jk,jn)+z5*tra(ji,jbdy+1,jk,jn)  & 
    191                                                  + z7*tra(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk) 
    192                            ENDIF 
    193                         ENDIF 
    194                      END DO 
    195                   END DO 
    196                   ! Restore ghost points: 
    197                   tra(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 
    198                END DO 
    199             ENDIF 
    200             ! 
    201             IF( western_side ) THEN 
    202                zrho = Agrif_Rhox() 
    203                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    204                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    205                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    206                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    207                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    208                !     
    209                ibdy = 1+nbghostcells        
    210                DO jn = 1, jptra 
    211                   tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
    212                   DO jk = 1, jpkm1 
    213                      DO jj = jmin,jmax 
    214                         IF( umask(ibdy,jj,jk) == 0._wp ) THEN 
    215                            tra(ibdy,jj,jk,jn) = tra(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk) 
    216                         ELSE 
    217                            tra(ibdy,jj,jk,jn)=(z4*tra(ibdy-1,jj,jk,jn)+z3*tra(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)         
    218                            IF( un(ibdy,jj,jk) < 0._wp ) THEN 
    219                               tra(ibdy,jj,jk,jn)=( z6*tra(ibdy+1,jj,jk,jn)+z5*tra(ibdy-1,jj,jk,jn) & 
    220                                                  + z7*tra(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
    221                            ENDIF 
    222                         ENDIF 
    223                      END DO 
    224                   END DO 
    225                   ! Restore ghost points: 
    226                   tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 
    227                END DO 
    228             ENDIF 
    229             ! 
    230             IF( southern_side ) THEN 
    231                zrho = Agrif_Rhoy() 
    232                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    233                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    234                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    235                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    236                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    237                !   
    238                jbdy=1+nbghostcells         
    239                DO jn = 1, jptra 
    240                   tra(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
    241                   DO jk = 1, jpkm1       
    242                      DO ji = imin,imax 
    243                         IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 
    244                            tra(ji,jbdy,jk,jn)=tra(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) 
    245                         ELSE 
    246                            tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy-1,jk,jn)+z3*tra(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk) 
    247                            IF( vn(ji,jbdy,jk) < 0._wp ) THEN 
    248                               tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy+1,jk,jn)+z5*tra(ji,jbdy-1,jk,jn) &  
    249                                                  + z7*tra(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk) 
    250                            ENDIF 
    251                         ENDIF 
    252                      END DO 
    253                   END DO 
    254                   ! Restore ghost points: 
    255                   tra(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 
    256                END DO 
    257             ENDIF 
    258             ! 
    259          ENDIF 
    260  
    261132      ENDIF 
    262133      ! 

  • NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/OCE/DYN/dynspg_ts.F90

    r11205 r11219  
    796796         ! Enforce volume conservation at open boundaries: 
    797797         IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e ) 
    798          ! 
    799 #if  defined key_agrif 
    800          ! Set fluxes during predictor step to ensure volume conservation 
    801          IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) CALL agrif_dyn_ts( jn ) 
    802 #endif       
     798         !       
    803799         zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)         ! fluxes at jn+0.5 
    804800         zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 
    805801         ! 
     802#if defined key_agrif 
     803         ! Set fluxes during predictor step to ensure volume conservation 
     804         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) CALL agrif_dyn_ts_flux( jn, zwx, zwy ) 
     805 
     806#endif 
    806807         IF( ln_wd_il )   CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt) 
    807808 
Note: See TracChangeset for help on using the changeset viewer.