1 | include(dom.inc)
   2 |       SUBROUTINE link_neighbour_cell(i,s,ndirs)
   3 | 
   4 | !       ================================================================!
   5 | !                                                                       !
   6 | !       link_neighbour_cell.F : Detects and links the neighbour cell    !
   7 | !                               in the given direction                  !
   8 | !                                                                       !
   9 | !       in                    : The directions number 'i'               !
  10 | !                               The direction components 's(3)'         !
  11 | !                               The 'current_cell' must be pointing at  !
  12 | !                               the evaluated cell.                     !
  13 | !       out                   : The linked cell in the direction 'i'    !
  14 | !                                                                       !
  15 | !       author                : J. AMAYA (april 2007)                   !
  16 | !                                                                       !
  17 | !       ================================================================!
  18 | 
  19 |         USE datas
  20 | 
  21 |         IMPLICIT NONE
  22 | 
  23 | !       IN
  24 |         DOM_REAL            :: s(3)
  25 |         DOM_INT             :: i, ndirs
  26 | 
  27 | !       LOCAL
  28 |         type(cell), pointer :: this_cell
  29 |         type(cell), pointer :: neigh_ptr
  30 |         type(face), pointer :: face_pt
  31 |         DOM_INT             :: neighbour_cell
  32 |         DOM_INT             :: faceout, k
  33 |         DOM_INT             :: thiscell_id
  34 |         DOM_INT             :: parent, ierr, j
  35 |         DOM_REAL            :: proj, last_proj
  36 |         DOM_REAL            :: n(3)
  37 | 
  38 |         this_cell => current_cell
  39 | 
  40 | !       ---------------------------------------------------------!
  41 | !       Outface = face with the biggest normal projection on s_i !
  42 | !       ---------------------------------------------------------!
  43 | 
  44 |         last_proj = 0.0d0
  45 |         faceout = 0
  46 |         thiscell_id = this_cell%cell_id
  47 | 
  48 | 
  49 |         DO j=1, this_cell%i_nbfaces
  50 | 
  51 |           face_pt => this_cell%cell_face(j)%face_ptr
  52 | 
  53 |           parent = 1
  54 |           IF (face_pt%parent_cell(1).ne.thiscell_id) parent = 2
  55 | 
  56 |           n(1:3) = face_pt%face_normal(1:3,parent)
  57 | 
  58 |           CALL projection(n,s,proj)
  59 | 
  60 |           IF (proj > last_proj) THEN
  61 |             faceout = j
  62 |             last_proj = proj
  63 |           ENDIF
  64 |        
  65 |         ENDDO
  66 | 
  67 | !        print*, "  > Cell ", this_cell%cell_id
  68 | !        print*, "    outface: ", faceout
  69 | 
  70 |         IF (faceout.ne.0) THEN
  71 | 
  72 |           face_pt => this_cell%cell_face(faceout)%face_ptr
  73 | 
  74 | !         ------------------------------------------!
  75 | !         Detect wich of the cells is the neighbour !
  76 | !         ------------------------------------------!
  77 | 
  78 |           IF (face_pt%parent_cell(1).eq.thiscell_id) THEN
  79 | 
  80 |             IF (face_pt%parent_cell(2).ne.0) THEN
  81 | 
  82 |               neighbour_cell =  face_pt%parent_cell(2)
  83 |               neigh_ptr      => face_pt%parent2_ptr
  84 |               this_cell%cell_dir (i)%cell_ptr => neigh_ptr
  85 |               IF (.not.ALLOCATED(neigh_ptr%cell_udir)) THEN
  86 |                 ALLOCATE(neigh_ptr%cell_udir(ndirs))
  87 |                 DO k=1, ndirs
  88 |                   NULLIFY(neigh_ptr%cell_udir(k)%cell_ptr)
  89 |                 ENDDO
  90 |               ENDIF
  91 |               neigh_ptr%cell_udir(i)%cell_ptr => this_cell
  92 | 
  93 |             ELSE
  94 | 
  95 |               NULLIFY(this_cell%cell_dir(i)%cell_ptr)
  96 | 
  97 |             ENDIF
  98 | 
  99 |           ELSE
 100 | 
 101 |             neighbour_cell = face_pt%parent_cell(1)
 102 |             neigh_ptr => face_pt%parent1_ptr
 103 |             this_cell%cell_dir (i)%cell_ptr => neigh_ptr
 104 |             IF (.not.ALLOCATED(neigh_ptr%cell_udir)) THEN
 105 |               ALLOCATE(neigh_ptr%cell_udir(ndirs))
 106 |               DO k=1, ndirs
 107 |                 NULLIFY(neigh_ptr%cell_udir(k)%cell_ptr)
 108 |               ENDDO
 109 |             ENDIF
 110 |             neigh_ptr%cell_udir(i)%cell_ptr => this_cell
 111 | 
 112 |           ENDIF
 113 | 
 114 |         ELSE
 115 | 
 116 |           NULLIFY(this_cell%cell_dir(i)%cell_ptr)
 117 | 
 118 |         ENDIF
 119 | 
 120 | !       ----------------------------------------------------!
 121 | !       And set back 'current_cell' pointer to initial cell !
 122 | !       ----------------------------------------------------!
 123 | 
 124 | !       current_cell => this_cell
 125 | 
 126 |       END SUBROUTINE link_neighbour_cell