| 1 | MODULE agrif_connect |
|---|
| 2 | |
|---|
| 3 | USE dom_oce |
|---|
| 4 | USE agrif_parameters |
|---|
| 5 | USE agrif_profiles |
|---|
| 6 | |
|---|
| 7 | IMPLICIT NONE |
|---|
| 8 | PRIVATE |
|---|
| 9 | |
|---|
| 10 | PUBLIC agrif_boundary_connections, agrif_bathymetry_connect |
|---|
| 11 | |
|---|
| 12 | CONTAINS |
|---|
| 13 | |
|---|
| 14 | #if defined key_agrif |
|---|
| 15 | |
|---|
| 16 | SUBROUTINE agrif_boundary_connections |
|---|
| 17 | !!---------------------------------------------------------------------- |
|---|
| 18 | !! *** ROUTINE agrif_boundary_connections *** |
|---|
| 19 | !!---------------------------------------------------------------------- |
|---|
| 20 | IF( Agrif_Root() ) return |
|---|
| 21 | |
|---|
| 22 | CALL agrif_connection() |
|---|
| 23 | ! |
|---|
| 24 | ! CALL Agrif_Bc_variable(bottom_level_id, procname = connect_bottom_level) |
|---|
| 25 | ! |
|---|
| 26 | ! CALL Agrif_Bc_variable(e3t_copy_id, procname = connect_e3t_copy) |
|---|
| 27 | |
|---|
| 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: |
|---|
| 35 | Agrif_UseSpecialValue = .FALSE. |
|---|
| 36 | e3t_interp_done(:,:) = .FALSE. |
|---|
| 37 | CALL Agrif_Bc_variable(e3t_copy_id, procname = connect_e3t_connect) |
|---|
| 38 | Agrif_UseSpecialValue = .FALSE. |
|---|
| 39 | DEALLOCATE(e3t_interp_done) |
|---|
| 40 | ! |
|---|
| 41 | 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 |
|---|
| 65 | |
|---|
| 66 | SUBROUTINE connect_e3t_copy( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir) |
|---|
| 67 | !!---------------------------------------------------------------------- |
|---|
| 68 | !! *** ROUTINE connect_e3t_copy *** |
|---|
| 69 | !!---------------------------------------------------------------------- |
|---|
| 70 | INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 |
|---|
| 71 | REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab |
|---|
| 72 | LOGICAL , INTENT(in ) :: before |
|---|
| 73 | INTEGER , INTENT(in ) :: nb , ndir |
|---|
| 74 | ! |
|---|
| 75 | !!---------------------------------------------------------------------- |
|---|
| 76 | ! |
|---|
| 77 | IF( before) THEN |
|---|
| 78 | ptab(i1:i2,j1:j2,k1:k2) = e3t_0(i1:i2,j1:j2,k1:k2) |
|---|
| 79 | ELSE |
|---|
| 80 | e3t_0(i1:i2,j1:j2,1:jpk) = ptab(i1:i2,j1:j2,1:jpk) |
|---|
| 81 | ENDIF |
|---|
| 82 | ! |
|---|
| 83 | END SUBROUTINE connect_e3t_copy |
|---|
| 84 | |
|---|
| 85 | SUBROUTINE connect_bottom_level( ptab, i1, i2, j1, j2, before, nb,ndir) |
|---|
| 86 | !!---------------------------------------------------------------------- |
|---|
| 87 | !! *** ROUTINE connect_bottom_level *** |
|---|
| 88 | !!---------------------------------------------------------------------- |
|---|
| 89 | INTEGER , INTENT(in ) :: i1, i2, j1, j2 |
|---|
| 90 | REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab |
|---|
| 91 | LOGICAL , INTENT(in ) :: before |
|---|
| 92 | INTEGER , INTENT(in ) :: nb , ndir |
|---|
| 93 | ! |
|---|
| 94 | !!---------------------------------------------------------------------- |
|---|
| 95 | ! |
|---|
| 96 | IF( before) THEN |
|---|
| 97 | ptab(i1:i2,j1:j2) = mbkt(i1:i2,j1:j2)*ssmask(i1:i2,j1:j2) |
|---|
| 98 | ELSE |
|---|
| 99 | mbkt(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2)) |
|---|
| 100 | WHERE (mbkt(i1:i2,j1:j2)==0) |
|---|
| 101 | ssmask(i1:i2,j1:j2) = 0. |
|---|
| 102 | ELSEWHERE |
|---|
| 103 | ssmask(i1:i2,j1:j2) = 1. |
|---|
| 104 | END WHERE |
|---|
| 105 | ENDIF |
|---|
| 106 | ! |
|---|
| 107 | END SUBROUTINE connect_bottom_level |
|---|
| 108 | |
|---|
| 109 | SUBROUTINE connect_e3t_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir) |
|---|
| 110 | !!---------------------------------------------------------------------- |
|---|
| 111 | !! *** ROUTINE connect_e3t_connect *** |
|---|
| 112 | !!---------------------------------------------------------------------- |
|---|
| 113 | INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 |
|---|
| 114 | REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab |
|---|
| 115 | LOGICAL , INTENT(in ) :: before |
|---|
| 116 | INTEGER , INTENT(in ) :: nb , ndir |
|---|
| 117 | ! |
|---|
| 118 | !!---------------------------------------------------------------------- |
|---|
| 119 | INTEGER :: ji, jj, jk, ik |
|---|
| 120 | REAL(wp), DIMENSION(i1:i2,j1:j2) :: bathy_local, bathy_interp |
|---|
| 121 | REAL(wp) :: zdepth, zdepwp, zmax, ze3tp, ze3wp, zhmin |
|---|
| 122 | ! |
|---|
| 123 | IF( before) THEN |
|---|
| 124 | DO jk=k1, k2 |
|---|
| 125 | DO jj=j1,j2 |
|---|
| 126 | DO ji=i1,i2 |
|---|
| 127 | IF( mbkt(ji,jj) .GE. jk ) THEN |
|---|
| 128 | ptab(ji,jj,jk) = e3t_0(ji,jj,jk) |
|---|
| 129 | ELSE |
|---|
| 130 | ptab(ji,jj,jk) = 0. |
|---|
| 131 | ENDIF |
|---|
| 132 | END DO |
|---|
| 133 | END DO |
|---|
| 134 | END DO |
|---|
| 135 | ! |
|---|
| 136 | DO jj=j1,j2 |
|---|
| 137 | DO ji=i1,i2 |
|---|
| 138 | ptab(ji,jj,k2) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) |
|---|
| 139 | END DO |
|---|
| 140 | END DO |
|---|
| 141 | ELSE |
|---|
| 142 | DO jj=j1,j2 |
|---|
| 143 | DO ji=i1,i2 |
|---|
| 144 | bathy_local (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) |
|---|
| 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 |
|---|
| 148 | ! Connected bathymetry |
|---|
| 149 | IF( .NOT.e3t_interp_done(ji,jj) ) THEN |
|---|
| 150 | bathy_local(ji,jj)=(1.-ztabramp(ji,jj))*bathy_local(ji,jj)+ztabramp(ji,jj)*bathy_interp(ji,jj) |
|---|
| 151 | ENDIF |
|---|
| 152 | END DO |
|---|
| 153 | END DO |
|---|
| 154 | |
|---|
| 155 | ! 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 | |
|---|
| 163 | zmax = gdepw_1d(jpk) + e3t_1d(jpk) |
|---|
| 164 | bathy_local(:,:) = MAX(MIN(zmax,bathy_local(:,:)),0._wp) |
|---|
| 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) ) |
|---|
| 170 | END WHERE |
|---|
| 171 | |
|---|
| 172 | DO jk=jpkm1,1,-1 |
|---|
| 173 | zdepth = gdepw_1d(jk) + MIN(e3zps_min,e3t_1d(jk)*e3zps_rat) |
|---|
| 174 | WHERE( 0._wp < bathy_local(:,:) .AND. bathy_local(:,:) <= zdepth ) mbathy(i1:i2,j1:j2) = jk-1 |
|---|
| 175 | ENDDO |
|---|
| 176 | |
|---|
| 177 | WHERE (mbathy(i1:i2,j1:j2) == 0); ssmask(i1:i2,j1:j2) = 0 |
|---|
| 178 | ELSE WHERE ; ssmask(i1:i2,j1:j2) = 1. |
|---|
| 179 | END WHERE |
|---|
| 180 | |
|---|
| 181 | mbkt(i1:i2,j1:j2) = MAX( mbathy(i1:i2,j1:j2), 1 ) |
|---|
| 182 | ! |
|---|
| 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 |
|---|
| 250 | DO jj=j1,j2 |
|---|
| 251 | DO ji=i1,i2 |
|---|
| 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 |
|---|
| 256 | ENDIF |
|---|
| 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 |
|---|
| 281 | |
|---|
| 282 | SUBROUTINE agrif_connection |
|---|
| 283 | !!---------------------------------------------------------------------- |
|---|
| 284 | !! *** ROUTINE Agrif_connection *** |
|---|
| 285 | !!---------------------------------------------------------------------- |
|---|
| 286 | INTEGER :: ji, jj, ind1, ind2 |
|---|
| 287 | INTEGER :: ispongearea, istart |
|---|
| 288 | REAL(wp) :: z1_spongearea |
|---|
| 289 | !!---------------------------------------------------------------------- |
|---|
| 290 | ! |
|---|
| 291 | ! Define ramp from boundaries towards domain interior at T-points |
|---|
| 292 | ! Store it in ztabramp |
|---|
| 293 | |
|---|
| 294 | ALLOCATE(ztabramp(jpi,jpj)) |
|---|
| 295 | ispongearea = 1 + npt_connect * Agrif_iRhox() |
|---|
| 296 | istart = npt_copy * Agrif_iRhox() |
|---|
| 297 | z1_spongearea = 1._wp / REAL( ispongearea, wp ) |
|---|
| 298 | |
|---|
| 299 | ztabramp(:,:) = 0._wp |
|---|
| 300 | |
|---|
| 301 | ! --- West --- ! |
|---|
| 302 | IF( lk_west ) THEN |
|---|
| 303 | ind1 = nn_hls + nbghostcells + istart |
|---|
| 304 | ind2 = ind1 + ispongearea |
|---|
| 305 | DO ji = mi0(ind1), mi1(ind2) |
|---|
| 306 | DO jj = 1, jpj |
|---|
| 307 | ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_spongearea |
|---|
| 308 | END DO |
|---|
| 309 | ENDDO |
|---|
| 310 | ! ghost cells: |
|---|
| 311 | ind1 = 1 |
|---|
| 312 | ind2 = nn_hls + nbghostcells + istart ! halo + land + nbghostcells |
|---|
| 313 | DO ji = mi0(ind1), mi1(ind2) |
|---|
| 314 | DO jj = 1, jpj |
|---|
| 315 | ztabramp(ji,jj) = 1._wp |
|---|
| 316 | END DO |
|---|
| 317 | END DO |
|---|
| 318 | ENDIF |
|---|
| 319 | |
|---|
| 320 | ! --- East --- ! |
|---|
| 321 | IF( lk_east ) THEN |
|---|
| 322 | ind2 = jpiglo - (nn_hls + nbghostcells -1 ) - istart |
|---|
| 323 | ind1 = ind2 -ispongearea |
|---|
| 324 | DO ji = mi0(ind1), mi1(ind2) |
|---|
| 325 | DO jj = 1, jpj |
|---|
| 326 | ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_spongearea ) |
|---|
| 327 | ENDDO |
|---|
| 328 | ENDDO |
|---|
| 329 | ! ghost cells: |
|---|
| 330 | ind1 = jpiglo - (nn_hls + nbghostcells - 1 ) - istart ! halo + land + nbghostcells - 1 |
|---|
| 331 | ind2 = jpiglo - 1 |
|---|
| 332 | DO ji = mi0(ind1), mi1(ind2) |
|---|
| 333 | DO jj = 1, jpj |
|---|
| 334 | ztabramp(ji,jj) = 1._wp |
|---|
| 335 | END DO |
|---|
| 336 | END DO |
|---|
| 337 | ENDIF |
|---|
| 338 | |
|---|
| 339 | ispongearea = 1 + npt_connect * Agrif_iRhoy() |
|---|
| 340 | istart = npt_copy * Agrif_iRhoy() |
|---|
| 341 | z1_spongearea = 1._wp / REAL( ispongearea, wp ) |
|---|
| 342 | |
|---|
| 343 | ! --- South --- ! |
|---|
| 344 | IF( lk_south ) THEN |
|---|
| 345 | ind1 = nn_hls + nbghostcells + istart |
|---|
| 346 | ind2 = ind1 + ispongearea |
|---|
| 347 | DO jj = mj0(ind1), mj1(ind2) |
|---|
| 348 | DO ji = 1, jpi |
|---|
| 349 | ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_spongearea ) |
|---|
| 350 | END DO |
|---|
| 351 | ENDDO |
|---|
| 352 | ! ghost cells: |
|---|
| 353 | ind1 = 1 |
|---|
| 354 | ind2 = nn_hls + nbghostcells + istart ! halo + land + nbghostcells |
|---|
| 355 | DO jj = mj0(ind1), mj1(ind2) |
|---|
| 356 | DO ji = 1, jpi |
|---|
| 357 | ztabramp(ji,jj) = 1._wp |
|---|
| 358 | END DO |
|---|
| 359 | END DO |
|---|
| 360 | ENDIF |
|---|
| 361 | |
|---|
| 362 | ! --- North --- ! |
|---|
| 363 | IF( lk_north ) THEN |
|---|
| 364 | ind2 = jpjglo - (nn_hls + nbghostcells - 1) - istart |
|---|
| 365 | ind1 = ind2 -ispongearea |
|---|
| 366 | DO jj = mj0(ind1), mj1(ind2) |
|---|
| 367 | DO ji = 1, jpi |
|---|
| 368 | ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_spongearea ) |
|---|
| 369 | END DO |
|---|
| 370 | ENDDO |
|---|
| 371 | ! ghost cells: |
|---|
| 372 | ind1 = jpjglo - (nn_hls + nbghostcells - 1) - istart ! halo + land + nbghostcells - 1 |
|---|
| 373 | ind2 = jpjglo |
|---|
| 374 | DO jj = mj0(ind1), mj1(ind2) |
|---|
| 375 | DO ji = 1, jpi |
|---|
| 376 | ztabramp(ji,jj) = 1._wp |
|---|
| 377 | END DO |
|---|
| 378 | END DO |
|---|
| 379 | ENDIF |
|---|
| 380 | ! |
|---|
| 381 | END SUBROUTINE agrif_connection |
|---|
| 382 | |
|---|
| 383 | #else |
|---|
| 384 | SUBROUTINE agrif_boundary_connections |
|---|
| 385 | END SUBROUTINE agrif_boundary_connections |
|---|
| 386 | SUBROUTINE agrif_bathymetry_connect |
|---|
| 387 | END SUBROUTINE agrif_bathymetry_connect |
|---|
| 388 | #endif |
|---|
| 389 | |
|---|
| 390 | END MODULE agrif_connect |
|---|
