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

Changeset 15279


Ignore:
Timestamp:
2021-09-23T12:00:23+02:00 (3 years ago)
Author:
jchanut
Message:

#2222 and #2638: Enable creating agrif meshes with different vertical grids (geopotential only as a start)

Location:
utils/tools/DOMAINcfg
Files:
14 edited

Legend:

Unmodified
Added
Removed

  • utils/tools/DOMAINcfg/1_namelist_ref

    r14629 r15279  
    171171&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    172172!----------------------------------------------------------------------- 
    173    ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    174    rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s] 
    175    rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s] 
    176    ln_chk_bathy  = .FALSE. ! 
     173   ln_vert_remap = .false. ! volume conserving update  
    177174   npt_connect   = 2 
    178175   npt_copy      = 2 

  • utils/tools/DOMAINcfg/2_namelist_ref

    r14629 r15279  
    171171&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    172172!----------------------------------------------------------------------- 
    173    ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    174    rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s] 
    175    rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s] 
    176    ln_chk_bathy  = .FALSE. ! 
     173   ln_vert_remap = .false. ! volume conserving update  
    177174   npt_connect   = 2 
    178175   npt_copy      = 2 

  • utils/tools/DOMAINcfg/3_namelist_ref

    r14629 r15279  
    171171&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    172172!----------------------------------------------------------------------- 
    173    ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    174    rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s] 
    175    rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s] 
    176    ln_chk_bathy  = .FALSE. ! 
     173   ln_vert_remap = .false. ! volume conserving update  
    177174   npt_connect   = 2 
    178175   npt_copy      = 2 

  • utils/tools/DOMAINcfg/make_namelist.py

    r14962 r15279  
    6262    print(int(Ni0glo_parent), int(Nj0glo_parent)) 
    6363 
    64     nbghostcells_x = nbghostcells 
    65     nbghostcells_y = nbghostcells 
    66     nbghostcells_y_n = nbghostcells_y 
    67     nbghostcells_y_s = nbghostcells_y 
     64    nbghostcells_x_e = nbghostcells 
     65    nbghostcells_x_w = nbghostcells 
     66    nbghostcells_y_n = nbghostcells 
     67    nbghostcells_y_s = nbghostcells 
    6868    if (int(grid[cnt-1][2]) == 1 ): 
    6969        nbghostcells_y_s = 1  
    7070    if int(grid[cnt-1][3]) == int(Nj0glo_parent)-1 : 
    7171        nbghostcells_y_n = 1  
     72    if (int(grid[cnt-1][0]) == 1 ): 
     73        nbghostcells_x_w = 1  
     74    if int(grid[cnt-1][1]) == int(Ni0glo_parent)-1 : 
     75        nbghostcells_x_e = 1  
     76    if int(grid[cnt-1][3]) == int(Nj0glo_parent) : 
     77        nbghostcells_y_n = 0  
    7278    if int(grid[cnt-1][1]) - int(grid[cnt-1][0]) == int(Ni0glo_parent) : 
    73         nbghostcells_x = 0 
     79        nbghostcells_x_w = 0 
     80        nbghostcells_x_e = 0 
    7481 
    75     Ni0glo = (int(grid[cnt-1][1])-int(grid[cnt-1][0]))*int(grid[cnt-1][4]) + 2*nbghostcells_x 
     82    Ni0glo = (int(grid[cnt-1][1])-int(grid[cnt-1][0]))*int(grid[cnt-1][4]) + nbghostcells_x_w  + nbghostcells_x_e 
    7683    Nj0glo = (int(grid[cnt-1][3])-int(grid[cnt-1][2]))*int(grid[cnt-1][5]) + nbghostcells_y_n  + nbghostcells_y_s 
    7784    #print( "Grid "+str(cnt)+" : jpiglo = "+cnt(jpiglo)+ "  jpjglo = "+str(jpjglo) )  
    7885    print(int(grid[cnt-1][0]), int(grid[cnt-1][1]), int(grid[cnt-1][2]),int(grid[cnt-1][3])) 
    79     print(nbghostcells_x, nbghostcells_y_s, nbghostcells_y_n) 
     86    print(nbghostcells_x_w, nbghostcells_x_e, nbghostcells_y_s, nbghostcells_y_n) 
    8087    print('Grid {:1d} : Ni0glo = {:3d} , Nj0glo = {:3d}'.format(cnt, Ni0glo, Nj0glo)) 
    8188 
    … …  
    9198               else: 
    9299                   line = "   jperio = 0\n" 
     100               if nbghostcells_y_n == 0: 
     101                   line = "   jperio = 4\n" 
    93102           if line.strip().startswith('nn_bathy'): 
    94103                  line = "   nn_bathy = 2\n" 

  • utils/tools/DOMAINcfg/namelist_cfg

    r14624 r15279  
    1919                           !  or compute (2) from external bathymetry 
    2020   nn_interp   =    1                          ! type of interpolation (nn_bathy =2) 
    21    cn_domcfg   = 'ORCA_R2_zps_domcfg_agrif.nc'                 
     21   cn_domcfg   =  'ORCA_R2_zps_domcfg.nc'                 
    2222   cn_topo     =  'bathymetry_ORCA12_V3.3.nc'  ! external topo file (nn_bathy =2) 
    2323   cn_bath     =  'Bathymetry'                 ! topo name in file  (nn_bathy =2) 

  • utils/tools/DOMAINcfg/namelist_ref

    r14629 r15279  
    171171&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    172172!----------------------------------------------------------------------- 
    173    ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    174    rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s] 
    175    rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s] 
    176    ln_chk_bathy  = .FALSE. ! 
     173   ln_vert_remap = .false. ! volume conserving update  
    177174   npt_connect   = 2 
    178175   npt_copy      = 2 

  • utils/tools/DOMAINcfg/src/agrif_connect.F90

    r14952 r15279  
    22 
    33   USE dom_oce 
    4    USE domzgr 
    54   USE agrif_parameters 
    65   USE agrif_profiles 
    … …  
    98   PRIVATE 
    109 
    11    PUBLIC agrif_boundary_connections  
     10   PUBLIC agrif_boundary_connections, agrif_bathymetry_connect  
    1211 
    1312CONTAINS 
    … …  
    2726!      CALL Agrif_Bc_variable(e3t_copy_id, procname = connect_e3t_copy) 
    2827 
    29       ALLOCATE(e3t_interp(jpi,jpj,jpk)) 
    30       e3t_interp = -10. 
     28      ALLOCATE(e3t_interp_done(jpi,jpj)) 
     29      e3t_interp_done(:,:) = .FALSE.  
     30      ! set extrapolation on for interpolation near the coastline: 
     31      Agrif_UseSpecialValue = .TRUE. 
     32      Agrif_SpecialValue = 0._wp 
     33      CALL Agrif_Bc_variable(e3t_connect_id, procname = connect_e3t_connect) 
     34      ! Override in ghost zone by nearest value: 
    3135      Agrif_UseSpecialValue = .FALSE. 
    32       Agrif_SpecialValue = 0. 
    33       CALL Agrif_Bc_variable(e3t_connect_id, procname = connect_e3t_connect) 
     36      e3t_interp_done(:,:) = .FALSE. 
     37      CALL Agrif_Bc_variable(e3t_copy_id,    procname = connect_e3t_connect) 
    3438      Agrif_UseSpecialValue = .FALSE. 
     39      DEALLOCATE(e3t_interp_done) 
    3540      ! 
    3641   END SUBROUTINE agrif_boundary_connections 
     42 
     43   SUBROUTINE agrif_bathymetry_connect 
     44      !!---------------------------------------------------------------------- 
     45      !!                  ***  ROUTINE agrif_bathymetry_connect  *** 
     46      !!----------------------------------------------------------------------   
     47      IF( Agrif_Root() ) return 
     48 
     49      CALL agrif_connection() 
     50      ! 
     51      ALLOCATE(e3t_interp_done(jpi,jpj)) 
     52      e3t_interp_done(:,:) = .FALSE.  
     53      ! set extrapolation on for interpolation near the coastline: 
     54      Agrif_UseSpecialValue = .TRUE. 
     55      Agrif_SpecialValue = 0._wp 
     56      CALL Agrif_Bc_variable(e3t_connect_id, procname = connect_bathy_connect) 
     57      ! Override in ghost zone by nearest value: 
     58      Agrif_UseSpecialValue = .FALSE. 
     59      e3t_interp_done(:,:) = .FALSE. 
     60      CALL Agrif_Bc_variable(e3t_copy_id,    procname = connect_bathy_connect) 
     61      Agrif_UseSpecialValue = .FALSE. 
     62      DEALLOCATE(e3t_interp_done) 
     63      ! 
     64   END SUBROUTINE agrif_bathymetry_connect 
    3765 
    3866   SUBROUTINE connect_e3t_copy( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir) 
    … …  
    5078         ptab(i1:i2,j1:j2,k1:k2) = e3t_0(i1:i2,j1:j2,k1:k2) 
    5179      ELSE 
    52          e3t_0(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2) 
     80         e3t_0(i1:i2,j1:j2,1:jpk) = ptab(i1:i2,j1:j2,1:jpk) 
    5381      ENDIF 
    5482      ! 
    … …  
    89117      ! 
    90118      !!----------------------------------------------------------------------  
    91       INTEGER :: ji, jj, jk  
     119      INTEGER :: ji, jj, jk, ik  
    92120      REAL(wp), DIMENSION(i1:i2,j1:j2) :: bathy_local, bathy_interp 
    93       REAL(wp) :: zdepth, zmax  
     121      REAL(wp) :: zdepth, zdepwp, zmax, ze3tp, ze3wp, zhmin  
    94122      ! 
    95123      IF( before) THEN 
    96          DO jk=1,jpk 
     124         DO jk=k1, k2 
    97125            DO jj=j1,j2 
    98126               DO ji=i1,i2 
    … …  
    108136         DO jj=j1,j2 
    109137            DO ji=i1,i2 
    110                ptab(ji,jj,jpk+1) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
     138               ptab(ji,jj,k2) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
    111139            END DO 
    112140         END DO 
    … …  
    115143            DO ji=i1,i2 
    116144               bathy_local (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
    117                bathy_interp (ji,jj) = ptab(ji,jj,jpk+1) 
    118  
     145               bathy_interp (ji,jj) = ptab(ji,jj,k2) 
     146               ! keep child masking in transition zone: 
     147               IF ((ztabramp(ji,jj)/=1._wp).AND.(bathy_local(ji,jj)==0._wp)) bathy_interp(ji,jj)=0._wp 
    119148        ! Connected bathymetry 
    120                IF( e3t_interp(ji,jj,1) == -10 ) THEN 
     149               IF( .NOT.e3t_interp_done(ji,jj) ) THEN 
    121150                  bathy_local(ji,jj)=(1.-ztabramp(ji,jj))*bathy_local(ji,jj)+ztabramp(ji,jj)*bathy_interp(ji,jj) 
    122151               ENDIF 
    … …  
    125154 
    126155        ! Update mbkt and ssmask 
     156         IF( rn_hmin < 0._wp ) THEN 
     157            ik = - INT( rn_hmin ) 
     158         ELSE 
     159            ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 ) 
     160         ENDIF 
     161         zhmin = gdepw_1d(ik+1) 
     162 
    127163         zmax = gdepw_1d(jpk) + e3t_1d(jpk) 
    128164         bathy_local(:,:) = MAX(MIN(zmax,bathy_local(:,:)),0._wp) 
    129          WHERE( bathy_local(i1:i2,j1:j2) == 0._wp); mbathy(i1:i2,j1:j2) = 0 
    130          ELSE WHERE                       ; mbathy(i1:i2,j1:j2) = jpkm1 
     165         WHERE( bathy_local(i1:i2,j1:j2) == 0._wp) 
     166            mbathy(i1:i2,j1:j2) = 0 
     167         ELSE WHERE  
     168            mbathy(i1:i2,j1:j2) = jpkm1  
     169            bathy_local(i1:i2,j1:j2) = MAX(  zhmin , bathy_local(i1:i2,j1:j2)  )  
    131170         END WHERE 
    132171 
    133172         DO jk=jpkm1,1,-1 
    134            zdepth = gdepw_1d(jk)+MIN(e3zps_min,e3t_1d(jk)*e3zps_rat) 
     173           zdepth = gdepw_1d(jk) + MIN(e3zps_min,e3t_1d(jk)*e3zps_rat) 
    135174           WHERE( 0._wp < bathy_local(:,:) .AND. bathy_local(:,:) <= zdepth ) mbathy(i1:i2,j1:j2) = jk-1 
    136175         ENDDO 
    … …  
    141180          
    142181         mbkt(i1:i2,j1:j2) = MAX( mbathy(i1:i2,j1:j2), 1 ) 
    143  
    144182         ! 
    145          DO jk=1,jpk 
     183         DO jj = j1, j2 
     184            DO ji = i1, i2 
     185               IF( .NOT.e3t_interp_done(ji,jj) ) THEN ! the connection has not yet been done 
     186                  DO jk = 1, jpk     
     187                     gdept_0(ji,jj,jk) = gdept_1d(jk) 
     188                     gdepw_0(ji,jj,jk) = gdepw_1d(jk) 
     189                     e3t_0  (ji,jj,jk) = e3t_1d  (jk) 
     190                     e3w_0  (ji,jj,jk) = e3w_1d  (jk) 
     191                  END DO  
     192                  ! 
     193                  ik = mbathy(ji,jj) 
     194                  IF( ik > 0 ) THEN               ! ocean point only 
     195                     ! max ocean level case 
     196                     IF( ik == jpkm1 ) THEN 
     197                        zdepwp = bathy_local(ji,jj) 
     198                        ze3tp  = bathy_local(ji,jj) - gdepw_1d(ik) 
     199                        ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
     200                        e3t_0(ji,jj,ik  ) = ze3tp 
     201                        e3t_0(ji,jj,ik+1) = ze3tp 
     202                        e3w_0(ji,jj,ik  ) = ze3wp 
     203                        e3w_0(ji,jj,ik+1) = ze3tp 
     204                        gdepw_0(ji,jj,ik+1) = zdepwp 
     205                        gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
     206                        gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
     207                        ! 
     208                     ELSE                         ! standard case 
     209                        IF( bathy_local(ji,jj) <= gdepw_1d(ik+1) ) THEN 
     210                           gdepw_0(ji,jj,ik+1) = bathy_local(ji,jj) 
     211                        ELSE 
     212                           gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
     213                        ENDIF 
     214                        gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) ) & 
     215                              &                * ((gdept_1d(     ik  ) - gdepw_1d(ik) )           & 
     216                              &                / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
     217                        e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik)) & 
     218                              &                / ( gdepw_1d(      ik+1) - gdepw_1d(ik)) 
     219                        e3w_0(ji,jj,ik) = & 
     220                              & 0.5_wp * (gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   & 
     221                              &        * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 
     222                        !       ... on ik+1 
     223                        e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     224                        e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     225                        gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 
     226                     ENDIF 
     227                  ENDIF 
     228               ENDIF 
     229               e3t_interp_done(ji,jj) = .TRUE. 
     230            END DO 
     231         END DO 
     232      ENDIF 
     233      ! 
     234   END SUBROUTINE connect_e3t_connect 
     235 
     236   SUBROUTINE connect_bathy_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir) 
     237      !!---------------------------------------------------------------------- 
     238      !!                  ***  ROUTINE connect_e3t_connect  *** 
     239      !!----------------------------------------------------------------------   
     240      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     241      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     242      LOGICAL                               , INTENT(in   ) ::   before 
     243      INTEGER                               , INTENT(in   ) ::   nb , ndir 
     244      ! 
     245      !!----------------------------------------------------------------------  
     246      INTEGER :: ji, jj, jk 
     247      ! 
     248      IF( before) THEN 
     249         DO jk=k1,k2 
    146250            DO jj=j1,j2 
    147251               DO ji=i1,i2 
    148                   IF( e3t_interp(ji,jj,jk) == -10 ) THEN ! the connection has not yet been done 
    149                      e3t_interp(ji,jj,jk) = MAX( ptab(ji,jj,jk),MIN(e3zps_min, e3t_1d(jk)*e3zps_rat) ) 
    150                   !   e3t_interp(ji,jj,jk) = MIN( e3t_interp(ji,jj,jk),e3t_1d(jk) ) 
    151                      e3t_0(ji,jj,jk) = ( 1. - ztabramp(ji,jj) )*e3t_0(ji,jj,jk) + ztabramp(ji,jj)*e3t_interp(ji,jj,jk) 
     252                  IF( mbkt(ji,jj) .GE. jk ) THEN 
     253                     ptab(ji,jj,jk) = e3t_0(ji,jj,jk) 
     254                  ELSE 
     255                     ptab(ji,jj,jk) = 0._wp 
    152256                  ENDIF 
    153                   IF( jk > mbkt(ji,jj)) THEN 
    154                     e3t_0(ji,jj,jk) = e3t_1d(jk) 
    155                   ENDIF 
    156              END DO 
    157            END DO 
    158          END DO 
    159       ENDIF 
    160       ! 
    161    END SUBROUTINE connect_e3t_connect 
     257               END DO 
     258            END DO 
     259         END DO 
     260         ! 
     261         DO jj=j1,j2 
     262            DO ji=i1,i2 
     263               ptab(ji,jj,k2) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
     264            END DO 
     265         END DO 
     266      ELSE 
     267         DO jj=j1,j2 
     268            DO ji=i1,i2 
     269               ! keep child masking in transition zone: 
     270               IF ((ztabramp(ji,jj)/=1._wp).AND.(bathy(ji,jj)==0._wp)) ptab(ji,jj,k2) = 0._wp 
     271               ! Connected bathymetry 
     272               IF( .NOT.e3t_interp_done(ji,jj) ) THEN 
     273                  bathy(ji,jj)=(1._wp-ztabramp(ji,jj))*bathy(ji,jj)+ztabramp(ji,jj)*ptab(ji,jj,k2) 
     274                  e3t_interp_done(ji,jj) = .TRUE. 
     275               ENDIF 
     276            END DO 
     277         END DO 
     278      ENDIF 
     279      ! 
     280   END SUBROUTINE connect_bathy_connect 
    162281    
    163282   SUBROUTINE agrif_connection 
    … …  
    181300 
    182301      ! --- West --- ! 
    183       IF( ((nbondi == -1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) THEN 
     302      IF( lk_west ) THEN 
    184303         ind1 = nn_hls + nbghostcells + istart 
    185304         ind2 = ind1 + ispongearea  
    … …  
    200319 
    201320      ! --- East --- ! 
    202       IF( ((nbondi == 1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) THEN 
     321      IF( lk_east ) THEN 
    203322         ind2 = jpiglo -  (nn_hls + nbghostcells -1 ) - istart 
    204323         ind1 = ind2 -ispongearea        
    … …  
    223342 
    224343      ! --- South --- ! 
    225       IF(( (nbondj == -1) .OR. (nbondj == 2) ).AND.(lk_south)) THEN 
     344      IF( lk_south ) THEN 
    226345         ind1 = nn_hls + nbghostcells + istart 
    227346         ind2 = ind1 + ispongearea  
    … …  
    242361 
    243362      ! --- North --- ! 
    244       IF(( (nbondj == 1) .OR. (nbondj == 2) ).AND.(lk_north)) THEN 
     363      IF( lk_north ) THEN 
    245364         ind2 = jpjglo - (nn_hls + nbghostcells - 1) - istart 
    246365         ind1 = ind2 -ispongearea 
    … …  
    265384   SUBROUTINE agrif_boundary_connections 
    266385   END SUBROUTINE agrif_boundary_connections 
     386   SUBROUTINE agrif_bathymetry_connect  
     387   END SUBROUTINE agrif_bathymetry_connect  
    267388#endif 
    268389 

  • utils/tools/DOMAINcfg/src/agrif_dom_update.F90

    r14634 r15279  
    22 
    33   USE dom_oce 
    4    USE domzgr 
    54   USE agrif_parameters 
    65   USE agrif_profiles 
    7    USE lbclnk 
    8     
     6   USE agrif_recompute_scales 
     7  
    98   IMPLICIT none 
    109   PRIVATE 
    … …  
    2120      !!----------------------------------------------------------------------   
    2221      ! 
     22      INTEGER :: ind1, ind2 
     23 
    2324      IF( Agrif_Root() ) return 
    24  
    25       CALL agrif_update_variable(bottom_level_id,procname = update_bottom_level) 
    26       ! 
    27       Agrif_UseSpecialValueInUpdate = .TRUE. 
    28       Agrif_SpecialValueFineGrid    = 0._wp          
    29       CALL agrif_update_variable(e3t_id,procname = update_e3t) 
     25       
     26      IF ( .NOT.ln_vert_remap ) THEN 
     27         CALL agrif_update_variable(bottom_level_id,procname = update_bottom_level) 
     28         Agrif_UseSpecialValueInUpdate = .FALSE. 
     29         Agrif_SpecialValueFineGrid    = 0._wp          
     30         CALL agrif_update_variable(e3t_id, procname = update_e3t_z)  
     31         ! 
     32      ELSE 
     33         Agrif_UseSpecialValueInUpdate = .FALSE. 
     34         Agrif_SpecialValueFineGrid    = 0._wp          
     35         CALL agrif_update_variable(e3t_id, procname = update_e3t_z_cons)  
     36 
     37         ! jc: extend update zone outside dynamical interface within sponge zone: 
     38         ! Use max operator this time to account for cases for which Agrif_Rho > nbghostcells 
     39         ind1 = CEILING(REAL(max(nbghostcells_x_w-1, nbghostcells_x_e-1), wp) / Agrif_Rhox() ) 
     40         ind2 = CEILING(REAL(max(nbghostcells_y_s-1, nbghostcells_y_n-1), wp) / Agrif_Rhoy() ) 
     41         CALL agrif_update_variable(e3t_copy_id, locupdate1=(/-ind1,0/), & 
     42                             &                   locupdate2=(/-ind2,0/),procname = update_e3t_z_cons) 
     43      ENDIF 
    3044      Agrif_UseSpecialValueInUpdate = .FALSE. 
     45      ! 
     46      ! Update vertical scale factors at U, V and F-points: 
     47      CALL Agrif_ChildGrid_To_ParentGrid() 
     48      CALL agrif_recompute_scalefactors 
     49      CALL Agrif_ParentGrid_To_ChildGrid() 
    3150      !     
    3251   END SUBROUTINE agrif_update_all 
    3352 
    34    SUBROUTINE update_bottom_level( ptab, i1, i2, j1, j2, before, nb,ndir) 
     53   SUBROUTINE update_bottom_level( ptab, i1, i2, j1, j2, before) 
    3554      !!---------------------------------------------------------------------- 
    36       !!                  ***  ROUTINE interpsshn  *** 
     55      !!       ***  ROUTINE update_bottom_level  *** 
    3756      !!----------------------------------------------------------------------   
    3857      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
    3958      REAL, DIMENSION(i1:i2,j1:j2)    , INTENT(inout) ::   ptab 
    4059      LOGICAL                         , INTENT(in   ) ::   before 
    41       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    4260      ! 
    4361      !!----------------------------------------------------------------------  
    44       REAL(WP),DIMENSION(jpi,jpj) :: zk 
    4562      ! 
    4663      IF( before) THEN 
    … …  
    5067          
    5168         WHERE ( mbkt(i1:i2,j1:j2) .EQ. 0 ) 
    52             ssmask(i1:i2,j1:j2) = 0. 
    53             mbkt(i1:i2,j1:j2)   = 1 
     69            ssmask(i1:i2,j1:j2) = 0._wp 
     70            mbkt(i1:i2,j1:j2)   = 1  
    5471         ELSEWHERE 
    55             ssmask(i1:i2,j1:j2) = 1. 
     72            ssmask(i1:i2,j1:j2) = 1._wp 
    5673         END WHERE  
    57 !         zk(:,:) = REAL(mbkt(:,:),wp); CALL lbc_lnk('update_bottom',zk,'T',1.); mbkt(:,:) = MAX(NINT(zk(:,:)),1) 
    58 !         CALL lbc_lnk('update_bottom',ssmask,'T',1.)           
    5974      ENDIF 
    6075      ! 
    6176   END SUBROUTINE update_bottom_level 
    62     
    63    SUBROUTINE update_e3t( tabres, i1, i2, j1, j2, k1, k2, before ) 
    64       !!--------------------------------------------- 
    65       !!           *** update_e3t *** 
     77 
     78   SUBROUTINE update_e3t_z( tabres, i1, i2, j1, j2, k1, k2, before ) 
     79      !!--------------------------------------------- 
     80      !!           *** update_e3t_z *** 
    6681      !!--------------------------------------------- 
    6782      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    … …  
    6984      LOGICAL, INTENT(in) :: before 
    7085      !! 
    71       INTEGER :: ji,jj,jk 
     86      INTEGER :: ji, jj, jk 
    7287      !!--------------------------------------------- 
    7388      ! 
    … …  
    7691            DO jj=j1,j2 
    7792               DO ji=i1,i2 
    78                    IF ((ssmask(ji,jj) /=0.).AND.( mbkt(ji,jj) .GE. jk )) THEN 
     93                  IF ( (ssmask(ji,jj) /=0._wp).AND.(mbkt(ji,jj).GE.jk) ) THEN 
     94                     tabres(ji,jj,jk) = e3t_0(ji,jj,jk) 
     95                  ELSE 
     96                     tabres(ji,jj,jk) = 0._wp 
     97                  ENDIF  
     98               END DO 
     99            END DO 
     100         END DO 
     101      ELSE 
     102         DO jk=1,jpk 
     103            DO jj=j1,j2 
     104               DO ji=i1,i2 
     105                  IF ( ( mbkt(ji,jj).GE.jk ).AND.(ssmask(ji,jj)==1._wp) ) THEN 
     106                     e3t_0(ji,jj,jk) = MAX(tabres(ji,jj,jk),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)) 
     107                 !    e3t_0(ji,jj,jk) = tabres(ji,jj,jk) 
     108                  ELSE 
     109                     e3t_0(ji,jj,jk) = e3t_1d(jk) 
     110                  ENDIF 
     111               END DO 
     112            END DO 
     113         END DO 
     114         ! 
     115      ENDIF 
     116      !  
     117   END SUBROUTINE update_e3t_z 
     118 
     119   SUBROUTINE update_e3t_z_cons( tabres, i1, i2, j1, j2, k1, k2, before ) 
     120      !!--------------------------------------------- 
     121      !!           *** update_e3t_z_cons *** 
     122      !!--------------------------------------------- 
     123      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     124      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     125      LOGICAL, INTENT(in) :: before 
     126      !! 
     127      INTEGER :: ji, jj, jk, ik 
     128      REAL(wp) :: zhmin, zdepth, zdepwp, ze3tp, ze3wp 
     129      !!--------------------------------------------- 
     130      ! 
     131      IF (before) THEN 
     132         DO jk = k1, k2-1 
     133            DO jj = j1, j2 
     134               DO ji = i1, i2 
     135                   IF ( (ssmask(ji,jj) /=0._wp).AND.( mbkt(ji,jj) .GE. jk ) ) THEN 
    79136                      tabres(ji,jj,jk) = e3t_0(ji,jj,jk) 
    80137                   ELSE 
    81                       tabres(ji,jj,jk) = 0. 
     138                      tabres(ji,jj,jk) = 0._wp 
    82139                   endif 
    83140               END DO 
    84141            END DO 
    85142         END DO 
    86       ELSE 
    87          DO jk=k1,k2 
    88             DO jj=j1,j2 
    89                DO ji=i1,i2 
    90                    IF( mbkt(ji,jj) .GE. jk ) THEN 
    91                       e3t_0(ji,jj,jk) = MAX(tabres(ji,jj,jk),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)) 
    92                   !    e3t_0(ji,jj,jk) = tabres(ji,jj,jk) 
    93                    ELSE 
    94                       e3t_0(ji,jj,jk) = e3t_1d(jk) 
    95                    ENDIF 
    96                END DO 
    97             END DO 
    98          END DO 
    99  
    100 !         CALL lbc_lnk('update_e3t',e3t_0,'T',1.,kfillmode = jpfillcopy) 
    101          ! 
     143         tabres(i1:i2,j1:j2,k2) = ssmask(i1:i2,j1:j2) ! To get fractional area 
     144      ELSE 
     145         IF( rn_hmin < 0._wp ) THEN    
     146            ik = - INT( rn_hmin ) 
     147         ELSE                           
     148            ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 ) 
     149         ENDIF 
     150         zhmin = gdepw_1d(ik+1) 
     151 
     152         ! Compute child bathymetry: 
     153         bathy(i1:i2,j1:j2) = 0._wp 
     154         DO jk=k1,k2-1    
     155            bathy(i1:i2,j1:j2) = bathy(i1:i2,j1:j2) + tabres(i1:i2,j1:j2,jk) 
     156         END DO 
     157         WHERE( bathy(i1:i2,j1:j2) == 0._wp )   ;   mbathy(i1:i2,j1:j2) = 0        
     158         ELSE WHERE                             ;   mbathy(i1:i2,j1:j2) = jpkm1   
     159         END WHERE 
     160 
     161         DO jk = jpkm1, 1, -1 
     162            zdepth = gdepw_1d(jk) ! + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
     163            WHERE( 0._wp < bathy(i1:i2,j1:j2) .AND. bathy(i1:i2,j1:j2) <= zdepth )   mbathy(i1:i2,j1:j2) = jk-1 
     164         END DO 
     165 
     166         ! Scale factors and depth at T- and W-points 
     167         DO jk = 1, jpk   
     168            gdept_0(i1:i2,j1:j2,jk) = gdept_1d(jk) 
     169            gdepw_0(i1:i2,j1:j2,jk) = gdepw_1d(jk) 
     170            e3t_0  (i1:i2,j1:j2,jk) = e3t_1d  (jk) 
     171            e3w_0  (i1:i2,j1:j2,jk) = e3w_1d  (jk) 
     172         END DO 
     173         ! Scale factors and depth at T- and W-points 
     174         DO jj = j1, j2 
     175            DO ji = i1, i2  
     176               ik = mbathy(ji,jj) 
     177               IF( ik > 0 ) THEN               ! ocean point only 
     178                  ! max ocean level case 
     179                  IF( ik == jpkm1 ) THEN 
     180                     zdepwp = bathy(ji,jj) 
     181                     ze3tp  = bathy(ji,jj) - gdepw_1d(ik) 
     182                     ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
     183                     e3t_0(ji,jj,ik  ) = ze3tp 
     184                     e3t_0(ji,jj,ik+1) = ze3tp 
     185                     e3w_0(ji,jj,ik  ) = ze3wp 
     186                     e3w_0(ji,jj,ik+1) = ze3tp 
     187                     gdepw_0(ji,jj,ik+1) = zdepwp 
     188                     gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
     189                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
     190                     ! 
     191                  ELSE                         ! standard case 
     192                     IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  
     193                        gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 
     194                     ELSE                                        
     195                        gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
     196                     ENDIF 
     197                     gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )           & 
     198                        &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )           & 
     199                        &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
     200                     e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik))           & 
     201                        &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik))  
     202                     e3w_0(ji,jj,ik) =                                                                   &  
     203                        &      0.5_wp * (gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   & 
     204                        &             * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 
     205                     !       ... on ik+1 
     206                     e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     207                     e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
     208                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 
     209                  ENDIF 
     210               ENDIF 
     211            END DO 
     212         END DO 
     213         ! 
     214         DO jj=j1,j2 
     215            DO ji=i1,i2 
     216               bathy(ji,jj) = SUM(e3t_0(ji,jj,1:mbkt(ji,jj) ) )  
     217            END DO 
     218         END DO 
     219         ! 
     220         WHERE ( ( mbathy(i1:i2,j1:j2) .EQ. 0 )  &  
     221           & .OR.(tabres(i1:i2,j1:j2,k2)<0.5_wp) & 
     222           & .OR.(bathy(i1:i2,j1:j2)<zhmin) ) 
     223            ssmask(i1:i2,j1:j2) = 0._wp 
     224            mbathy(i1:i2,j1:j2) = 0  
     225         ELSEWHERE 
     226            ssmask(i1:i2,j1:j2) = 1._wp 
     227         END WHERE 
     228         mbkt(i1:i2,j1:j2) = MAX( mbathy(i1:i2,j1:j2), 1 ) 
    102229      ENDIF 
    103230      !  
    104    END SUBROUTINE update_e3t 
     231   END SUBROUTINE update_e3t_z_cons 
    105232       
    106233#else 

  • utils/tools/DOMAINcfg/src/agrif_parameters.F90

    r13204 r15279  
    77#if defined key_agrif 
    88 
    9    INTEGER :: nn_cln_update 
    10    LOGICAL :: ln_spc_dyn 
    11    REAL(wp) :: rn_sponge_tra 
    12    REAL(wp) :: rn_sponge_dyn 
    13    LOGICAL :: ln_chk_bathy 
    14    INTEGER :: npt_copy 
    15    INTEGER :: npt_connect 
     9        LOGICAL :: ln_vert_remap ! =T is using volume conserving update 
     10   INTEGER :: npt_copy      ! area (in coarse grid points) with piecewise 
     11                                 ! constant bathymetry inside child zoom: should equal the sponge length 
     12   INTEGER :: npt_connect   ! area (in coarse grid points) of coarse/child 
     13                                 ! bathymetry blending 
    1614   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ztabramp 
    17    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:,:) ::   e3t_interp 
     15   LOGICAL,  PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e3t_interp_done 
    1816 
    1917#endif 

  • utils/tools/DOMAINcfg/src/agrif_user.F90

    r15059 r15279  
    4646      ! 
    4747      INTEGER :: irafx, irafy 
    48       LOGICAL :: ln_perio, l_deg 
     48      LOGICAL :: ln_perio, ldIperio, ldNFold, l_deg 
    4949      ! 
    5050      irafx = agrif_irhox() 
    … …  
    7373      ln_perio = .FALSE. 
    7474      l_deg = .TRUE. 
    75   
    76       IF( jperio == 1 .OR. jperio == 2 .OR. jperio == 4 ) ln_perio=.TRUE. 
     75 
     76      ldIperio = (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) 
     77      ldNFold  = jperio >= 3 .AND. jperio <= 6  
     78      IF( ldIperio.OR.ldNFold ) ln_perio=.TRUE. 
    7779      IF ( Agrif_Parent(jphgr_msh)==2 & 
    7880      &.OR.Agrif_Parent(jphgr_msh)==3 &  
    … …  
    113115      !South: 
    114116      IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    115          glamf(:,nn_hls) = glamf(:,1+nn_hls) 
    116          gphif(:,nn_hls) = gphif(:,1+nn_hls) 
    117       ENDIF 
    118  
     117         gphif(:,nn_hls) = gphif(:,1+nn_hls)  
     118         glamf(:,nn_hls) = glamf(:,1+nn_hls)  
     119      ENDIF  
     120 
     121      IF ( .NOT.ldNFold ) THEN 
     122         IF ((.not.lk_north).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
     123            glamt(:,jpj-nn_hls) = glamt(:,jpj-nn_hls-1) 
     124            gphit(:,jpj-nn_hls) = gphit(:,jpj-nn_hls-1) 
     125            glamu(:,jpj-nn_hls) = glamu(:,jpj-nn_hls-1) 
     126            gphiu(:,jpj-nn_hls) = gphiu(:,jpj-nn_hls-1) 
     127            glamv(:,jpj-nn_hls) = glamv(:,jpj-nn_hls-1) 
     128            gphiv(:,jpj-nn_hls) = gphiv(:,jpj-nn_hls-1) 
     129            glamf(:,jpj-nn_hls) = glamf(:,jpj-nn_hls-1) 
     130            gphif(:,jpj-nn_hls) = gphif(:,jpj-nn_hls-1) 
     131         ENDIF 
     132      ENDIF 
    119133      IF ((nbondj == 1).OR.(nbondj == 2)) THEN 
    120          glamt(:,jpj) = glamt(:,jpj-1) 
    121          gphit(:,jpj) = gphit(:,jpj-1) 
    122          glamu(:,jpj) = glamu(:,jpj-1) 
    123          gphiu(:,jpj) = gphiu(:,jpj-1) 
    124          glamv(:,jpj) = glamv(:,jpj-1) 
    125          gphiv(:,jpj) = gphiv(:,jpj-1) 
    126          glamf(:,jpj) = glamf(:,jpj-1) 
    127          gphif(:,jpj) = gphif(:,jpj-1) 
     134         glamf(:,jpj-nn_hls+1) = glamf(:,jpj-nn_hls) 
     135         gphif(:,jpj-nn_hls+1) = gphif(:,jpj-nn_hls) 
    128136      ENDIF 
    129137 
    130138      ! Correct West and East 
    131       IF( jperio /= 1 ) THEN 
     139      IF( .NOT.ldIperio ) THEN 
    132140         IF((nbondi == -1) .OR. (nbondi == 2) ) THEN 
    133             glamt(1,:) = glamt(2,:) 
    134             gphit(1,:) = gphit(2,:) 
    135             glamu(1,:) = glamu(2,:) 
    136             gphiu(1,:) = gphiu(2,:) 
    137             glamv(1,:) = glamv(2,:) 
    138             gphiv(1,:) = gphiv(2,:) 
    139             glamf(1,:) = glamf(2,:) 
    140             gphif(1,:) = gphif(2,:) 
     141            glamt(1+nn_hls,:) = glamt(2+nn_hls,:) 
     142            gphit(1+nn_hls,:) = gphit(2+nn_hls,:) 
     143            glamv(1+nn_hls,:) = glamv(2+nn_hls,:) 
     144            gphiv(1+nn_hls,:) = gphiv(2+nn_hls,:) 
    141145         ENDIF 
    142146         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
    143             glamt(jpi,:) = glamt(jpi-1,:) 
    144             gphit(jpi,:) = gphit(jpi-1,:) 
    145             glamu(jpi,:) = glamu(jpi-1,:) 
    146             gphiu(jpi,:) = gphiu(jpi-1,:) 
    147             glamv(jpi,:) = glamv(jpi-1,:) 
    148             gphiv(jpi,:) = gphiv(jpi-1,:) 
    149             glamf(jpi,:) = glamf(jpi-1,:) 
    150             gphif(jpi,:) = gphif(jpi-1,:) 
    151          ENDIF 
    152       ENDIF 
    153       !South: 
    154       IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    155          glamf(:,1) = glamf(:,2)  
    156       ENDIF  
     147            glamt(jpi-nn_hls,:) = glamt(jpi-nn_hls-1,:) 
     148            gphit(jpi-nn_hls,:) = gphit(jpi-nn_hls-1,:) 
     149            glamu(jpi-nn_hls,:) = glamu(jpi-nn_hls-1,:) 
     150            gphiu(jpi-nn_hls,:) = gphiu(jpi-nn_hls-1,:) 
     151            glamv(jpi-nn_hls,:) = glamv(jpi-nn_hls-1,:) 
     152            gphiv(jpi-nn_hls,:) = gphiv(jpi-nn_hls-1,:) 
     153            glamf(jpi-nn_hls,:) = glamf(jpi-nn_hls-1,:) 
     154            gphif(jpi-nn_hls,:) = gphif(jpi-nn_hls-1,:) 
     155         ENDIF 
     156      ENDIF 
     157      IF((nbondi == -1) .OR. (nbondi == 2) ) THEN 
     158         gphif(nn_hls,:) = gphif(nn_hls+1,:) 
     159         glamf(nn_hls,:) = glamf(nn_hls+1,:) 
     160      ENDIF 
     161      IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
     162         glamf(jpi-nn_hls+1,:) = glamf(jpi-nn_hls,:) 
     163         gphif(jpi-nn_hls+1,:) = gphif(jpi-nn_hls,:) 
     164      ENDIF 
     165 
    157166      CALL agrif_init_scales() 
    158167 
     168      ! Fill ghost points in case of closed boundaries: 
    159169      ! Correct South and North 
    160       IF ((.not.lk_south).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
     170      IF ((.NOT.lk_south).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
    161171         e1t(:,1+nn_hls) = e1t(:,2+nn_hls) 
    162172         e2t(:,1+nn_hls) = e2t(:,2+nn_hls) 
    … …  
    164174         e2u(:,1+nn_hls) = e2u(:,2+nn_hls) 
    165175      ENDIF 
    166       IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
    167          e1t(:,jpj) = e1t(:,jpj-1) 
    168          e2t(:,jpj) = e2t(:,jpj-1) 
    169          e1u(:,jpj) = e1u(:,jpj-1) 
    170          e2u(:,jpj) = e2u(:,jpj-1) 
    171          e1v(:,jpj) = e1v(:,jpj-1) 
    172          e2v(:,jpj) = e2v(:,jpj-1) 
    173          e1f(:,jpj) = e1f(:,jpj-1) 
    174          e2f(:,jpj) = e2f(:,jpj-1) 
     176      IF ( .NOT.ldNFold ) THEN 
     177         IF((.NOT.lk_north).AND.((nbondj == 1) .OR. (nbondj == 2) )) THEN 
     178            e1t(:,jpj-nn_hls) = e1t(:,jpj-nn_hls-1) 
     179            e2t(:,jpj-nn_hls) = e2t(:,jpj-nn_hls-1) 
     180            e1u(:,jpj-nn_hls) = e1u(:,jpj-nn_hls-1) 
     181            e2u(:,jpj-nn_hls) = e2u(:,jpj-nn_hls-1) 
     182            e1v(:,jpj-nn_hls) = e1v(:,jpj-nn_hls-1) 
     183            e2v(:,jpj-nn_hls) = e2v(:,jpj-nn_hls-1) 
     184            e1f(:,jpj-nn_hls) = e1f(:,jpj-nn_hls-1) 
     185            e2f(:,jpj-nn_hls) = e2f(:,jpj-nn_hls-1) 
     186         ENDIF 
    175187      ENDIF 
    176188 
    177189      ! Correct West and East 
    178       IF( jperio /= 1 ) THEN 
    179          IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
    180             e1t(1,:) = e1t(2,:) 
    181             e2t(1,:) = e2t(2,:) 
    182             e1u(1,:) = e1u(2,:) 
    183             e2u(1,:) = e2u(2,:) 
    184             e1v(1,:) = e1v(2,:) 
    185             e2v(1,:) = e2v(2,:) 
    186          ENDIF 
    187          IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
    188             e1t(jpi,:) = e1t(jpi-1,:) 
    189             e2t(jpi,:) = e2t(jpi-1,:) 
    190             e1u(jpi,:) = e1u(jpi-1,:) 
    191             e2u(jpi,:) = e2u(jpi-1,:) 
    192             e1v(jpi,:) = e1v(jpi-1,:) 
    193             e2v(jpi,:) = e2v(jpi-1,:) 
    194             e1f(jpi,:) = e1f(jpi-1,:) 
    195             e2f(jpi,:) = e2f(jpi-1,:) 
     190      IF( .NOT.ldIperio ) THEN 
     191         IF((.NOT.lk_west).AND.(nbondj == -1).OR.(nbondj == 2) ) THEN 
     192            e1t(1+nn_hls,:) = e1t(2+nn_hls,:) 
     193            e2t(1+nn_hls,:) = e2t(2+nn_hls,:) 
     194            e1v(1+nn_hls,:) = e1v(2+nn_hls,:) 
     195            e2v(1+nn_hls,:) = e2v(2+nn_hls,:) 
     196         ENDIF 
     197         IF((.NOT.lk_east).AND.(nbondj == 1) .OR. (nbondj == 2) ) THEN 
     198            e1t(jpi-nn_hls,:) = e1t(jpi-nn_hls-1,:) 
     199            e2t(jpi-nn_hls,:) = e2t(jpi-nn_hls-1,:) 
     200            e1u(jpi-nn_hls,:) = e1u(jpi-nn_hls-1,:) 
     201            e2u(jpi-nn_hls,:) = e2u(jpi-nn_hls-1,:) 
     202            e1v(jpi-nn_hls,:) = e1v(jpi-nn_hls-1,:) 
     203            e2v(jpi-nn_hls,:) = e2v(jpi-nn_hls-1,:) 
     204            e1f(jpi-nn_hls,:) = e1f(jpi-nn_hls-1,:) 
     205            e2f(jpi-nn_hls,:) = e2f(jpi-nn_hls-1,:) 
    196206         ENDIF 
    197207      ENDIF 
    … …  
    222232      !--------------------------------------------------------------------- 
    223233 
    224       ind2 = nn_hls + 1 + nbghostcells_x 
     234      ind2 = nn_hls + 1 + nbghostcells_x_w 
    225235      ind3 = nn_hls + 1 + nbghostcells_y_s 
    226236 
    227       nbghostcellsfine_tot_x=nbghostcells_x+1 
     237      nbghostcellsfine_tot_x=max(nbghostcells_x_w,nbghostcells_x_e)+1 
    228238      nbghostcellsfine_tot_y=max(nbghostcells_y_s,nbghostcells_y_n)+1 
    229239 
    … …  
    232242      ! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 
    233243      ! The procnames will not be CALLed at these boundaries 
    234       if (jperio == 1) THEN 
     244      if (.not.lk_west) THEN 
    235245        CALL Agrif_Set_NearCommonBorderX(.TRUE.) 
     246      endif 
     247      if (.not.lk_east) THEN 
    236248        CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 
    237249      endif 
    … …  
    360372      CALL Agrif_Set_interp(e3t_copy_id,interp=AGRIF_constant) 
    361373      CALL Agrif_Set_bc( e3t_copy_id, (/-npt_copy*iraf-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/)) 
     374      CALL Agrif_Set_Updatetype( e3t_copy_id, update = AGRIF_Update_Max) 
    362375 
    363376!      CALL Agrif_Set_bcinterp(e3t_connect_id,interp=AGRIF_linear) 
    … …  
    417430               bounds_chunks(i,:,:,:) = bounds 
    418431            END DO 
    419  
    420432         ! FIRST CHUNCK (for j<=jpjglo) 
    421  
    422433            ! Original indices 
    423434            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
    … …  
    439450            bounds_chunks(2,1,1,1) = bounds(1,1,2) 
    440451            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
    441             bounds_chunks(2,2,1,1) = jpjglo-2 
     452            bounds_chunks(2,2,1,1) = jpjglo-2*nn_hls 
    442453            bounds_chunks(2,2,2,1) = bounds(2,2,2) 
    443454 
    444455           ! Where to find them 
    445456           ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 
     457           ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2*nn_hls-(jj-jpjglo)) 
    446458 
    447459            IF (ptx == 2) THEN ! T, V points 
    … …  
    454466 
    455467            IF (pty == 2) THEN ! T, U points 
    456                bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
    457                bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2      -jpjglo) 
     468               bounds_chunks(2,2,1,2) = jpjglo-2*nn_hls-(bounds(2,2,2) -jpjglo) 
     469               bounds_chunks(2,2,2,2) = jpjglo-2*nn_hls-(jpjglo-nn_hls -jpjglo) 
    458470            ELSE ! V, F points 
    459                bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
    460                bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2      -jpjglo) 
     471               bounds_chunks(2,2,1,2) = jpjglo-2*nn_hls-1-(bounds(2,2,2) -jpjglo) 
     472               bounds_chunks(2,2,2,2) = jpjglo-2*nn_hls-1-(jpjglo-nn_hls -jpjglo) 
    461473            ENDIF 
    462474       
    … …  
    465477 
    466478         ELSE 
    467             
    468479            nb_chunks = 1 
    469480            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
    … …  
    481492            bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
    482493 
    483             bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo) 
    484             bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo) 
     494            bounds_chunks(1,2,1,2) = jpjglo-nn_hls-1-(bounds(2,2,2)-jpjglo) 
     495            bounds_chunks(1,2,2,2) = jpjglo-nn_hls-1-(bounds(2,1,2)-jpjglo) 
    485496 
    486497            IF (ptx == 2) THEN ! T, V points 
    … …  
    493504 
    494505            IF (pty == 2) THEN ! T, U points 
    495                bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
    496                bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo) 
     506               bounds_chunks(1,2,1,2) = jpjglo-2*nn_hls-(bounds(2,2,2) -jpjglo) 
     507               bounds_chunks(1,2,2,2) = jpjglo-2*nn_hls-(bounds(2,1,2) -jpjglo) 
    497508            ELSE ! V, F points 
    498                bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
    499                bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo) 
     509               bounds_chunks(1,2,1,2) = jpjglo-2*nn_hls-1-(bounds(2,2,2) -jpjglo) 
     510               bounds_chunks(1,2,2,2) = jpjglo-2*nn_hls-1-(bounds(2,1,2) -jpjglo) 
    500511            ENDIF 
    501512 
    … …  
    505516 
    506517      ELSE IF ( (bounds(1,1,2) < 1).AND.ldIperio ) THEN 
    507           
     518 
    508519         IF (bounds(1,2,2) > 0) THEN 
    509520            nb_chunks = 2 
    … …  
    515526            END DO 
    516527 
    517             bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
    518             bounds_chunks(1,1,2,2) = 1+jpiglo-2 
     528            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2*nn_hls 
     529            bounds_chunks(1,1,2,2) = jpiglo-nn_hls 
    519530 
    520531            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
    521             bounds_chunks(1,1,2,1) = 1 
    522  
    523             bounds_chunks(2,1,1,2) = 2 
     532            bounds_chunks(1,1,2,1) = 1+nn_hls 
     533 
     534            bounds_chunks(2,1,1,2) = 1+nn_hls  
    524535            bounds_chunks(2,1,2,2) = bounds(1,2,2) 
    525536 
    526             bounds_chunks(2,1,1,1) = 2 
     537            bounds_chunks(2,1,1,1) = 1+nn_hls  
    527538            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
    528539         ELSE 
    … …  
    534545               bounds_chunks(i,:,:,:) = bounds 
    535546            END DO 
    536             bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
    537             bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 
     547            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2*nn_hls 
     548            bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2*nn_hls 
    538549 
    539550            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
    … …  
    577588      ELSE IF (isens ==2) THEN 
    578589         IF (pty == 2) THEN ! T, U points 
    579             agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
     590            agrif_external_switch_index = jpjglo-2*nn_hls-(i1 -jpjglo) 
    580591         ELSE ! V, F points 
    581             agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
     592            agrif_external_switch_index = jpjglo-2*nn_hls-1-(i1 -jpjglo) 
    582593         ENDIF 
    583594      ENDIF 
    … …  
    10941105 
    10951106      INTEGER ::   ios 
    1096  
    1097       NAMELIST/namagrif/ nn_cln_update,ln_spc_dyn,rn_sponge_tra,rn_sponge_dyn,ln_chk_bathy,npt_connect,   & 
    1098       &  npt_copy 
     1107      INTEGER :: imin, imax, jmin, jmax 
     1108 
     1109      NAMELIST/namagrif/ ln_vert_remap, npt_connect, npt_copy  
    10991110 
    11001111  !    REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : nesting parameters 
    … …  
    11071118      IF(lwm) WRITE ( numond, namagrif ) 
    11081119 
     1120      IF (.NOT.Agrif_Root()) THEN 
     1121 
     1122         IF(lwp) THEN                     ! Control print 
     1123            WRITE(numout,*) 
     1124            WRITE(numout,*) 'agrif_nemo_init : nesting' 
     1125            WRITE(numout,*) '~~~~~~~' 
     1126            WRITE(numout,*) '   Namelist namagrif : set nesting parameters' 
     1127            WRITE(numout,*) '      ln_vert_remap        = ', ln_vert_remap  
     1128            WRITE(numout,*) '      npt_copy             = ', npt_copy 
     1129            WRITE(numout,*) '      npt_connect          = ', npt_connect 
     1130         ENDIF 
     1131 
     1132         imin = Agrif_Ix() 
     1133         imax = Agrif_Ix() + nbcellsx/AGRIF_Irhox() 
     1134         jmin = Agrif_Iy() 
     1135         jmax = Agrif_Iy() + nbcellsy/AGRIF_Irhoy() 
     1136         lk_west  = .TRUE. ; lk_east  = .TRUE. 
     1137         lk_north = .TRUE. ; lk_south = .TRUE. 
     1138 
     1139         ! Check zoom position along i: 
     1140         ! ---------------------------- 
     1141         IF ( imin >= imax ) THEN  
     1142            CALL ctl_stop( 'STOP', 'AGRIF zoom imin must be < imax' )  
     1143         ENDIF 
     1144 
     1145         IF ( (Agrif_Parent(jperio)==4).OR.(Agrif_Parent(jperio)==1) ) THEN  
     1146            IF ( (jperio==4).OR.(jperio==1) ) THEN ! Cyclic east-west zoom 
     1147               lk_west = .FALSE. ; lk_east = .FALSE.  
     1148               ! Checks: 
     1149               IF ( imin/=1-Agrif_Parent(nbghostcells_x_w) ) THEN 
     1150                  WRITE(ctmp1, 9000) ' AGRIF zoom is East-West cyclic, imin must = ', & 
     1151                  1 - Agrif_Parent(nbghostcells_x_w)  
     1152                  CALL ctl_stop( 'STOP', ctmp1 )  
     1153               ENDIF 
     1154               IF ( imax/=Agrif_Parent(Ni0glo)+1-Agrif_Parent(nbghostcells_x_w)) THEN 
     1155                  WRITE(ctmp1, 9000) ' AGRIF zoom is East-West cyclic, imax must = ', &  
     1156                  Agrif_Parent(Ni0glo) + 1 - Agrif_Parent(nbghostcells_x_w)  
     1157                  CALL ctl_stop( 'STOP', ctmp1 )  
     1158               ENDIF 
     1159            ELSE 
     1160               IF ( imax>Agrif_Parent(Ni0glo)-Agrif_Parent(nbghostcells_x_w)) THEN 
     1161                  WRITE(ctmp1, 9000) ' AGRIF zoom imax must be <= ', & 
     1162                  Agrif_Parent(Ni0glo) - Agrif_Parent(nbghostcells_x_w) 
     1163                  CALL ctl_stop( 'STOP', ctmp1 ) 
     1164               ENDIF 
     1165            ENDIF  
     1166         ELSE 
     1167            IF ( imin<2-Agrif_Parent(nbghostcells_x_w) ) THEN 
     1168               WRITE(ctmp1, 9000) ' AGRIF zoom imin must be >= ', & 
     1169               2 - Agrif_Parent(nbghostcells_x_w) 
     1170               CALL ctl_stop( 'STOP', ctmp1 ) 
     1171            ENDIF 
     1172            IF ( imax>Agrif_Parent(Ni0glo)-Agrif_Parent(nbghostcells_x_w)) THEN 
     1173               WRITE(ctmp1, 9000) ' AGRIF zoom imax must be <= ', & 
     1174               Agrif_Parent(Ni0glo) - Agrif_Parent(nbghostcells_x_w) 
     1175               CALL ctl_stop( 'STOP', ctmp1 ) 
     1176            ENDIF 
     1177            IF ( imin==2-Agrif_Parent(nbghostcells_x_w) )                    lk_west = .FALSE. ! Set along wall 
     1178            IF ( imax==Agrif_Parent(Ni0glo)-Agrif_Parent(nbghostcells_x_w) ) lk_east = .FALSE. ! Set along wall 
     1179         ENDIF 
     1180 
     1181         ! Check zoom position along j: 
     1182         ! ---------------------------- 
     1183         IF ( jmin >= jmax ) THEN  
     1184            CALL ctl_stop( 'STOP', 'AGRIF zoom jmin must be < jmax' )  
     1185         ENDIF 
     1186 
     1187         IF ( Agrif_Parent(jperio)==4 ) THEN  
     1188            IF (jperio==4) THEN ! North-Fold  
     1189               lk_north = .FALSE.  
     1190               ! Checks: 
     1191               IF ( jmax/=Agrif_Parent(Nj0glo)+1-Agrif_Parent(nbghostcells_y_s)) THEN 
     1192                  WRITE(ctmp1, 9000) ' AGRIF zoom has a North-Fold, jmax must = ', &  
     1193                  Agrif_Parent(Nj0glo) + 1 - Agrif_Parent(nbghostcells_y_s)  
     1194                  CALL ctl_stop( 'STOP', ctmp1 )  
     1195               ENDIF 
     1196            ENDIF  
     1197         ELSE 
     1198            IF ( jmax>Agrif_Parent(Nj0glo)-Agrif_Parent(nbghostcells_y_s)) THEN 
     1199               WRITE(ctmp1, 9000) ' AGRIF zoom jmax must be <= ', & 
     1200               Agrif_Parent(Nj0glo) - Agrif_Parent(nbghostcells_y_s) 
     1201               CALL ctl_stop( 'STOP', ctmp1 ) 
     1202            ENDIF 
     1203            IF ( jmax==Agrif_Parent(Nj0glo)-Agrif_Parent(nbghostcells_y_s) ) lk_north = .FALSE. ! Set along wall 
     1204         ENDIF 
     1205 
     1206         IF ( jmin<2-Agrif_Parent(nbghostcells_y_s)) THEN 
     1207            WRITE(ctmp1, 9000) ' AGRIF zoom jmin must be >= ', & 
     1208            2 - Agrif_Parent(nbghostcells_y_s) 
     1209            CALL ctl_stop( 'STOP', ctmp1 ) 
     1210         ENDIF 
     1211         IF ( jmin==2-Agrif_Parent(nbghostcells_y_s) )                       lk_south = .FALSE. ! Set along wall 
     1212 
     1213      ELSE ! Root grid 
     1214         lk_west  = .FALSE. ; lk_east  = .FALSE. 
     1215         lk_north = .FALSE. ; lk_south = .FALSE. 
     1216      ENDIF 
     1217 
     1218      ! Set ghost cells: 
     1219      nbghostcells_x_w = nbghostcells 
     1220      nbghostcells_x_e = nbghostcells 
     1221      nbghostcells_y_s = nbghostcells 
     1222      nbghostcells_y_n = nbghostcells 
     1223 
     1224      IF (.NOT.lk_west ) nbghostcells_x_w = 1  
     1225      IF (.NOT.lk_east ) nbghostcells_x_e = 1  
     1226      IF (.NOT.lk_south) nbghostcells_y_s = 1  
     1227      IF (.NOT.lk_north) nbghostcells_y_n = 1  
     1228 
     1229      IF ((jperio == 1).OR.(jperio == 4)) THEN 
     1230         nbghostcells_x_w = 0 ; nbghostcells_x_e = 0 
     1231      ENDIF 
     1232      IF (jperio == 4) THEN 
     1233         nbghostcells_y_n = 0 
     1234      ENDIF 
     1235 
    11091236      IF(lwp) THEN                     ! Control print 
    11101237         WRITE(numout,*) 
    1111          WRITE(numout,*) 'agrif_nemo_init : nesting' 
    1112          WRITE(numout,*) '~~~~~~~' 
    1113          WRITE(numout,*) '   Namelist namagrif : set nesting parameters' 
    1114          WRITE(numout,*) '      npt_copy             = ', npt_copy 
    1115          WRITE(numout,*) '      npt_connect          = ', npt_connect 
    1116       ENDIF 
    1117  
    1118    ! Set the number of ghost cells according to periodicity 
    1119  
    1120       IF (.not.agrif_root()) THEN 
    1121          lk_west  = .NOT. ( Agrif_Ix() == 1 ) 
    1122          lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) + 1 ) 
    1123          lk_south = .NOT. ( Agrif_Iy() == 1 ) 
    1124          lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) - 1 ) 
    1125  
    1126          nbghostcells_x   = nbghostcells 
    1127          nbghostcells_y_s = nbghostcells 
    1128          nbghostcells_y_n = nbghostcells 
    1129  
    1130          IF (.NOT.lk_south) THEN 
    1131             nbghostcells_y_s = 1  
    1132          ENDIF 
    1133          IF (.NOT.lk_north) THEN 
    1134             nbghostcells_y_n = 1  
    1135          ENDIF 
    1136  
    1137          IF ((jperio == 1).OR.(jperio == 4)) THEN 
    1138             nbghostcells_x = 0 
    1139          ENDIF 
    1140          IF(lwp) THEN                     ! Control print 
    1141             WRITE(numout,*) 
    1142             WRITE(numout,*) 'nbghostcells_y_s', nbghostcells_y_s 
    1143             WRITE(numout,*) 'nbghostcells_y_n', nbghostcells_y_n 
    1144             WRITE(numout,*) 'nbghostcells_x', nbghostcells_x 
    1145             WRITE(numout,*) 'lk_west', lk_west 
    1146             WRITE(numout,*) 'lk_east', lk_east 
    1147             WRITE(numout,*) 'lk_south', lk_south 
    1148             WRITE(numout,*) 'lk_north', lk_north 
    1149          ENDIF 
    1150       ELSE ! root grid 
    1151          nbghostcells_x   = 1  
    1152          nbghostcells_y_s = 1  
    1153          nbghostcells_y_n = 1  
    1154  
    1155          IF ((jperio == 1).OR.(jperio == 4)) THEN 
    1156            nbghostcells_x = 0 
    1157          ENDIF 
    1158          IF (jperio == 4) THEN 
    1159            nbghostcells_y_n = 0 ! for completeness 
    1160          ENDIF 
    1161       ENDIF 
     1238         WRITE(numout,*) 'AGRIF boundaries and ghost cells:' 
     1239         WRITE(numout,*) 'lk_west' , lk_west 
     1240         WRITE(numout,*) 'lk_east' , lk_east 
     1241         WRITE(numout,*) 'lk_south', lk_south 
     1242         WRITE(numout,*) 'lk_north', lk_north 
     1243         WRITE(numout,*) 'nbghostcells_y_s', nbghostcells_y_s 
     1244         WRITE(numout,*) 'nbghostcells_y_n', nbghostcells_y_n 
     1245         WRITE(numout,*) 'nbghostcells_x_w', nbghostcells_x_w 
     1246         WRITE(numout,*) 'nbghostcells_x_e', nbghostcells_x_e 
     1247      ENDIF 
     1248 
     12499000  FORMAT (a, i4) 
    11621250 
    11631251   END SUBROUTINE agrif_nemo_init 

  • utils/tools/DOMAINcfg/src/domzgr.F90

    r14952 r15279  
    4545   USE dombat 
    4646   USE domisf 
     47   USE agrif_connect 
    4748   USE agrif_domzgr 
    4849 
    … …  
    176177      IF ( ln_sco .AND. ln_isfcav ) ioptio = ioptio + 1 
    177178      IF( ioptio > 0 )   CALL ctl_stop( ' Cavity not tested/compatible with full step (zco) and sigma (ln_sco) ' ) 
     179 
     180#if defined key_agrif 
     181!      IF ( (.NOT.Agrif_Root()).AND.((.NOT.ln_zps).OR.(.NOT.Agrif_parent(ln_zps)))) THEN 
     182!         CALL ctl_stop( 'STOP', 'AGRIF zooms require ln_zps=T for both Child and Parent') 
     183!      ENDIF 
     184#endif 
    178185 
    179186      IF(.NOT.ln_read_cfg) THEN 
    … …  
    560567      REAL(wp) ::   r_bump , h_bump , h_oce   ! bump characteristics  
    561568      REAL(wp) ::   zi, zj, zh, zhmin         ! local scalars 
    562       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zrand  
     569      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zrand, zbatv  
    563570      !!---------------------------------------------------------------------- 
    564571      ! 
    … …  
    609616            ENDIF 
    610617            IF ( cp_cfg=='DOME' ) THEN 
    611                bathy(:,:) = MIN(3600._wp, MAX( 600._wp,  600._wp -gphit(:,:)*1.e3*0.01 )) 
     618               ALLOCATE(zbatv(jpi,jpj)) 
     619               zbatv(:,:) = MIN(3600._wp, MAX( 600._wp,  600._wp -gphiv(:,:)*1.e3*0.01 )) 
     620               bathy(:,1) = 0._wp 
     621               DO jj =2,jpj 
     622                  bathy(:,jj) = 0.5_wp*(zbatv(:,jj) + zbatv(:,jj-1)) 
     623               END DO  
     624               CALL lbc_lnk( 'zgr_bat', bathy, 'T', 1._wp ) 
    612625               WHERE (gphit(:,:) >0._wp) bathy(:,:) = 0._wp 
    613626               ! Dig inlet: 
    614627               WHERE ((gphit(:,:)>0._wp).AND.(glamt(:,:)>-50._wp).AND.(glamt(:,:)<50._wp)) bathy(:,:) = 600._wp 
     628               DEALLOCATE(zbatv) 
    615629            ENDIF 
    616630!            CALL lbc_lnk( 'zgr_bat', bathy, 'T', 1._wp ) 
    … …  
    731745      ENDIF 
    732746      ! 
     747#if defined key_agrif 
     748      IF ( .NOT.Agrif_Root() ) CALL agrif_bathymetry_connect 
     749#endif 
     750      ! 
    733751      IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==! 
    734752         IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level 
    … …  
    827845           mbathy(  mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = jpkm1 
    828846         ENDIF 
    829       ELSEIF( l_Iperio ) THEN 
     847      ELSEIF( jperio == 1 .OR. jperio == 4 .OR. jperio ==  6 ) THEN 
    830848         IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: jperio = ', jperio 
    831          mbathy( 1 ,:) = mbathy(jpim1,:) 
    832          mbathy(jpi,:) = mbathy(  2  ,:) 
     849!         mbathy( 1 ,:) = mbathy(jpim1,:) 
     850!         mbathy(jpi,:) = mbathy(  2  ,:) 
    833851      ELSEIF( jperio == 2 ) THEN 
    834852         IF(lwp) WRITE(numout,*) '   equatorial boundary conditions on mbathy: jperio = ', jperio 
    … …  
    14091427      ! Envelope bathymetry saved in hbatt 
    14101428      hbatt(:,:) = zenv(:,:)  
    1411       IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN 
     1429      IF ((ntopo>0).AND.MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN 
    14121430         CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' ) 
    14131431         DO jj = 1, jpj 
    … …  
    15321550         END DO 
    15331551      END DO 
     1552 
     1553      WHERE (bathy(:,:)<=0) mbathy(:,:) = 0 
     1554 
    15341555      IF(lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   & 
    15351556         &                                                       ' MAX ', MAXVAL( mbathy(:,:) ) 

  • utils/tools/DOMAINcfg/src/mppini.F90

    r14674 r15279  
    107107 
    108108      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
    109          print *,'nbcellsx = ',nbcellsx,nbghostcells_x 
     109         print *,'nbcellsx = ',nbcellsx,nbghostcells_x_w,nbghostcells_x_e 
    110110         print *,'nbcellsy = ',nbcellsy,nbghostcells_y_s,nbghostcells_y_n 
    111          IF( Ni0glo /= nbcellsx + 2*nbghostcells_x ) THEN 
     111         IF( Ni0glo /= nbcellsx + nbghostcells_x_w + nbghostcells_x_e ) THEN 
    112112            IF(lwp) THEN 
    113113               WRITE(numout,*) 
    114                WRITE(numout,*) 'Ni0glo should be: ', nbcellsx + 2*nbghostcells_x 
     114               WRITE(numout,*) 'Ni0glo should be: ', nbcellsx + nbghostcells_x_w  + nbghostcells_x_e 
    115115            ENDIF         
    116             CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires Ni0glo == nbcellsx + 2*nbghostcells_x' ) 
     116            CALL ctl_stop( 'STOP', & 
     117                'mpp_init: Agrif children requires Ni0glo == nbcellsx + nbghostcells_x_w + nbghostcells_x_e' ) 
    117118         ENDIF    
    118119         IF( Nj0glo /= nbcellsy + nbghostcells_y_s + nbghostcells_y_n ) THEN 
    … …  
    361362      CALL agrif_nemo_init() 
    362363      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
    363          IF( Ni0glo /= nbcellsx + 2*nbghostcells_x ) THEN 
     364         IF( Ni0glo /= nbcellsx + nbghostcells_x_w + nbghostcells_x_e ) THEN 
    364365            IF(lwp) THEN 
    365366               WRITE(numout,*) 
    366                WRITE(numout,*) 'Ni0glo should be: ', nbcellsx + 2*nbghostcells_x 
     367               WRITE(numout,*) 'Ni0glo should be: ', nbcellsx + nbghostcells_x_w  + nbghostcells_x_e 
    367368            ENDIF         
    368             CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires Ni0glo == nbcellsx + 2*nbghostcells_x' ) 
     369            CALL ctl_stop( 'STOP', &  
     370                 'mpp_init: Agrif children requires Ni0glo == nbcellsx + nbghostcells_x_w + nbghostcells_x_e' ) 
    369371         ENDIF    
    370372         IF( Nj0glo /= nbcellsy  + nbghostcells_y_s + nbghostcells_y_n ) THEN 

  • utils/tools/DOMAINcfg/src/nemogcm.F90

    r14623 r15279  
    104104      CALL Agrif_Regrid() 
    105105       
    106       CALL Agrif_Step_Child(agrif_boundary_connections) 
     106!      CALL Agrif_Step_Child(agrif_boundary_connections) 
    107107       
    108108      CALL Agrif_Step_Child_adj(agrif_update_all) 
    109109 
    110       CALL Agrif_Step_Child(agrif_recompute_scalefactors) 
     110!      CALL Agrif_Step_Child(agrif_recompute_scalefactors) 
    111111       
    112112      CALL Agrif_Step_Child(cfg_write) 

  • utils/tools/DOMAINcfg/src/par_oce.f90

    r14931 r15279  
    5656   INTEGER, PUBLIC            ::   nbug_in_agrif_conv_do_not_remove_or_modify = 1 - 1 
    5757   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 4 !: number of ghost cells: default value 
    58    INTEGER, PUBLIC            ::   nbghostcells_x   !: number of ghost cells in i-direction 
    59    INTEGER, PUBLIC            ::   nbghostcells_y_s   !: number of ghost cells in j-direction at south 
    60    INTEGER, PUBLIC            ::   nbghostcells_y_n   !: number of ghost cells in j-direction at north 
    61    INTEGER, PUBLIC            ::   nbcellsx   ! = jpiglo - 2 - 2*nbghostcells_x   !: number of cells in i-direction 
    62    INTEGER, PUBLIC            ::   nbcellsy   ! = jpjglo - 2 - 2*nbghostcells_y   !: number of cells in j-direction 
     58   INTEGER, PUBLIC            ::   nbghostcells_x_w   !: number of ghost cells in i-direction (west) 
     59   INTEGER, PUBLIC            ::   nbghostcells_x_e   !: number of ghost cells in i-direction (east) 
     60   INTEGER, PUBLIC            ::   nbghostcells_y_s   !: number of ghost cells in j-direction (south) 
     61   INTEGER, PUBLIC            ::   nbghostcells_y_n   !: number of ghost cells in j-direction (north) 
     62   INTEGER, PUBLIC            ::   nbcellsx   ! = Ni0glo - nbghostcells_x_w - nbghostcells_x_e  !: number of cells in i-direction 
     63   INTEGER, PUBLIC            ::   nbcellsy   ! = Nj0glo - nbghostcells_y_s - nbghostcells_y_n  !: number of cells in j-direction 
    6364 
    6465   ! local domain size                !!! * local computational domain * 
Note: See TracChangeset for help on using the changeset viewer.