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 13286 for NEMO/trunk/src/NST – NEMO

Changeset 13286 for NEMO/trunk/src/NST


Ignore:
Timestamp:
2020-07-09T17:48:29+02:00 (4 years ago)
Author:
smasson
Message:

trunk: merge extra halos branch in trunk, see #2366

Location:
NEMO/trunk
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        22^/utils/build/makenemo@HEAD   makenemo 
        33^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools/@HEAD           tools 
         4^/utils/tools@HEAD            tools 
        55^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        … …  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@12931        sette 
         10^/utils/CI/r12931_sette_ticket2366@HEAD  sette 

  • NEMO/trunk/src/NST/agrif_ice_interp.F90

    r13216 r13286  
    269269!            imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2 
    270270!            IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3 
    271 !            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2 
     271!            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = jpj-2 
    272272!            IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3 
    273 !            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2 
     273!            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = jpi-2 
    274274! 
    275275!            ! smoothed fields 
    276276!            IF( eastern_side ) THEN 
    277 !               ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 
     277!               ztab(jpi,j1:j2,:) = z1 * ptab(jpi,j1:j2,:) + z2 * ptab(jpi-1,j1:j2,:) 
    278278!               DO jj = jmin, jmax 
    279279!                  rswitch = 0. 
    280 !                  IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 
    281 !                  ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  & 
    282 !                     &                +      umask(nlci-2,jj,1)   *  & 
    283 !                     &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  & 
    284 !                     &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 
    285 !                  ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 
     280!                  IF( u_ice(jpi-2,jj) > 0._wp ) rswitch = 1. 
     281!                  ztab(jpi-1,jj,:) = ( 1. - umask(jpi-2,jj,1) ) * ztab(jpi,jj,:)  & 
     282!                     &               +      umask(jpi-2,jj,1)   *  & 
     283!                     &               ( (1. - rswitch) * ( z4 * ztab(jpi  ,jj,:) + z3 * ztab(jpi-2,jj,:) )  & 
     284!                     &                 +     rswitch  * ( z6 * ztab(jpi-2,jj,:) + z5 * ztab(jpi  ,jj,:) + z7 * ztab(jpi-3,jj,:) ) ) 
     285!                  ztab(jpi-1,jj,:) = ztab(jpi-1,jj,:) * tmask(jpi-1,jj,1) 
    286286!               END DO 
    287287!            ENDIF 
    288288!            !  
    289289!            IF( northern_side ) THEN 
    290 !               ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 
     290!               ztab(i1:i2,jpj,:) = z1 * ptab(i1:i2,jpj,:) + z2 * ptab(i1:i2,jpj-1,:) 
    291291!               DO ji = imin, imax 
    292292!                  rswitch = 0. 
    293 !                  IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 
    294 !                  ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  & 
    295 !                     &                +      vmask(ji,nlcj-2,1)   *  & 
    296 !                     &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) & 
    297 !                     &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 
    298 !                  ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 
     293!                  IF( v_ice(ji,jpj-2) > 0._wp ) rswitch = 1. 
     294!                  ztab(ji,jpj-1,:) = ( 1. - vmask(ji,jpj-2,1) ) * ztab(ji,jpj,:)  & 
     295!                     &               +      vmask(ji,jpj-2,1)   *  & 
     296!                     &               ( (1. - rswitch) * ( z4 * ztab(ji,jpj  ,:) + z3 * ztab(ji,jpj-2,:) ) & 
     297!                     &                 +     rswitch  * ( z6 * ztab(ji,jpj-2,:) + z5 * ztab(ji,jpj  ,:) + z7 * ztab(ji,jpj-3,:) ) ) 
     298!                  ztab(ji,jpj-1,:) = ztab(ji,jpj-1,:) * tmask(ji,jpj-1,1) 
    299299!               END DO 
    300300!            END IF 
    … …  
    327327!            ! 
    328328!            ! Treatment of corners 
    329 !            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south 
    330 !            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 
    331 !            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south 
    332 !            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north 
     329!            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(jpi-1,2    ,:) = ptab(jpi-1,    2,:)   ! East south 
     330!            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(jpi-1,jpj-1,:) = ptab(jpi-1,jpj-1,:)  ! East north 
     331!            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(    2,    2,:) = ptab(    2,    2,:)   ! West south 
     332!            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(    2,jpj-1,:) = ptab(    2,jpj-1,:)   ! West north 
    333333!             
    334334!            ! retrieve ice tracers 

  • NEMO/trunk/src/NST/agrif_oce.F90

    r13216 r13286  
    6868   INTEGER, PUBLIC :: avt_id, avm_id, en_id                ! TKE related identificators 
    6969   INTEGER, PUBLIC :: mbkt_id, ht0_id 
     70   INTEGER, PUBLIC :: glamt_id, gphit_id 
    7071   INTEGER, PUBLIC :: kindic_agr 
    7172 

  • NEMO/trunk/src/NST/agrif_oce_interp.F90

    r13216 r13286  
    4444   PUBLIC   interptsn, interpsshn, interpavm 
    4545   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    46    PUBLIC   interpe3t 
     46   PUBLIC   interpe3t, interpglamt, interpgphit 
    4747   PUBLIC   interpht0, interpmbkt 
    4848   PUBLIC   agrif_initts, agrif_initssh 
    … …  
    8787      IF( Agrif_Root() )   RETURN 
    8888      ! 
    89       Agrif_SpecialValue    = 0._wp 
     89      Agrif_SpecialValue    = 0.0_wp 
    9090      Agrif_UseSpecialValue = ln_spc_dyn 
    9191      ! 
    9292      use_sign_north = .TRUE. 
    93       sign_north = -1. 
     93      sign_north = -1.0_wp 
    9494      CALL Agrif_Bc_variable( un_interp_id, procname=interpun ) 
    9595      CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn ) 
    … …  
    100100      ! --- West --- ! 
    101101      IF( lk_west ) THEN 
    102          ibdy1 = 2 
    103          ibdy2 = 1+nbghostcells  
     102         ibdy1 = nn_hls + 2                  ! halo + land + 1 
     103         ibdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
    104104         ! 
    105105         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    106106            DO ji = mi0(ibdy1), mi1(ibdy2) 
    107107               uu_b(ji,:,Krhs_a) = 0._wp 
    108  
    109108               DO jk = 1, jpkm1 
    110109                  DO jj = 1, jpj 
    … …  
    112111                  END DO 
    113112               END DO 
    114  
    115113               DO jj = 1, jpj 
    116114                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
    … …  
    123121            DO jk = 1, jpkm1 
    124122               DO jj = 1, jpj 
    125                   zub(ji,jj) = zub(ji,jj) &  
    126                      & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 
     123                  zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    127124               END DO 
    128125            END DO 
    129126            DO jj=1,jpj 
    130127               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    131             END DO 
    132                 
     128            END DO  
    133129            DO jk = 1, jpkm1 
    134130               DO jj = 1, jpj 
    135                   uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a)-zub(ji,jj)) * umask(ji,jj,jk) 
    136                END DO 
    137             END DO 
    138          END DO 
    139                 
     131                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     132               END DO 
     133            END DO 
     134         END DO 
     135         !    
    140136         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    141137            DO ji = mi0(ibdy1), mi1(ibdy2) 
    … …  
    151147               DO jk = 1, jpkm1 
    152148                  DO jj = 1, jpj 
    153                      vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a)-zvb(ji,jj))*vmask(ji,jj,jk) 
     149                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk) 
    154150                  END DO 
    155151               END DO 
    156152            END DO 
    157153         ENDIF 
     154         ! 
    158155      ENDIF 
    159156 
    160157      ! --- East --- ! 
    161158      IF( lk_east) THEN 
    162          ibdy1 = jpiglo-1-nbghostcells 
    163          ibdy2 = jpiglo-2  
     159         ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     160         ibdy2 = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    164161         ! 
    165162         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    … …  
    168165               DO jk = 1, jpkm1 
    169166                  DO jj = 1, jpj 
    170                      uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) &  
    171                          & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     167                     uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    172168                  END DO 
    173169               END DO 
    … …  
    182178            DO jk = 1, jpkm1 
    183179               DO jj = 1, jpj 
    184                   zub(ji,jj) = zub(ji,jj) &  
    185                      & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     180                  zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    186181               END DO 
    187182            END DO 
    … …  
    189184               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    190185            END DO 
    191                 
    192186            DO jk = 1, jpkm1 
    193187               DO jj = 1, jpj 
    194                   uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    195                     & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk) 
    196                END DO 
    197             END DO 
    198          END DO 
    199                 
     188                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     189               END DO 
     190            END DO 
     191         END DO 
     192         ! 
    200193         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    201             ibdy1 = jpiglo-nbghostcells 
    202             ibdy2 = jpiglo-1  
     194            ibdy1 = jpiglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     195            ibdy2 = jpiglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
    203196            DO ji = mi0(ibdy1), mi1(ibdy2) 
    204197               zvb(ji,:) = 0._wp 
    205198               DO jk = 1, jpkm1 
    206199                  DO jj = 1, jpj 
    207                      zvb(ji,jj) = zvb(ji,jj) & 
    208                         & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     200                     zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    209201                  END DO 
    210202               END DO 
    … …  
    214206               DO jk = 1, jpkm1 
    215207                  DO jj = 1, jpj 
    216                      vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    217                          & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 
     208                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    218209                  END DO 
    219210               END DO 
    220211            END DO 
    221212         ENDIF 
     213         ! 
    222214      ENDIF 
    223215 
    224216      ! --- South --- ! 
    225217      IF( lk_south ) THEN 
    226          jbdy1 = 2 
    227          jbdy2 = 1+nbghostcells  
     218         jbdy1 = nn_hls + 2                  ! halo + land + 1 
     219         jbdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
    228220         ! 
    229221         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    … …  
    232224               DO jk = 1, jpkm1 
    233225                  DO ji = 1, jpi 
    234                      vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
    235                          & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     226                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    236227                  END DO 
    237228               END DO 
    … …  
    246237            DO jk=1,jpkm1 
    247238               DO ji=1,jpi 
    248                   zvb(ji,jj) = zvb(ji,jj) &  
    249                      & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     239                  zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    250240               END DO 
    251241            END DO 
    … …  
    253243               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    254244            END DO 
    255  
    256245            DO jk = 1, jpkm1 
    257246               DO ji = 1, jpi 
    258                   vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    259                     & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    260                END DO 
    261             END DO 
    262          END DO 
    263                 
     247                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     248               END DO 
     249            END DO 
     250         END DO 
     251         ! 
    264252         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    265253            DO jj = mj0(jbdy1), mj1(jbdy2) 
    … …  
    267255               DO jk = 1, jpkm1 
    268256                  DO ji = 1, jpi 
    269                      zub(ji,jj) = zub(ji,jj) &  
    270                         & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     257                     zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    271258                  END DO 
    272259               END DO 
    … …  
    274261                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    275262               END DO 
    276                    
    277263               DO jk = 1, jpkm1 
    278264                  DO ji = 1, jpi 
    279                      uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    280                        & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     265                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
    281266                  END DO 
    282267               END DO 
    283268            END DO 
    284269         ENDIF 
     270         ! 
    285271      ENDIF 
    286272 
    287273      ! --- North --- ! 
    288274      IF( lk_north ) THEN 
    289          jbdy1 = jpjglo-1-nbghostcells 
    290          jbdy2 = jpjglo-2  
     275         jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     276         jbdy2 = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    291277         ! 
    292278         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    … …  
    295281               DO jk = 1, jpkm1 
    296282                  DO ji = 1, jpi 
    297                      vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
    298                          & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     283                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    299284                  END DO 
    300285               END DO 
    … …  
    309294            DO jk=1,jpkm1 
    310295               DO ji=1,jpi 
    311                   zvb(ji,jj) = zvb(ji,jj) &  
    312                      & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     296                  zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    313297               END DO 
    314298            END DO 
    … …  
    316300               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    317301            END DO 
    318  
    319302            DO jk = 1, jpkm1 
    320303               DO ji = 1, jpi 
    321                   vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    322                     & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    323                END DO 
    324             END DO 
    325          END DO 
    326                 
     304                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     305               END DO 
     306            END DO 
     307         END DO 
     308         ! 
    327309         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    328             jbdy1 = jpjglo-nbghostcells 
    329             jbdy2 = jpjglo-1 
     310            jbdy1 = jpjglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     311            jbdy2 = jpjglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
    330312            DO jj = mj0(jbdy1), mj1(jbdy2) 
    331313               zub(:,jj) = 0._wp 
    332314               DO jk = 1, jpkm1 
    333315                  DO ji = 1, jpi 
    334                      zub(ji,jj) = zub(ji,jj) &  
    335                         & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     316                     zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    336317                  END DO 
    337318               END DO 
    … …  
    339320                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    340321               END DO 
    341                    
    342322               DO jk = 1, jpkm1 
    343323                  DO ji = 1, jpi 
    344                      uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    345                        & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     324                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
    346325                  END DO 
    347326               END DO 
    348327            END DO 
    349328         ENDIF 
     329         ! 
    350330      ENDIF 
    351331      ! 
    … …  
    367347      !--- West ---! 
    368348      IF( lk_west ) THEN 
    369          istart = 2 
    370          iend   = nbghostcells+1 
     349         istart = nn_hls + 2                              ! halo + land + 1 
     350         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    371351         DO ji = mi0(istart), mi1(iend) 
    372352            DO jj=1,jpj 
    … …  
    379359      !--- East ---! 
    380360      IF( lk_east ) THEN 
    381          istart = jpiglo-nbghostcells 
    382          iend   = jpiglo-1 
     361         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     362         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    383363         DO ji = mi0(istart), mi1(iend) 
    384364 
    … …  
    387367            END DO 
    388368         END DO 
    389          istart = jpiglo-nbghostcells-1 
    390          iend   = jpiglo-2 
     369         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     370         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    391371         DO ji = mi0(istart), mi1(iend) 
    392372            DO jj=1,jpj 
    … …  
    398378      !--- South ---! 
    399379      IF( lk_south ) THEN 
    400          jstart = 2 
    401          jend   = nbghostcells+1 
     380         jstart = nn_hls + 2                              ! halo + land + 1 
     381         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    402382         DO jj = mj0(jstart), mj1(jend) 
    403383 
    … …  
    411391      !--- North ---! 
    412392      IF( lk_north ) THEN 
    413          jstart = jpjglo-nbghostcells 
    414          jend   = jpjglo-1 
     393         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     394         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    415395         DO jj = mj0(jstart), mj1(jend) 
    416396            DO ji=1,jpi 
    … …  
    418398            END DO 
    419399         END DO 
    420          jstart = jpjglo-nbghostcells-1 
    421          jend   = jpjglo-2 
     400         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     401         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    422402         DO jj = mj0(jstart), mj1(jend) 
    423403            DO ji=1,jpi 
    … …  
    429409   END SUBROUTINE Agrif_dyn_ts 
    430410 
     411    
    431412   SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv ) 
    432413      !!---------------------------------------------------------------------- 
    … …  
    444425      !--- West ---! 
    445426      IF( lk_west ) THEN 
    446          istart = 2 
    447          iend   = nbghostcells+1 
     427         istart = nn_hls + 2                              ! halo + land + 1 
     428         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    448429         DO ji = mi0(istart), mi1(iend) 
    449430            DO jj=1,jpj 
    … …  
    456437      !--- East ---! 
    457438      IF( lk_east ) THEN 
    458          istart = jpiglo-nbghostcells 
    459          iend   = jpiglo-1 
     439         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     440         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    460441         DO ji = mi0(istart), mi1(iend) 
    461442            DO jj=1,jpj 
    … …  
    463444            END DO 
    464445         END DO 
    465          istart = jpiglo-nbghostcells-1 
    466          iend   = jpiglo-2 
     446         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     447         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    467448         DO ji = mi0(istart), mi1(iend) 
    468449            DO jj=1,jpj 
    … …  
    474455      !--- South ---! 
    475456      IF( lk_south ) THEN 
    476          jstart = 2 
    477          jend   = nbghostcells+1 
     457         jstart = nn_hls + 2                              ! halo + land + 1 
     458         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    478459         DO jj = mj0(jstart), mj1(jend) 
    479460            DO ji=1,jpi 
    … …  
    486467      !--- North ---! 
    487468      IF( lk_north ) THEN 
    488          jstart = jpjglo-nbghostcells 
    489          jend   = jpjglo-1 
     469         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     470         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    490471         DO jj = mj0(jstart), mj1(jend) 
    491472            DO ji=1,jpi 
    … …  
    493474            END DO 
    494475         END DO 
    495          jstart = jpjglo-nbghostcells-1 
    496          jend   = jpjglo-2 
     476         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     477         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    497478         DO jj = mj0(jstart), mj1(jend) 
    498479            DO ji=1,jpi 
    … …  
    504485   END SUBROUTINE Agrif_dyn_ts_flux 
    505486 
     487    
    506488   SUBROUTINE Agrif_dta_ts( kt ) 
    507489      !!---------------------------------------------------------------------- 
    … …  
    578560      ! --- West --- ! 
    579561      IF(lk_west) THEN 
    580          istart = 2 
    581          iend   = 1 + nbghostcells 
     562         istart = nn_hls + 2                              ! halo + land + 1 
     563         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    582564         DO ji = mi0(istart), mi1(iend) 
    583565            DO jj = 1, jpj 
    584566               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    585             ENDDO 
    586          ENDDO 
     567            END DO 
     568         END DO 
    587569      ENDIF 
    588570      ! 
    589571      ! --- East --- ! 
    590572      IF(lk_east) THEN 
    591          istart = jpiglo - nbghostcells 
    592          iend   = jpiglo - 1 
     573         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     574         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    593575         DO ji = mi0(istart), mi1(iend) 
    594576            DO jj = 1, jpj 
    595577               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    596             ENDDO 
    597          ENDDO 
     578            END DO 
     579         END DO 
    598580      ENDIF 
    599581      ! 
    600582      ! --- South --- ! 
    601583      IF(lk_south) THEN 
    602          jstart = 2 
    603          jend   = 1 + nbghostcells 
     584         jstart = nn_hls + 2                              ! halo + land + 1 
     585         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    604586         DO jj = mj0(jstart), mj1(jend) 
    605587            DO ji = 1, jpi 
    606588               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    607             ENDDO 
    608          ENDDO 
     589            END DO 
     590         END DO 
    609591      ENDIF 
    610592      ! 
    611593      ! --- North --- ! 
    612594      IF(lk_north) THEN 
    613          jstart = jpjglo - nbghostcells 
    614          jend   = jpjglo - 1 
     595         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     596         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    615597         DO jj = mj0(jstart), mj1(jend) 
    616598            DO ji = 1, jpi 
    617599               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    618             ENDDO 
    619          ENDDO 
     600            END DO 
     601         END DO 
    620602      ENDIF 
    621603      ! 
    … …  
    637619      ! --- West --- ! 
    638620      IF(lk_west) THEN 
    639          istart = 2 
    640          iend   = 1+nbghostcells 
     621         istart = nn_hls + 2                              ! halo + land + 1 
     622         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    641623         DO ji = mi0(istart), mi1(iend) 
    642624            DO jj = 1, jpj 
    643625               ssha_e(ji,jj) = hbdy(ji,jj) 
    644             ENDDO 
    645          ENDDO 
     626            END DO 
     627         END DO 
    646628      ENDIF 
    647629      ! 
    648630      ! --- East --- ! 
    649631      IF(lk_east) THEN 
    650          istart = jpiglo - nbghostcells 
    651          iend   = jpiglo - 1 
     632         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     633         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    652634         DO ji = mi0(istart), mi1(iend) 
    653635            DO jj = 1, jpj 
    654636               ssha_e(ji,jj) = hbdy(ji,jj) 
    655             ENDDO 
    656          ENDDO 
     637            END DO 
     638         END DO 
    657639      ENDIF 
    658640      ! 
    659641      ! --- South --- ! 
    660642      IF(lk_south) THEN 
    661          jstart = 2 
    662          jend   = 1+nbghostcells 
     643         jstart = nn_hls + 2                              ! halo + land + 1 
     644         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    663645         DO jj = mj0(jstart), mj1(jend) 
    664646            DO ji = 1, jpi 
    665647               ssha_e(ji,jj) = hbdy(ji,jj) 
    666             ENDDO 
    667          ENDDO 
     648            END DO 
     649         END DO 
    668650      ENDIF 
    669651      ! 
    670652      ! --- North --- ! 
    671653      IF(lk_north) THEN 
    672          jstart = jpjglo - nbghostcells 
    673          jend   = jpjglo - 1 
     654         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     655         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    674656         DO jj = mj0(jstart), mj1(jend) 
    675657            DO ji = 1, jpi 
    676658               ssha_e(ji,jj) = hbdy(ji,jj) 
    677             ENDDO 
    678          ENDDO 
     659            END DO 
     660         END DO 
    679661      ENDIF 
    680662      ! 
    681663   END SUBROUTINE Agrif_ssh_ts 
    682664 
     665    
    683666   SUBROUTINE Agrif_avm 
    684667      !!---------------------------------------------------------------------- 
    … …  
    701684      ! 
    702685   END SUBROUTINE Agrif_avm 
    703     
     686 
    704687 
    705688   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    … …  
    793776                  DO jk=2,N_in 
    794777                     z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
    795                   ENDDO 
     778                  END DO 
    796779 
    797780                  N_out = 0 
    … …  
    800783                     N_out = N_out + 1 
    801784                     h_out(jk) = e3t(ji,jj,jk,Krhs_a) 
    802                   ENDDO 
     785                  END DO 
    803786 
    804787                  z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + ht_0(ji,jj) 
    805788                  DO jk=2,N_out 
    806789                     z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 
    807                   ENDDO 
     790                  END DO 
    808791 
    809792                  IF (N_in*N_out > 0) THEN 
    … …  
    816799                     ENDIF 
    817800                  ENDIF 
    818                ENDDO 
    819             ENDDO 
     801               END DO 
     802            END DO 
    820803            Krhs_a = item 
    821804  
    … …  
    831814   END SUBROUTINE interptsn 
    832815 
     816    
    833817   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before ) 
    834818      !!---------------------------------------------------------------------- 
    … …  
    849833   END SUBROUTINE interpsshn 
    850834 
     835    
    851836   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    852837      !!---------------------------------------------------------------------- 
    … …  
    934919                     tabin(jk) = 0. 
    935920                     ENDIF 
    936                  ENDDO 
     921                 END DO 
    937922                 z_in(1) = 0.5_wp * h_in(1) - zhtot + hu0_parent(ji,jj)  
    938923                 DO jk=2,N_in 
    939924                    z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
    940                  ENDDO 
     925                 END DO 
    941926                      
    942927                 N_out = 0 
    … …  
    945930                    N_out = N_out + 1 
    946931                    h_out(N_out) = e3u(ji,jj,jk,Krhs_a) 
    947                  ENDDO 
     932                 END DO 
    948933 
    949934                 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hu_0(ji,jj) 
    950935                 DO jk=2,N_out 
    951936                    z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk)  
    952                  ENDDO   
     937                 END DO   
    953938 
    954939                 IF (N_in*N_out > 0) THEN 
    … …  
    959944                     ENDIF    
    960945                 ENDIF 
    961                ENDDO 
    962             ENDDO 
     946               END DO 
     947            END DO 
    963948         ELSE 
    964949            DO jk = 1, jpkm1 
    … …  
    973958   END SUBROUTINE interpun 
    974959 
     960    
    975961   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    976962      !!---------------------------------------------------------------------- 
    … …  
    10551041                       tabin(jk)  = 0. 
    10561042                     ENDIF  
    1057                   ENDDO 
     1043                  END DO 
    10581044 
    10591045                  z_in(1) = 0.5_wp * h_in(1) - zhtot + hv0_parent(ji,jj) 
    10601046                  DO jk=2,N_in 
    10611047                     z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
    1062                   ENDDO 
     1048                  END DO 
    10631049 
    10641050                  N_out = 0 
    … …  
    10671053                     N_out = N_out + 1 
    10681054                     h_out(N_out) = e3v(ji,jj,jk,Krhs_a) 
    1069                   ENDDO 
     1055                  END DO 
    10701056 
    10711057                  z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hv_0(ji,jj) 
    10721058                  DO jk=2,N_out 
    10731059                     z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 
    1074                   ENDDO 
     1060                  END DO 
    10751061  
    10761062                  IF (N_in*N_out > 0) THEN 
    … …  
    12861272                     WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ',  &  
    12871273                     &                 ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 
    1288                      &                 ji+nimpp-1, jj+njmpp-1, jk 
    1289                      kindic_agr = kindic_agr + 1 
     1274                     &                 mig0(ji), mig0(jj), jk 
     1275                !     kindic_agr = kindic_agr + 1 
    12901276                  ENDIF 
    12911277               END DO 
    … …  
    12961282      !  
    12971283   END SUBROUTINE interpe3t 
     1284 
     1285   SUBROUTINE interpglamt( ptab, i1, i2, j1, j2, before ) 
     1286      !!---------------------------------------------------------------------- 
     1287      !!                  ***  ROUTINE interpglamt  *** 
     1288      !!----------------------------------------------------------------------   
     1289      INTEGER                        , INTENT(in   ) :: i1, i2, j1, j2 
     1290      REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1291      LOGICAL                        , INTENT(in   ) :: before 
     1292      ! 
     1293      INTEGER :: ji, jj, jk 
     1294      REAL(wp):: ztst 
     1295      !!----------------------------------------------------------------------   
     1296      !     
     1297      IF( before ) THEN 
     1298         ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2) 
     1299      ELSE 
     1300         ztst = MAXVAL(ABS(glamt(i1:i2,j1:j2)))*1.e-4 
     1301         DO jj = j1, j2 
     1302            DO ji = i1, i2 
     1303               IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN 
     1304                  WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj) 
     1305!                  kindic_agr = kindic_agr + 1 
     1306               ENDIF 
     1307            END DO 
     1308         END DO 
     1309      ENDIF 
     1310      !  
     1311   END SUBROUTINE interpglamt 
     1312 
     1313 
     1314   SUBROUTINE interpgphit( ptab, i1, i2, j1, j2, before ) 
     1315      !!---------------------------------------------------------------------- 
     1316      !!                  ***  ROUTINE interpgphit  *** 
     1317      !!----------------------------------------------------------------------   
     1318      INTEGER                        , INTENT(in   ) :: i1, i2, j1, j2 
     1319      REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1320      LOGICAL                        , INTENT(in   ) :: before 
     1321      ! 
     1322      INTEGER :: ji, jj, jk 
     1323      REAL(wp):: ztst 
     1324      !!----------------------------------------------------------------------   
     1325      !     
     1326      IF( before ) THEN 
     1327         ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2) 
     1328      ELSE 
     1329         ztst = MAXVAL(ABS(gphit(i1:i2,j1:j2)))*1.e-4 
     1330         DO jj = j1, j2 
     1331            DO ji = i1, i2 
     1332               IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN 
     1333                  WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj) 
     1334!                  kindic_agr = kindic_agr + 1 
     1335               ENDIF 
     1336            END DO 
     1337         END DO 
     1338      ENDIF 
     1339      !  
     1340   END SUBROUTINE interpgphit 
     1341 
    12981342 
    12991343   SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    … …  
    13681412                  DO jk = 1, N_out        ! Child vertical grid 
    13691413                     z_out(jk) = gdepw(ji,jj,jk,Kmm_a) 
    1370                   ENDDO 
     1414                  END DO 
    13711415                  IF (N_in*N_out > 0) THEN 
    13721416                     CALL remap_linear(tabin(1:N_in),z_in(1:N_in),avm_k(ji,jj,1:N_out),z_out(1:N_out),N_in,N_out,1) 
    13731417                  ENDIF 
    1374                ENDDO 
    1375             ENDDO 
     1418               END DO 
     1419            END DO 
    13761420         ELSE 
    13771421            avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2,1) 
    … …  
    13811425   END SUBROUTINE interpavm 
    13821426 
     1427    
    13831428   SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before ) 
    13841429      !!---------------------------------------------------------------------- 
    … …  
    13991444   END SUBROUTINE interpmbkt 
    14001445 
     1446    
    14011447   SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before ) 
    14021448      !!---------------------------------------------------------------------- 
    … …  
    14171463   END SUBROUTINE interpht0 
    14181464 
     1465    
    14191466   SUBROUTINE agrif_initts(tabres,i1,i2,j1,j2,k1,k2,m1,m2,before) 
    14201467       INTEGER :: i1, i2, j1, j2, k1, k2, m1, m2 
    … …  
    14351482   END SUBROUTINE agrif_initts  
    14361483 
     1484    
    14371485   SUBROUTINE agrif_initssh( ptab, i1, i2, j1, j2, before ) 
    14381486      !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/NST/agrif_oce_sponge.F90

    r13226 r13286  
    7878      zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 
    7979 
    80       Agrif_SpecialValue=0. 
     80      Agrif_SpecialValue    = 0._wp 
    8181      Agrif_UseSpecialValue = ln_spc_dyn 
    82       use_sign_north = .TRUE. 
    83       sign_north = -1. 
     82      use_sign_north        = .TRUE. 
     83      sign_north            = -1._wp 
    8484      ! 
    8585      tabspongedone_u = .FALSE. 
    … …  
    9292      ! 
    9393      Agrif_UseSpecialValue = .FALSE. 
    94       use_sign_north = .FALSE. 
     94      use_sign_north        = .FALSE. 
    9595#endif 
    9696      ! 
    … …  
    109109      REAL(wp) ::   z1_ispongearea, z1_jspongearea 
    110110      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 
     111#if defined key_vertical 
     112      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu 
     113      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv 
     114#endif 
    111115      REAL(wp), DIMENSION(jpjmax)  :: zmskwest,  zmskeast 
    112116      REAL(wp), DIMENSION(jpimax)  :: zmsknorth, zmsksouth 
    … …  
    129133         ! Retrieve masks at open boundaries: 
    130134 
    131          ! --- West --- ! 
    132          IF( lk_west) THEN 
     135         IF( lk_west ) THEN                             ! --- West --- ! 
    133136            ztabramp(:,:) = 0._wp 
    134             ind1 = 1+nbghostcells 
     137            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    135138            DO ji = mi0(ind1), mi1(ind1)                 
    136139               ztabramp(ji,:) = ssumask(ji,:) 
    137140            END DO 
    138             ! 
    139             zmskwest(:) = 0._wp 
    140             zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     141            zmskwest(    1:jpj   ) = MAXVAL(ztabramp(:,:), dim=1) 
     142            zmskwest(jpj+1:jpjmax) = 0._wp 
    141143         ENDIF 
    142  
    143          ! --- East --- ! 
    144          IF( lk_east ) THEN 
     144         IF( lk_east ) THEN                             ! --- East --- ! 
    145145            ztabramp(:,:) = 0._wp 
    146             ind1 = jpiglo - nbghostcells - 1 
     146            ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    147147            DO ji = mi0(ind1), mi1(ind1)                  
    148148               ztabramp(ji,:) = ssumask(ji,:) 
    149149            END DO 
    150             ! 
    151             zmskeast(:) = 0._wp 
    152             zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     150            zmskeast(    1:jpj   ) = MAXVAL(ztabramp(:,:), dim=1) 
     151            zmskeast(jpj+1:jpjmax) = 0._wp 
    153152         ENDIF 
    154  
    155          ! --- South --- ! 
    156          IF( lk_south ) THEN 
     153         IF( lk_south ) THEN                            ! --- South --- ! 
    157154            ztabramp(:,:) = 0._wp 
    158             ind1 = 1+nbghostcells 
     155            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    159156            DO jj = mj0(ind1), mj1(ind1)                  
    160157               ztabramp(:,jj) = ssvmask(:,jj) 
    161158            END DO 
    162             ! 
    163             zmsksouth(:) = 0._wp 
    164             zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     159            zmsksouth(    1:jpi   ) = MAXVAL(ztabramp(:,:), dim=2) 
     160            zmsksouth(jpi+1:jpimax) = 0._wp 
    165161         ENDIF 
    166  
    167          ! --- North --- ! 
    168          IF( lk_north) THEN 
     162         IF( lk_north ) THEN                            ! --- North --- ! 
    169163            ztabramp(:,:) = 0._wp 
    170             ind1 = jpjglo - nbghostcells - 1 
     164            ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    171165            DO jj = mj0(ind1), mj1(ind1)                  
    172166               ztabramp(:,jj) = ssvmask(:,jj) 
    173167            END DO 
    174             ! 
    175             zmsknorth(:) = 0._wp 
    176             zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     168            zmsknorth(    1:jpi   ) = MAXVAL(ztabramp(:,:), dim=2) 
     169            zmsknorth(jpi+1:jpimax) = 0._wp 
    177170         ENDIF 
    178171 
    … …  
    180173         zmskwest(:)  = 1._wp 
    181174         zmskeast(:)  = 1._wp 
     175         zmsksouth(:) = 1._wp 
    182176         zmsknorth(:) = 1._wp 
    183          zmsksouth(:) = 1._wp 
    184177#if defined key_mpp_mpi 
    185178!         CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax ) 
    … …  
    192185         ! Store it in ztabramp 
    193186 
    194          ispongearea  = nn_sponge_len * Agrif_irhox() 
    195          z1_ispongearea = 1._wp / REAL( ispongearea ) 
    196          jspongearea  = nn_sponge_len * Agrif_irhoy() 
    197          z1_jspongearea = 1._wp / REAL( jspongearea ) 
     187         ispongearea    = nn_sponge_len * Agrif_irhox() 
     188         z1_ispongearea = 1._wp / REAL( ispongearea, wp ) 
     189         jspongearea    = nn_sponge_len * Agrif_irhoy() 
     190         z1_jspongearea = 1._wp / REAL( jspongearea, wp ) 
    198191          
    199192         ztabramp(:,:) = 0._wp 
    … …  
    203196         IF ( nbcellsy <= 3 ) jspongearea = -1 
    204197 
    205          ! --- West --- ! 
    206          IF(lk_west) THEN 
    207             ind1 = 1+nbghostcells 
    208             ind2 = 1+nbghostcells + ispongearea  
     198         IF( lk_west ) THEN                             ! --- West --- ! 
     199            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     200            ind2 = nn_hls + 1 + nbghostcells + ispongearea  
    209201            DO ji = mi0(ind1), mi1(ind2)    
    210202               DO jj = 1, jpj                
    211                   ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
    212                END DO 
    213             END DO          
    214  
     203                  ztabramp(ji,jj) =                       REAL(ind2 - mig(ji), wp) * z1_ispongearea   * zmskwest(jj) 
     204               END DO 
     205            END DO 
    215206            ! ghost cells: 
    216207            ind1 = 1 
    217             ind2 = nbghostcells + 1 
     208            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    218209            DO ji = mi0(ind1), mi1(ind2)    
    219210               DO jj = 1, jpj                
    … …  
    222213            END DO 
    223214         ENDIF 
    224  
    225          ! --- East --- ! 
    226          IF(lk_east) THEN 
    227             ind1 = jpiglo - nbghostcells - ispongearea 
    228             ind2 = jpiglo - nbghostcells 
     215         IF( lk_east ) THEN                             ! --- East --- ! 
     216            ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 
     217            ind2 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    229218            DO ji = mi0(ind1), mi1(ind2) 
    230  
    231219               DO jj = 1, jpj 
    232                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
    233                ENDDO 
    234             END DO 
    235  
     220                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj) 
     221               END DO 
     222            END DO 
    236223            ! ghost cells: 
    237             ind1 = jpiglo - nbghostcells 
     224            ind1 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    238225            ind2 = jpiglo 
    239226            DO ji = mi0(ind1), mi1(ind2) 
    240  
    241227               DO jj = 1, jpj 
    242228                  ztabramp(ji,jj) = zmskeast(jj) 
    243                ENDDO 
    244             END DO 
    245          ENDIF 
    246  
    247          ! --- South --- ! 
    248          IF( lk_south ) THEN  
    249             ind1 = 1+nbghostcells 
    250             ind2 = 1+nbghostcells + jspongearea 
     229               END DO 
     230            END DO 
     231         ENDIF       
     232         IF( lk_south ) THEN                            ! --- South --- ! 
     233            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     234            ind2 = nn_hls + 1 + nbghostcells + jspongearea  
    251235            DO jj = mj0(ind1), mj1(ind2)  
    252236               DO ji = 1, jpi 
    253                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
    254                END DO 
    255             END DO 
    256  
     237                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji) 
     238               END DO 
     239            END DO 
    257240            ! ghost cells: 
    258241            ind1 = 1 
    259             ind2 = nbghostcells + 1 
     242            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    260243            DO jj = mj0(ind1), mj1(ind2)  
    261244               DO ji = 1, jpi 
    … …  
    264247            END DO 
    265248         ENDIF 
    266  
    267          ! --- North --- ! 
    268          IF( lk_north ) THEN   
    269             ind1 = jpjglo - nbghostcells - jspongearea 
    270             ind2 = jpjglo - nbghostcells 
     249         IF( lk_north ) THEN                            ! --- North --- ! 
     250            ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 
     251            ind2 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    271252            DO jj = mj0(ind1), mj1(ind2) 
    272253               DO ji = 1, jpi 
    273                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
    274                END DO 
    275             END DO 
    276  
     254                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji) 
     255               END DO 
     256            END DO 
    277257            ! ghost cells: 
    278             ind1 = jpjglo - nbghostcells 
     258            ind1 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    279259            ind2 = jpjglo 
    280260            DO jj = mj0(ind1), mj1(ind2) 
    … …  
    284264            END DO 
    285265         ENDIF 
    286        
     266         ! 
    287267      ENDIF 
    288268 
    … …  
    295275            fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) * ssvmask(ji,jj) 
    296276         END_2D 
    297          CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1.0_wp )   ! Lateral boundary conditions 
    298          CALL lbc_lnk( 'agrif_Sponge', fspv, 'V', 1.0_wp ) 
    299  
    300          spongedoneT = .TRUE. 
    301277      ENDIF 
    302278 
    … …  
    311287                                  &  * ssvmask(ji,jj) * ssvmask(ji,jj+1) 
    312288         END_2D 
    313          CALL lbc_lnk( 'agrif_Sponge', fspt, 'T', 1.0_wp )   ! Lateral boundary conditions 
    314          CALL lbc_lnk( 'agrif_Sponge', fspf, 'F', 1.0_wp ) 
    315           
     289      ENDIF 
     290       
     291      IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 
     292         CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 
     293         spongedoneT = .TRUE. 
     294         spongedoneU = .TRUE. 
     295      ENDIF 
     296      IF( .NOT. spongedoneT ) THEN 
     297         CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp ) 
     298         spongedoneT = .TRUE. 
     299      ENDIF 
     300      IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 
     301         CALL lbc_lnk_multi( 'agrif_Sponge', fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 
    316302         spongedoneU = .TRUE. 
    317303      ENDIF 
    … …  
    334320      END_2D 
    335321      ! 
    336       ztabramp(:,:) = REAL( mbkt_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'T', 1.0_wp ) 
    337       mbkt_parent(:,:) = NINT( ztabramp(:,:) ) 
    338       ztabramp(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'U', 1.0_wp ) 
    339       mbku_parent(:,:) = NINT( ztabramp(:,:) ) 
    340       ztabramp(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'V', 1.0_wp ) 
    341       mbkv_parent(:,:) = NINT( ztabramp(:,:) ) 
     322      ztabramp (:,:) = REAL( mbkt_parent (:,:), wp ) 
     323      ztabrampu(:,:) = REAL( mbku_parentu(:,:), wp ) 
     324      ztabrampv(:,:) = REAL( mbkv_parentv(:,:), wp ) 
     325      CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp ) 
     326      mbkt_parent(:,:) = NINT( ztabramp (:,:) ) 
     327      mbku_parent(:,:) = NINT( ztabrampu(:,:) ) 
     328      mbkv_parent(:,:) = NINT( ztabrampv(:,:) ) 
    342329#endif 
    343330      ! 
    … …  
    346333   END SUBROUTINE Agrif_Sponge 
    347334 
     335    
    348336   SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    349337      !!---------------------------------------------------------------------- 
    … …  
    433421                  N_out = N_out + 1 
    434422                  h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
    435                ENDDO 
     423               END DO 
    436424 
    437425               ! Account for small differences in free-surface 
    … …  
    444432                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
    445433               ENDIF 
    446             ENDDO 
    447          ENDDO 
     434            END DO 
     435         END DO 
    448436# endif 
    449437 
    … …  
    456444                  tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk) 
    457445# endif 
    458                ENDDO 
    459             ENDDO 
    460          ENDDO 
     446               END DO 
     447            END DO 
     448         END DO 
    461449 
    462450         DO jn = 1, jpts             
    … …  
    513501   END SUBROUTINE interptsn_sponge 
    514502 
     503    
    515504   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 
    516505      !!--------------------------------------------- 
    … …  
    521510      LOGICAL, INTENT(in) :: before 
    522511 
    523       INTEGER :: ji,jj,jk,jmax 
    524  
     512      INTEGER  :: ji,jj,jk,jmax 
     513      INTEGER  :: ind1 
    525514      ! sponge parameters  
    526515      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot 
    … …  
    586575                  zhtot = zhtot + h_in(jk) 
    587576                  tabin(jk) = tabres(ji,jj,jk,m1) 
    588                ENDDO 
     577               END DO 
    589578               !          
    590579               N_out = 0 
    … …  
    593582                  N_out = N_out + 1 
    594583                  h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 
    595                ENDDO 
     584               END DO 
    596585 
    597586               ! Account for small differences in free-surface 
    … …  
    605594                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    606595               ENDIF  
    607             ENDDO 
    608          ENDDO 
     596            END DO 
     597         END DO 
    609598 
    610599         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 
    … …  
    659648 
    660649         jmax = j2-1 
    661         ! IF (lk_north) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North 
    662          IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North 
     650         ind1 = jpjglo - ( nn_hls + nbghostcells + 2 )   ! North 
     651         DO jj = mj0(ind1), mj1(ind1)                  
     652            jmax = MIN(jmax,jj) 
     653         END DO 
    663654 
    664655         DO jj = j1+1, jmax 
    … …  
    688679   END SUBROUTINE interpun_sponge 
    689680 
    690    SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before,nb,ndir) 
     681    
     682   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 
    691683      !!--------------------------------------------- 
    692684      !!   *** ROUTINE interpvn_sponge *** 
    … …  
    695687      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: tabres 
    696688      LOGICAL, INTENT(in) :: before 
    697       INTEGER, INTENT(in) :: nb , ndir 
    698689      ! 
    699690      INTEGER  ::   ji, jj, jk, imax 
     691      INTEGER  :: ind1 
    700692      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr, zhtot 
    701693      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff 
    … …  
    759751                  zhtot = zhtot + h_in(jk) 
    760752                  tabin(jk) = tabres(ji,jj,jk,m1) 
    761                ENDDO 
     753               END DO 
    762754               !           
    763755               N_out = 0 
    … …  
    766758                  N_out = N_out + 1 
    767759                  h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 
    768                ENDDO 
     760               END DO 
    769761 
    770762               ! Account for small differences in free-surface 
    … …  
    778770                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    779771               ENDIF 
    780             ENDDO 
    781          ENDDO 
     772            END DO 
     773         END DO 
    782774 
    783775         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)   
    … …  
    812804 
    813805         imax = i2 - 1 
    814       !   IF(lk_east) imax = MIN(imax,nlci-nbghostcells-2)   ! East 
    815          IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-nbghostcells-2)   ! East 
    816  
     806         ind1 = jpiglo - ( nn_hls + nbghostcells + 2 )   ! East 
     807         DO ji = mi0(ind1), mi1(ind1)                 
     808            imax = MIN(imax,ji) 
     809         END DO 
     810          
    817811         DO jj = j1+1, j2 
    818812            DO ji = i1+1, imax   ! vector opt. 

  • NEMO/trunk/src/NST/agrif_oce_update.F90

    r13216 r13286  
    8585 
    8686      Agrif_UseSpecialValueInUpdate = .FALSE. 
    87       Agrif_SpecialValueFineGrid = 0. 
     87      Agrif_SpecialValueFineGrid    = 0._wp 
    8888 
    8989      use_sign_north = .TRUE. 
    90       sign_north = -1. 
     90      sign_north     = -1._wp 
    9191 
    9292      !      
    … …  
    144144      ! 
    145145      Agrif_UseSpecialValueInUpdate = .TRUE. 
    146       Agrif_SpecialValueFineGrid = 0. 
     146      Agrif_SpecialValueFineGrid = 0._wp 
    147147# if ! defined DECAL_FEEDBACK_2D 
    148148      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH) 
    … …  
    156156      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
    157157         use_sign_north = .TRUE. 
    158          sign_north = -1. 
     158         sign_north = -1._wp 
    159159         ! Refluxing on ssh: 
    160160#  if defined DECAL_FEEDBACK_2D 

  • NEMO/trunk/src/NST/agrif_user.F90

    r13226 r13286  
    1111   END SUBROUTINE agrif_user 
    1212 
     13    
    1314   SUBROUTINE agrif_before_regridding 
    1415   END SUBROUTINE agrif_before_regridding 
    1516 
     17    
    1618   SUBROUTINE Agrif_InitWorkspace 
    1719   END SUBROUTINE Agrif_InitWorkspace 
    1820 
     21    
    1922   SUBROUTINE Agrif_InitValues 
    2023      !!---------------------------------------------------------------------- 
    … …  
    3841   END SUBROUTINE Agrif_initvalues 
    3942 
    40    SUBROUTINE agrif_istate( Kbb, Kmm, Kaa ) 
    41  
    42        USE domvvl 
    43        USE domain 
    44        USE par_oce 
    45        USE agrif_oce 
    46        USE agrif_oce_interp 
    47        USE oce 
    48        USE lib_mpp 
    49        USe lbclnk 
    50  
     43    
     44   SUBROUTINE Agrif_Istate( Kbb, Kmm, Kaa ) 
     45      !!---------------------------------------------------------------------- 
     46      !!                 *** ROUTINE agrif_istate *** 
     47      !!---------------------------------------------------------------------- 
     48      USE domvvl 
     49      USE domain 
     50      USE par_oce 
     51      USE agrif_oce 
     52      USE agrif_oce_interp 
     53      USE oce 
     54      USE lib_mpp 
     55      USE lbclnk 
     56      ! 
     57      IMPLICIT NONE 
     58      ! 
    5159      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa 
    5260      INTEGER :: jn 
    53  
     61      !!---------------------------------------------------------------------- 
    5462      IF(lwp) WRITE(numout,*) ' ' 
    5563      IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 
    5664      IF(lwp) WRITE(numout,*) ' ' 
    5765 
    58       l_ini_child = .TRUE. 
    59       Agrif_SpecialValue    = 0._wp 
     66      l_ini_child           = .TRUE. 
     67      Agrif_SpecialValue    = 0.0_wp 
    6068      Agrif_UseSpecialValue = .TRUE. 
    61       uu(:,:,:,:) = 0.  ;  vv(:,:,:,:) = 0.   ;  ts(:,:,:,:,:) = 0. 
     69      uu(:,:,:,:) = 0.0_wp   ;   vv(:,:,:,:) = 0.0_wp   ;   ts(:,:,:,:,:) = 0.0_wp 
    6270        
    63       Krhs_a = Kbb ; Kmm_a = Kbb 
     71      Krhs_a = Kbb   ;  Kmm_a = Kbb 
    6472 
    6573      ! Brutal fix to pas 1x1 refinment.  
    … …  
    7987      use_sign_north = .FALSE. 
    8088 
    81       Agrif_UseSpecialValue = .FALSE.            ! 
    82       l_ini_child = .FALSE. 
    83  
    84       Krhs_a = Kaa ; Kmm_a = Kmm 
     89      Agrif_UseSpecialValue = .FALSE. 
     90      l_ini_child           = .FALSE. 
     91 
     92      Krhs_a = Kaa   ;  Kmm_a = Kmm 
    8593 
    8694      DO jn = 1, jpts 
    8795         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 
    8896      END DO 
    89       uu(:,:,:,Kbb) =  uu(:,:,:,Kbb) * umask(:,:,:)      
    90       vv(:,:,:,Kbb) =  vv(:,:,:,Kbb) * vmask(:,:,:)  
    91  
    92  
    93       CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 
    94       CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 
    95  
    96    END SUBROUTINE agrif_istate    
    97  
     97      uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:)      
     98      vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:)  
     99 
     100 
     101      CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 
     102      CALL lbc_lnk(       'agrif_istate', ts(:,:,:,:,Kbb), 'T',  1.0_wp ) 
     103 
     104   END SUBROUTINE Agrif_Istate 
     105 
     106    
    98107   SUBROUTINE agrif_declare_var_ini 
    99108      !!---------------------------------------------------------------------- 
    100       !!                 *** ROUTINE agrif_declare_var *** 
     109      !!                 *** ROUTINE agrif_declare_var_ini *** 
    101110      !!---------------------------------------------------------------------- 
    102111      USE agrif_util 
    … …  
    110119      ! 
    111120      INTEGER :: ind1, ind2, ind3 
     121      INTEGER :: its 
    112122      External :: nemo_mapping 
    113123      !!---------------------------------------------------------------------- 
    … …  
    126136      ! 1. Declaration of the type of variable which have to be interpolated 
    127137      !--------------------------------------------------------------------- 
    128       ind1 =     nbghostcells 
    129       ind2 = 2 + nbghostcells_x 
    130       ind3 = 2 + nbghostcells_y_s 
    131  
    132       CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
    133       CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 
    134       CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id) 
    135  
    136       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
    137       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
    138  
     138      ind1 =              nbghostcells 
     139      ind2 = nn_hls + 2 + nbghostcells_x 
     140      ind3 = nn_hls + 2 + nbghostcells_y_s 
     141 
     142      CALL agrif_declare_variable((/2,2,0  /),(/ind2  ,ind3,0    /),(/'x','y','N'    /),(/1,1,1  /),(/jpi,jpj,jpk    /),   e3t_id) 
     143      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),  mbkt_id) 
     144      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   ht0_id) 
     145 
     146      CALL agrif_declare_variable((/1,2    /),(/ind2-1,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   e1u_id) 
     147      CALL agrif_declare_variable((/2,1    /),(/ind2  ,ind3-1    /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   e2v_id) 
    139148    
    140149      ! Initial or restart velues 
    141        
    142       CALL agrif_declare_variable((/2,2,0,0/),(/ind2  ,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsini_id) 
    143       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/)     ,uini_id )  
    144       CALL agrif_declare_variable((/2,1,0,0/),(/ind2  ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/)     ,vini_id ) 
    145       CALL agrif_declare_variable((/2,2/)    ,(/ind2,ind3/)        ,(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshini_id) 
     150      its = jpts+1 
     151      CALL agrif_declare_variable((/2,2,0,0/),(/ind2  ,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id) 
     152      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2  /),  uini_id)  
     153      CALL agrif_declare_variable((/2,1,0,0/),(/ind2  ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2  /),  vini_id) 
     154      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),sshini_id) 
    146155      !  
    147156      
    148157      ! 2. Type of interpolation 
    149158      !------------------------- 
    150       CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
    151  
    152       CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
    153       CALL Agrif_Set_interp  (mbkt_id,interp=AGRIF_constant) 
    154       CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
    155       CALL Agrif_Set_interp  (ht0_id ,interp=AGRIF_constant) 
    156  
    157       CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
    158       CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
     159      CALL Agrif_Set_bcinterp(   e3t_id,interp =AGRIF_constant) 
     160 
     161      CALL Agrif_Set_bcinterp(  mbkt_id,interp =AGRIF_constant) 
     162      CALL Agrif_Set_interp  (  mbkt_id,interp =AGRIF_constant) 
     163      CALL Agrif_Set_bcinterp(   ht0_id,interp =AGRIF_constant) 
     164      CALL Agrif_Set_interp  (   ht0_id,interp =AGRIF_constant) 
     165 
     166      CALL Agrif_Set_bcinterp(   e1u_id,interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
     167      CALL Agrif_Set_bcinterp(   e2v_id,interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    159168 
    160169      ! Initial fields 
    161       CALL Agrif_Set_bcinterp(tsini_id ,interp=AGRIF_linear) 
    162       CALL Agrif_Set_interp  (tsini_id ,interp=AGRIF_linear) 
    163       CALL Agrif_Set_bcinterp(uini_id  ,interp=AGRIF_linear) 
    164       CALL Agrif_Set_interp  (uini_id  ,interp=AGRIF_linear) 
    165       CALL Agrif_Set_bcinterp(vini_id  ,interp=AGRIF_linear) 
    166       CALL Agrif_Set_interp  (vini_id  ,interp=AGRIF_linear) 
    167       CALL Agrif_Set_bcinterp(sshini_id,interp=AGRIF_linear) 
    168       CALL Agrif_Set_interp  (sshini_id,interp=AGRIF_linear) 
     170      CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear  ) 
     171      CALL Agrif_Set_interp  ( tsini_id,interp =AGRIF_linear  ) 
     172      CALL Agrif_Set_bcinterp(  uini_id,interp =AGRIF_linear  ) 
     173      CALL Agrif_Set_interp  (  uini_id,interp =AGRIF_linear  ) 
     174      CALL Agrif_Set_bcinterp(  vini_id,interp =AGRIF_linear  ) 
     175      CALL Agrif_Set_interp  (  vini_id,interp =AGRIF_linear  ) 
     176      CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear  ) 
     177      CALL Agrif_Set_interp  (sshini_id,interp =AGRIF_linear  ) 
    169178 
    170179       ! 3. Location of interpolation 
    … …  
    172181!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
    173182! JC: check near the boundary only until matching in sponge has been sorted out: 
    174       CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     183      CALL Agrif_Set_bc(    e3t_id, (/0,ind1-1/) )   
    175184 
    176185      ! extend the interpolation zone by 1 more point than necessary: 
    177186      ! RB check here 
    178       CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
    179       CALL Agrif_Set_bc(  ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     187      CALL Agrif_Set_bc(   mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     188      CALL Agrif_Set_bc(    ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
    180189       
    181       CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    182       CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))   
    183  
    184       CALL Agrif_Set_bc( tsini_id , (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
    185       CALL Agrif_Set_bc( uini_id  , (/0,ind1-1/) )  
    186       CALL Agrif_Set_bc( vini_id  , (/0,ind1-1/) ) 
     190      CALL Agrif_Set_bc(    e1u_id, (/0,ind1-1/) ) 
     191      CALL Agrif_Set_bc(    e2v_id, (/0,ind1-1/) )   
     192 
     193      CALL Agrif_Set_bc(  tsini_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     194      CALL Agrif_Set_bc(   uini_id, (/0,ind1-1/) )  
     195      CALL Agrif_Set_bc(   vini_id, (/0,ind1-1/) ) 
    187196      CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 
    188197 
    … …  
    190199      !---------------  
    191200# if defined UPD_HIGH 
    192       CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 
    193       CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 
     201      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average       , update2=Agrif_Update_Full_Weighting) 
     202      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average       ) 
    194203#else 
    195       CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    196       CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     204      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy          , update2=Agrif_Update_Average       ) 
     205      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average       , update2=Agrif_Update_Copy          ) 
    197206#endif 
    198207       
    … …  
    204213   SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa )  
    205214      !!---------------------------------------------------------------------- 
    206       !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
    207       !!---------------------------------------------------------------------- 
    208    
    209          !!---------------------------------------------------------------------- 
    210          !!                 *** ROUTINE Agrif_InitValues_cont *** 
    211          !! 
    212          !! ** Purpose ::   Declaration of variables to be interpolated 
    213          !!---------------------------------------------------------------------- 
     215      !!                 *** ROUTINE Agrif_Init_Domain *** 
     216      !!---------------------------------------------------------------------- 
    214217      USE agrif_oce_update 
    215218      USE agrif_oce_interp 
    … …  
    243246      ! on the child grid  
    244247      Agrif_UseSpecialValue = .FALSE. 
    245       ht0_parent(:,:) = 0._wp 
     248      ht0_parent( :,:) = 0._wp 
    246249      mbkt_parent(:,:) = 0 
    247250      ! 
    … …  
    255258      !       and no refinement 
    256259      DO_2D_10_10 
    257          mbku_parent(ji,jj) = MIN(  mbkt_parent(ji+1,jj  ) , mbkt_parent(ji,jj) ) 
    258          mbkv_parent(ji,jj) = MIN(  mbkt_parent(ji  ,jj+1) , mbkt_parent(ji,jj) ) 
     260         mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj  ), mbkt_parent(ji,jj) ) 
     261         mbkv_parent(ji,jj) = MIN( mbkt_parent(ji  ,jj+1), mbkt_parent(ji,jj) ) 
    259262      END_2D 
    260263      IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN  
    … …  
    265268      ELSE 
    266269         DO_2D_10_10 
    267             hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj)) 
    268             hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1)) 
     270            hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) ) 
     271            hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) ) 
    269272         END_2D 
    270  
    271       ENDIF 
    272       ! 
    273       CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp ) 
    274       CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1.0_wp ) 
    275       zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk('Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 
    276       mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 
    277       zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 
     273      ENDIF 
     274      ! 
     275      CALL lbc_lnk_multi( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp ) 
     276      DO_2D_00_00 
     277         zk(ji,jj) = REAL( mbku_parent(ji,jj), wp ) 
     278      END_2D 
     279      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 
     280      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     281      DO_2D_00_00 
     282         zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp ) 
     283      END_2D 
     284      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 
    278285      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    279286 
    … …  
    333340 
    334341   SUBROUTINE Agrif_InitValues_cont 
    335          !!---------------------------------------------------------------------- 
    336          !!                 *** ROUTINE Agrif_InitValues_cont *** 
    337          !! 
    338          !! ** Purpose ::   Declaration of variables to be interpolated 
    339          !!---------------------------------------------------------------------- 
     342      !!---------------------------------------------------------------------- 
     343      !!                 *** ROUTINE Agrif_InitValues_cont *** 
     344      !! 
     345      !! ** Purpose ::   Declaration of variables to be interpolated 
     346      !!---------------------------------------------------------------------- 
    340347      USE agrif_oce_update 
    341348      USE agrif_oce_interp 
    … …  
    367374      Agrif_SpecialValue    = 0._wp 
    368375      Agrif_UseSpecialValue = .TRUE. 
    369       CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
     376      CALL Agrif_Bc_variable(       tsn_id,calledweight=1.,procname=interptsn) 
    370377      CALL Agrif_Sponge 
    371378      tabspongedone_tsn = .FALSE. 
    … …  
    398405         use_sign_north = .TRUE. 
    399406         sign_north = -1. 
    400          CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
    401          CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
     407         CALL Agrif_Bc_variable(        unb_id,calledweight=1.,procname=interpunb ) 
     408         CALL Agrif_Bc_variable(        vnb_id,calledweight=1.,procname=interpvnb ) 
    402409         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    403410         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
    … …  
    460467      ! 1. Declaration of the type of variable which have to be interpolated 
    461468      !--------------------------------------------------------------------- 
    462  
    463       ind1 =     nbghostcells 
    464       ind2 = 2 + nbghostcells_x 
    465       ind3 = 2 + nbghostcells_y_s 
    466  
     469      ind1 =              nbghostcells 
     470      ind2 = nn_hls + 2 + nbghostcells_x 
     471      ind3 = nn_hls + 2 + nbghostcells_y_s 
    467472# if defined key_vertical 
    468       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 
    469       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 
    470       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
    471       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
    472       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
    473       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
    474       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 
    475       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 
     473      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
     474      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
     475      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 
     476      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 
     477      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 
     478      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 
     479      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 
     480      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 
    476481# else 
    477       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
    478       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
    479       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 
    480       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 
    481       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 
    482       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 
    483       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 
    484       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 
     482      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     483      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 
     484      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 
     485      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 
     486      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 
     487      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 
     488      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 
     489      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 
    485490# endif 
    486       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
    487       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
    488       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
    489       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
    490       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
    491       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
    492  
    493       CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     491      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
     492      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
     493      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 
     494      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 
     495      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 
     496      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 
     497 
     498!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 
     499!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 
     500      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    494501 
    495502 
    496503      IF( ln_zdftke.OR.ln_zdfgls ) THEN  ! logical not known at this point 
    497 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
    498 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
     504!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
     505!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    499506# if defined key_vertical 
    500          CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 
     507         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
    501508# else 
    502          CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
     509         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 
    503510# endif 
    504511      ENDIF 
    … …  
    506513      ! 2. Type of interpolation 
    507514      !------------------------- 
    508       CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    509       CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    510       CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    511  
    512       CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
    513       CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    514       CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    515  
    516       CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
    517       CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    518       CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    519       CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    520       CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     515      CALL Agrif_Set_bcinterp(       tsn_id,interp =AGRIF_linear) 
     516      CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     517      CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
     518 
     519      CALL Agrif_Set_bcinterp( tsn_sponge_id,interp =AGRIF_linear) 
     520      CALL Agrif_Set_bcinterp(  un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     521      CALL Agrif_Set_bcinterp(  vn_sponge_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
     522 
     523      CALL Agrif_Set_bcinterp(       sshn_id,interp =AGRIF_linear) 
     524      CALL Agrif_Set_bcinterp(        unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     525      CALL Agrif_Set_bcinterp(        vnb_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
     526      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     527      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
    521528! 
    522529! > Divergence conserving alternative: 
    … …  
    531538     
    532539 
    533        ! 3. Location of interpolation 
     540!      CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 
     541!      CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 
     542 
     543      ! 3. Location of interpolation 
    534544      !----------------------------- 
    535545      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
    … …  
    548558 
    549559      IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
     560!!$      CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )   
     561!!$      CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )   
    550562 
    551563      ! 4. Update type 
    … …  
    553565 
    554566# if defined UPD_HIGH 
    555       CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
    556       CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    557       CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    558  
    559       CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    560       CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    561       CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting) 
    562       CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
     567      CALL Agrif_Set_Updatetype(      tsn_id,update = Agrif_Update_Full_Weighting) 
     568      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
     569      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
     570 
     571      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
     572      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
     573      CALL Agrif_Set_Updatetype(       sshn_id,update = Agrif_Update_Full_Weighting) 
     574      CALL Agrif_Set_Updatetype(        e3t_id,update = Agrif_Update_Full_Weighting) 
    563575 
    564576  !    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    … …  
    569581 
    570582#else 
    571       CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    572       CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    573       CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    574  
    575       CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    576       CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    577       CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average) 
    578       CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
     583      CALL Agrif_Set_Updatetype(     tsn_id, update = AGRIF_Update_Average) 
     584      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
     585      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
     586 
     587      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
     588      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
     589      CALL Agrif_Set_Updatetype(       sshn_id,update = AGRIF_Update_Average) 
     590      CALL Agrif_Set_Updatetype(        e3t_id,update = AGRIF_Update_Average) 
    579591 
    580592 !     IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    … …  
    589601 
    590602#if defined key_si3 
    591 SUBROUTINE Agrif_InitValues_cont_ice 
     603   SUBROUTINE Agrif_InitValues_cont_ice 
     604      !!---------------------------------------------------------------------- 
     605      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     606      !!---------------------------------------------------------------------- 
    592607      USE Agrif_Util 
    593608      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
    … …  
    597612      USE agrif_ice_interp 
    598613      USE lib_mpp 
    599       !!---------------------------------------------------------------------- 
    600       !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
    601       !!---------------------------------------------------------------------- 
    602  
     614      ! 
     615      IMPLICIT NONE 
     616      ! 
     617      !!---------------------------------------------------------------------- 
    603618      ! Controls 
    604619 
    … …  
    623638   END SUBROUTINE Agrif_InitValues_cont_ice 
    624639 
     640    
    625641   SUBROUTINE agrif_declare_var_ice 
    626642      !!---------------------------------------------------------------------- 
    627643      !!                 *** ROUTINE agrif_declare_var_ice *** 
    628644      !!---------------------------------------------------------------------- 
    629  
    630645      USE Agrif_Util 
    631646      USE ice 
    … …  
    635650      ! 
    636651      INTEGER :: ind1, ind2, ind3 
    637          !!---------------------------------------------------------------------- 
     652      INTEGER :: ipl 
     653      !!---------------------------------------------------------------------- 
    638654      ! 
    639655      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
    … …  
    644660      !                            2,2 = two ghost lines 
    645661      !------------------------------------------------------------------------------------- 
    646  
    647       ind1 =     nbghostcells 
    648       ind2 = 2 + nbghostcells_x 
    649       ind3 = 2 + nbghostcells_y_s 
    650       CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
    651       CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  ) 
    652       CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  ) 
    653  
    654       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_iceini_id) 
    655       CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_iceini_id  ) 
    656       CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_iceini_id  ) 
     662      ind1 =              nbghostcells 
     663      ind2 = nn_hls + 2 + nbghostcells_x 
     664      ind3 = nn_hls + 2 + nbghostcells_y_s 
     665      ipl = jpl*(8+nlay_s+nlay_i) 
     666      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) 
     667      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  u_ice_id) 
     668      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  v_ice_id) 
     669 
     670      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id) 
     671      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  u_iceini_id) 
     672      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  v_iceini_id) 
    657673 
    658674      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
    … …  
    712728      USE agrif_top_interp 
    713729      USE agrif_top_sponge 
    714       !! 
    715    
    716    !! 
    717    IMPLICIT NONE 
    718    ! 
    719    CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    720    LOGICAL :: check_namelist 
    721       !!---------------------------------------------------------------------- 
    722  
    723  
    724    ! 1. Declaration of the type of variable which have to be interpolated 
    725    !--------------------------------------------------------------------- 
    726    CALL agrif_declare_var_top 
    727  
    728    ! 2. First interpolations of potentially non zero fields 
    729    !------------------------------------------------------- 
    730    Agrif_SpecialValue=0. 
    731    Agrif_UseSpecialValue = .TRUE. 
    732    CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
    733    Agrif_UseSpecialValue = .FALSE. 
    734    CALL Agrif_Sponge 
    735    tabspongedone_trn = .FALSE. 
    736    CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    737    ! reset tsa to zero 
    738    tra(:,:,:,:) = 0. 
    739  
    740    ! 3. Some controls 
    741    !----------------- 
    742    check_namelist = .TRUE. 
    743  
    744    IF( check_namelist ) THEN 
    745       ! Check time steps 
    746       IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    747          WRITE(cl_check1,*)  Agrif_Parent(rdt) 
    748          WRITE(cl_check2,*)  rdt 
    749          WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
    750          CALL ctl_stop( 'incompatible time step between grids',   & 
     730      ! 
     731      IMPLICIT NONE 
     732      ! 
     733      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
     734      LOGICAL :: check_namelist 
     735      !!---------------------------------------------------------------------- 
     736 
     737      ! 1. Declaration of the type of variable which have to be interpolated 
     738      !--------------------------------------------------------------------- 
     739      CALL agrif_declare_var_top 
     740 
     741      ! 2. First interpolations of potentially non zero fields 
     742      !------------------------------------------------------- 
     743      Agrif_SpecialValue=0._wp 
     744      Agrif_UseSpecialValue = .TRUE. 
     745      CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
     746      Agrif_UseSpecialValue = .FALSE. 
     747      CALL Agrif_Sponge 
     748      tabspongedone_trn = .FALSE. 
     749      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     750      ! reset tsa to zero 
     751      tra(:,:,:,:) = 0._wp 
     752 
     753      ! 3. Some controls 
     754      !----------------- 
     755      check_namelist = .TRUE. 
     756 
     757      IF( check_namelist ) THEN 
     758         ! Check time steps 
     759         IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     760            WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     761            WRITE(cl_check2,*)  rdt 
     762            WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
     763            CALL ctl_stop( 'incompatible time step between grids',   & 
    751764               &               'parent grid value : '//cl_check1    ,   &  
    752765               &               'child  grid value : '//cl_check2    ,   &  
    753766               &               'value on child grid should be changed to  & 
    754767               &               :'//cl_check3  ) 
    755       ENDIF 
    756  
    757       ! Check run length 
    758       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     768         ENDIF 
     769 
     770         ! Check run length 
     771         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    759772            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
    760          WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    761          WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    762          CALL ctl_warn( 'incompatible run length between grids'               ,   & 
     773            WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     774            WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
     775            CALL ctl_warn( 'incompatible run length between grids'               ,   & 
    763776               &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
    764777               &              ' nitend on fine grid will be change to : '//cl_check2    ) 
    765          nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    766          nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    767       ENDIF 
    768    ENDIF 
    769    ! 
     778            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     779            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
     780         ENDIF 
     781      ENDIF 
     782      ! 
    770783   END SUBROUTINE Agrif_InitValues_cont_top 
    771784 
    … …  
    784797      INTEGER :: ind1, ind2, ind3 
    785798      !!---------------------------------------------------------------------- 
    786  
    787  
    788  
    789799!RB_CMEMS : declare here init for top       
    790800      ! 1. Declaration of the type of variable which have to be interpolated 
    791801      !--------------------------------------------------------------------- 
    792       ind1 =     nbghostcells 
    793       ind2 = 2 + nbghostcells_x 
    794       ind3 = 2 + nbghostcells_y_s 
     802      ind1 =              nbghostcells 
     803      ind2 = nn_hls + 2 + nbghostcells_x 
     804      ind3 = nn_hls + 2 + nbghostcells_y_s 
    795805# if defined key_vertical 
    796       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 
    797       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 
     806      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 
     807      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 
    798808# else 
    799809! LAURENT: STRANGE why (3,3) here ? 
    800       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) 
    801       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) 
     810      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     811      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
    802812# endif 
    803813 
    … …  
    822832   END SUBROUTINE agrif_declare_var_top 
    823833# endif 
     834    
    824835 
    825836   SUBROUTINE Agrif_detect( kg, ksizex ) 
    … …  
    835846   END SUBROUTINE Agrif_detect 
    836847 
     848    
    837849   SUBROUTINE agrif_nemo_init 
    838850      !!---------------------------------------------------------------------- 
    839851      !!                     *** ROUTINE agrif_init *** 
    840852      !!---------------------------------------------------------------------- 
    841    USE agrif_oce  
    842    USE agrif_ice 
    843    USE dom_oce 
    844    USE in_out_manager 
    845    USE lib_mpp 
    846       !! 
     853      USE agrif_oce  
     854      USE agrif_ice 
     855      USE dom_oce 
     856      USE in_out_manager 
     857      USE lib_mpp 
     858      ! 
    847859      IMPLICIT NONE 
    848860      ! 
    … …  
    880892      ! 
    881893      ! Set the number of ghost cells according to periodicity 
    882       nbghostcells_x = nbghostcells 
     894      nbghostcells_x   = nbghostcells 
    883895      nbghostcells_y_s = nbghostcells 
    884896      nbghostcells_y_n = nbghostcells 
    885897      ! 
    886       IF ( jperio == 1 ) nbghostcells_x = 0 
    887       IF ( .NOT. lk_south ) nbghostcells_y_s = 0 
    888  
     898      IF(   jperio == 1  )   nbghostcells_x   = 0 
     899      IF( .NOT. lk_south )   nbghostcells_y_s = 0 
    889900      ! Some checks 
    890       IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x )   & 
    891           CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells_x' ) 
    892       IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n )   & 
    893           CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' ) 
     901      IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x   + nbghostcells_x   )   CALL ctl_stop( 'STOP',    & 
     902         &   'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nn_hls + 2*nbghostcells_x' ) 
     903      IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n )   CALL ctl_stop( 'STOP',    & 
     904         &   'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' ) 
    894905      IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
    895906      ! 
    896907   END SUBROUTINE agrif_nemo_init 
    897908 
     909    
    898910# if defined key_mpp_mpi 
    899911   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    … …  
    909921      ! 
    910922      SELECT CASE( i ) 
    911       CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
    912       CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
    913       CASE DEFAULT 
    914          indglob = indloc 
     923      CASE(1)        ;   indglob = mig(indloc) 
     924      CASE(2)        ;   indglob = mjg(indloc) 
     925      CASE DEFAULT   ;   indglob = indloc 
    915926      END SELECT 
    916927      ! 
    917928   END SUBROUTINE Agrif_InvLoc 
    918929 
     930    
    919931   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
    920932      !!---------------------------------------------------------------------- 
    … …  
    929941      !!---------------------------------------------------------------------- 
    930942      ! 
    931       imin = nimppt(Agrif_Procrank+1)  ! ????? 
    932       jmin = njmppt(Agrif_Procrank+1)  ! ????? 
    933       imax = imin + jpi - 1 
    934       jmax = jmin + jpj - 1 
     943      imin = mig( 1 ) 
     944      jmin = mjg( 1 ) 
     945      imax = mig(jpi) 
     946      jmax = mjg(jpj) 
    935947      !  
    936948   END SUBROUTINE Agrif_get_proc_info 
    937949 
     950    
    938951   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
    939952      !!---------------------------------------------------------------------- 
    … …  
    11301143   FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 
    11311144 
    1132    USE dom_oce 
    1133  
    1134    INTEGER :: ptx, pty, i1, isens 
    1135    INTEGER :: agrif_external_switch_index 
    1136  
    1137    IF( isens == 1 ) THEN 
    1138       IF( ptx == 2 ) THEN ! T, V points 
    1139          agrif_external_switch_index = jpiglo-i1+2 
    1140       ELSE ! U, F points 
    1141          agrif_external_switch_index = jpiglo-i1+1       
    1142       ENDIF 
    1143    ELSE IF( isens ==2 ) THEN 
    1144       IF ( pty == 2 ) THEN ! T, U points 
    1145          agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
    1146       ELSE ! V, F points 
    1147          agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
    1148       ENDIF 
    1149    ENDIF 
     1145      USE dom_oce 
     1146      ! 
     1147      IMPLICIT NONE 
     1148 
     1149      INTEGER :: ptx, pty, i1, isens 
     1150      INTEGER :: agrif_external_switch_index 
     1151      !!---------------------------------------------------------------------- 
     1152 
     1153      IF( isens == 1 ) THEN 
     1154         IF( ptx == 2 ) THEN ! T, V points 
     1155            agrif_external_switch_index = jpiglo-i1+2 
     1156         ELSE ! U, F points 
     1157            agrif_external_switch_index = jpiglo-i1+1       
     1158         ENDIF 
     1159      ELSE IF( isens ==2 ) THEN 
     1160         IF ( pty == 2 ) THEN ! T, U points 
     1161            agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
     1162         ELSE ! V, F points 
     1163            agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
     1164         ENDIF 
     1165      ENDIF 
    11501166 
    11511167   END FUNCTION agrif_external_switch_index 
    … …  
    11551171      !!                   *** ROUTINE Correct_field *** 
    11561172      !!---------------------------------------------------------------------- 
    1157     
    1158    USE dom_oce 
    1159    USE agrif_oce 
    1160  
    1161    INTEGER :: i1,i2,j1,j2 
    1162    REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
    1163  
    1164    INTEGER :: i,j 
    1165    REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
    1166  
    1167    tab2dtemp = tab2d 
    1168  
    1169    IF( .NOT. use_sign_north ) THEN 
    1170       DO j=j1,j2 
    1171          DO i=i1,i2 
    1172             tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1173      USE dom_oce 
     1174      USE agrif_oce 
     1175      ! 
     1176      IMPLICIT NONE 
     1177      ! 
     1178      INTEGER :: i1,i2,j1,j2 
     1179      REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
     1180      ! 
     1181      INTEGER :: i,j 
     1182      REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
     1183      !!---------------------------------------------------------------------- 
     1184 
     1185      tab2dtemp = tab2d 
     1186 
     1187      IF( .NOT. use_sign_north ) THEN 
     1188         DO j=j1,j2 
     1189            DO i=i1,i2 
     1190               tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1191            END DO 
    11731192         END DO 
    1174       END DO 
    1175    ELSE 
    1176       DO j=j1,j2 
    1177          DO i=i1,i2 
    1178             tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1193      ELSE 
     1194         DO j=j1,j2 
     1195            DO i=i1,i2 
     1196               tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1197            END DO 
    11791198         END DO 
    1180       END DO 
    1181    ENDIF 
     1199      ENDIF 
    11821200 
    11831201   END SUBROUTINE Correct_field 
Note: See TracChangeset for help on using the changeset viewer.