12 INTEGER :: nb_tile_num
13 CHARACTER (1) :: nb_tile_bndry
48 SUBROUTINE idx_init(cres_in)
51 nb_tile(1,1)%nb_tile_num = 3; nb_tile(1,1)%nb_tile_bndry =
'l' 52 nb_tile(2,1)%nb_tile_num = 6; nb_tile(2,1)%nb_tile_bndry =
't' 53 nb_tile(3,1)%nb_tile_num = 5; nb_tile(3,1)%nb_tile_bndry =
't' 54 nb_tile(4,1)%nb_tile_num = 2; nb_tile(4,1)%nb_tile_bndry =
'l' 56 nb_tile(1,2)%nb_tile_num = 3; nb_tile(1,2)%nb_tile_bndry =
'b' 57 nb_tile(2,2)%nb_tile_num = 6; nb_tile(2,2)%nb_tile_bndry =
'r' 58 nb_tile(3,2)%nb_tile_num = 1; nb_tile(3,2)%nb_tile_bndry =
'r' 59 nb_tile(4,2)%nb_tile_num = 4; nb_tile(4,2)%nb_tile_bndry =
'b' 61 nb_tile(1,3)%nb_tile_num = 5; nb_tile(1,3)%nb_tile_bndry =
'l' 62 nb_tile(2,3)%nb_tile_num = 2; nb_tile(2,3)%nb_tile_bndry =
't' 63 nb_tile(3,3)%nb_tile_num = 1; nb_tile(3,3)%nb_tile_bndry =
't' 64 nb_tile(4,3)%nb_tile_num = 4; nb_tile(4,3)%nb_tile_bndry =
'l' 66 nb_tile(1,4)%nb_tile_num = 5; nb_tile(1,4)%nb_tile_bndry =
'b' 67 nb_tile(2,4)%nb_tile_num = 2; nb_tile(2,4)%nb_tile_bndry =
'r' 68 nb_tile(3,4)%nb_tile_num = 3; nb_tile(3,4)%nb_tile_bndry =
'r' 69 nb_tile(4,4)%nb_tile_num = 6; nb_tile(4,4)%nb_tile_bndry =
'b' 71 nb_tile(1,5)%nb_tile_num = 1; nb_tile(1,5)%nb_tile_bndry =
'l' 72 nb_tile(2,5)%nb_tile_num = 4; nb_tile(2,5)%nb_tile_bndry =
't' 73 nb_tile(3,5)%nb_tile_num = 3; nb_tile(3,5)%nb_tile_bndry =
't' 74 nb_tile(4,5)%nb_tile_num = 6; nb_tile(4,5)%nb_tile_bndry =
'l' 76 nb_tile(1,6)%nb_tile_num = 1; nb_tile(1,6)%nb_tile_bndry =
'b' 77 nb_tile(2,6)%nb_tile_num = 4; nb_tile(2,6)%nb_tile_bndry =
'r' 78 nb_tile(3,6)%nb_tile_num = 5; nb_tile(3,6)%nb_tile_bndry =
'r' 79 nb_tile(4,6)%nb_tile_num = 2; nb_tile(4,6)%nb_tile_bndry =
'b' 83 END SUBROUTINE idx_init
91 SUBROUTINE idx_init_reg(xres_in, yres_in)
92 INTEGER,
INTENT(IN) :: xres_in, yres_in
97 END SUBROUTINE idx_init_reg
106 INTEGER FUNCTION bndry(i, j)
115 ELSE IF (i == cres)
THEN 118 ELSE IF (j == 1)
THEN 122 ELSE IF (i == cres)
THEN 125 ELSE IF (i == 1)
THEN 127 ELSE IF (i == cres)
THEN 140 INTEGER FUNCTION bndry_reg(i, j)
149 ELSE IF (i == xres)
THEN 152 ELSE IF (j == 1)
THEN 156 ELSE IF (i == xres)
THEN 159 ELSE IF (i == 1)
THEN 161 ELSE IF (i == xres)
THEN 165 END FUNCTION bndry_reg
192 SUBROUTINE neighbors(tile, i, j, nb)
193 INTEGER :: tile, i, j
194 TYPE(nb_gp_idx) :: nb
196 INTEGER :: bd, nb_t_num
198 nb%gp_type = bndry(i,j)
199 IF (nb%gp_type == 0)
THEN 201 nb%ijt(1,1) = i; nb%ijt(2,1) = j+1; nb%ijt(3,1) = tile
202 nb%ijt(1,2) = i-1; nb%ijt(2,2) = j; nb%ijt(3,2) = tile
203 nb%ijt(1,3) = i+1; nb%ijt(2,3) = j; nb%ijt(3,3) = tile
204 nb%ijt(1,4) = i; nb%ijt(2,4) = j-1; nb%ijt(3,4) = tile
206 nb%ijt(1,5) = i-1; nb%ijt(2,5) = j+1; nb%ijt(3,5) = tile
207 nb%ijt(1,6) = i+1; nb%ijt(2,6) = j+1; nb%ijt(3,6) = tile
208 nb%ijt(1,7) = i-1; nb%ijt(2,7) = j-1; nb%ijt(3,7) = tile
209 nb%ijt(1,8) = i+1; nb%ijt(2,8) = j-1; nb%ijt(3,8) = tile
210 ELSEIF (nb%gp_type == 1)
THEN 212 nb_t_num = nb_tile(nb%gp_type,tile)%nb_tile_num
213 nb%ijt(3,1)=nb_t_num; nb%ijt(3,5)=nb_t_num; nb%ijt(3,6)=nb_t_num
214 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'l')
THEN 215 nb%ijt(1,1) = 1; nb%ijt(2,1) = cres+1-i;
216 nb%ijt(1,5) = 1; nb%ijt(2,5) = cres+1-(i-1);
217 nb%ijt(1,6) = 1; nb%ijt(2,6) = cres+1-(i+1);
218 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
'b')
THEN 219 nb%ijt(1,1) = i; nb%ijt(2,1) = 1
220 nb%ijt(1,5) = i-1; nb%ijt(2,5) = 1
221 nb%ijt(1,6) = i+1; nb%ijt(2,6) = 1
223 nb%ijt(1,2) = i-1; nb%ijt(2,2) = j; nb%ijt(3,2) = tile
224 nb%ijt(1,3) = i+1; nb%ijt(2,3) = j; nb%ijt(3,3) = tile
225 nb%ijt(1,4) = i; nb%ijt(2,4) = j-1; nb%ijt(3,4) = tile
226 nb%ijt(1,7) = i-1; nb%ijt(2,7) = j-1; nb%ijt(3,7) = tile
227 nb%ijt(1,8) = i+1; nb%ijt(2,8) = j-1; nb%ijt(3,8) = tile
228 ELSEIF (nb%gp_type == 2)
THEN 230 nb_t_num = nb_tile(nb%gp_type,tile)%nb_tile_num
231 nb%ijt(3,4)=nb_t_num; nb%ijt(3,7)=nb_t_num; nb%ijt(3,8)=nb_t_num
232 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'r')
THEN 233 nb%ijt(1,4) = cres; nb%ijt(2,4) = cres+1-i;
234 nb%ijt(1,7) = cres; nb%ijt(2,7) = cres+1-(i-1);
235 nb%ijt(1,8) = cres; nb%ijt(2,8) = cres+1-(i+1);
236 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
't')
THEN 237 nb%ijt(1,4) = i; nb%ijt(2,4) = cres
238 nb%ijt(1,7) = i-1; nb%ijt(2,7) = cres
239 nb%ijt(1,8) = i+1; nb%ijt(2,8) = cres
241 nb%ijt(1,1) = i; nb%ijt(2,1) = j+1; nb%ijt(3,1) = tile
242 nb%ijt(1,2) = i-1; nb%ijt(2,2) = j; nb%ijt(3,2) = tile
243 nb%ijt(1,3) = i+1; nb%ijt(2,3) = j; nb%ijt(3,3) = tile
244 nb%ijt(1,5) = i-1; nb%ijt(2,5) = j+1; nb%ijt(3,5) = tile
245 nb%ijt(1,6) = i+1; nb%ijt(2,6) = j+1; nb%ijt(3,6) = tile
246 ELSEIF (nb%gp_type == 3)
THEN 248 nb_t_num = nb_tile(nb%gp_type,tile)%nb_tile_num
249 nb%ijt(3,2)=nb_t_num; nb%ijt(3,5)=nb_t_num; nb%ijt(3,7)=nb_t_num
250 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'r')
THEN 251 nb%ijt(1,2) = cres; nb%ijt(2,2) = j;
252 nb%ijt(1,5) = cres; nb%ijt(2,5) = j+1;
253 nb%ijt(1,7) = cres; nb%ijt(2,7) = j-1;
254 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
't')
THEN 255 nb%ijt(1,2) = cres+1-j; nb%ijt(2,2) = cres
256 nb%ijt(1,5) = cres+1-(j+1); nb%ijt(2,5) = cres
257 nb%ijt(1,7) = cres+1-(j-1); nb%ijt(2,7) = cres
259 nb%ijt(1,1) = i; nb%ijt(2,1) = j+1; nb%ijt(3,1) = tile
260 nb%ijt(1,3) = i+1; nb%ijt(2,3) = j; nb%ijt(3,3) = tile
261 nb%ijt(1,4) = i; nb%ijt(2,4) = j-1; nb%ijt(3,4) = tile
262 nb%ijt(1,6) = i+1; nb%ijt(2,6) = j+1; nb%ijt(3,6) = tile
263 nb%ijt(1,8) = i+1; nb%ijt(2,8) = j-1; nb%ijt(3,8) = tile
264 ELSEIF (nb%gp_type == 4)
THEN 266 nb_t_num = nb_tile(nb%gp_type,tile)%nb_tile_num
267 nb%ijt(3,3)=nb_t_num; nb%ijt(3,6)=nb_t_num; nb%ijt(3,8)=nb_t_num
268 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'l')
THEN 269 nb%ijt(1,3) = 1; nb%ijt(2,3) = j;
270 nb%ijt(1,6) = 1; nb%ijt(2,6) = j+1;
271 nb%ijt(1,8) = 1; nb%ijt(2,8) = j-1;
272 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
'b')
THEN 273 nb%ijt(1,3) = cres+1-j; nb%ijt(2,3) = 1
274 nb%ijt(1,6) = cres+1-(j+1); nb%ijt(2,6) = 1
275 nb%ijt(1,8) = cres+1-(j-1); nb%ijt(2,8) = 1
277 nb%ijt(1,1) = i; nb%ijt(2,1) = j+1; nb%ijt(3,1) = tile
278 nb%ijt(1,2) = i-1; nb%ijt(2,2) = j; nb%ijt(3,2) = tile
279 nb%ijt(1,4) = i; nb%ijt(2,4) = j-1; nb%ijt(3,4) = tile
280 nb%ijt(1,5) = i-1; nb%ijt(2,5) = j+1; nb%ijt(3,5) = tile
281 nb%ijt(1,7) = i-1; nb%ijt(2,7) = j-1; nb%ijt(3,7) = tile
282 ELSEIF (nb%gp_type == 13)
THEN 284 nb_t_num = nb_tile(bd,tile)%nb_tile_num
285 nb%ijt(3,1)=nb_t_num; nb%ijt(3,6)=nb_t_num
286 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'l')
THEN 287 nb%ijt(1,1) = 1; nb%ijt(2,1) = cres+1-i
288 nb%ijt(1,6) = 1; nb%ijt(2,6) = cres+1-(i+1)
289 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
'b')
THEN 290 nb%ijt(1,1) = i; nb%ijt(2,1) = 1
291 nb%ijt(1,6) = i+1; nb%ijt(2,6) = 1
294 nb_t_num = nb_tile(bd,tile)%nb_tile_num
295 nb%ijt(3,2)=nb_t_num; nb%ijt(3,7)=nb_t_num
296 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'r')
THEN 297 nb%ijt(1,2) = cres; nb%ijt(2,2) = j
298 nb%ijt(1,7) = cres; nb%ijt(2,7) = j-1
299 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
't')
THEN 300 nb%ijt(1,2) = cres+1-j; nb%ijt(2,2) = cres
301 nb%ijt(1,7) = cres+1-(j-1); nb%ijt(2,7) = cres
304 nb%ijt(1,3) = i+1; nb%ijt(2,3) = j; nb%ijt(3,3) = tile
305 nb%ijt(1,4) = i; nb%ijt(2,4) = j-1; nb%ijt(3,4) = tile
306 nb%ijt(1,8) = i+1; nb%ijt(2,8) = j-1; nb%ijt(3,8) = tile
307 ELSEIF (nb%gp_type == 14)
THEN 309 nb_t_num = nb_tile(bd,tile)%nb_tile_num
310 nb%ijt(3,1)=nb_t_num; nb%ijt(3,5)=nb_t_num
311 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'l')
THEN 312 nb%ijt(1,1) = 1; nb%ijt(2,1) = cres+1-i
313 nb%ijt(1,5) = 1; nb%ijt(2,5) = cres+1-(i-1)
314 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
'b')
THEN 315 nb%ijt(1,1) = i; nb%ijt(2,1) = 1
316 nb%ijt(1,5) = i-1; nb%ijt(2,5) = 1
319 nb_t_num = nb_tile(bd,tile)%nb_tile_num
320 nb%ijt(3,3)=nb_t_num; nb%ijt(3,8)=nb_t_num
321 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'l')
THEN 322 nb%ijt(1,3) = 1; nb%ijt(2,3) = j
323 nb%ijt(1,8) = 1; nb%ijt(2,8) = j-1
324 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
'b')
THEN 325 nb%ijt(1,3) = cres+1-j; nb%ijt(2,3) = 1
326 nb%ijt(1,8) = cres+1-(j-1); nb%ijt(2,8) = 1
329 nb%ijt(1,2) = i-1; nb%ijt(2,2) = j; nb%ijt(3,2) = tile
330 nb%ijt(1,4) = i; nb%ijt(2,4) = j-1; nb%ijt(3,4) = tile
331 nb%ijt(1,7) = i-1; nb%ijt(2,7) = j-1; nb%ijt(3,7) = tile
332 ELSEIF (nb%gp_type == 23)
THEN 334 nb_t_num = nb_tile(bd,tile)%nb_tile_num
335 nb%ijt(3,4)=nb_t_num; nb%ijt(3,8)=nb_t_num
336 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'r')
THEN 337 nb%ijt(1,4) = cres; nb%ijt(2,4) = cres+1-i
338 nb%ijt(1,8) = cres; nb%ijt(2,8) = cres+1-(i+1)
339 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
't')
THEN 340 nb%ijt(1,4) = i; nb%ijt(2,4) = cres
341 nb%ijt(1,8) = i+1; nb%ijt(2,8) = cres
344 nb_t_num = nb_tile(bd,tile)%nb_tile_num
345 nb%ijt(3,2)=nb_t_num; nb%ijt(3,5)=nb_t_num
346 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'r')
THEN 347 nb%ijt(1,2) = cres; nb%ijt(2,2) = j
348 nb%ijt(1,5) = cres; nb%ijt(2,5) = j+1
349 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
't')
THEN 350 nb%ijt(1,2) = cres+1-j; nb%ijt(2,2) = cres
351 nb%ijt(1,5) = cres+1-(j+1); nb%ijt(2,5) = cres
354 nb%ijt(1,1) = i; nb%ijt(2,1) = j+1; nb%ijt(3,1) = tile
355 nb%ijt(1,3) = i+1; nb%ijt(2,3) = j; nb%ijt(3,3) = tile
356 nb%ijt(1,6) = i+1; nb%ijt(2,6) = j+1; nb%ijt(3,6) = tile
357 ELSEIF (nb%gp_type == 24)
THEN 359 nb_t_num = nb_tile(bd,tile)%nb_tile_num
360 nb%ijt(3,4)=nb_t_num; nb%ijt(3,7)=nb_t_num
361 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'r')
THEN 362 nb%ijt(1,4) = cres; nb%ijt(2,4) = cres+1-i
363 nb%ijt(1,7) = cres; nb%ijt(2,7) = cres+1-(i-1)
364 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
't')
THEN 365 nb%ijt(1,4) = i; nb%ijt(2,4) = cres
366 nb%ijt(1,7) = i-1; nb%ijt(2,7) = cres
369 nb_t_num = nb_tile(bd,tile)%nb_tile_num
370 nb%ijt(3,3)=nb_t_num; nb%ijt(3,6)=nb_t_num
371 IF (nb_tile(bd,tile)%nb_tile_bndry ==
'l')
THEN 372 nb%ijt(1,3) = 1; nb%ijt(2,3) = j
373 nb%ijt(1,6) = 1; nb%ijt(2,6) = j+1
374 ELSEIF (nb_tile(bd,tile)%nb_tile_bndry ==
'b')
THEN 375 nb%ijt(1,3) = cres+1-j; nb%ijt(2,3) = 1
376 nb%ijt(1,6) = cres+1-(j+1); nb%ijt(2,6) = 1
379 nb%ijt(1,1) = i; nb%ijt(2,1) = j+1; nb%ijt(3,1) = tile
380 nb%ijt(1,2) = i-1; nb%ijt(2,2) = j; nb%ijt(3,2) = tile
381 nb%ijt(1,5) = i-1; nb%ijt(2,5) = j+1; nb%ijt(3,5) = tile
384 END SUBROUTINE neighbors
393 SUBROUTINE neighbors_reg(i, j, nb)
395 TYPE(nb_gp_idx) :: nb
399 nb%ijt(1,1) = i; nb%ijt(2,1) = j+1; nb%ijt(3,1) = 1
400 nb%ijt(1,2) = i-1; nb%ijt(2,2) = j; nb%ijt(3,2) = 1
401 nb%ijt(1,3) = i+1; nb%ijt(2,3) = j; nb%ijt(3,3) = 1
402 nb%ijt(1,4) = i; nb%ijt(2,4) = j-1; nb%ijt(3,4) = 1
404 nb%ijt(1,5) = i-1; nb%ijt(2,5) = j+1; nb%ijt(3,5) = 1
405 nb%ijt(1,6) = i+1; nb%ijt(2,6) = j+1; nb%ijt(3,6) = 1
406 nb%ijt(1,7) = i-1; nb%ijt(2,7) = j-1; nb%ijt(3,7) = 1
407 nb%ijt(1,8) = i+1; nb%ijt(2,8) = j-1; nb%ijt(3,8) = 1
409 nb%gp_type = bndry_reg(i,j)
410 IF (nb%gp_type == 1)
THEN 411 nb%ijt(3,1) = 0; nb%ijt(3,5) = 0; nb%ijt(3,6) = 0
412 ELSEIF (nb%gp_type == 2)
THEN 413 nb%ijt(3,4) = 0; nb%ijt(3,7) = 0; nb%ijt(3,8) = 0
414 ELSEIF (nb%gp_type == 3)
THEN 415 nb%ijt(3,2) = 0; nb%ijt(3,5) = 0; nb%ijt(3,7) = 0
416 ELSEIF (nb%gp_type == 4)
THEN 417 nb%ijt(3,3) = 0; nb%ijt(3,6) = 0; nb%ijt(3,8) = 0
418 ELSEIF (nb%gp_type == 13)
THEN 419 nb%ijt(3,1) = 0; nb%ijt(3,5) = 0; nb%ijt(3,6) = 0;
420 nb%ijt(3,2) = 0; nb%ijt(3,7) = 0
421 ELSEIF (nb%gp_type == 14)
THEN 422 nb%ijt(3,1) = 0; nb%ijt(3,5) = 0; nb%ijt(3,6) = 0;
423 nb%ijt(3,3) = 0; nb%ijt(3,8) = 0
424 ELSEIF (nb%gp_type == 23)
THEN 425 nb%ijt(3,4) = 0; nb%ijt(3,7) = 0; nb%ijt(3,8) = 0
426 nb%ijt(3,2) = 0; nb%ijt(3,5) = 0;
427 ELSEIF (nb%gp_type == 24)
THEN 428 nb%ijt(3,4) = 0; nb%ijt(3,7) = 0; nb%ijt(3,8) = 0
429 nb%ijt(3,3) = 0; nb%ijt(3,6) = 0;
432 END SUBROUTINE neighbors_reg
440 INTEGER :: tile, i, j
441 TYPE(nb_gp_idx) :: nbs
443 INTEGER,
PARAMETER :: res = 96
449 tile = 2; i = 96; j = 96
450 CALL neighbors(tile, i, j, nbs)
451 print*,
'tile = ', tile,
' i = ',i,
' j = ', j
452 print*,
'nbs%type: ', nbs%gp_type
Neighboring cell descriptor.
Neighboring tile descriptor.