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 13251 for NEMO/branches/2020 – NEMO

Changeset 13251 for NEMO/branches/2020


Ignore:
Timestamp:
2020-07-05T16:59:00+02:00 (4 years ago)
Author:
smasson
Message:

Extra_Halo: bugfix following merge with trunk@13218, see #2366

Location:
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_interp.F90

    r13230 r13251  
    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 ) 
    … …  
    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 
    … …  
    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 
    … …  
    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 
    … …  
    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      ! 
    … …  
    400380         jstart = nn_hls + 2                              ! halo + land + 1 
    401381         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    402          jstart = 2 
    403          jend   = nbghostcells+1 
    404382         DO jj = mj0(jstart), mj1(jend) 
    405383 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90

    r13232 r13251  
    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 
    134137            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    … …  
    139142            zmskwest(jpj+1:jpjmax) = 0._wp 
    140143         ENDIF 
    141  
    142          ! --- East --- ! 
    143          IF( lk_east ) THEN 
     144         IF( lk_east ) THEN                             ! --- East --- ! 
    144145            ztabramp(:,:) = 0._wp 
    145146            ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    … …  
    150151            zmskeast(jpj+1:jpjmax) = 0._wp 
    151152         ENDIF 
    152  
    153          ! --- South --- ! 
    154          IF( lk_south ) THEN 
     153         IF( lk_south ) THEN                            ! --- South --- ! 
    155154            ztabramp(:,:) = 0._wp 
    156155            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    … …  
    161160            zmsksouth(jpi+1:jpimax) = 0._wp 
    162161         ENDIF 
    163  
    164          ! --- North --- ! 
    165          IF( lk_north) THEN 
     162         IF( lk_north ) THEN                            ! --- North --- ! 
    166163            ztabramp(:,:) = 0._wp 
    167164            ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    … …  
    188185         ! Store it in ztabramp 
    189186 
    190          ispongearea  = nn_sponge_len * Agrif_irhox() 
    191          z1_ispongearea = 1._wp / REAL( ispongearea ) 
    192          jspongearea  = nn_sponge_len * Agrif_irhoy() 
    193          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 ) 
    194191          
    195192         ztabramp(:,:) = 0._wp 
    … …  
    199196         IF ( nbcellsy <= 3 ) jspongearea = -1 
    200197 
    201          ! --- West --- ! 
    202          IF(lk_west) THEN 
     198         IF( lk_west ) THEN                             ! --- West --- ! 
    203199            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    204200            ind2 = nn_hls + 1 + nbghostcells + ispongearea  
    205201            DO ji = mi0(ind1), mi1(ind2)    
    206202               DO jj = 1, jpj                
    207                   ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
     203                  ztabramp(ji,jj) =                       REAL(ind2 - mig(ji), wp) * z1_ispongearea  * zmskwest(jj) 
    208204               END DO 
    209205            END DO 
    … …  
    217213            END DO 
    218214         ENDIF 
    219  
    220          ! --- East --- ! 
    221          IF(lk_east) THEN 
     215         IF( lk_east ) THEN                             ! --- East --- ! 
    222216            ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 
    223217            ind2 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    224218            DO ji = mi0(ind1), mi1(ind2) 
    225219               DO jj = 1, jpj 
    226                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
     220                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj) 
    227221               END DO 
    228222            END DO 
    … …  
    235229               END DO 
    236230            END DO 
    237          ENDIF 
    238           
    239          ! --- South --- ! 
    240          IF( lk_south ) THEN  
     231         ENDIF       
     232         IF( lk_south ) THEN                            ! --- South --- ! 
    241233            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    242234            ind2 = nn_hls + 1 + nbghostcells + jspongearea  
    243235            DO jj = mj0(ind1), mj1(ind2)  
    244236               DO ji = 1, jpi 
    245                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
     237                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji) 
    246238               END DO 
    247239            END DO 
    … …  
    255247            END DO 
    256248         ENDIF 
    257                 
    258          ! --- North --- ! 
    259          IF( lk_north ) THEN   
     249         IF( lk_north ) THEN                            ! --- North --- ! 
    260250            ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 
    261251            ind2 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    262252            DO jj = mj0(ind1), mj1(ind2) 
    263253               DO ji = 1, jpi 
    264                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
     254                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji) 
    265255               END DO 
    266256            END DO 
    … …  
    333323      ztabrampu(:,:) = REAL( mbku_parentu(:,:), wp ) 
    334324      ztabrampv(:,:) = REAL( mbkv_parentv(:,:), wp ) 
    335       CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1., ztabrampu, 'U', 1., ztabrampv, 'V', 1. ) 
     325      CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp ) 
    336326      mbkt_parent(:,:) = NINT( ztabramp (:,:) ) 
    337327      mbku_parent(:,:) = NINT( ztabrampu(:,:) ) 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_update.F90

    r13229 r13251  
    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/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90

    r13247 r13251  
    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      !!---------------------------------------------------------------------- 
    … …  
    130140      ind3 = nn_hls + 2 + nbghostcells_y_s 
    131141 
    132       CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 
    133       CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id) 
    134       CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id) 
    135  
    136       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    137       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    138  
     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/),(/jpi,jpj,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/),(/jpi,jpj,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/),(/jpi,jpj,jpk,2/)     ,vini_id ) 
    145       CALL agrif_declare_variable((/2,2/)    ,(/ind2,ind3/)        ,(/'x','y'/),(/1,1/),(/jpi,jpj/),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) 
    … …  
    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: 
    … …  
    558565 
    559566# if defined UPD_HIGH 
    560       CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
    561       CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    562       CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    563  
    564       CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    565       CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    566       CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting) 
    567       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) 
    568575 
    569576  !    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    … …  
    574581 
    575582#else 
    576       CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    577       CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    578       CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    579  
    580       CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    581       CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    582       CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average) 
    583       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) 
    584591 
    585592 !     IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    … …  
    594601 
    595602#if defined key_si3 
    596 SUBROUTINE Agrif_InitValues_cont_ice 
     603   SUBROUTINE Agrif_InitValues_cont_ice 
     604      !!---------------------------------------------------------------------- 
     605      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     606      !!---------------------------------------------------------------------- 
    597607      USE Agrif_Util 
    598608      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
    … …  
    602612      USE agrif_ice_interp 
    603613      USE lib_mpp 
    604       !!---------------------------------------------------------------------- 
    605       !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
    606       !!---------------------------------------------------------------------- 
    607  
     614      ! 
     615      IMPLICIT NONE 
     616      ! 
     617      !!---------------------------------------------------------------------- 
    608618      ! Controls 
    609619 
    … …  
    628638   END SUBROUTINE Agrif_InitValues_cont_ice 
    629639 
     640    
    630641   SUBROUTINE agrif_declare_var_ice 
    631642      !!---------------------------------------------------------------------- 
    632643      !!                 *** ROUTINE agrif_declare_var_ice *** 
    633644      !!---------------------------------------------------------------------- 
    634  
    635645      USE Agrif_Util 
    636646      USE ice 
    637       USE par_oce 
     647      USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 
    638648      ! 
    639649      IMPLICIT NONE 
    640650      ! 
    641651      INTEGER :: ind1, ind2, ind3 
    642          !!---------------------------------------------------------------------- 
     652      INTEGER :: ipl 
     653      !!---------------------------------------------------------------------- 
    643654      ! 
    644655      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
    … …  
    652663      ind2 = nn_hls + 2 + nbghostcells_x 
    653664      ind3 = nn_hls + 2 + nbghostcells_y_s 
    654       CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
    655       CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_ice_id  ) 
    656       CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_ice_id  ) 
    657  
    658       CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_iceini_id) 
    659       CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_iceini_id  ) 
    660       CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_iceini_id  ) 
     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) 
    661673 
    662674      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
    … …  
    716728      USE agrif_top_interp 
    717729      USE agrif_top_sponge 
    718       !! 
    719    
    720    !! 
    721    IMPLICIT NONE 
    722    ! 
    723    CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    724    LOGICAL :: check_namelist 
    725       !!---------------------------------------------------------------------- 
    726  
    727  
    728    ! 1. Declaration of the type of variable which have to be interpolated 
    729    !--------------------------------------------------------------------- 
    730    CALL agrif_declare_var_top 
    731  
    732    ! 2. First interpolations of potentially non zero fields 
    733    !------------------------------------------------------- 
    734    Agrif_SpecialValue=0. 
    735    Agrif_UseSpecialValue = .TRUE. 
    736    CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
    737    Agrif_UseSpecialValue = .FALSE. 
    738    CALL Agrif_Sponge 
    739    tabspongedone_trn = .FALSE. 
    740    CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    741    ! reset tsa to zero 
    742    tra(:,:,:,:) = 0. 
    743  
    744    ! 3. Some controls 
    745    !----------------- 
    746    check_namelist = .TRUE. 
    747  
    748    IF( check_namelist ) THEN 
    749       ! Check time steps 
    750       IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    751          WRITE(cl_check1,*)  Agrif_Parent(rdt) 
    752          WRITE(cl_check2,*)  rdt 
    753          WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
    754          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',   & 
    755764               &               'parent grid value : '//cl_check1    ,   &  
    756765               &               'child  grid value : '//cl_check2    ,   &  
    757766               &               'value on child grid should be changed to  & 
    758767               &               :'//cl_check3  ) 
    759       ENDIF 
    760  
    761       ! Check run length 
    762       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     768         ENDIF 
     769 
     770         ! Check run length 
     771         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    763772            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
    764          WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    765          WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    766          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'               ,   & 
    767776               &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
    768777               &              ' nitend on fine grid will be change to : '//cl_check2    ) 
    769          nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    770          nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    771       ENDIF 
    772    ENDIF 
    773    ! 
     778            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     779            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
     780         ENDIF 
     781      ENDIF 
     782      ! 
    774783   END SUBROUTINE Agrif_InitValues_cont_top 
    775784 
    … …  
    788797      INTEGER :: ind1, ind2, ind3 
    789798      !!---------------------------------------------------------------------- 
    790  
    791  
    792  
    793799!RB_CMEMS : declare here init for top       
    794800      ! 1. Declaration of the type of variable which have to be interpolated 
    … …  
    826832   END SUBROUTINE agrif_declare_var_top 
    827833# endif 
     834    
    828835 
    829836   SUBROUTINE Agrif_detect( kg, ksizex ) 
    … …  
    839846   END SUBROUTINE Agrif_detect 
    840847 
     848    
    841849   SUBROUTINE agrif_nemo_init 
    842850      !!---------------------------------------------------------------------- 
    843851      !!                     *** ROUTINE agrif_init *** 
    844852      !!---------------------------------------------------------------------- 
    845    USE agrif_oce  
    846    USE agrif_ice 
    847    USE dom_oce 
    848    USE in_out_manager 
    849    USE lib_mpp 
    850       !! 
     853      USE agrif_oce  
     854      USE agrif_ice 
     855      USE dom_oce 
     856      USE in_out_manager 
     857      USE lib_mpp 
     858      ! 
    851859      IMPLICIT NONE 
    852860      ! 
    … …  
    899907   END SUBROUTINE agrif_nemo_init 
    900908 
     909    
    901910# if defined key_mpp_mpi 
    902911   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    … …  
    919928   END SUBROUTINE Agrif_InvLoc 
    920929 
     930    
    921931   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
    922932      !!---------------------------------------------------------------------- 
    … …  
    938948   END SUBROUTINE Agrif_get_proc_info 
    939949 
     950    
    940951   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
    941952      !!---------------------------------------------------------------------- 
    … …  
    11321143   FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 
    11331144 
    1134    USE dom_oce 
    1135  
    1136    INTEGER :: ptx, pty, i1, isens 
    1137    INTEGER :: agrif_external_switch_index 
    1138  
    1139    IF( isens == 1 ) THEN 
    1140       IF( ptx == 2 ) THEN ! T, V points 
    1141          agrif_external_switch_index = jpiglo-i1+2 
    1142       ELSE ! U, F points 
    1143          agrif_external_switch_index = jpiglo-i1+1       
    1144       ENDIF 
    1145    ELSE IF( isens ==2 ) THEN 
    1146       IF ( pty == 2 ) THEN ! T, U points 
    1147          agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
    1148       ELSE ! V, F points 
    1149          agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
    1150       ENDIF 
    1151    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 
    11521166 
    11531167   END FUNCTION agrif_external_switch_index 
    … …  
    11571171      !!                   *** ROUTINE Correct_field *** 
    11581172      !!---------------------------------------------------------------------- 
    1159     
    1160    USE dom_oce 
    1161    USE agrif_oce 
    1162  
    1163    INTEGER :: i1,i2,j1,j2 
    1164    REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
    1165  
    1166    INTEGER :: i,j 
    1167    REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
    1168  
    1169    tab2dtemp = tab2d 
    1170  
    1171    IF( .NOT. use_sign_north ) THEN 
    1172       DO j=j1,j2 
    1173          DO i=i1,i2 
    1174             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 
    11751192         END DO 
    1176       END DO 
    1177    ELSE 
    1178       DO j=j1,j2 
    1179          DO i=i1,i2 
    1180             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 
    11811198         END DO 
    1182       END DO 
    1183    ENDIF 
     1199      ENDIF 
    11841200 
    11851201   END SUBROUTINE Correct_field 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DYN/sshwzv.F90

    r13248 r13251  
    222222         ! inside computational domain (cosmetic)  
    223223         DO jk = 1, jpkm1 
    224             ! --- West --- ! 
    225             IF( lk_west) THEN 
     224            IF( lk_west ) THEN                             ! --- West --- ! 
    226225               DO ji = mi0(2+nn_hls), mi1(2+nn_hls) 
    227226                  DO jj = 1, jpj 
    … …  
    230229               END DO 
    231230            ENDIF 
    232             ! 
    233             ! --- East --- ! 
    234             IF( lk_east) THEN 
     231            IF( lk_east ) THEN                             ! --- East --- ! 
    235232               DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls) 
    236233                  DO jj = 1, jpj 
    … …  
    239236               END DO 
    240237            ENDIF 
    241             ! 
    242             ! --- South --- ! 
    243             IF( lk_south) THEN 
     238            IF( lk_south ) THEN                            ! --- South --- ! 
    244239               DO jj = mj0(2+nn_hls), mj1(2+nn_hls) 
    245240                  DO ji = 1, jpi 
    … …  
    248243               END DO 
    249244            ENDIF 
    250             ! 
    251             ! --- North --- ! 
    252             IF( lk_north) THEN 
     245            IF( lk_north ) THEN                            ! --- North --- ! 
    253246               DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls) 
    254247                  DO ji = 1, jpi 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90

    r13236 r13251  
    339339      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' ) 
    340340       
     341#if defined key_agrif 
     342      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
     343         CALL agrif_nemo_init() 
     344      ENDIF 
     345#endif 
    341346      ! 
    342347      !  2. Index arrays for subdomains 
    … …  
    550555      njmpp = ijmppt(ii,ij) 
    551556      jpk = jpkglo                              ! third dim 
    552 #if defined key_agrif 
    553       ! simple trick to use same vertical grid as parent but different number of levels:  
    554       ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 
    555       ! Suppress once vertical online interpolation is ok 
    556 !!$      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo ) 
    557 #endif 
    558557      ! 
    559558      CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls)  

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_nam.F90

    r13247 r13251  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
     16   USE dom_oce 
    1617   USE par_oce        ! ocean space and time domain 
    1718   USE phycst         ! physical constants 
    … …  
    7374#if defined key_agrif 
    7475      IF( .NOT.Agrif_Root() ) THEN         ! Global Domain size: add 1 land point on each side 
    75          kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
    76          kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
     76         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     77         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     78!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     79!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    7780      ENDIF 
    7881#endif 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90

    r13238 r13251  
    8888         kpj = kpj - 2   ! for compatibility with old version (because kerio=7) --> to be removed 
    8989      ELSE                           ! Global Domain size: add nbghostcells + 1 "land" point on each side 
    90          kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
    91          kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
     90         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     91         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     92!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     93!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    9294      ENDIF 
    9395      kpk = 2 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/VORTEX/MY_SRC/usrdef_nam.F90

    r13238 r13251  
    8585         kpj = NINT( 1800.e3  / rn_dy ) + 3  
    8686      ELSE                          ! Global Domain size: add nbghostcells + 1 "land" point on each side 
    87          kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
    88          kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
     87         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     88         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     89!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     90!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    8991      ENDIF 
    9092      kpk = NINT( 5000._wp / rn_dz ) + 1 
Note: See TracChangeset for help on using the changeset viewer.