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 13899 for NEMO/branches/2020/tickets_icb_1900/src/NST/agrif_oce_interp.F90 – NEMO

Ignore:
Timestamp:
2020-11-27T17:26:33+01:00 (4 years ago)
Author:
mathiot
Message:

ticket #1900: update branch to trunk and add ICB test case

Location:
NEMO/branches/2020/tickets_icb_1900
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/tickets_icb_1900

    • 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/sette@13559        sette 

  • NEMO/branches/2020/tickets_icb_1900/src/NST/agrif_oce_interp.F90

    r13216 r13899  
    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      !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.