1 | include(dom.inc)
2 |
3 | SUBROUTINE test2dom
4 |
5 | ! ================================================================!
6 | ! !
7 | ! test2dom.F: This program tests the data structure used for the !
8 | ! geometrical pre-processing in Prissma. A 2D !
9 | ! hybrid (tri and quand) geometry is tested. !
10 | ! !
11 | ! nota : For any implementation of the DATAStructure (DATAS) !
12 | ! follow the steps used in this example. !
13 | ! !
14 | ! author : J. AMAYA (april 2008) !
15 | ! !
16 | ! ================================================================!
17 |
18 | ! ----------------------------------------------!
19 | ! 0/ Include 'datas' module and constant values !
20 | ! ----------------------------------------------!
21 |
22 | USE datas
23 |
24 | IMPLICIT NONE
25 |
26 | INCLUDE 'dom_constants.h'
27 |
28 | DOM_INT, ALLOCATABLE, DIMENSION(:) :: facelist
29 | DOM_INT, ALLOCATABLE, DIMENSION(:,:) :: facenodes
30 |
31 | type(cell), pointer :: new_cell
32 |
33 | DOM_INT :: nfaces
34 | DOM_INT :: nfacevert
35 | DOM_INT :: patch
36 | DOM_INT :: cellid
37 |
38 | ! ----------------------------------------------------------------!
39 | ! 1/ Initialize i_nnodes (number of nodes) and i_nfacesmax !
40 | ! (maximum number of faces per cell) !
41 | ! ----------------------------------------------------------------!
42 |
43 | i_nnodes = 12
44 | i_nfacesmax = 4
45 |
46 | ! ----------------------------------------------------------------!
47 | ! 2/ Allocation of the list of nodes and the list of 'faces@node' !
48 | ! ----------------------------------------------------------------!
49 |
50 | ALLOCATE (node_list(3, 12))
51 | ALLOCATE (facesatnode(12))
52 |
53 | ! ---------------------------!
54 | ! 3/ Creation of vertex list !
55 | ! ---------------------------!
56 | WRITE(*,*) "--- Creating node list: ---"
57 | node_list(:,1) = (/ 1.0d0, 0.0d0, 0.0d0 /)
58 | node_list(:,2) = (/ 0.0d0, 0.0d0, 0.0d0 /)
59 | node_list(:,3) = (/ 0.0d0, 0.0d0, 1.0d0 /)
60 | node_list(:,4) = (/ 1.0d0, 0.0d0, 1.0d0 /)
61 | node_list(:,5) = (/ 1.0d0, 1.0d0, 0.0d0 /)
62 | node_list(:,6) = (/ 0.0d0, 1.0d0, 0.0d0 /)
63 | node_list(:,7) = (/ 0.0d0, 1.0d0, 1.0d0 /)
64 | node_list(:,8) = (/ 1.0d0, 1.0d0, 1.0d0 /)
65 | node_list(:,9) = (/ 1.0d0, 2.0d0, 0.0d0 /)
66 | node_list(:,10) = (/ 0.0d0, 2.0d0, 0.0d0 /)
67 | node_list(:,11) = (/ 1.0d0, 2.0d0, 1.0d0 /)
68 | node_list(:,12) = (/ 0.0d0, 2.0d0, 1.0d0 /)
69 |
70 | ! --------------------------------------------------!
71 | ! 4/ Creating faces and elements from the node_list !
72 | ! --------------------------------------------------!
73 |
74 | ! ---------------------------------------------------------------!
75 | ! 2D - TRI element 1: To add an element, first allocate the cell !
76 | ! memory and point the 'current_cell' !
77 | ! pointer at the new memory space, then add !
78 | ! the faces list, and finally add the cell !
79 | ! to the list. !
80 | ! ---------------------------------------------------------------!
81 |
82 | ! ----------------------------!
83 | ! 4a/ Initialize cell counter !
84 | ! ----------------------------!
85 |
86 | cellid = 1
87 |
88 | ! -----------------------------------!
89 | ! 4b/ Allocate the cell memory space !
90 | ! -----------------------------------!
91 |
92 | WRITE(*,*) "--- Allocating memory for cells"
93 | ALLOCATE(new_cell)
94 | NULLIFY(new_cell%next_cell)
95 | current_cell => new_cell
96 | current_cell%cell_id = cellid
97 |
98 | nfaces = 3 ! No of faces in the cell
99 | nfacevert = 2 ! 4 for Hexa, 4 or 3 for pyramid
100 |
101 | IF (ALLOCATED(facelist)) DEALLOCATE(facelist)
102 | IF (ALLOCATED(facenodes)) DEALLOCATE(facenodes)
103 |
104 | ALLOCATE(facelist (nfaces))
105 | ALLOCATE(facenodes(nfacevert,nfaces))
106 |
107 | ! ------------------------------------------------------------!
108 | ! 4c/ Set node list for each face (face normals pointing out) !
109 | ! ------------------------------------------------------------!
110 |
111 | facenodes(:,1) = (/ 1, 5 /)
112 | facenodes(:,2) = (/ 5, 2 /)
113 | facenodes(:,3) = (/ 2, 1 /)
114 |
115 | patch = 4 ! 0 if the face is IN the domain
116 | CALL addface(cellid,nfacevert,facenodes(:,1),facelist(1),patch)
117 |
118 | patch = 0
119 | CALL addface(cellid,nfacevert,facenodes(:,2),facelist(2),patch)
120 |
121 | patch = 1
122 | CALL addface(cellid,nfacevert,facenodes(:,3),facelist(3),patch)
123 |
124 | CALL addcell(cellid, EL_TRI, 3, facelist)
125 | print*, "Cell ",cellid," added"
126 |
127 | cellid = cellid + 1
128 |
129 | ! ---------------------!
130 | ! 2D - Tri element 2 : !
131 | ! ---------------------!
132 |
133 | ALLOCATE(new_cell)
134 | NULLIFY(new_cell%next_cell)
135 | current_cell => new_cell
136 | current_cell%cell_id = cellid
137 |
138 | nfaces = 3
139 | nfacevert = 2
140 |
141 | IF (ALLOCATED(facelist)) DEALLOCATE(facelist)
142 | IF (ALLOCATED(facenodes)) DEALLOCATE(facenodes)
143 |
144 | ALLOCATE(facelist (nfaces))
145 | ALLOCATE(facenodes(nfacevert,nfaces))
146 |
147 | facenodes(:,1) = (/ 5, 6 /)
148 | facenodes(:,2) = (/ 6, 2 /)
149 | facenodes(:,3) = (/ 2, 5 /)
150 |
151 | patch = 0
152 | CALL addface(cellid,nfacevert,facenodes(:,1),facelist(1),patch)
153 |
154 | patch = 2
155 | CALL addface(cellid,nfacevert,facenodes(:,2),facelist(2),patch)
156 |
157 | patch = 0
158 | CALL addface(cellid,nfacevert,facenodes(:,3),facelist(3),patch)
159 |
160 | CALL addcell(cellid, EL_TRI, 3, facelist)
161 | print*, "Cell ",cellid," added"
162 |
163 | cellid = cellid + 1
164 |
165 | ! ----------------------!
166 | ! 2D - Qaud element 3 : !
167 | ! ----------------------!
168 |
169 | ALLOCATE(new_cell)
170 | NULLIFY(new_cell%next_cell)
171 | current_cell => new_cell
172 | current_cell%cell_id = cellid
173 |
174 | nfaces = 4
175 | nfacevert = 2
176 |
177 | IF (ALLOCATED(facelist)) DEALLOCATE(facelist)
178 | IF (ALLOCATED(facenodes)) DEALLOCATE(facenodes)
179 |
180 | ALLOCATE(facelist (nfaces))
181 | ALLOCATE(facenodes(nfacevert,nfaces))
182 |
183 | facenodes(:,1) = (/ 5, 9 /)
184 | facenodes(:,2) = (/ 9, 10/)
185 | facenodes(:,3) = (/10, 6 /)
186 | facenodes(:,4) = (/ 6, 5 /)
187 |
188 | patch = 4
189 | CALL addface(cellid,nfacevert,facenodes(:,1),facelist(1),patch)
190 |
191 | patch = 3
192 | CALL addface(cellid,nfacevert,facenodes(:,2),facelist(2),patch)
193 |
194 | patch = 2
195 | CALL addface(cellid,nfacevert,facenodes(:,3),facelist(3),patch)
196 |
197 | patch = 0
198 | CALL addface(cellid,nfacevert,facenodes(:,4),facelist(4),patch)
199 |
200 | CALL addcell(cellid, EL_QUAD, 4, facelist)
201 | print*, "Cell ",cellid," added"
202 |
203 | cellid = cellid + 1
204 |
205 | END SUBROUTINE test2dom
test2dom.F could be called by: