File: N:\mfix\model\des\stl_dbg_des_mod.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Module name: stl_dbg_des                                            !
4     !  Author: Rahul Garg                                 Date: 24-Oct-13  !
5     !                                                                      !
6     !  Purpose: Random functions for debugging STLs with DES.              !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           MODULE STL_DBG_DES
10     
11           IMPLICIT NONE
12     
13     ! Use this module only to define functions and subroutines.
14           CONTAINS
15     
16     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
17     !                                                                      !
18     !  Subroutine: STL_DBG_DG_REPORT                                       !
19     !  Author: Rahul Garg                                 Date: 24-Oct-13  !
20     !                                                                      !
21     !  Purpose: Reports the total number of facets in each DES grid cell.  !
22     !                                                                      !
23     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
24           SUBROUTINE STL_DBG_DG_REPORT
25     
26           use desgrid, only: DG_IJKSTART2, DG_IJKEND2
27     
28           use stl, only: FACETS_AT_DG
29     
30           use compar, only: myPE, numPEs
31     
32           IMPLICIT NONE
33     
34           INTEGER :: IJK, TOTAL_FACETS, LC
35     
36           CHARACTER(LEN=100) :: FN
37     
38           IF(numPEs == 1) THEN
39              WRITE(FN,'("FACETS_DG_GRID.DAT")')
40           ELSE
41              WRITE(FN,'("FACETS_DG_GRID_",I5.5,".DAT")') myPE
42           ENDIF
43     
44           OPEN(1001, file=TRIM(FN))
45     
46           DO IJK=DG_IJKSTART2, DG_IJKEND2
47              TOTAL_FACETS = FACETS_AT_DG(IJK)%COUNT  
48              IF(TOTAL_FACETS < 1) CYCLE
49              WRITE(1001,2000) IJK, TOTAL_FACETS
50              DO LC=1, TOTAL_FACETS
51                 WRITE(1001,'(2x,I10)') FACETS_AT_DG(IJK)%ID(LC)
52              ENDDO
53           ENDDO
54     
55           CLOSE(1001, STATUS = "keep")
56     
57      2000 FORMAT(2/2x,'DG CELL: ',I10,3x,'Total STLs: ',I4)
58     
59           RETURN
60           END SUBROUTINE STL_DBG_DG_REPORT
61     
62     
63     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
64     !                                                                      !
65     !  Subroutine: STL_DBG_WRITE_FACETS                                    !
66     !  Author: Rahul Garg                                 Date: 24-Oct-13  !
67     !                                                                      !
68     !  Purpose: Write back out the STL files read from input files.        !
69     !                                                                      !
70     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
71           SUBROUTINE STL_DBG_WRITE_FACETS(STL_TYPE)
72     
73     ! Number of facets 
74           use stl, only: N_FACETS, N_FACETS_DES
75     ! Facet Vertices and normal
76           use stl, only: VERTEX, NORM_FACE
77     ! Processor rank and rank of IO
78           use compar, only: myPE, PE_IO
79     ! Start/End position of different STLs
80           use stl, only: STL_START, STL_END
81     ! All STLS
82           use stl, only: ALL_STL
83     ! STLs read from geometry files
84           use stl, only: BASE_STL
85     ! STLs for user specified walls (NSW, PSW, FSW)
86           use stl, only: BCWALLS_STL
87     ! STLs for impermeable surfaces
88           use stl, only: IMPRMBL_STL
89     ! STLs for default walls
90           use stl, only: DEFAULT_STL
91     
92           use error_manager
93     
94           IMPLICIT NONE
95     
96     ! Type of STL to output
97           INTEGER, INTENT(IN) :: STL_TYPE
98     
99           INTEGER :: LC, lSTART, lEND
100           CHARACTER(len=128) :: FNAME
101     
102           IF(myPE /= PE_IO) RETURN
103     
104           SELECT CASE(STL_TYPE)
105           CASE(BASE_STL)
106              lSTART = STL_START(BASE_STL) 
107              lEND=STL_END(BASE_STL)
108              FNAME='BASE_FACETS.stl'
109           CASE(BCWALLS_STL)
110              lSTART = STL_START(BCWALLS_STL) 
111              lEND=STL_END(BCWALLS_STL)
112              FNAME='BCWALLS_FACETS.stl'
113           CASE(IMPRMBL_STL)
114              lSTART = STL_START(IMPRMBL_STL) 
115              lEND=STL_END(IMPRMBL_STL)
116              FNAME='IMPRMBL_FACETS.stl'
117           CASE(DEFAULT_STL)
118              lSTART = STL_START(DEFAULT_STL) 
119              lEND=STL_END(DEFAULT_STL)
120              FNAME='DEFAULT_FACETS.stl'
121           CASE(ALL_STL)
122              lSTART = 1
123              lEND=N_FACETS_DES
124              FNAME='ALL_FACETS.stl'
125           END SELECT
126     
127           IF(lEND < lSTART) THEN
128              WRITE(ERR_MSG,"('No FACETS to report: ',A)") trim(FNAME)
129              CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
130              RETURN
131           ENDIF
132     
133           OPEN(UNIT=444, FILE=trim(FNAME))
134     
135           WRITE(444,*) 'solid vcg'
136           DO LC = lSTART, lEND
137              WRITE(444,*) '   facet normal ', NORM_FACE(:,LC)
138              WRITE(444,*) '      outer loop'
139              WRITE(444,*) '         vertex ', VERTEX(1,1:3,LC)
140              WRITE(444,*) '         vertex ', VERTEX(2,1:3,LC)
141              WRITE(444,*) '         vertex ', VERTEX(3,1:3,LC)
142              WRITE(444,*) '      endloop'
143              WRITE(444,*) '   endfacet'
144           ENDDO
145           WRITE(444,*)'endsolid vcg'
146     
147           CLOSE(555)
148     
149           RETURN
150           END SUBROUTINE STL_DBG_WRITE_FACETS
151     
152     
153     
154     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
155     !                                                                      !
156     !  Subroutine: DEBUG_write_stl_from_grid_facet                         !
157     !  Author: Rahul Garg                                 Date: 24-Oct-13  !
158     !                                                                      !
159     !  Purpose:                                                            !
160     !                                                                      !
161     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
162           SUBROUTINE STL_DBG_WRITE_STL_FROM_DG(WRITE_EACH_CELL,STL_TYPE)
163     
164     ! DES grid loop bounds
165           use desgrid, only: DG_IJKSTART2, DG_IJKEND2
166     ! Max numer of STLs
167           use stl, only: DIM_STL
168     ! Facets binned to DES grid
169           use stl, only: FACETS_AT_DG
170     ! Facet normal and vertex data
171           use stl, only: NORM_FACE, VERTEX
172     ! Processor ID and total proc count
173           USE compar, only: myPE, numPEs
174     ! Start/End position of different STLs
175           use stl, only: STL_START, STL_END
176     ! STLs read from geometry files
177           use stl, only: BASE_STL
178     ! STLs for user specified walls (NSW, PSW, FSW)
179           use stl, only: BCWALLS_STL
180     ! STLs for impermeable surfaces
181           use stl, only: IMPRMBL_STL
182     ! STLs for default walls
183           use stl, only: DEFAULT_STL
184     ! All STLs
185           use stl, only: ALL_STL
186     ! Total number of STLs for DES
187           use stl, only: N_FACETS_DES
188     
189           IMPLICIT NONE
190     
191           LOGICAL, INTENT(IN), OPTIONAL :: WRITE_EACH_CELL
192           INTEGER, INTENT(IN), OPTIONAL :: STL_TYPE
193     
194           INTEGER :: IJK, LC1, LC2
195           INTEGER :: lSTART, lEND
196           CHARACTER(LEN=8) :: FID, IDX
197           LOGICAL :: EACH_CELL
198     
199           LOGICAL, ALLOCATABLE :: WRITE_FACET(:)
200     
201     ! Initialize flag.
202           EACH_CELL = .FALSE.
203           IF(present(WRITE_EACH_CELL)) EACH_CELL = WRITE_EACH_CELL
204     
205           ALLOCATE (WRITE_FACET(DIM_STL))
206           WRITE_FACET = .TRUE.
207     
208     
209           IF(present(STL_TYPE)) THEN
210              SELECT CASE(STL_TYPE)
211              CASE(BASE_STL)
212                 lSTART = STL_START(BASE_STL) 
213                 lEND=STL_END(BASE_STL)
214                 FID='BASE'
215              CASE(BCWALLS_STL)
216                 LSTART = STL_START(BCWALLS_STL) 
217                 LEND=STL_END(BCWALLS_STL)
218                 FID='BCWALLS'
219              CASE(IMPRMBL_STL)
220                 LSTART = STL_START(IMPRMBL_STL) 
221                 LEND=STL_END(IMPRMBL_STL)
222                 FID='IMPRMBL'
223              CASE(DEFAULT_STL)
224                 LSTART = STL_START(DEFAULT_STL) 
225                 LEND=STL_END(DEFAULT_STL)
226                 FID='DEFAULT'
227              CASE(ALL_STL)
228                 LSTART = 1
229                 LEND=N_FACETS_DES
230                 FID='ALL'
231              END SELECT
232           ELSE
233              LSTART = 1
234              LEND=N_FACETS_DES
235              FID='ALL'
236           ENDIF
237     
238           IF(numPEs == 1) THEN
239              OPEN(UNIT=444,FILE='DG_FACETS_'//trim(FID)//&
240                 '.stl', STATUS='UNKNOWN')
241           ELSE
242              WRITE(IDX,"(I8.8)") myPE
243              OPEN(UNIT=444,FILE='DG_FACETS_'//trim(FID)//&
244                 '_'//IDX//'.stl', STATUS='UNKNOWN')
245           ENDIF
246     
247           write(444,*)'solid vcg'
248           DO IJK=DG_IJKSTART2,DG_IJKEND2
249              IF(FACETS_AT_DG(IJK)%COUNT< 1) CYCLE
250     
251              IF(EACH_CELL) CALL WRITE_STLS_THIS_DG(IJK, STL_TYPE)
252     
253              DO LC1 = 1, FACETS_AT_DG(IJK)%COUNT
254                 LC2 = FACETS_AT_DG(IJK)%ID(LC1)
255     
256                 IF(LC2 < lSTART .OR. LC2 > lEND) &
257                    WRITE_FACET(LC2) = .FALSE.
258     
259                 IF(WRITE_FACET(LC2)) THEN
260                    write(444,*) '   facet normal ', NORM_FACE(:,LC2)
261                    write(444,*) '      outer loop'
262                    write(444,*) '         vertex ', VERTEX(1,:,LC2)
263                    write(444,*) '         vertex ', VERTEX(2,:,LC2)
264                    write(444,*) '         vertex ', VERTEX(3,:,LC2)
265                    write(444,*) '      endloop'
266                    write(444,*) '   endfacet'
267                    WRITE_FACET(LC2) = .FALSE.
268                 ENDIF
269              ENDDO
270           ENDDO
271           write(444,*)'endsolid vcg'
272     
273           close(444)
274     
275           DEALLOCATE (WRITE_FACET)
276     
277           RETURN
278           END SUBROUTINE STL_DBG_WRITE_STL_FROM_DG
279     
280     
281     
282     
283     !----------------------------------------------------------------------!
284     !                                                                      !
285     !                                                                      !
286     !                                                                      !
287     !----------------------------------------------------------------------!
288           SUBROUTINE WRITE_STLS_THIS_DG(DG, STL_TYPE)
289     
290     ! STL Vertices
291           use stl, only: VERTEX
292     ! STL Facet normals
293           use stl, only: NORM_FACE
294     ! Facets binned to DES grid
295           use stl, only: FACETS_AT_DG
296     ! Start/End position of different STLs
297           use stl, only: STL_START, STL_END
298     ! STLs read from geometry files
299           use stl, only: BASE_STL
300     ! STLs for user specified walls (NSW, PSW, FSW)
301           use stl, only: BCWALLS_STL
302     ! STLs for impermeable surfaces
303           use stl, only: IMPRMBL_STL
304     ! STLs for default walls
305           use stl, only: DEFAULT_STL
306     ! All STLs
307           use stl, only: ALL_STL
308     ! Total number of STLs for DES
309           use stl, only: N_FACETS_DES
310     
311     
312           IMPLICIT NONE
313     !-----------------------------------------------
314           INTEGER, INTENT(IN) :: DG
315           INTEGER, INTENT(IN), OPTIONAL :: STL_TYPE
316     
317           INTEGER :: ID, FACET, lCOUNT
318           INTEGER :: lSTART, lEND
319     
320           LOGICAL :: EXISTS
321           CHARACTER(LEN=8) :: IDX, FID
322     
323           IF(present(STL_TYPE)) THEN
324              SELECT CASE(STL_TYPE)
325              CASE(BASE_STL)
326                 lSTART = STL_START(BASE_STL) 
327                 lEND=STL_END(BASE_STL)
328                 FID='base'
329              CASE(BCWALLS_STL)
330                 lSTART = STL_START(BCWALLS_STL) 
331                 lEND=STL_END(BCWALLS_STL)
332                 FID='bcwalls'
333              CASE(IMPRMBL_STL)
334                 lSTART = STL_START(IMPRMBL_STL) 
335                 lEND=STL_END(IMPRMBL_STL)
336                 FID='imprmbl'
337              CASE(DEFAULT_STL)
338                 lSTART = STL_START(DEFAULT_STL) 
339                 lEND=STL_END(DEFAULT_STL)
340                 FID='default'
341              CASE(ALL_STL)
342                 lSTART = 1
343                 lEND=N_FACETS_DES
344                 FID='all'
345              END SELECT
346           ELSE
347              lSTART = 1
348              lEND=N_FACETS_DES
349              FID='all'
350           ENDIF
351     
352           lCOUNT = 0
353           DO FACET=1, FACETS_AT_DG(DG)%COUNT
354              ID = FACETS_AT_DG(DG)%ID(FACET)
355              IF(ID >= lSTART .AND. ID <= lEND) lCOUNT = lCOUNT+1
356           ENDDO
357     
358           IF(FACETS_AT_DG(DG)%COUNT < 1) RETURN
359     
360           write(idx,"(I8.8)") dg
361           open(unit=555,file='dg_'//idx//'_'//trim(FID)//&
362              '.stl',status='UNKNOWN')
363     
364           write(555,*) 'solid vcg'
365     
366           DO FACET=1, FACETS_AT_DG(DG)%COUNT
367     
368              ID = FACETS_AT_DG(DG)%ID(FACET)
369              IF(ID < lSTART .OR. ID > lEND) CYCLE 
370     
371              write(555,*) '   facet normal ', NORM_FACE(:,ID)
372              write(555,*) '      outer loop'
373              write(555,*) '         vertex ', VERTEX(1,1:3,ID)
374              write(555,*) '         vertex ', VERTEX(2,1:3,ID)
375              write(555,*) '         vertex ', VERTEX(3,1:3,ID)
376              write(555,*) '      endloop'
377              write(555,*) '   endfacet'
378           ENDDO
379           CLOSE(555)
380     
381           RETURN
382           END SUBROUTINE write_stls_this_dg
383     
384     
385     !----------------------------------------------------------------------!
386     !                                                                      !
387     !                                                                      !
388     !                                                                      !
389     !----------------------------------------------------------------------!
390           SUBROUTINE write_this_stl(this)
391     
392     
393     ! STL Vertices
394           use stl, only: VERTEX
395     ! STL Facet normals
396           use stl, only: NORM_FACE
397           use compar, only: myPE
398     
399           IMPLICIT NONE
400     !-----------------------------------------------
401           integer, intent(in) :: this
402     
403           logical :: EXISTS
404           character(len=4) :: IDX
405           character(len=4) :: IPE
406     
407     
408           write(idx,"(I4.4)") this
409           write(ipe,"(I4.4)") myPE
410           open(unit=555, file='idv_'//idx//'_'//IPE//'.stl',&
411              status='UNKNOWN')
412           write(555,*) 'solid vcg'
413           write(555,*) '   facet normal ', NORM_FACE(:,this)
414           write(555,*) '      outer loop'
415           write(555,*) '         vertex ', VERTEX(1,1:3,this)
416           write(555,*) '         vertex ', VERTEX(2,1:3,this)
417           write(555,*) '         vertex ', VERTEX(3,1:3,this)
418           write(555,*) '      endloop'
419           write(555,*) '   endfacet'
420           close(555)
421     
422     
423           RETURN
424           END SUBROUTINE write_this_stl
425     
426           END MODULE STL_DBG_DES
427     
428     
429