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 11574 for NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src – NEMO

Ignore:
Timestamp:
2019-09-19T12:08:31+02:00 (5 years ago)
Author:
jchanut
Message:

#2222, import changes from dev_r10973_AGRIF-01_jchanut_small_jpi_jpj (i.e. #2199)

Location:
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_all_update.F90

    r10069 r11574  
    1 #define TWO_WAY 
    2  
    3  MODULE agrif_all_update 
     1MODULE agrif_all_update 
    42   !!====================================================================== 
    53   !!                   ***  MODULE  agrif_all_update  *** 
     
    4139      !!               Order of update matters here ! 
    4240      !!---------------------------------------------------------------------- 
    43 # if defined TWO_WAY 
    44       IF (Agrif_Root()) RETURN 
     41      IF (( .NOT.ln_agrif_2way ).OR.(Agrif_Root())) RETURN 
    4542      ! 
    4643      IF (lwp.AND.lk_agrif_debug) Write(*,*) ' --> START AGRIF UPDATE from grid Number',Agrif_Fixed() 
     
    6764      ! 
    6865      Agrif_UseSpecialValueInUpdate = .FALSE. 
    69 #endif 
    7066    END SUBROUTINE agrif_Update_All 
    7167 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_ice_update.F90

    r10069 r11574  
    1 #define TWO_WAY 
    2 !!#undef TWO_WAY 
    31#undef DECAL_FEEDBACK  /* SEPARATION of INTERFACES*/ 
    42 
     
    6361      Agrif_UseSpecialValueInUpdate = .TRUE. 
    6462 
    65 # if defined TWO_WAY 
    6663# if ! defined DECAL_FEEDBACK 
    6764      CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  ) 
     
    7976!      CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    ) 
    8077!      CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    ) 
    81 # endif 
    8278      Agrif_SpecialValueFineGrid    = 0. 
    8379      Agrif_UseSpecialValueInUpdate = .FALSE. 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce.F90

    r10425 r11574  
    2121#endif    
    2222   !                                              !!* Namelist namagrif: AGRIF parameters 
    23    LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: 
    24    INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points) 
     23   LOGICAL , PUBLIC ::   ln_agrif_2way = .TRUE.    !: activate two way nesting  
     24   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: use zeros (.false.) or not (.true.) in 
     25                                                   !: bdys dynamical fields interpolation 
    2526   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers 
    2627   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics 
    2728   LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry  
    28    LOGICAL , PUBLIC ::   lk_agrif_clp  = .FALSE.   !: Force clamped bcs 
    29    !                                              !!! OLD namelist names 
    30    REAL(wp), PUBLIC ::   visc_tra                  !: sponge coeff. for tracers 
    31    REAL(wp), PUBLIC ::   visc_dyn                  !: sponge coeff. for dynamics 
    32  
     29   ! 
     30   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points) 
    3331   LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator 
    3432   LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator 
     
    4240   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u 
    4341   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v 
     42   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utint_stage 
     43   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtint_stage 
    4444   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities 
    4545   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities 
    4646 
    4747   ! Barotropic arrays used to store open boundary data during time-splitting loop: 
    48    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_w, vbdy_w, hbdy_w 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_e, vbdy_e, hbdy_e 
    50    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_n, vbdy_n, hbdy_n 
    51    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_s, vbdy_s, hbdy_s 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy, vbdy, hbdy 
    5249 
    5350 
     
    8279      ierr(:) = 0 
    8380      ! 
    84       ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),   & 
    85          &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),   & 
    86          &      tabspongedone_tsn(jpi,jpj),           & 
     81      ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),     & 
     82         &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),     & 
     83         &      tabspongedone_tsn(jpi,jpj),                 & 
     84         &      utint_stage(jpi,jpj), vtint_stage(jpi,jpj), & 
    8785# if defined key_top          
    8886         &      tabspongedone_trn(jpi,jpj),           & 
     
    9189         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) ) 
    9290 
    93       ALLOCATE( ubdy_w(nbghostcells,jpj), vbdy_w(nbghostcells,jpj), hbdy_w(nbghostcells,jpj),   & 
    94          &      ubdy_e(nbghostcells,jpj), vbdy_e(nbghostcells,jpj), hbdy_e(nbghostcells,jpj),   &  
    95          &      ubdy_n(jpi,nbghostcells), vbdy_n(jpi,nbghostcells), hbdy_n(jpi,nbghostcells),   &  
    96          &      ubdy_s(jpi,nbghostcells), vbdy_s(jpi,nbghostcells), hbdy_s(jpi,nbghostcells), STAT = ierr(2) ) 
     91      ALLOCATE( ubdy(jpi,jpj), vbdy(jpi,jpj), hbdy(jpi,jpj), STAT = ierr(2) ) 
    9792 
    9893      agrif_oce_alloc = MAXVAL(ierr) 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_interp.F90

    r10068 r11574  
    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 = jpjglo-1-nbghostcells 
     275      jbdy2 = jpjglo-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 = jpjglo-nbghostcells 
     314         jbdy2 = jpjglo-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      ! 
     
    401344      !! 
    402345      INTEGER :: ji, jj 
     346      INTEGER :: istart, iend, jstart, jend 
    403347      !!----------------------------------------------------------------------   
    404348      ! 
    405349      IF( Agrif_Root() )   RETURN 
    406350      ! 
    407       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     351      !--- West ---! 
     352      istart = 2 
     353      iend   = nbghostcells+1 
     354      DO ji = mi0(istart), mi1(iend) 
    408355         DO jj=1,jpj 
    409             va_e(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * hvr_e(2:nbghostcells+1,jj) 
    410             ! Specified fluxes: 
    411             ua_e(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * hur_e(2:nbghostcells+1,jj) 
    412             ! Characteristics method (only if ghostcells=1): 
    413             !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
    414             !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 
    415          END DO 
    416       ENDIF 
    417       ! 
    418       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     356            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     357            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     358         END DO 
     359      END DO 
     360      ! 
     361      !--- East ---! 
     362      istart = jpiglo-nbghostcells 
     363      iend   = jpiglo-1 
     364      DO ji = mi0(istart), mi1(iend) 
    419365         DO jj=1,jpj 
    420             va_e(nlci-nbghostcells:nlci-1,jj)   = vbdy_e(1:nbghostcells,jj) * hvr_e(nlci-nbghostcells:nlci-1,jj) 
    421             ! Specified fluxes: 
    422             ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj) 
    423             ! Characteristics method (only if ghostcells=1): 
    424             !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
    425             !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 
    426          END DO 
    427       ENDIF 
    428       ! 
    429       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     366            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     367         END DO 
     368      END DO 
     369      istart = jpiglo-nbghostcells-1 
     370      iend   = jpiglo-2 
     371      DO ji = mi0(istart), mi1(iend) 
     372         DO jj=1,jpj 
     373            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     374         END DO 
     375      END DO 
     376      ! 
     377      !--- South ---! 
     378      jstart = 2 
     379      jend   = nbghostcells+1 
     380      DO jj = mj0(jstart), mj1(jend) 
    430381         DO ji=1,jpi 
    431             ua_e(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * hur_e(ji,2:nbghostcells+1) 
    432             ! Specified fluxes: 
    433             va_e(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * hvr_e(ji,2:nbghostcells+1) 
    434             ! Characteristics method (only if ghostcells=1): 
    435             !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
    436             !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 
    437          END DO 
    438       ENDIF 
    439       ! 
    440       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     382            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     383            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     384         END DO 
     385      END DO 
     386      ! 
     387      !--- North ---! 
     388      jstart = jpjglo-nbghostcells 
     389      jend   = jpjglo-1 
     390      DO jj = mj0(jstart), mj1(jend) 
    441391         DO ji=1,jpi 
    442             ua_e(ji,nlcj-nbghostcells:nlcj-1)   = ubdy_n(ji,1:nbghostcells) * hur_e(ji,nlcj-nbghostcells:nlcj-1) 
    443             ! Specified fluxes: 
    444             va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2) 
    445             ! Characteristics method (only if ghostcells=1): 
    446             !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
    447             !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 
    448          END DO 
    449       ENDIF 
     392            ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     393         END DO 
     394      END DO 
     395      jstart = jpjglo-nbghostcells-1 
     396      jend   = jpjglo-2 
     397      DO jj = mj0(jstart), mj1(jend) 
     398         DO ji=1,jpi 
     399            va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     400         END DO 
     401      END DO 
    450402      ! 
    451403   END SUBROUTINE Agrif_dyn_ts 
    452404 
     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 
    453471 
    454472   SUBROUTINE Agrif_dta_ts( kt ) 
     
    470488      ! 
    471489      ! Interpolate barotropic fluxes 
    472       Agrif_SpecialValue=0._wp 
     490      Agrif_SpecialValue = 0._wp 
    473491      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 
    474496      ! 
    475497      IF( ll_int_cons ) THEN  ! Conservative interpolation 
    476498         ! order matters here !!!!!! 
    477499         CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 
    478          CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
    479          bdy_tinterp = 1 
     500         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b )  
     501         ! 
    480502         CALL Agrif_Bc_variable( unb_id        , calledweight=1._wp, procname=interpunb  ) ! After 
    481503         CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  ) 
    482          bdy_tinterp = 2 
     504         ! 
    483505         CALL Agrif_Bc_variable( unb_id        , calledweight=0._wp, procname=interpunb  ) ! Before 
    484506         CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )          
    485507      ELSE ! Linear interpolation 
    486          bdy_tinterp = 0 
    487          ubdy_w(:,:) = 0._wp   ;   vbdy_w(:,:) = 0._wp  
    488          ubdy_e(:,:) = 0._wp   ;   vbdy_e(:,:) = 0._wp  
    489          ubdy_n(:,:) = 0._wp   ;   vbdy_n(:,:) = 0._wp  
    490          ubdy_s(:,:) = 0._wp   ;   vbdy_s(:,:) = 0._wp 
     508         ! 
     509         ubdy(:,:) = 0._wp   ;   vbdy(:,:) = 0._wp  
    491510         CALL Agrif_Bc_variable( unb_id, procname=interpunb ) 
    492511         CALL Agrif_Bc_variable( vnb_id, procname=interpvnb ) 
     
    503522      INTEGER, INTENT(in) ::   kt 
    504523      ! 
    505       INTEGER  :: ji, jj, indx, indy 
     524      INTEGER  :: ji, jj 
     525      INTEGER  :: istart, iend, jstart, jend 
    506526      !!----------------------------------------------------------------------   
    507527      ! 
     
    516536      ! 
    517537      ! --- West --- ! 
    518       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    519          indx = 1+nbghostcells 
     538      istart = 2 
     539      iend   = 1 + nbghostcells 
     540      DO ji = mi0(istart), mi1(iend) 
    520541         DO jj = 1, jpj 
    521             DO ji = 2, indx 
    522                ssha(ji,jj) = hbdy_w(ji-1,jj) 
    523             ENDDO 
     542            ssha(ji,jj) = hbdy(ji,jj) 
    524543         ENDDO 
    525       ENDIF 
     544      ENDDO 
    526545      ! 
    527546      ! --- East --- ! 
    528       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    529          indx = nlci-nbghostcells 
     547      istart = jpiglo - nbghostcells 
     548      iend   = jpiglo - 1 
     549      DO ji = mi0(istart), mi1(iend) 
    530550         DO jj = 1, jpj 
    531             DO ji = indx, nlci-1 
    532                ssha(ji,jj) = hbdy_e(ji-indx+1,jj) 
    533             ENDDO 
     551            ssha(ji,jj) = hbdy(ji,jj) 
    534552         ENDDO 
    535       ENDIF 
     553      ENDDO 
    536554      ! 
    537555      ! --- South --- ! 
    538       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    539          indy = 1+nbghostcells 
    540          DO jj = 2, indy 
    541             DO ji = 1, jpi 
    542                ssha(ji,jj) = hbdy_s(ji,jj-1) 
    543             ENDDO 
     556      jstart = 2 
     557      jend   = 1 + nbghostcells 
     558      DO jj = mj0(jstart), mj1(jend) 
     559         DO ji = 1, jpi 
     560            ssha(ji,jj) = hbdy(ji,jj) 
    544561         ENDDO 
    545       ENDIF 
     562      ENDDO 
    546563      ! 
    547564      ! --- North --- ! 
    548       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    549          indy = nlcj-nbghostcells 
    550          DO jj = indy, nlcj-1 
    551             DO ji = 1, jpi 
    552                ssha(ji,jj) = hbdy_n(ji,jj-indy+1) 
    553             ENDDO 
     565      jstart = jpjglo - nbghostcells 
     566      jend   = jpjglo - 1 
     567      DO jj = mj0(jstart), mj1(jend) 
     568         DO ji = 1, jpi 
     569            ssha(ji,jj) = hbdy(ji,jj) 
    554570         ENDDO 
    555       ENDIF 
     571      ENDDO 
    556572      ! 
    557573   END SUBROUTINE Agrif_ssh 
     
    564580      INTEGER, INTENT(in) ::   jn 
    565581      !! 
    566       INTEGER :: ji, jj, indx, indy 
    567       !!----------------------------------------------------------------------   
    568       !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 
     582      INTEGER :: ji, jj 
     583      INTEGER  :: istart, iend, jstart, jend 
     584      !!----------------------------------------------------------------------   
    569585      ! 
    570586      IF( Agrif_Root() )   RETURN 
    571587      ! 
    572588      ! --- West --- ! 
    573       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    574          indx = 1+nbghostcells 
     589      istart = 2 
     590      iend   = 1+nbghostcells 
     591      DO ji = mi0(istart), mi1(iend) 
    575592         DO jj = 1, jpj 
    576             DO ji = 2, indx 
    577                ssha_e(ji,jj) = hbdy_w(ji-1,jj) 
    578             ENDDO 
     593            ssha_e(ji,jj) = hbdy(ji,jj) 
    579594         ENDDO 
    580       ENDIF 
     595      ENDDO 
    581596      ! 
    582597      ! --- East --- ! 
    583       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    584          indx = nlci-nbghostcells 
     598      istart = jpiglo - nbghostcells 
     599      iend   = jpiglo - 1 
     600      DO ji = mi0(istart), mi1(iend) 
    585601         DO jj = 1, jpj 
    586             DO ji = indx, nlci-1 
    587                ssha_e(ji,jj) = hbdy_e(ji-indx+1,jj) 
    588             ENDDO 
     602            ssha_e(ji,jj) = hbdy(ji,jj) 
    589603         ENDDO 
    590       ENDIF 
     604      ENDDO 
    591605      ! 
    592606      ! --- South --- ! 
    593       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    594          indy = 1+nbghostcells 
    595          DO jj = 2, indy 
    596             DO ji = 1, jpi 
    597                ssha_e(ji,jj) = hbdy_s(ji,jj-1) 
    598             ENDDO 
     607      jstart = 2 
     608      jend   = 1+nbghostcells 
     609      DO jj = mj0(jstart), mj1(jend) 
     610         DO ji = 1, jpi 
     611            ssha_e(ji,jj) = hbdy(ji,jj) 
    599612         ENDDO 
    600       ENDIF 
     613      ENDDO 
    601614      ! 
    602615      ! --- North --- ! 
    603       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    604          indy = nlcj-nbghostcells 
    605          DO jj = indy, nlcj-1 
    606             DO ji = 1, jpi 
    607                ssha_e(ji,jj) = hbdy_n(ji,jj-indy+1) 
    608             ENDDO 
     616      jstart = jpjglo - nbghostcells 
     617      jend   = jpjglo - 1 
     618      DO jj = mj0(jstart), mj1(jend) 
     619         DO ji = 1, jpi 
     620            ssha_e(ji,jj) = hbdy(ji,jj) 
    609621         ENDDO 
    610       ENDIF 
     622      ENDDO 
    611623      ! 
    612624   END SUBROUTINE Agrif_ssh_ts 
     
    634646    
    635647 
    636    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 ) 
    637649      !!---------------------------------------------------------------------- 
    638650      !!                  *** ROUTINE interptsn *** 
     
    641653      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
    642654      LOGICAL                                     , INTENT(in   ) ::   before 
    643       INTEGER                                     , INTENT(in   ) ::   nb , ndir 
    644       ! 
    645       INTEGER  ::   ji, jj, jk, jn, iref, jref, ibdy, jbdy   ! dummy loop indices 
    646       INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out 
    647       REAL(wp) ::   zrho, z1, z2, z3, z4, z5, z6, z7 
    648       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 
    649658      ! vertical interpolation: 
    650659      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child 
     
    652661      REAL(wp), DIMENSION(k1:k2) :: h_in 
    653662      REAL(wp), DIMENSION(1:jpk) :: h_out 
    654       REAL(wp) :: h_diff 
    655663 
    656664      IF( before ) THEN          
     
    676684      ELSE  
    677685 
    678          western_side  = (nb == 1).AND.(ndir == 1)   ;   eastern_side  = (nb == 1).AND.(ndir == 2) 
    679          southern_side = (nb == 2).AND.(ndir == 1)   ;   northern_side = (nb == 2).AND.(ndir == 2) 
    680  
    681686# if defined key_vertical               
    682687         DO jj=j1,j2 
    683688            DO ji=i1,i2 
    684                iref = ji 
    685                jref = jj 
    686                if(western_side) iref=MAX(2,ji) 
    687                if(eastern_side) iref=MIN(nlci-1,ji) 
    688                if(southern_side) jref=MAX(2,jj) 
    689                if(northern_side) jref=MIN(nlcj-1,jj) 
    690689               N_in = 0 
    691690               DO jk=k1,k2 !k2 = jpk of parent grid 
     
    697696               N_out = 0 
    698697               DO jk=1,jpk ! jpk of child grid 
    699                   IF (tmask(iref,jref,jk) == 0) EXIT  
     698                  IF (tmask(ji,jj,jk) == 0) EXIT  
    700699                  N_out = N_out + 1 
    701                   h_out(jk) = e3t_n(iref,jref,jk) 
     700                  h_out(jk) = e3t_n(ji,jj,jk) 
    702701               ENDDO 
    703702               IF (N_in > 0) THEN 
     
    716715         END DO 
    717716 
    718          IF ( .NOT.lk_agrif_clp ) THEN  
    719             ! 
    720             imin = i1 ; imax = i2 
    721             jmin = j1 ; jmax = j2 
    722             !  
    723             ! Remove CORNERS 
    724             IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells 
    725             IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1 
    726             IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells 
    727             IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1       
    728             ! 
    729             IF( eastern_side ) THEN 
    730                zrho = Agrif_Rhox() 
    731                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    732                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    733                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    734                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    735                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    736                ! 
    737                ibdy = nlci-nbghostcells 
    738                DO jn = 1, jpts 
    739                   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) 
    740                   DO jk = 1, jpkm1 
    741                      DO jj = jmin,jmax 
    742                         IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN 
    743                            tsa(ibdy,jj,jk,jn) = tsa(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk) 
    744                         ELSE 
    745                            tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy+1,jj,jk,jn)+z3*tsa(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk) 
    746                            IF( un(ibdy-1,jj,jk) > 0._wp ) THEN 
    747                               tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy-1,jj,jk,jn)+z5*tsa(ibdy+1,jj,jk,jn) &  
    748                                                  + z7*tsa(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
    749                            ENDIF 
    750                         ENDIF 
    751                      END DO 
    752                   END DO 
    753                   ! Restore ghost points: 
    754                   tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 
    755                END DO 
    756             ENDIF 
    757             !  
    758             IF( northern_side ) THEN 
    759                zrho = Agrif_Rhoy() 
    760                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    761                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    762                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    763                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    764                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    765                ! 
    766                jbdy = nlcj-nbghostcells          
    767                DO jn = 1, jpts 
    768                   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) 
    769                   DO jk = 1, jpkm1 
    770                      DO ji = imin,imax 
    771                         IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN 
    772                            tsa(ji,jbdy,jk,jn) = tsa(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk) 
    773                         ELSE 
    774                            tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy+1,jk,jn)+z3*tsa(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)         
    775                            IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN 
    776                               tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy-1,jk,jn)+z5*tsa(ji,jbdy+1,jk,jn)  & 
    777                                                  + z7*tsa(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk) 
    778                            ENDIF 
    779                         ENDIF 
    780                      END DO 
    781                   END DO 
    782                   ! Restore ghost points: 
    783                   tsa(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 
    784                END DO 
    785             ENDIF 
    786             ! 
    787             IF( western_side ) THEN 
    788                zrho = Agrif_Rhox() 
    789                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    790                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    791                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    792                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    793                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    794                !     
    795                ibdy = 1+nbghostcells        
    796                DO jn = 1, jpts 
    797                   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) 
    798                   DO jk = 1, jpkm1 
    799                      DO jj = jmin,jmax 
    800                         IF( umask(ibdy,jj,jk) == 0._wp ) THEN 
    801                            tsa(ibdy,jj,jk,jn) = tsa(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk) 
    802                         ELSE 
    803                            tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy-1,jj,jk,jn)+z3*tsa(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)         
    804                            IF( un(ibdy,jj,jk) < 0._wp ) THEN 
    805                               tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy-1,jj,jk,jn) & 
    806                                                  + z7*tsa(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
    807                            ENDIF 
    808                         ENDIF 
    809                      END DO 
    810                   END DO 
    811                   ! Restore ghost points: 
    812                   tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 
    813                END DO 
    814             ENDIF 
    815             ! 
    816             IF( southern_side ) THEN 
    817                zrho = Agrif_Rhoy() 
    818                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    819                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    820                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    821                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    822                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    823                !   
    824                jbdy=1+nbghostcells         
    825                DO jn = 1, jpts 
    826                   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) 
    827                   DO jk = 1, jpkm1       
    828                      DO ji = imin,imax 
    829                         IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 
    830                            tsa(ji,jbdy,jk,jn)=tsa(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) 
    831                         ELSE 
    832                            tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy-1,jk,jn)+z3*tsa(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk) 
    833                            IF( vn(ji,jbdy,jk) < 0._wp ) THEN 
    834                               tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy-1,jk,jn) &  
    835                                                  + z7*tsa(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk) 
    836                            ENDIF 
    837                         ENDIF 
    838                      END DO 
    839                   END DO 
    840                   ! Restore ghost points: 
    841                   tsa(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 
    842                END DO 
    843             ENDIF 
    844             ! 
    845          ENDIF 
    846717      ENDIF 
    847718      ! 
    848719   END SUBROUTINE interptsn 
    849720 
    850    SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before, nb, ndir ) 
     721   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before ) 
    851722      !!---------------------------------------------------------------------- 
    852723      !!                  ***  ROUTINE interpsshn  *** 
     
    855726      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    856727      LOGICAL                         , INTENT(in   ) ::   before 
    857       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    858       ! 
    859       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     728      ! 
    860729      !!----------------------------------------------------------------------   
    861730      ! 
     
    863732         ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 
    864733      ELSE 
    865          western_side  = (nb == 1).AND.(ndir == 1) 
    866          eastern_side  = (nb == 1).AND.(ndir == 2) 
    867          southern_side = (nb == 2).AND.(ndir == 1) 
    868          northern_side = (nb == 2).AND.(ndir == 2) 
    869          !! clem ghost 
    870          IF(western_side)  hbdy_w(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
    871          IF(eastern_side)  hbdy_e(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
    872          IF(southern_side) hbdy_s(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)  
    873          IF(northern_side) hbdy_n(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
     734         hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
    874735      ENDIF 
    875736      ! 
     
    1045906   END SUBROUTINE interpvn 
    1046907 
    1047    SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before, nb, ndir ) 
     908   SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before) 
    1048909      !!---------------------------------------------------------------------- 
    1049910      !!                  ***  ROUTINE interpunb  *** 
     
    1052913      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    1053914      LOGICAL                         , INTENT(in   ) ::   before 
    1054       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    1055915      ! 
    1056916      INTEGER  ::   ji, jj 
    1057917      REAL(wp) ::   zrhoy, zrhot, zt0, zt1, ztcoeff 
    1058       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
    1059918      !!----------------------------------------------------------------------   
    1060919      ! 
     
    1062921         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * un_b(i1:i2,j1:j2) 
    1063922      ELSE 
    1064          western_side  = (nb == 1).AND.(ndir == 1) 
    1065          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1066          southern_side = (nb == 2).AND.(ndir == 1) 
    1067          northern_side = (nb == 2).AND.(ndir == 2) 
    1068923         zrhoy = Agrif_Rhoy() 
    1069924         zrhot = Agrif_rhot() 
     
    1071926         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
    1072927         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
    1073          ! Polynomial interpolation coefficients: 
    1074          IF( bdy_tinterp == 1 ) THEN 
    1075             ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    1076                &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    1077          ELSEIF( bdy_tinterp == 2 ) THEN 
    1078             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    1079                &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
    1080          ELSE 
    1081             ztcoeff = 1 
    1082          ENDIF 
    1083          !    
    1084          IF(western_side)   ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)   
    1085          IF(eastern_side)   ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)   
    1086          IF(southern_side)  ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 
    1087          IF(northern_side)  ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2)  
    1088          !             
    1089          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    1090             IF(western_side)   ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 
    1091             IF(eastern_side)   ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 
    1092             IF(southern_side)  ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 
    1093             IF(northern_side)  ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 
    1094          ENDIF 
    1095       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 
    1096954      !  
    1097955   END SUBROUTINE interpunb 
    1098956 
    1099957 
    1100    SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before, nb, ndir ) 
     958   SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before ) 
    1101959      !!---------------------------------------------------------------------- 
    1102960      !!                  ***  ROUTINE interpvnb  *** 
     
    1105963      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    1106964      LOGICAL                         , INTENT(in   ) ::   before 
    1107       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    1108       ! 
    1109       INTEGER  ::   ji,jj 
     965      ! 
     966      INTEGER  ::   ji, jj 
    1110967      REAL(wp) ::   zrhox, zrhot, zt0, zt1, ztcoeff    
    1111       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
    1112968      !!----------------------------------------------------------------------   
    1113969      !  
     
    1115971         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vn_b(i1:i2,j1:j2) 
    1116972      ELSE 
    1117          western_side  = (nb == 1).AND.(ndir == 1) 
    1118          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1119          southern_side = (nb == 2).AND.(ndir == 1) 
    1120          northern_side = (nb == 2).AND.(ndir == 2) 
    1121973         zrhox = Agrif_Rhox() 
    1122974         zrhot = Agrif_rhot() 
    1123975         ! Time indexes bounds for integration 
    1124976         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
    1125          zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
    1126          IF( bdy_tinterp == 1 ) THEN 
    1127             ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    1128                &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    1129          ELSEIF( bdy_tinterp == 2 ) THEN 
    1130             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    1131                &               - zt0        * (       zt0 - 1._wp)**2._wp )  
    1132          ELSE 
    1133             ztcoeff = 1 
    1134          ENDIF 
    1135          !! clem ghost 
    1136          IF(western_side)   vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)   
    1137          IF(eastern_side)   vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)    
    1138          IF(southern_side)  vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 
    1139          IF(northern_side)  vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2)  
    1140          !             
    1141          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    1142             IF(western_side)   vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 
    1143             IF(eastern_side)   vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 
    1144             IF(southern_side)  vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 
    1145             IF(northern_side)  vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 
    1146          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           
    11471003      ENDIF 
    11481004      ! 
     
    11501006 
    11511007 
    1152    SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 
     1008   SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before ) 
    11531009      !!---------------------------------------------------------------------- 
    11541010      !!                  ***  ROUTINE interpub2b  *** 
     
    11571013      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    11581014      LOGICAL                         , INTENT(in   ) ::   before 
    1159       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    11601015      ! 
    11611016      INTEGER  ::   ji,jj 
    1162       REAL(wp) ::   zrhot, zt0, zt1,zat 
    1163       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     1017      REAL(wp) ::   zrhot, zt0, zt1, zat 
    11641018      !!----------------------------------------------------------------------   
    11651019      IF( before ) THEN 
     
    11701024         ENDIF 
    11711025      ELSE 
    1172          western_side  = (nb == 1).AND.(ndir == 1) 
    1173          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1174          southern_side = (nb == 2).AND.(ndir == 1) 
    1175          northern_side = (nb == 2).AND.(ndir == 2) 
    1176          zrhot = Agrif_rhot() 
    1177          ! Time indexes bounds for integration 
    1178          zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
    1179          zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
    1180          ! Polynomial interpolation coefficients: 
    1181          zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    & 
    1182             &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    1183          !! clem ghost 
    1184          IF(western_side ) ubdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)   
    1185          IF(eastern_side ) ubdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)   
    1186          IF(southern_side) ubdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 
    1187          IF(northern_side) ubdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2)  
    1188       ENDIF 
    1189       !  
    1190    END SUBROUTINE interpub2b 
    1191     
    1192  
    1193    SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    1194       !!---------------------------------------------------------------------- 
    1195       !!                  ***  ROUTINE interpvb2b  *** 
    1196       !!----------------------------------------------------------------------   
    1197       INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
    1198       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    1199       LOGICAL                         , INTENT(in   ) ::   before 
    1200       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    1201       ! 
    1202       INTEGER ::   ji,jj 
    1203       REAL(wp) ::   zrhot, zt0, zt1,zat 
    1204       LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    1205       !!----------------------------------------------------------------------   
    1206       ! 
    1207       IF( before ) THEN 
    1208          IF ( ln_bt_fw ) THEN 
    1209             ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 
    1210          ELSE 
    1211             ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 
    1212          ENDIF 
    1213       ELSE       
    1214          western_side  = (nb == 1).AND.(ndir == 1) 
    1215          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1216          southern_side = (nb == 2).AND.(ndir == 1) 
    1217          northern_side = (nb == 2).AND.(ndir == 2) 
    12181026         zrhot = Agrif_rhot() 
    12191027         ! Time indexes bounds for integration 
     
    12241032            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    12251033         ! 
    1226          IF(western_side )   vbdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)   
    1227          IF(eastern_side )   vbdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)   
    1228          IF(southern_side)   vbdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 
    1229          IF(northern_side)   vbdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2)  
     1034         ubdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2)  
     1035         ! 
     1036         ! Update interpolation stage: 
     1037         utint_stage(i1:i2,j1:j2) = 1 
     1038      ENDIF 
     1039      !  
     1040   END SUBROUTINE interpub2b 
     1041    
     1042 
     1043   SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before ) 
     1044      !!---------------------------------------------------------------------- 
     1045      !!                  ***  ROUTINE interpvb2b  *** 
     1046      !!----------------------------------------------------------------------   
     1047      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     1048      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     1049      LOGICAL                         , INTENT(in   ) ::   before 
     1050      ! 
     1051      INTEGER ::   ji,jj 
     1052      REAL(wp) ::   zrhot, zt0, zt1, zat 
     1053      !!----------------------------------------------------------------------   
     1054      ! 
     1055      IF( before ) THEN 
     1056         IF ( ln_bt_fw ) THEN 
     1057            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 
     1058         ELSE 
     1059            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 
     1060         ENDIF 
     1061      ELSE       
     1062         zrhot = Agrif_rhot() 
     1063         ! Time indexes bounds for integration 
     1064         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
     1065         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
     1066         ! Polynomial interpolation coefficients: 
     1067         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    & 
     1068            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
     1069         ! 
     1070         vbdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2) 
     1071         ! 
     1072         ! update interpolation stage: 
     1073         vtint_stage(i1:i2,j1:j2) = 1 
    12301074      ENDIF 
    12311075      !       
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_sponge.F90

    r10425 r11574  
    2222   USE agrif_oce 
    2323   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     24   USE iom 
    2425 
    2526   IMPLICIT NONE 
     
    5859#endif 
    5960      ! 
     61      CALL iom_put("fsaht_spu", fsaht_spu(:,:)) 
     62      CALL iom_put("fsaht_spv", fsaht_spv(:,:)) 
     63      ! 
    6064   END SUBROUTINE Agrif_Sponge_Tra 
    6165 
     
    8589#endif 
    8690      ! 
     91      CALL iom_put("fsahm_spt", fsahm_spt(:,:)) 
     92      CALL iom_put("fsahm_spf", fsahm_spf(:,:)) 
     93      ! 
    8794   END SUBROUTINE Agrif_Sponge_dyn 
    8895 
     
    93100      !!---------------------------------------------------------------------- 
    94101      INTEGER  ::   ji, jj, ind1, ind2 
    95       INTEGER  ::   ispongearea 
    96       REAL(wp) ::   z1_spongearea 
     102      INTEGER  ::   ispongearea, jspongearea 
     103      REAL(wp) ::   z1_ispongearea, z1_jspongearea 
    97104      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 
     105      REAL(wp), DIMENSION(jpjmax)  :: zmskwest,  zmskeast 
     106      REAL(wp), DIMENSION(jpimax)  :: zmsknorth, zmsksouth 
    98107      !!---------------------------------------------------------------------- 
    99108      ! 
    100109#if defined SPONGE || defined SPONGE_TOP 
    101110      IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 
     111         ! 
     112         ! Retrieve masks at open boundaries: 
     113 
     114         ! --- West --- ! 
     115         ztabramp(:,:) = 0._wp 
     116         ind1 = 1+nbghostcells 
     117         DO ji = mi0(ind1), mi1(ind1)                 
     118            ztabramp(ji,:) = umask(ji,:,1) 
     119         END DO 
     120         ! 
     121         zmskwest(:) = 0._wp 
     122         zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     123 
     124         ! --- East --- ! 
     125         ztabramp(:,:) = 0._wp 
     126         ind1 = jpiglo - nbghostcells - 1 
     127         DO ji = mi0(ind1), mi1(ind1)                  
     128            ztabramp(ji,:) = umask(ji,:,1) 
     129         END DO 
     130         ! 
     131         zmskeast(:) = 0._wp 
     132         zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     133 
     134         ! --- South --- ! 
     135         ztabramp(:,:) = 0._wp 
     136         ind1 = 1+nbghostcells 
     137         DO jj = mj0(ind1), mj1(ind1)                  
     138            ztabramp(:,jj) = vmask(:,jj,1) 
     139         END DO 
     140         ! 
     141         zmsksouth(:) = 0._wp 
     142         zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     143 
     144         ! --- North --- ! 
     145         ztabramp(:,:) = 0._wp 
     146         ind1 = jpjglo - nbghostcells - 1 
     147         DO jj = mj0(ind1), mj1(ind1)                  
     148            ztabramp(:,jj) = vmask(:,jj,1) 
     149         END DO 
     150         ! 
     151         zmsknorth(:) = 0._wp 
     152         zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     153 
     154#if defined key_mpp_mpi 
     155         CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax ) 
     156         CALL mpp_max( 'AGRIF_Sponge', zmskeast(:) , jpjmax ) 
     157         CALL mpp_max( 'AGRIF_Sponge', zmsksouth(:), jpimax ) 
     158         CALL mpp_max( 'AGRIF_Sponge', zmsknorth(:), jpimax ) 
     159#endif 
     160 
    102161         ! Define ramp from boundaries towards domain interior at T-points 
    103162         ! Store it in ztabramp 
    104163 
    105164         ispongearea  = 1 + nn_sponge_len * Agrif_irhox() 
    106          z1_spongearea = 1._wp / REAL( ispongearea ) 
     165         z1_ispongearea = 1._wp / REAL( ispongearea ) 
     166         jspongearea  = 1 + nn_sponge_len * Agrif_irhoy() 
     167         z1_jspongearea = 1._wp / REAL( jspongearea ) 
    107168          
    108169         ztabramp(:,:) = 0._wp 
     170         IF ( Agrif_irhox()==1 ) ispongearea =-1 
     171         IF ( Agrif_irhoy()==1 ) jspongearea =-1 
    109172 
    110173         ! --- West --- ! 
    111          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
    112             ind1 = 1+nbghostcells 
    113             ind2 = 1+nbghostcells + ispongearea  
     174         ind1 = 1+nbghostcells 
     175         ind2 = 1+nbghostcells + ispongearea  
     176         DO ji = mi0(ind1), mi1(ind2)    
     177            DO jj = 1, jpj                
     178               ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
     179            END DO 
     180         END DO 
     181 
     182         ! ghost cells (cosmetic): 
     183         ind1 = 1 
     184         ind2 = nbghostcells 
     185         DO ji = mi0(ind1), mi1(ind2)    
     186            DO jj = 1, jpj                
     187               ztabramp(ji,jj) = zmskwest(jj) 
     188            END DO 
     189         END DO 
     190 
     191         ! --- East --- ! 
     192         ind1 = jpiglo - nbghostcells - ispongearea 
     193         ind2 = jpiglo - nbghostcells 
     194         DO ji = mi0(ind1), mi1(ind2) 
    114195            DO jj = 1, jpj 
    115                DO ji = ind1, ind2                 
    116                   ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 
    117                END DO 
     196               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
    118197            ENDDO 
    119          ENDIF 
    120  
    121          ! --- East --- ! 
    122          IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
    123             ind1 = nlci - nbghostcells - ispongearea 
    124             ind2 = nlci - nbghostcells 
     198         END DO 
     199 
     200         ! ghost cells (cosmetic): 
     201         ind1 = jpiglo - nbghostcells + 1 
     202         ind2 = jpiglo 
     203         DO ji = mi0(ind1), mi1(ind2) 
    125204            DO jj = 1, jpj 
    126                DO ji = ind1, ind2 
    127                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind1 ) * z1_spongearea * umask(ind2-1,jj,1) ) 
    128                ENDDO 
     205               ztabramp(ji,jj) = zmskeast(jj) 
    129206            ENDDO 
    130          ENDIF 
     207         END DO 
    131208 
    132209         ! --- South --- ! 
    133          IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
    134             ind1 = 1+nbghostcells 
    135             ind2 = 1+nbghostcells + ispongearea 
    136             DO jj = ind1, ind2  
    137                DO ji = 1, jpi 
    138                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 
    139                END DO 
    140             ENDDO 
    141          ENDIF 
     210         ind1 = 1+nbghostcells 
     211         ind2 = 1+nbghostcells + jspongearea 
     212         DO jj = mj0(ind1), mj1(ind2)  
     213            DO ji = 1, jpi 
     214               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
     215            END DO 
     216         END DO 
     217 
     218         ! ghost cells (cosmetic): 
     219         ind1 = 1 
     220         ind2 = nbghostcells 
     221         DO jj = mj0(ind1), mj1(ind2)  
     222            DO ji = 1, jpi 
     223               ztabramp(ji,jj) = zmsksouth(ji) 
     224            END DO 
     225         END DO 
    142226 
    143227         ! --- North --- ! 
    144          IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
    145             ind1 = nlcj - nbghostcells - ispongearea 
    146             ind2 = nlcj - nbghostcells 
    147             DO jj = ind1, ind2 
    148                DO ji = 1, jpi 
    149                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind1 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 
    150                END DO 
    151             ENDDO 
    152          ENDIF 
     228         ind1 = jpjglo - nbghostcells - jspongearea 
     229         ind2 = jpjglo - nbghostcells 
     230         DO jj = mj0(ind1), mj1(ind2) 
     231            DO ji = 1, jpi 
     232               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
     233            END DO 
     234         END DO 
     235 
     236         ! ghost cells (cosmetic): 
     237         ind1 = jpjglo - nbghostcells + 1 
     238         ind2 = jpjglo 
     239         DO jj = mj0(ind1), mj1(ind2) 
     240            DO ji = 1, jpi 
     241               ztabramp(ji,jj) = zmsknorth(ji) 
     242            END DO 
     243         END DO 
    153244 
    154245      ENDIF 
     
    160251         DO jj = 2, jpjm1 
    161252            DO ji = 2, jpim1   ! vector opt. 
    162                fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
    163                fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) 
    164             END DO 
    165          END DO 
    166          CALL lbc_lnk( 'agrif_oce_sponge', fsaht_spu, 'U', 1. )   ! Lateral boundary conditions 
    167          CALL lbc_lnk( 'agrif_oce_sponge', fsaht_spv, 'V', 1. ) 
     253               fsaht_spu(ji,jj) = 0.5_wp * rn_sponge_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
     254               fsaht_spv(ji,jj) = 0.5_wp * rn_sponge_tra * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) 
     255            END DO 
     256         END DO 
     257         CALL lbc_lnk( 'agrif_Sponge', fsaht_spu, 'U', 1. )   ! Lateral boundary conditions 
     258         CALL lbc_lnk( 'agrif_Sponge', fsaht_spv, 'V', 1. ) 
    168259          
    169260         spongedoneT = .TRUE. 
     
    176267         DO jj = 2, jpjm1 
    177268            DO ji = 2, jpim1   ! vector opt. 
    178                fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj) 
    179                fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji  ,jj  ) + ztabramp(ji  ,jj+1) & 
    180                                                      &  +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj  ) ) 
    181             END DO 
    182          END DO 
    183          CALL lbc_lnk( 'agrif_oce_sponge', fsahm_spt, 'T', 1. )   ! Lateral boundary conditions 
    184          CALL lbc_lnk( 'agrif_oce_sponge', fsahm_spf, 'F', 1. ) 
     269               fsahm_spt(ji,jj) = rn_sponge_dyn * ztabramp(ji,jj) 
     270               fsahm_spf(ji,jj) = 0.25_wp * rn_sponge_dyn * ( ztabramp(ji  ,jj  ) + ztabramp(ji  ,jj+1) & 
     271                                                          &  +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj  ) ) 
     272            END DO 
     273         END DO 
     274         CALL lbc_lnk( 'agrif_Sponge', fsahm_spt, 'T', 1. )   ! Lateral boundary conditions 
     275         CALL lbc_lnk( 'agrif_Sponge', fsahm_spf, 'F', 1. ) 
    185276          
    186277         spongedoneU = .TRUE. 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_update.F90

    r11243 r11574  
    1 #define TWO_WAY        /* TWO WAY NESTING */ 
    21#undef DECAL_FEEDBACK  /* SEPARATION of INTERFACES*/ 
    32#undef VOL_REFLUX      /* VOLUME REFLUXING*/ 
     
    4645      IF (Agrif_Root()) RETURN 
    4746      ! 
    48 #if defined TWO_WAY   
    4947      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed() 
    5048 
     
    6462      Agrif_UseSpecialValueInUpdate = .FALSE. 
    6563      ! 
    66 #endif 
    6764      ! 
    6865   END SUBROUTINE Agrif_Update_Tra 
     
    7572      IF (Agrif_Root()) RETURN 
    7673      ! 
    77 #if defined TWO_WAY 
    7874      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed() 
    7975 
     
    121117#  endif 
    122118      END IF 
    123 #endif 
    124119      ! 
    125120   END SUBROUTINE Agrif_Update_Dyn 
     
    131126      !  
    132127      IF (Agrif_Root()) RETURN 
    133       ! 
    134 #if defined TWO_WAY 
    135128      ! 
    136129      Agrif_UseSpecialValueInUpdate = .TRUE. 
     
    157150#  endif 
    158151      ! 
    159 #endif 
    160       ! 
    161152   END SUBROUTINE Agrif_Update_ssh 
    162153 
     
    170161      IF (Agrif_Root()) RETURN 
    171162      !        
    172 #  if defined TWO_WAY 
    173  
    174163      Agrif_UseSpecialValueInUpdate = .TRUE. 
    175164      Agrif_SpecialValueFineGrid = 0. 
     
    180169 
    181170      Agrif_UseSpecialValueInUpdate = .FALSE. 
    182  
    183 #  endif 
    184171       
    185172   END SUBROUTINE Agrif_Update_Tke 
     
    192179      ! 
    193180      IF (Agrif_Root()) RETURN 
    194       ! 
    195 #if defined TWO_WAY   
    196181      ! 
    197182      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step() 
     
    209194      CALL dom_vvl_update_UVF 
    210195      CALL Agrif_ParentGrid_To_ChildGrid() 
    211       ! 
    212 #endif 
    213196      ! 
    214197   END SUBROUTINE Agrif_Update_vvl 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_top_interp.F90

    r10068 r11574  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_top_update.F90

    r11078 r11574  
    1 #define TWO_WAY 
    21#undef DECAL_FEEDBACK 
    32 
     
    4039      IF (Agrif_Root()) RETURN  
    4140      ! 
    42 #if defined TWO_WAY    
    4341      Agrif_UseSpecialValueInUpdate = .TRUE. 
    4442      Agrif_SpecialValueFineGrid    = 0._wp 
     
    5351      ! 
    5452      Agrif_UseSpecialValueInUpdate = .FALSE. 
    55       ! 
    56 #endif 
    5753      ! 
    5854   END SUBROUTINE Agrif_Update_Trc 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90

    r11573 r11574  
    66   !! Software governed by the CeCILL license (see ./LICENSE) 
    77   !!---------------------------------------------------------------------- 
    8 SUBROUTINE agrif_user 
    9 END SUBROUTINE agrif_user 
    10  
    11 SUBROUTINE agrif_before_regridding 
    12 END SUBROUTINE agrif_before_regridding 
    13  
    14 SUBROUTINE Agrif_InitWorkspace 
    15       !!---------------------------------------------------------------------- 
    16       !!                 *** ROUTINE Agrif_InitWorkspace *** 
    17       !!---------------------------------------------------------------------- 
    18    USE par_oce 
    19    USE dom_oce 
    20    USE nemogcm 
    21    USE mppini 
    22       !! 
    23    IMPLICIT NONE 
    24       !!---------------------------------------------------------------------- 
    25    ! 
    26    IF( .NOT. Agrif_Root() ) THEN 
    27       ! no more static variables 
    28 !!$! JC: change to allow for different vertical levels 
    29 !!$!     jpk is already set 
    30 !!$!     keep it jpk possibly different from jpkglo which  
    31 !!$!     hold parent grid vertical levels number (set earlier) 
    32 !!$!      jpk     = jpkglo  
    33    ENDIF 
    34    ! 
    35 END SUBROUTINE Agrif_InitWorkspace 
    36  
    37  
    38 SUBROUTINE Agrif_InitValues 
     8   SUBROUTINE agrif_user 
     9   END SUBROUTINE agrif_user 
     10 
     11   SUBROUTINE agrif_before_regridding 
     12   END SUBROUTINE agrif_before_regridding 
     13 
     14   SUBROUTINE Agrif_InitWorkspace 
     15   END SUBROUTINE Agrif_InitWorkspace 
     16 
     17   SUBROUTINE Agrif_InitValues 
    3918      !!---------------------------------------------------------------------- 
    4019      !!                 *** ROUTINE Agrif_InitValues *** 
    41       !! 
    42       !! ** Purpose :: Declaration of variables to be interpolated 
    43       !!---------------------------------------------------------------------- 
    44    USE Agrif_Util 
    45    USE oce  
    46    USE dom_oce 
    47    USE nemogcm 
    48    USE tradmp 
    49    USE bdy_oce   , ONLY: ln_bdy 
    50    !! 
    51    IMPLICIT NONE 
    52       !!---------------------------------------------------------------------- 
    53    ! 
    54    CALL nemo_init       !* Initializations of each fine grid 
    55  
    56    !                    !* Agrif initialization 
    57    CALL agrif_nemo_init 
    58    CALL Agrif_InitValues_cont_dom 
    59    CALL Agrif_InitValues_cont 
     20      !!---------------------------------------------------------------------- 
     21      USE nemogcm 
     22      !!---------------------------------------------------------------------- 
     23      ! 
     24      CALL nemo_init       !* Initializations of each fine grid 
     25      ! 
     26      !                    !* Agrif initialization 
     27      CALL agrif_nemo_init 
     28      CALL Agrif_InitValues_cont_dom 
     29      CALL Agrif_InitValues_cont 
    6030# if defined key_top 
    61    CALL Agrif_InitValues_cont_top 
     31      CALL Agrif_InitValues_cont_top 
    6232# endif 
    6333# if defined key_si3 
    64    CALL Agrif_InitValues_cont_ice 
     34      CALL Agrif_InitValues_cont_ice 
    6535# endif 
    66    !     
    67 END SUBROUTINE Agrif_initvalues 
    68  
    69  
    70 SUBROUTINE Agrif_InitValues_cont_dom 
    71       !!---------------------------------------------------------------------- 
    72       !!                 *** ROUTINE Agrif_InitValues_cont *** 
    73       !! 
    74       !! ** Purpose ::   Declaration of variables to be interpolated 
    75       !!---------------------------------------------------------------------- 
    76    USE Agrif_Util 
    77    USE oce  
    78    USE dom_oce 
    79    USE nemogcm 
    80    USE in_out_manager 
    81    USE agrif_oce_update 
    82    USE agrif_oce_interp 
    83    USE agrif_oce_sponge 
    84    ! 
    85    IMPLICIT NONE 
    86       !!---------------------------------------------------------------------- 
    87    ! 
    88    ! Declaration of the type of variable which have to be interpolated 
    89    ! 
    90    CALL agrif_declare_var_dom 
    91    ! 
    92 END SUBROUTINE Agrif_InitValues_cont_dom 
    93  
    94  
    95 SUBROUTINE agrif_declare_var_dom 
    96       !!---------------------------------------------------------------------- 
    97       !!                 *** ROUTINE agrif_declare_var *** 
    98       !! 
    99       !! ** Purpose :: Declaration of variables to be interpolated 
    100       !!---------------------------------------------------------------------- 
    101    USE agrif_util 
    102    USE par_oce        
    103    USE oce 
    104    ! 
    105    IMPLICIT NONE 
    106    ! 
    107    INTEGER :: ind1, ind2, ind3 
     36      !     
     37   END SUBROUTINE Agrif_initvalues 
     38 
     39   SUBROUTINE Agrif_InitValues_cont_dom 
     40      !!---------------------------------------------------------------------- 
     41      !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
     42      !!---------------------------------------------------------------------- 
     43      ! 
     44      CALL agrif_declare_var_dom 
     45      ! 
     46   END SUBROUTINE Agrif_InitValues_cont_dom 
     47 
     48   SUBROUTINE agrif_declare_var_dom 
     49      !!---------------------------------------------------------------------- 
     50      !!                 *** ROUTINE agrif_declare_var_dom *** 
     51      !!---------------------------------------------------------------------- 
     52      USE par_oce, ONLY:  nbghostcells       
     53      ! 
     54      IMPLICIT NONE 
     55      ! 
     56      INTEGER :: ind1, ind2, ind3 
    10857      !!---------------------------------------------------------------------- 
    10958 
    11059      ! 1. Declaration of the type of variable which have to be interpolated 
    11160      !--------------------------------------------------------------------- 
    112    ind1 =     nbghostcells 
    113    ind2 = 1 + nbghostcells 
    114    ind3 = 2 + nbghostcells 
    115    CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
    116    CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
     61      ind1 =     nbghostcells 
     62      ind2 = 1 + nbghostcells 
     63      ind3 = 2 + nbghostcells 
     64      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
     65      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
    11766 
    11867      ! 2. Type of interpolation 
    11968      !------------------------- 
    120    CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
    121    CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
     69      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
     70      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    12271 
    12372      ! 3. Location of interpolation 
    12473      !----------------------------- 
    125    CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    126    CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
     74      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
     75      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
    12776 
    12877      ! 4. Update type 
    12978      !---------------  
    13079# if defined UPD_HIGH 
    131    CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 
    132    CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 
     80      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 
     81      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 
    13382#else 
    134    CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    135    CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     83      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     84      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    13685#endif 
    13786 
    138 END SUBROUTINE agrif_declare_var_dom 
    139  
    140  
    141 SUBROUTINE Agrif_InitValues_cont 
     87   END SUBROUTINE agrif_declare_var_dom 
     88 
     89   SUBROUTINE Agrif_InitValues_cont 
    14290      !!---------------------------------------------------------------------- 
    14391      !!                 *** ROUTINE Agrif_InitValues_cont *** 
    144       !! 
    145       !! ** Purpose ::   Declaration of variables to be interpolated 
    146       !!---------------------------------------------------------------------- 
    147    USE agrif_oce_update 
    148    USE agrif_oce_interp 
    149    USE agrif_oce_sponge 
    150    USE Agrif_Util 
    151    USE oce  
    152    USE dom_oce 
    153    USE zdf_oce 
    154    USE nemogcm 
    155    ! 
    156    USE lib_mpp 
    157    USE in_out_manager 
    158    ! 
    159    IMPLICIT NONE 
    160    ! 
    161    LOGICAL :: check_namelist 
    162    CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    163       !!---------------------------------------------------------------------- 
    164  
    165    ! 1. Declaration of the type of variable which have to be interpolated 
    166    !--------------------------------------------------------------------- 
    167    CALL agrif_declare_var 
    168  
    169    ! 2. First interpolations of potentially non zero fields 
    170    !------------------------------------------------------- 
    171    Agrif_SpecialValue    = 0._wp 
    172    Agrif_UseSpecialValue = .TRUE. 
    173    CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
    174    CALL Agrif_Sponge 
    175    tabspongedone_tsn = .FALSE. 
    176    CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    177    ! reset tsa to zero 
    178    tsa(:,:,:,:) = 0. 
    179  
    180    Agrif_UseSpecialValue = ln_spc_dyn 
    181    CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
    182    CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
    183    tabspongedone_u = .FALSE. 
    184    tabspongedone_v = .FALSE. 
    185    CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 
    186    tabspongedone_u = .FALSE. 
    187    tabspongedone_v = .FALSE. 
    188    CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
    189  
    190    Agrif_UseSpecialValue = .TRUE. 
    191    CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
    192    hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0 
    193    ssha(:,:) = 0.e0 
    194  
    195    IF ( ln_dynspg_ts ) THEN 
     92      !!---------------------------------------------------------------------- 
     93      USE agrif_oce 
     94      USE agrif_oce_interp 
     95      USE agrif_oce_sponge 
     96      USE dom_oce 
     97      USE oce 
     98      USE lib_mpp 
     99      ! 
     100      IMPLICIT NONE 
     101      ! 
     102      LOGICAL :: check_namelist 
     103      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
     104      !!---------------------------------------------------------------------- 
     105 
     106      ! 1. Declaration of the type of variable which have to be interpolated 
     107      !--------------------------------------------------------------------- 
     108      CALL agrif_declare_var 
     109 
     110      ! 2. First interpolations of potentially non zero fields 
     111      !------------------------------------------------------- 
     112      Agrif_SpecialValue    = 0._wp 
     113      Agrif_UseSpecialValue = .TRUE. 
     114      CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
     115      CALL Agrif_Sponge 
     116      tabspongedone_tsn = .FALSE. 
     117      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
     118      ! reset tsa to zero 
     119      tsa(:,:,:,:) = 0._wp 
     120 
    196121      Agrif_UseSpecialValue = ln_spc_dyn 
    197       CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
    198       CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
    199       CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    200       CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
    201       ubdy_w(:,:) = 0.e0 ; vbdy_w(:,:) = 0.e0 
    202       ubdy_e(:,:) = 0.e0 ; vbdy_e(:,:) = 0.e0 
    203       ubdy_n(:,:) = 0.e0 ; vbdy_n(:,:) = 0.e0 
    204       ubdy_s(:,:) = 0.e0 ; vbdy_s(:,:) = 0.e0 
    205    ENDIF 
    206  
    207    Agrif_UseSpecialValue = .FALSE.  
    208    ! reset velocities to zero 
    209    ua(:,:,:) = 0. 
    210    va(:,:,:) = 0. 
    211  
    212    ! 3. Some controls 
    213    !----------------- 
    214    check_namelist = .TRUE. 
    215  
    216    IF( check_namelist ) THEN  
    217  
    218       ! Check time steps            
    219       IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    220          WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt)) 
    221          WRITE(cl_check2,*)  NINT(rdt) 
    222          WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 
    223          CALL ctl_stop( 'Incompatible time step between ocean grids',   & 
    224                &               'parent grid value : '//cl_check1    ,   &  
    225                &               'child  grid value : '//cl_check2    ,   &  
    226                &               'value on child grid should be changed to : '//cl_check3 ) 
    227       ENDIF 
    228  
    229       ! Check run length 
    230       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    231             Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
    232          WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    233          WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    234          CALL ctl_warn( 'Incompatible run length between grids'                      ,   & 
    235                &               'nit000 on fine grid will be changed to : '//cl_check1,   & 
    236                &               'nitend on fine grid will be changed to : '//cl_check2    ) 
    237          nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    238          nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    239       ENDIF 
    240  
    241       ! Check free surface scheme 
    242       IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
    243          & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 
    244          WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts ) 
    245          WRITE(cl_check2,*)  ln_dynspg_ts 
    246          WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp ) 
    247          WRITE(cl_check4,*)  ln_dynspg_exp 
    248          CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  & 
    249                &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  &  
    250                &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  & 
    251                &               'parent grid ln_dynspg_exp :'//cl_check3  ,  & 
    252                &               'child  grid ln_dynspg_exp :'//cl_check4  ,  & 
    253                &               'those logicals should be identical' )                  
    254          STOP 
    255       ENDIF 
    256  
    257       ! Check if identical linear free surface option 
    258       IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 
    259          & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 
    260          WRITE(cl_check1,*)  Agrif_Parent(ln_linssh ) 
    261          WRITE(cl_check2,*)  ln_linssh 
    262          CALL ctl_stop( 'Incompatible linearized fs option between grids',  & 
    263                &               'parent grid ln_linssh  :'//cl_check1     ,  & 
    264                &               'child  grid ln_linssh  :'//cl_check2     ,  & 
    265                &               'those logicals should be identical' )                   
    266          STOP 
    267       ENDIF 
    268  
    269       ! check if masks and bathymetries match 
    270       IF(ln_chk_bathy) THEN 
     122      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
     123      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
     124      tabspongedone_u = .FALSE. 
     125      tabspongedone_v = .FALSE. 
     126      CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 
     127      tabspongedone_u = .FALSE. 
     128      tabspongedone_v = .FALSE. 
     129      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     130      ua(:,:,:) = 0._wp 
     131      va(:,:,:) = 0._wp 
     132 
     133      Agrif_UseSpecialValue = .TRUE. 
     134      CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
     135      hbdy(:,:) = 0._wp 
     136      ssha(:,:) = 0._wp 
     137 
     138      IF ( ln_dynspg_ts ) THEN 
     139         Agrif_UseSpecialValue = ln_spc_dyn 
     140         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
     141         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
     142         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
     143         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     144         ubdy(:,:) = 0._wp 
     145         vbdy(:,:) = 0._wp 
     146      ENDIF 
     147 
     148      Agrif_UseSpecialValue = .FALSE. 
     149 
     150      ! 3. Some controls 
     151      !----------------- 
     152      check_namelist = .TRUE. 
     153 
     154      IF( check_namelist ) THEN  
     155 
     156         ! Check time steps            
     157         IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     158            WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt)) 
     159            WRITE(cl_check2,*)  NINT(rdt) 
     160            WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 
     161            CALL ctl_stop( 'Incompatible time step between ocean grids',   & 
     162                  &               'parent grid value : '//cl_check1    ,   &  
     163                  &               'child  grid value : '//cl_check2    ,   &  
     164                  &               'value on child grid should be changed to : '//cl_check3 ) 
     165         ENDIF 
     166 
     167         ! Check run length 
     168         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     169               Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
     170            WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     171            WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
     172            CALL ctl_warn( 'Incompatible run length between grids'                      ,   & 
     173                  &               'nit000 on fine grid will be changed to : '//cl_check1,   & 
     174                  &               'nitend on fine grid will be changed to : '//cl_check2    ) 
     175            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     176            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
     177         ENDIF 
     178 
     179         ! Check free surface scheme 
     180         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
     181            & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 
     182            WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts ) 
     183            WRITE(cl_check2,*)  ln_dynspg_ts 
     184            WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp ) 
     185            WRITE(cl_check4,*)  ln_dynspg_exp 
     186            CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  & 
     187                  &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  &  
     188                  &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  & 
     189                  &               'parent grid ln_dynspg_exp :'//cl_check3  ,  & 
     190                  &               'child  grid ln_dynspg_exp :'//cl_check4  ,  & 
     191                  &               'those logicals should be identical' )                  
     192            STOP 
     193         ENDIF 
     194 
     195         ! Check if identical linear free surface option 
     196         IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 
     197            & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 
     198            WRITE(cl_check1,*)  Agrif_Parent(ln_linssh ) 
     199            WRITE(cl_check2,*)  ln_linssh 
     200            CALL ctl_stop( 'Incompatible linearized fs option between grids',  & 
     201                  &               'parent grid ln_linssh  :'//cl_check1     ,  & 
     202                  &               'child  grid ln_linssh  :'//cl_check2     ,  & 
     203                  &               'those logicals should be identical' )                   
     204            STOP 
     205         ENDIF 
     206 
     207         ! check if masks and bathymetries match 
     208         IF(ln_chk_bathy) THEN 
     209            ! 
     210            IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
     211            ! 
     212            kindic_agr = 0 
     213            ! check if umask agree with parent along western and eastern boundaries: 
     214            CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 
     215            ! check if vmask agree with parent along northern and southern boundaries: 
     216            CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 
     217            ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 
     218            CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
     219            ! 
     220            CALL mpp_sum( 'agrif_user', kindic_agr ) 
     221            IF( kindic_agr /= 0 ) THEN 
     222               CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 
     223            ELSE 
     224               IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 
     225            END IF 
     226         ENDIF 
    271227         ! 
    272          IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
    273          ! 
    274          kindic_agr = 0 
    275          ! check if umask agree with parent along western and eastern boundaries: 
    276          CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 
    277          ! check if vmask agree with parent along northern and southern boundaries: 
    278          CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 
    279          ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 
    280          CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
    281          ! 
    282          CALL mpp_sum( 'agrif_user', kindic_agr ) 
    283          IF( kindic_agr /= 0 ) THEN 
    284             CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 
    285          ELSE 
    286             IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 
    287          END IF 
    288       ENDIF 
    289       ! 
    290    ENDIF 
    291    !  
    292 END SUBROUTINE Agrif_InitValues_cont 
    293  
    294 SUBROUTINE agrif_declare_var 
    295       !!---------------------------------------------------------------------- 
    296       !!                 *** ROUTINE agrif_declarE_var *** 
    297       !! 
    298       !! ** Purpose :: Declaration of variables to be interpolated 
    299       !!---------------------------------------------------------------------- 
    300    USE agrif_util 
    301    USE agrif_oce 
    302    USE par_oce       ! ocean parameters 
    303    USE zdf_oce       ! vertical physics 
    304    USE oce 
    305    ! 
    306    IMPLICIT NONE 
    307    ! 
    308    INTEGER :: ind1, ind2, ind3 
    309       !!---------------------------------------------------------------------- 
    310  
    311    ! 1. Declaration of the type of variable which have to be interpolated 
    312    !--------------------------------------------------------------------- 
    313    ind1 =     nbghostcells 
    314    ind2 = 1 + nbghostcells 
    315    ind3 = 2 + nbghostcells 
     228      ENDIF 
     229      !  
     230   END SUBROUTINE Agrif_InitValues_cont 
     231 
     232   SUBROUTINE agrif_declare_var 
     233      !!---------------------------------------------------------------------- 
     234      !!                 *** ROUTINE agrif_declare_var *** 
     235      !!---------------------------------------------------------------------- 
     236      USE agrif_util 
     237      USE agrif_oce 
     238      USE par_oce 
     239      USE zdf_oce  
     240      USE oce 
     241      ! 
     242      IMPLICIT NONE 
     243      ! 
     244      INTEGER :: ind1, ind2, ind3 
     245      !!---------------------------------------------------------------------- 
     246 
     247      ! 1. Declaration of the type of variable which have to be interpolated 
     248      !--------------------------------------------------------------------- 
     249      ind1 =     nbghostcells 
     250      ind2 = 1 + nbghostcells 
     251      ind3 = 2 + nbghostcells 
    316252# if defined key_vertical 
    317    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 
    318    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 
    319  
    320    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
    321    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
    322    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
    323    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
    324    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 
    325    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 
     253      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 
     254      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 
     255 
     256      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
     257      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
     258      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
     259      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
     260      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 
     261      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 
    326262# else 
    327    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) 
    328    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) 
    329  
    330    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 
    331    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 
    332    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 
    333    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 
    334    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 
    335    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 
     263      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) 
     264      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) 
     265 
     266      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 
     267      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 
     268      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 
     269      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 
     270      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 
     271      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 
    336272# endif 
    337273 
    338    CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
    339    CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
    340    CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
    341  
    342    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) 
    343  
    344    CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
    345    CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
    346    CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
    347    CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
    348    CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
    349    CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
    350  
    351    CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
    352  
    353    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    354 !      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
    355 !      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
     274      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     275      CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
     276      CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
     277 
     278      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) 
     279 
     280      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
     281      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
     282      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
     283      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
     284      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
     285      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
     286 
     287      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     288 
     289      IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     290!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
     291!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
    356292# if defined key_vertical 
    357       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 
     293         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 
    358294# else 
    359       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
     295         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
    360296# endif 
    361    ENDIF 
    362  
    363    ! 2. Type of interpolation 
    364    !------------------------- 
    365    CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    366  
    367    CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    368    CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    369  
    370    CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
    371  
    372    CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
    373    CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    374    CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    375    CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    376    CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    377  
    378  
    379    CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    380    CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    381  
    382    CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
    383    CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 
    384    CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 
    385  
    386    IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
    387  
    388    ! 3. Location of interpolation 
    389    !----------------------------- 
    390    CALL Agrif_Set_bc(       tsn_id, (/0,ind1/) ) 
    391    CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) ) 
    392    CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) ) 
    393  
    394    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  
    395    CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 
    396    CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 
    397  
    398    CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) ) 
    399    CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) ) 
    400    CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) ) 
    401    CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) ) 
    402    CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
    403  
    404    CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 6  
    405    CALL Agrif_Set_bc( umsk_id, (/0,0/) ) 
    406    CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) 
    407  
    408  
    409    IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
    410  
    411    ! 4. Update type 
    412    !---------------  
    413    CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
     297      ENDIF 
     298 
     299      ! 2. Type of interpolation 
     300      !------------------------- 
     301      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
     302 
     303      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     304      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     305 
     306      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
     307 
     308      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
     309      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     310      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     311      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     312      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     313 
     314 
     315      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     316      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     317 
     318      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
     319      CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 
     320      CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 
     321 
     322      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
     323 
     324      ! 3. Location of interpolation 
     325      !----------------------------- 
     326      CALL Agrif_Set_bc(       tsn_id, (/0,ind1/) ) 
     327      CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) ) 
     328      CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) ) 
     329 
     330      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  
     331      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 
     332      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 
     333 
     334      CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) ) 
     335      CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) ) 
     336      CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) ) 
     337      CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) ) 
     338      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
     339 
     340      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 6  
     341      CALL Agrif_Set_bc( umsk_id, (/0,0/) ) 
     342      CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) 
     343 
     344 
     345      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
     346 
     347      ! 4. Update type 
     348      !---------------  
     349      CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
    414350 
    415351# if defined UPD_HIGH 
    416    CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
    417    CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    418    CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    419  
    420    CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    421    CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    422    CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 
    423    CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
    424  
    425    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    426 !      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
    427 !      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
    428 !      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
    429    ENDIF 
     352      CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
     353      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     354      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     355 
     356      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     357      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     358      CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting) 
     359      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
     360 
     361      IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     362!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
     363!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
     364!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
     365      ENDIF 
    430366 
    431367#else 
    432    CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    433    CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    434    CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    435  
    436    CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    437    CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    438    CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    439    CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
    440  
    441    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    442 !      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
    443 !      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
    444 !      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
    445    ENDIF 
     368      CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     369      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     370      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     371 
     372      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     373      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     374      CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average) 
     375      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
     376 
     377      IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     378!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
     379!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
     380!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
     381      ENDIF 
    446382 
    447383#endif 
    448    ! 
    449 END SUBROUTINE agrif_declare_var 
     384      ! 
     385   END SUBROUTINE agrif_declare_var 
    450386 
    451387#if defined key_si3 
     
    453389      !!---------------------------------------------------------------------- 
    454390      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     391      !!---------------------------------------------------------------------- 
     392      USE Agrif_Util 
     393      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
     394      USE ice 
     395      USE agrif_ice 
     396      USE in_out_manager 
     397      USE agrif_ice_interp 
     398      USE lib_mpp 
     399      ! 
     400      IMPLICIT NONE 
     401      !!---------------------------------------------------------------------- 
     402      ! 
     403      ! Declaration of the type of variable which have to be interpolated (parent=>child) 
     404      !---------------------------------------------------------------------------------- 
     405      CALL agrif_declare_var_ice 
     406 
     407      ! Controls 
     408 
     409      ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom) 
     410      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 
     411      !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 
     412      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 
     413      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 
     414 
     415      ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 
     416      IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN 
     417         CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 
     418      ENDIF 
     419      ! First Interpolations (using "after" ice subtime step => nbstep_ice=1) 
     420      !---------------------------------------------------------------------- 
     421      nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong) 
     422      CALL agrif_interp_ice('U') ! interpolation of ice velocities 
     423      CALL agrif_interp_ice('V') ! interpolation of ice velocities 
     424      CALL agrif_interp_ice('T') ! interpolation of ice tracers  
     425      nbstep_ice = 0    
     426      ! 
     427   END SUBROUTINE Agrif_InitValues_cont_ice 
     428 
     429   SUBROUTINE agrif_declare_var_ice 
     430      !!---------------------------------------------------------------------- 
     431      !!                 *** ROUTINE agrif_declare_var_ice *** 
     432      !!---------------------------------------------------------------------- 
     433      USE Agrif_Util 
     434      USE ice 
     435      USE par_oce, ONLY : nbghostcells 
     436      ! 
     437      IMPLICIT NONE 
     438      ! 
     439      INTEGER :: ind1, ind2, ind3 
     440      !!---------------------------------------------------------------------- 
     441      ! 
     442      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
     443      !       agrif_declare_variable(position,1st point index,--,--,dimensions,name) 
     444      !           ex.:  position=> 1,1 = not-centered (in i and j) 
     445      !                            2,2 =     centered (    -     ) 
     446      !                 index   => 1,1 = one ghost line 
     447      !                            2,2 = two ghost lines 
     448      !------------------------------------------------------------------------------------- 
     449      ind1 =     nbghostcells 
     450      ind2 = 1 + nbghostcells 
     451      ind3 = 2 + nbghostcells 
     452      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
     453      CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  ) 
     454      CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  ) 
     455 
     456      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
     457      !----------------------------------- 
     458      CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear) 
     459      CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   ) 
     460      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear) 
     461 
     462      ! 3. Set location of interpolations 
     463      !---------------------------------- 
     464      CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 
     465      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
     466      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
     467 
     468      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
     469      !-------------------------------------------------- 
     470# if defined UPD_HIGH 
     471      CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting) 
     472      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
     473      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
     474#else 
     475      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average) 
     476      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
     477      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
     478#endif 
     479 
     480   END SUBROUTINE agrif_declare_var_ice 
     481#endif 
     482 
     483 
     484# if defined key_top 
     485   SUBROUTINE Agrif_InitValues_cont_top 
     486      !!---------------------------------------------------------------------- 
     487      !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
     488      !!---------------------------------------------------------------------- 
     489      USE Agrif_Util 
     490      USE oce  
     491      USE dom_oce 
     492      USE nemogcm 
     493      USE par_trc 
     494      USE lib_mpp 
     495      USE trc 
     496      USE in_out_manager 
     497      USE agrif_oce_sponge 
     498      USE agrif_top_update 
     499      USE agrif_top_interp 
     500      USE agrif_top_sponge 
    455501      !! 
    456       !! ** Purpose :: Initialisation of variables to be interpolated for ice 
    457       !!---------------------------------------------------------------------- 
    458    USE Agrif_Util 
    459    USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
    460    USE ice 
    461    USE agrif_ice 
    462    USE in_out_manager 
    463    USE agrif_ice_interp 
    464    USE lib_mpp 
    465    ! 
    466    IMPLICIT NONE 
    467       !!---------------------------------------------------------------------- 
    468    ! 
    469    ! Declaration of the type of variable which have to be interpolated (parent=>child) 
    470    !---------------------------------------------------------------------------------- 
    471    CALL agrif_declare_var_ice 
    472  
    473    ! Controls 
    474  
    475    ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom) 
    476    !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 
    477    !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 
    478    !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 
    479    IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 
    480  
    481    ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 
    482    IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN 
    483       CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 
    484    ENDIF 
    485    ! First Interpolations (using "after" ice subtime step => nbstep_ice=1) 
    486    !---------------------------------------------------------------------- 
    487    nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong) 
    488    CALL agrif_interp_ice('U') ! interpolation of ice velocities 
    489    CALL agrif_interp_ice('V') ! interpolation of ice velocities 
    490    CALL agrif_interp_ice('T') ! interpolation of ice tracers  
    491    nbstep_ice = 0 
    492     
    493    ! 
    494 END SUBROUTINE Agrif_InitValues_cont_ice 
    495  
    496 SUBROUTINE agrif_declare_var_ice 
    497       !!---------------------------------------------------------------------- 
    498       !!                 *** ROUTINE agrif_declare_var_ice *** 
    499       !! 
    500       !! ** Purpose :: Declaration of variables to be interpolated for ice 
    501       !!---------------------------------------------------------------------- 
    502    USE Agrif_Util 
    503    USE ice 
    504    USE par_oce, ONLY : nbghostcells 
    505    ! 
    506    IMPLICIT NONE 
    507    ! 
    508    INTEGER :: ind1, ind2, ind3 
    509       !!---------------------------------------------------------------------- 
    510    ! 
    511    ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
    512    !       agrif_declare_variable(position,1st point index,--,--,dimensions,name) 
    513    !           ex.:  position=> 1,1 = not-centered (in i and j) 
    514    !                            2,2 =     centered (    -     ) 
    515    !                 index   => 1,1 = one ghost line 
    516    !                            2,2 = two ghost lines 
    517    !------------------------------------------------------------------------------------- 
    518    ind1 =     nbghostcells 
    519    ind2 = 1 + nbghostcells 
    520    ind3 = 2 + nbghostcells 
    521    CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
    522    CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  ) 
    523    CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  ) 
    524  
    525    ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
    526    !----------------------------------- 
    527    CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear) 
    528    CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   ) 
    529    CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear) 
    530  
    531    ! 3. Set location of interpolations 
    532    !---------------------------------- 
    533    CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 
    534    CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
    535    CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
    536  
    537    ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
    538    !-------------------------------------------------- 
    539 # if defined UPD_HIGH 
    540    CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting) 
    541    CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
    542    CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
    543 #else 
    544    CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average) 
    545    CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
    546    CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
    547 #endif 
    548  
    549 END SUBROUTINE agrif_declare_var_ice 
    550 #endif 
    551  
    552  
    553 # if defined key_top 
    554 SUBROUTINE Agrif_InitValues_cont_top 
    555       !!---------------------------------------------------------------------- 
    556       !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
    557       !! 
    558       !! ** Purpose :: Declaration of variables to be interpolated 
    559       !!---------------------------------------------------------------------- 
    560    USE Agrif_Util 
    561    USE oce  
    562    USE dom_oce 
    563    USE nemogcm 
    564    USE par_trc 
    565    USE lib_mpp 
    566    USE trc 
    567    USE in_out_manager 
    568    USE agrif_oce_sponge 
    569    USE agrif_top_update 
    570    USE agrif_top_interp 
    571    USE agrif_top_sponge 
    572    !! 
    573    IMPLICIT NONE 
    574    ! 
    575    CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    576    LOGICAL :: check_namelist 
    577       !!---------------------------------------------------------------------- 
    578  
    579  
    580    ! 1. Declaration of the type of variable which have to be interpolated 
    581    !--------------------------------------------------------------------- 
    582    CALL agrif_declare_var_top 
    583  
    584    ! 2. First interpolations of potentially non zero fields 
    585    !------------------------------------------------------- 
    586    Agrif_SpecialValue=0. 
    587    Agrif_UseSpecialValue = .TRUE. 
    588    CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
    589    Agrif_UseSpecialValue = .FALSE. 
    590    CALL Agrif_Sponge 
    591    tabspongedone_trn = .FALSE. 
    592    CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    593    ! reset tsa to zero 
    594    tra(:,:,:,:) = 0. 
    595  
    596  
    597    ! 3. Some controls 
    598    !----------------- 
    599    check_namelist = .TRUE. 
    600  
    601    IF( check_namelist ) THEN 
    602       ! Check time steps 
     502      IMPLICIT NONE 
     503      ! 
     504      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
     505      LOGICAL :: check_namelist 
     506      !!---------------------------------------------------------------------- 
     507 
     508      ! 1. Declaration of the type of variable which have to be interpolated 
     509      !--------------------------------------------------------------------- 
     510      CALL agrif_declare_var_top 
     511 
     512      ! 2. First interpolations of potentially non zero fields 
     513      !------------------------------------------------------- 
     514      Agrif_SpecialValue=0._wp 
     515      Agrif_UseSpecialValue = .TRUE. 
     516      CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
     517      Agrif_UseSpecialValue = .FALSE. 
     518      CALL Agrif_Sponge 
     519      tabspongedone_trn = .FALSE. 
     520      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     521      ! reset tsa to zero 
     522      tra(:,:,:,:) = 0._wp 
     523 
     524      ! 3. Some controls 
     525      !----------------- 
     526      check_namelist = .TRUE. 
     527 
     528      IF( check_namelist ) THEN 
     529         ! Check time steps 
    603530      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    604531         WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     
    630557   ENDIF 
    631558   ! 
    632 END SUBROUTINE Agrif_InitValues_cont_top 
    633  
    634  
    635 SUBROUTINE agrif_declare_var_top 
     559   END SUBROUTINE Agrif_InitValues_cont_top 
     560 
     561 
     562   SUBROUTINE agrif_declare_var_top 
    636563      !!---------------------------------------------------------------------- 
    637564      !!                 *** ROUTINE agrif_declare_var_top *** 
     565      !!---------------------------------------------------------------------- 
     566      USE agrif_util 
     567      USE agrif_oce 
     568      USE dom_oce 
     569      USE trc 
    638570      !! 
    639       !! ** Purpose :: Declaration of TOP variables to be interpolated 
    640       !!---------------------------------------------------------------------- 
    641    USE agrif_util 
    642    USE agrif_oce 
    643    USE dom_oce 
    644    USE trc 
    645    !! 
    646    IMPLICIT NONE 
    647    ! 
    648    INTEGER :: ind1, ind2, ind3 
    649       !!---------------------------------------------------------------------- 
    650  
    651    ! 1. Declaration of the type of variable which have to be interpolated 
    652    !--------------------------------------------------------------------- 
    653    ind1 =     nbghostcells 
    654    ind2 = 1 + nbghostcells 
    655    ind3 = 2 + nbghostcells 
     571      IMPLICIT NONE 
     572      ! 
     573      INTEGER :: ind1, ind2, ind3 
     574      !!---------------------------------------------------------------------- 
     575 
     576      ! 1. Declaration of the type of variable which have to be interpolated 
     577      !--------------------------------------------------------------------- 
     578      ind1 =     nbghostcells 
     579      ind2 = 1 + nbghostcells 
     580      ind3 = 2 + nbghostcells 
    656581# if defined key_vertical 
    657    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 
    658    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 
     582      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 
     583      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 
    659584# else 
    660    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) 
    661    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) 
     585      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) 
     586      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) 
    662587# endif 
    663588 
    664    ! 2. Type of interpolation 
    665    !------------------------- 
    666    CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
    667    CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear) 
    668  
    669    ! 3. Location of interpolation 
    670    !----------------------------- 
    671    CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 
    672    CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    673  
    674    ! 4. Update type 
    675    !---------------  
     589      ! 2. Type of interpolation 
     590      !------------------------- 
     591      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
     592      CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear) 
     593 
     594      ! 3. Location of interpolation 
     595      !----------------------------- 
     596      CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 
     597      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     598 
     599      ! 4. Update type 
     600      !---------------  
    676601# if defined UPD_HIGH 
    677    CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 
     602      CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 
    678603#else 
    679    CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
     604      CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
    680605#endif 
    681606   ! 
    682 END SUBROUTINE agrif_declare_var_top 
     607   END SUBROUTINE agrif_declare_var_top 
    683608# endif 
    684609 
    685 SUBROUTINE Agrif_detect( kg, ksizex ) 
     610   SUBROUTINE Agrif_detect( kg, ksizex ) 
    686611      !!---------------------------------------------------------------------- 
    687612      !!                      *** ROUTINE Agrif_detect *** 
    688613      !!---------------------------------------------------------------------- 
    689    INTEGER, DIMENSION(2) :: ksizex 
    690    INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
    691       !!---------------------------------------------------------------------- 
    692    ! 
    693    RETURN 
    694    ! 
    695 END SUBROUTINE Agrif_detect 
    696  
    697  
    698 SUBROUTINE agrif_nemo_init 
     614      INTEGER, DIMENSION(2) :: ksizex 
     615      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
     616      !!---------------------------------------------------------------------- 
     617      ! 
     618      RETURN 
     619      ! 
     620   END SUBROUTINE Agrif_detect 
     621 
     622   SUBROUTINE agrif_nemo_init 
    699623      !!---------------------------------------------------------------------- 
    700624      !!                     *** ROUTINE agrif_init *** 
    701625      !!---------------------------------------------------------------------- 
    702    USE agrif_oce  
    703    USE agrif_ice 
    704    USE in_out_manager 
    705    USE lib_mpp 
    706    !! 
    707    IMPLICIT NONE 
    708    ! 
    709    INTEGER  ::   ios                 ! Local integer output status for namelist read 
    710    INTEGER  ::   iminspon 
    711    NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
     626      USE agrif_oce  
     627      USE agrif_ice 
     628      USE in_out_manager 
     629      USE lib_mpp 
     630      !! 
     631      IMPLICIT NONE 
     632      ! 
     633      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     634      NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
    712635      !!-------------------------------------------------------------------------------------- 
    713    ! 
    714    REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
    715    READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
     636      ! 
     637      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
     638      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
    716639901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' ) 
    717    REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom 
    718    READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
     640      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom 
     641      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
    719642902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' ) 
    720    IF(lwm) WRITE ( numond, namagrif ) 
    721    ! 
    722    IF(lwp) THEN                    ! control print 
    723       WRITE(numout,*) 
    724       WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 
    725       WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    726       WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    727       WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s' 
    728       WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
    729       WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    730       WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    731    ENDIF 
    732    ! 
    733    ! convert DOCTOR namelist name into OLD names 
    734    visc_tra      = rn_sponge_tra 
    735    visc_dyn      = rn_sponge_dyn 
    736    ! 
    737    ! Check sponge length: 
    738    iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) ) 
    739    IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 
    740    IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large') 
    741    ! 
    742    IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
    743    ! 
    744 END SUBROUTINE agrif_nemo_init 
     643      IF(lwm) WRITE ( numond, namagrif ) 
     644      ! 
     645      IF(lwp) THEN                    ! control print 
     646         WRITE(numout,*) 
     647         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 
     648         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     649         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
     650         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way 
     651         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' m^2/s' 
     652         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s' 
     653         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
     654         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
     655      ENDIF 
     656      ! 
     657      ! 
     658      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     659      ! 
     660   END SUBROUTINE agrif_nemo_init 
    745661 
    746662# if defined key_mpp_mpi 
    747663 
    748 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
     664   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    749665      !!---------------------------------------------------------------------- 
    750666      !!                     *** ROUTINE Agrif_InvLoc *** 
    751667      !!---------------------------------------------------------------------- 
    752    USE dom_oce 
    753    !! 
    754    IMPLICIT NONE 
    755    ! 
    756    INTEGER :: indglob, indloc, nprocloc, i 
    757       !!---------------------------------------------------------------------- 
    758    ! 
    759    SELECT CASE( i ) 
    760    CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
    761    CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
    762    CASE DEFAULT 
    763       indglob = indloc 
    764    END SELECT 
    765    ! 
    766 END SUBROUTINE Agrif_InvLoc 
    767  
    768  
    769 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
     668      USE dom_oce 
     669      !! 
     670      IMPLICIT NONE 
     671      ! 
     672      INTEGER :: indglob, indloc, nprocloc, i 
     673      !!---------------------------------------------------------------------- 
     674      ! 
     675      SELECT CASE( i ) 
     676      CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
     677      CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
     678      CASE DEFAULT 
     679         indglob = indloc 
     680      END SELECT 
     681      ! 
     682   END SUBROUTINE Agrif_InvLoc 
     683 
     684   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
    770685      !!---------------------------------------------------------------------- 
    771686      !!                 *** ROUTINE Agrif_get_proc_info *** 
    772687      !!---------------------------------------------------------------------- 
    773    USE par_oce 
    774    !! 
    775    IMPLICIT NONE 
    776    ! 
    777    INTEGER, INTENT(out) :: imin, imax 
    778    INTEGER, INTENT(out) :: jmin, jmax 
    779       !!---------------------------------------------------------------------- 
    780    ! 
    781    imin = nimppt(Agrif_Procrank+1)  ! ????? 
    782    jmin = njmppt(Agrif_Procrank+1)  ! ????? 
    783    imax = imin + jpi - 1 
    784    jmax = jmin + jpj - 1 
    785    !  
    786 END SUBROUTINE Agrif_get_proc_info 
    787  
    788  
    789 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
     688      USE par_oce 
     689      !! 
     690      IMPLICIT NONE 
     691      ! 
     692      INTEGER, INTENT(out) :: imin, imax 
     693      INTEGER, INTENT(out) :: jmin, jmax 
     694      !!---------------------------------------------------------------------- 
     695      ! 
     696      imin = nimppt(Agrif_Procrank+1)  ! ????? 
     697      jmin = njmppt(Agrif_Procrank+1)  ! ????? 
     698      imax = imin + jpi - 1 
     699      jmax = jmin + jpj - 1 
     700      !  
     701   END SUBROUTINE Agrif_get_proc_info 
     702 
     703   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
    790704      !!---------------------------------------------------------------------- 
    791705      !!                 *** ROUTINE Agrif_estimate_parallel_cost *** 
    792706      !!---------------------------------------------------------------------- 
    793    USE par_oce 
    794    !! 
    795    IMPLICIT NONE 
    796    ! 
    797    INTEGER,  INTENT(in)  :: imin, imax 
    798    INTEGER,  INTENT(in)  :: jmin, jmax 
    799    INTEGER,  INTENT(in)  :: nbprocs 
    800    REAL(wp), INTENT(out) :: grid_cost 
    801       !!---------------------------------------------------------------------- 
    802    ! 
    803    grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 
    804    ! 
    805 END SUBROUTINE Agrif_estimate_parallel_cost 
     707      USE par_oce 
     708      !! 
     709      IMPLICIT NONE 
     710      ! 
     711      INTEGER,  INTENT(in)  :: imin, imax 
     712      INTEGER,  INTENT(in)  :: jmin, jmax 
     713      INTEGER,  INTENT(in)  :: nbprocs 
     714      REAL(wp), INTENT(out) :: grid_cost 
     715      !!---------------------------------------------------------------------- 
     716      ! 
     717      grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 
     718      ! 
     719   END SUBROUTINE Agrif_estimate_parallel_cost 
    806720 
    807721# endif 
    808722 
    809723#else 
    810 SUBROUTINE Subcalledbyagrif 
     724   SUBROUTINE Subcalledbyagrif 
    811725      !!---------------------------------------------------------------------- 
    812726      !!                   *** ROUTINE Subcalledbyagrif *** 
    813727      !!---------------------------------------------------------------------- 
    814    WRITE(*,*) 'Impossible to be here' 
    815 END SUBROUTINE Subcalledbyagrif 
     728      WRITE(*,*) 'Impossible to be here' 
     729   END SUBROUTINE Subcalledbyagrif 
    816730#endif 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/OCE/DYN/dynspg_ts.F90

    r11573 r11574  
    483483         !                             ! values of zhup2_e and zhvp2_e on the halo are not needed in bdy_vol2d 
    484484         IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e ) 
    485          ! 
     485         !       
    486486         !                             ! resulting flux at mid-step (not over the full domain) 
    487487         zhU(1:jpim1,1:jpj  ) = e2u(1:jpim1,1:jpj  ) * ua_e(1:jpim1,1:jpj  ) * zhup2_e(1:jpim1,1:jpj  )   ! not jpi-column 
     
    490490#if defined key_agrif 
    491491         ! Set fluxes during predictor step to ensure volume conservation 
    492          IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 
    493             IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    494                DO jj = 1, jpj 
    495                   zhU(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * e2u(2:nbghostcells+1,jj) 
    496                   zhV(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * e1v(2:nbghostcells+1,jj) 
    497                END DO 
    498             ENDIF 
    499             IF((nbondi ==  1).OR.(nbondi == 2)) THEN 
    500                DO jj=1,jpj 
    501                   zhU(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * e2u(nlci-nbghostcells-1:nlci-2,jj) 
    502                   zhV(nlci-nbghostcells  :nlci-1,jj) = vbdy_e(1:nbghostcells,jj) * e1v(nlci-nbghostcells  :nlci-1,jj) 
    503                END DO 
    504             ENDIF 
    505             IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    506                DO ji=1,jpi 
    507                   zhV(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * e1v(ji,2:nbghostcells+1) 
    508                   zhU(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * e2u(ji,2:nbghostcells+1) 
    509                END DO 
    510             ENDIF 
    511             IF((nbondj ==  1).OR.(nbondj == 2)) THEN 
    512                DO ji=1,jpi 
    513                   zhV(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * e1v(ji,nlcj-nbghostcells-1:nlcj-2) 
    514                   zhU(ji,nlcj-nbghostcells  :nlcj-1) = ubdy_n(ji,1:nbghostcells) * e2u(ji,nlcj-nbghostcells  :nlcj-1) 
    515                END DO 
    516             ENDIF 
    517          ENDIF 
     492         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) CALL agrif_dyn_ts_flux( jn, zhU, zhV ) 
    518493#endif 
    519494         IF( ln_wd_il )   CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rdtbt)    !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV 
Note: See TracChangeset for help on using the changeset viewer.