1 | include(dom.inc)
   2 |       PROGRAM ptrtest
   3 |         USE datas
   4 | 
   5 |         IMPLICIT NONE
   6 | 
   7 |         INCLUDE 'dom_constants.h'
   8 | 
   9 |         DOM_INT :: i, found, face1, face2, face3, face4
  10 |         DOM_INT :: face5, face6
  11 |         DOM_INT :: nodelist(3)
  12 |         DOM_INT :: node2dlist(2)
  13 |         DOM_INT :: hexnodelist(4)
  14 |         DOM_INT :: tetfacelist(4)
  15 |         DOM_INT :: hexfacelist(6)
  16 |         DOM_INT :: trifacelist(3)
  17 |         DOM_INT :: ndirs
  18 |         DOM_REAL :: s(3,3)
  19 |         CHARACTER*80     :: file
  20 |         TYPE(ptr_cell)   :: new_cell(5)
  21 | 
  22 |         i_nfaces = 0
  23 |         i_ncells = 0
  24 | 
  25 | !       -------------------!
  26 | !       Creation des nodes !
  27 | !       -------------------!
  28 |         WRITE(*,*) "--- Creating node list: ---"
  29 |         ALLOCATE (node_list(3, 12))
  30 |         ALLOCATE (facesatnode(12))
  31 |         i_nnodes = 12
  32 | 
  33 |         node_list(:,1)  = (/ 1.0d0, 0.0d0, 0.0d0 /)
  34 |         node_list(:,2)  = (/ 0.0d0, 0.0d0, 0.0d0 /)
  35 |         node_list(:,3)  = (/ 0.0d0, 0.0d0, 1.0d0 /)
  36 |         node_list(:,4)  = (/ 1.0d0, 0.0d0, 1.0d0 /)
  37 |         node_list(:,5)  = (/ 1.0d0, 1.0d0, 0.0d0 /)
  38 |         node_list(:,6)  = (/ 0.0d0, 1.0d0, 0.0d0 /)
  39 |         node_list(:,7)  = (/ 0.0d0, 1.0d0, 1.0d0 /)
  40 |         node_list(:,8)  = (/ 1.0d0, 1.0d0, 1.0d0 /)
  41 |         node_list(:,9)  = (/ 1.0d0, 2.0d0, 0.0d0 /)
  42 |         node_list(:,10) = (/ 0.0d0, 2.0d0, 0.0d0 /)
  43 |         node_list(:,11) = (/ 1.0d0, 2.0d0, 1.0d0 /)
  44 |         node_list(:,12) = (/ 0.0d0, 2.0d0, 1.0d0 /)
  45 | 
  46 | !       --------------------------------------!
  47 | !       Test addfaces and addcell subroutines !
  48 | !       --------------------------------------!
  49 |         WRITE(*,*) "--- Adding faces and cells: ---"
  50 | 
  51 | !       -----------!
  52 | !       Element 1: !
  53 | !       -----------!
  54 |         print*, " allocating 1st element memory"
  55 |         ALLOCATE(new_cell(1)%cell_ptr)
  56 |         print*, " pointing with current_cell"
  57 |         current_cell => new_cell(1)%cell_ptr
  58 | 
  59 |         nodelist = (/ 5, 4, 1 /)
  60 |         print*, "Add first face"
  61 |         CALL addface(1, 3, nodelist, face1)
  62 |         nodelist = (/ 1, 4, 2 /)
  63 |         CALL addface(1, 3, nodelist, face2)
  64 |         nodelist = (/ 5, 2, 4 /)
  65 |         CALL addface(1, 3, nodelist, face3)
  66 |         nodelist = (/ 1, 2, 5 /)
  67 |         CALL addface(1, 3, nodelist, face4)
  68 | 
  69 |         tetfacelist = (/ face1, face2, face3, face4 /)
  70 |         print*, "Add cell..."
  71 |         CALL addcell(1, EL_TETRA, 4, tetfacelist)
  72 |         print*, "Cell 1 added"
  73 | 
  74 | !       -----------!
  75 | !       Element 2: !
  76 | !       -----------!
  77 |         ALLOCATE(new_cell(2)%cell_ptr)
  78 |         current_cell => new_cell(2)%cell_ptr
  79 | 
  80 |         nodelist = (/ 5, 7, 2 /)
  81 |         CALL addface(2, 3, nodelist, face1)
  82 |         nodelist = (/ 5, 6, 7 /)
  83 |         CALL addface(2, 3, nodelist, face2)
  84 |         nodelist = (/ 6, 2, 7 /)
  85 |         CALL addface(2, 3, nodelist, face3)
  86 |         nodelist = (/ 5, 2, 6 /)
  87 |         CALL addface(2, 3, nodelist, face4)
  88 | 
  89 |         tetfacelist = (/ face1, face2, face3, face4 /)
  90 |         CALL addcell(2, EL_TETRA, 4, tetfacelist)
  91 |         print*, "Cell 2 added"
  92 | 
  93 | !       -----------!
  94 | !       Element 3: !
  95 | !       -----------!
  96 |         ALLOCATE(new_cell(3)%cell_ptr)
  97 |         current_cell => new_cell(3)%cell_ptr
  98 | 
  99 |         nodelist = (/ 2, 7, 4 /)
 100 |         CALL addface(3, 3, nodelist, face1)
 101 |         nodelist = (/ 2, 3, 7 /)
 102 |         CALL addface(3, 3, nodelist, face2)
 103 |         nodelist = (/ 2, 4, 3 /)
 104 |         CALL addface(3, 3, nodelist, face3)
 105 |         nodelist = (/ 3, 4, 7 /)
 106 |         CALL addface(3, 3, nodelist, face4)
 107 | 
 108 |         tetfacelist = (/ face1, face2, face3, face4 /)
 109 |         CALL addcell(3, EL_TETRA, 4, tetfacelist)
 110 |         print*, "Cell 3 added"
 111 | 
 112 | !       -----------!
 113 | !       Element 4: !
 114 | !       -----------!
 115 |         ALLOCATE(new_cell(4)%cell_ptr)
 116 |         current_cell => new_cell(4)%cell_ptr
 117 | 
 118 |         nodelist = (/ 5, 8, 4 /)
 119 |         CALL addface(4, 3, nodelist, face1)
 120 |         nodelist = (/ 5, 7, 8 /)
 121 |         CALL addface(4, 3, nodelist, face2)
 122 |         nodelist = (/ 7, 4, 8 /)
 123 |         CALL addface(4, 3, nodelist, face3)
 124 |         nodelist = (/ 5, 4, 7 /)
 125 |         CALL addface(4, 3, nodelist, face4)
 126 | 
 127 |         tetfacelist = (/ face1, face2, face3, face4 /)
 128 |         CALL addcell(4, EL_TETRA, 4, tetfacelist)
 129 |         print*, "Cell 4 added"
 130 | 
 131 | !       -----------!
 132 | !       Element 5: !
 133 | !       -----------!
 134 |         ALLOCATE(new_cell(5)%cell_ptr)
 135 |         current_cell => new_cell(5)%cell_ptr
 136 | 
 137 |         nodelist = (/ 5, 7, 4 /)
 138 |         CALL addface(5, 3, nodelist, face1)
 139 |         nodelist = (/ 4, 7, 2 /)
 140 |         CALL addface(5, 3, nodelist, face2)
 141 |         nodelist = (/ 5, 4, 2 /)
 142 |         CALL addface(5, 3, nodelist, face3)
 143 |         nodelist = (/ 2, 7, 5 /)
 144 |         CALL addface(5, 3, nodelist, face4)
 145 | 
 146 |         tetfacelist = (/ face1, face2, face3, face4 /)
 147 |         CALL addcell(5, EL_TETRA, 4, tetfacelist)
 148 |         print*, "Cell 5 added"
 149 | 
 150 | !       ----------------------------!
 151 | !       Printing faces' information !
 152 | !       ----------------------------!
 153 | 
 154 |         CALL printfacesinfo
 155 | 
 156 | !       ---------------!
 157 | !       Set directions !
 158 | !       ---------------!
 159 | 
 160 |         ndirs = 3
 161 |         s(1,:) = (/ 1, 0, 0 /)
 162 |         s(2,:) = (/ 0, 1, 0 /)
 163 |         s(3,:) = (/ 0, 0, 1 /)
 164 | 
 165 | !       ------------------------!
 166 | !       Link neighbouring cells !
 167 | !       ------------------------!
 168 | 
 169 |         CALL create_cell_link(ndirs, s)
 170 | 
 171 | !       ----------------------------!
 172 | !       Printing cells' information !
 173 | !       ----------------------------!
 174 | 
 175 |         CALL printcellsinfo(ndirs)
 176 | 
 177 |         CALL writeinfiles('.', 24)
 178 | 
 179 |       END PROGRAM ptrtest