1 | include(dom.inc)
2 | PROGRAM ptrtest
3 |
4 | ! ================================================================!
5 | ! !
6 | ! ptrtest.F : This program tests the data structure used for the !
7 | ! geometrical pre-processing in Prissma. A 2D !
8 | ! hybrid (tri and quand) geometry is tested. !
9 | ! !
10 | ! nota : For any implementation of the DATAStructure (DATAS) !
11 | ! follow the steps used in this example. !
12 | ! !
13 | ! This is an example of how to use the 'datas' module.!
14 | ! For integration into the 'predatas' tool, steps 0, !
15 | ! 1, 2, 7 and 8 are done in predatas.F. A subroutine !
16 | ! must be created for steps 3 to 6 and integrated in !
17 | ! the SELECTCASE(meshtype) call in predatas.F (as !
18 | ! done for avbp2dom and gambit2dom) !
19 | ! !
20 | ! author : J. AMAYA (april 2007) !
21 | ! !
22 | ! ================================================================!
23 |
24 | ! ----------------------------------------------!
25 | ! 0/ Include 'datas' module and constant values !
26 | ! ----------------------------------------------!
27 |
28 | USE datas
29 |
30 | IMPLICIT NONE
31 |
32 | INCLUDE 'dom_constants.h'
33 |
34 | DOM_INT :: ndirs, meshtype, i, quadorder, n, iel
35 | DOM_INT :: cellid
36 |
37 | DOM_REAL :: T, P, rho, gloabl_kabs
38 |
39 | DOM_INT, ALLOCATABLE, DIMENSION(:) :: facelist
40 | DOM_INT, ALLOCATABLE, DIMENSION(:) :: facenodes
41 |
42 | DOM_REAL, ALLOCATABLE, DIMENSION(:,:) :: s
43 |
44 | CHARACTER*80 :: path, meshfile, inpath
45 | CHARACTER*80 :: quadtype, initial
46 |
47 | type(cell), pointer :: new_cell
48 |
49 | ! -------------------------!
50 | ! 1/ Read the choices file !
51 | ! -------------------------!
52 |
53 | OPEN(1, FILE="predatas.choices", FORM='formatted')
54 |
55 | READ(1,*) meshfile
56 | READ(1,*) inpath
57 | READ(1,*) meshtype
58 | READ(1,*) path
59 | READ(1,*) quadtype
60 | READ(1,*) quadorder
61 | READ(1,*) initial
62 |
63 | IF (trim(initial).eq.'YES') THEN
64 | READ(1,*) T
65 | READ(1,*) P
66 | READ(1,*) gloabl_kabs
67 | ENDIF
68 |
69 | CLOSE(1)
70 |
71 | ! -----------------------------------------------------!
72 | ! 2/ Setup the directions from angular quadrature data !
73 | ! -----------------------------------------------------!
74 |
75 | IF (quadtype.eq.SNDOM) THEN
76 | ndirs=quadorder*(quadorder+2)
77 | IF (ALLOCATED(s)) DEALLOCATE(s)
78 | ALLOCATE(s(4,ndirs))
79 | CALL createdirections(quadtype, quadorder, inpath, ndirs, s)
80 | ELSE
81 | write (*,*) 'By now only works with SNDOM quadrature'
82 | STOP
83 | ENDIF
84 |
85 | ! ----------------------------------------------------------------!
86 | ! 3/ Initialize i_nnodes (number of nodes) and i_nfacesmax !
87 | ! (maximum number of faces per cell) !
88 | ! ----------------------------------------------------------------!
89 |
90 | i_nnodes = 12
91 | i_nfacesmax = 6
92 |
93 | ! ----------------------------------------------------------------!
94 | ! 4/ Allocation of the list of nodes and the list of 'faces@node' !
95 | ! ----------------------------------------------------------------!
96 |
97 | ALLOCATE (node_list(3, 12))
98 | ALLOCATE (facesatnode(12))
99 |
100 | ! ---------------------------!
101 | ! 5/ Creation of vertex list !
102 | ! ---------------------------!
103 | WRITE(*,*) "--- Creating node list: ---"
104 | node_list(:,1) = (/ 1.0d0, 0.0d0, 0.0d0 /)
105 | node_list(:,2) = (/ 0.0d0, 0.0d0, 0.0d0 /)
106 | node_list(:,3) = (/ 0.0d0, 0.0d0, 1.0d0 /)
107 | node_list(:,4) = (/ 1.0d0, 0.0d0, 1.0d0 /)
108 | node_list(:,5) = (/ 1.0d0, 1.0d0, 0.0d0 /)
109 | node_list(:,6) = (/ 0.0d0, 1.0d0, 0.0d0 /)
110 | node_list(:,7) = (/ 0.0d0, 1.0d0, 1.0d0 /)
111 | node_list(:,8) = (/ 1.0d0, 1.0d0, 1.0d0 /)
112 | node_list(:,9) = (/ 1.0d0, 2.0d0, 0.0d0 /)
113 | node_list(:,10) = (/ 0.0d0, 2.0d0, 0.0d0 /)
114 | node_list(:,11) = (/ 1.0d0, 2.0d0, 1.0d0 /)
115 | node_list(:,12) = (/ 0.0d0, 2.0d0, 1.0d0 /)
116 |
117 | ! --------------------------------------------------!
118 | ! 6/ Creating faces and elements from the node_list !
119 | ! --------------------------------------------------!
120 |
121 | ! ---------------------------------------------------------------!
122 | ! 2D - TRI element 1: To add an element, first allocate the cell !
123 | ! memory and point the 'current_cell' !
124 | ! pointer at the new memory space, then add !
125 | ! the faces list, and finally add the cell !
126 | ! to the list. !
127 | ! ---------------------------------------------------------------!
128 |
129 | ! ----------------------------!
130 | ! 6a/ Initialize cell counter !
131 | ! ----------------------------!
132 |
133 | cellid = 1
134 |
135 | ! -----------------------------------!
136 | ! 6b/ Allocate the cell memory space !
137 | ! -----------------------------------!
138 |
139 | ALLOCATE(new_cell)
140 | NULLIFY(new_cell%next_cell)
141 | current_cell => new_cell
142 | current_cell%cell_id = cellid
143 |
144 | nfaces = 3 ! # of faces in the cell
145 | nfacevert = 2 ! 4 for Hexa, 4 or 3 for pyramid
146 |
147 | IF (ALLOCATED(facelist)) DEALLOCATE(facelist)
148 | IF (ALLOCATED(facenodes)) DEALLOCATE(facenodes)
149 |
150 | ALLOCATE(facelist (nfaces))
151 | ALLOCATE(facenodes(nfacevert))
152 |
153 | ! ------------------------------------------------------------!
154 | ! 6c/ Set node list for each face (face normals pointing out) !
155 | ! ------------------------------------------------------------!
156 |
157 | facenodes = (/ 1, 5 /)
158 | patch = 4 ! 0 if the face is IN the domain
159 | CALL addface(cellid, nfacevert, facenodes, facelist(1), patch)
160 |
161 | facenodes = (/ 5, 2 /)
162 | patch = 0
163 | CALL addface(cellid, nfacevert, facenodes, facelist(2), patch)
164 |
165 | facenodes = (/ 2, 1 /)
166 | patch = 1
167 | CALL addface(cellid, nfacevert, facenodes, facelist(3), patch)
168 |
169 | CALL addcell(cellid, EL_TRI, 3, facelist)
170 | print*, "Cell ",cellid," added"
171 |
172 | cellid = cellid + 1
173 |
174 | ! ---------------------!
175 | ! 2D - Tri element 2 : !
176 | ! ---------------------!
177 |
178 | ALLOCATE(new_cell)
179 | NULLIFY(new_cell%next_cell)
180 | current_cell => new_cell
181 | current_cell%cell_id = cellid
182 |
183 | nfaces = 3 ! # of faces in the cell
184 | nfacevert = 2 ! 4 for Hexa, 4 or 3 for pyramid
185 |
186 | IF (ALLOCATED(facelist)) DEALLOCATE(facelist)
187 | IF (ALLOCATED(facenodes)) DEALLOCATE(facenodes)
188 |
189 | ALLOCATE(facelist (nfaces))
190 | ALLOCATE(facenodes(nfacevert))
191 |
192 | facenodes = (/ 5, 6 /)
193 | patch = 0 ! 0 if the face is IN the domain
194 | CALL addface(cellid, nfacevert, facenodes, facelist(1), patch)
195 |
196 | facenodes = (/ 6, 2 /)
197 | patch = 2
198 | CALL addface(cellid, nfacevert, facenodes, facelist(2), patch)
199 |
200 | facenodes = (/ 2, 5 /)
201 | patch = 0
202 | CALL addface(cellid, nfacevert, facenodes, facelist(3), patch)
203 |
204 | CALL addcell(cellid, EL_TRI, 3, facelist)
205 | print*, "Cell ",cellid," added"
206 |
207 | cellid = cellid + 1
208 |
209 | ! ----------------------!
210 | ! 2D - Qaud element 3 : !
211 | ! ----------------------!
212 |
213 | ALLOCATE(new_cell)
214 | NULLIFY(new_cell%next_cell)
215 | current_cell => new_cell
216 | current_cell%cell_id = cellid
217 |
218 | nfaces = 4 ! # of faces in the cell
219 | nfacevert = 2 ! 4 for Hexa, 4 or 3 for pyramid
220 |
221 | IF (ALLOCATED(facelist)) DEALLOCATE(facelist)
222 | IF (ALLOCATED(facenodes)) DEALLOCATE(facenodes)
223 |
224 | ALLOCATE(facelist (nfaces))
225 | ALLOCATE(facenodes(nfacevert))
226 |
227 | facenodes = (/ 5, 9 /)
228 | patch = 4 ! 0 if the face is IN the domain
229 | CALL addface(cellid, nfacevert, facenodes, facelist(1), patch)
230 |
231 | facenodes = (/ 9, 10 /)
232 | patch = 3
233 | CALL addface(cellid, nfacevert, facenodes, facelist(2), patch)
234 |
235 | facenodes = (/ 10, 6 /)
236 | patch = 2
237 | CALL addface(cellid, nfacevert, facenodes, facelist(3), patch)
238 |
239 | facenodes = (/ 6, 5 /)
240 | patch = 0
241 | CALL addface(cellid, nfacevert, facenodes, facelist(3), patch)
242 |
243 | CALL addcell(cellid, EL_QUAD, 4, facelist)
244 | print*, "Cell ",cellid," added"
245 |
246 | cellid = cellid + 1
247 |
248 | ! ---------------------------!
249 | ! 7/ Link neighbouring cells !
250 | ! ---------------------------!
251 |
252 | CALL create_cell_link(ndirs, s)
253 |
254 | ! -------------------------------------!
255 | ! 8/ Create PRISSMA input files (*.in) !
256 | ! -------------------------------------!
257 |
258 | CALL writeinfiles(path, ndirs, s, T, P, global_kabs)
259 |
260 | END PROGRAM ptrtest