grid_unstructured.F90 coverage: 61.90 %func 44.00 %block
1) module Grid_Unstructured_module
2)
3) use Connection_module
4) use Grid_Unstructured_Aux_module
5) use Grid_Unstructured_Cell_module
6)
7) use PFLOTRAN_Constants_module
8)
9) implicit none
10)
11) private
12)
13) #include "petsc/finclude/petscsys.h"
14) #include "petsc/finclude/petscvec.h"
15) #include "petsc/finclude/petscvec.h90"
16) #include "petsc/finclude/petscis.h"
17) #include "petsc/finclude/petscis.h90"
18) #if defined(SCORPIO)
19) include "scorpiof.h"
20) #endif
21)
22) ! PetscInt, parameter :: HEX_TYPE = 1
23) ! PetscInt, parameter :: TET_TYPE = 2
24) ! PetscInt, parameter :: WEDGE_TYPE = 3
25) ! PetscInt, parameter :: PYR_TYPE = 4
26) ! PetscInt, parameter :: TRI_FACE_TYPE = 1
27) ! PetscInt, parameter :: QUAD_FACE_TYPE = 2
28) ! PetscInt, parameter :: MAX_VERT_PER_FACE = 4
29)
30) public :: UGridRead, &
31) #if defined(PETSC_HAVE_HDF5)
32) UGridReadHDF5, &
33) #endif
34) #if defined(SCORPIO)
35) UGridReadHDF5PIOLib, &
36) #endif
37) UGridReadSurfGrid, &
38) #if defined(PETSC_HAVE_HDF5)
39) UGridReadHDF5SurfGrid, &
40) #endif
41) UGridDecompose, &
42) UGridComputeInternConnect, &
43) UGridPopulateConnection, &
44) UGridComputeCoord, &
45) UGridComputeVolumes, &
46) UGridComputeAreas, &
47) UGridComputeQuality, &
48) UGridGetCellFromPoint, &
49) UGridGetCellsInRectangle, &
50) UGridEnsureRightHandRule, &
51) UGridMapSideSet, &
52) UGridGrowStencilSupport, &
53) UGridMapBoundFacesInPolVol
54)
55) contains
56)
57) ! ************************************************************************** !
58)
59) subroutine UGridRead(unstructured_grid,filename,option)
60) !
61) ! Reads an unstructured grid
62) !
63) ! Author: Glenn Hammond
64) ! Date: 09/30/09
65) !
66)
67) use Input_Aux_module
68) use Option_module
69) use String_module
70)
71) implicit none
72)
73) type(grid_unstructured_type) :: unstructured_grid
74) character(len=MAXSTRINGLENGTH) :: filename
75) type(option_type) :: option
76)
77) type(input_type), pointer :: input
78) character(len=MAXSTRINGLENGTH) :: string, hint
79) character(len=MAXWORDLENGTH) :: word
80) PetscInt :: num_cells_local_save
81) PetscInt :: num_cells_local
82) PetscInt :: num_vertices_local_save
83) PetscInt :: num_vertices_local
84) PetscInt :: num_to_read
85) PetscInt, allocatable :: temp_int_array(:,:)
86) PetscReal, allocatable :: temp_real_array(:,:)
87) PetscReal, allocatable :: vertex_coordinates(:,:)
88)
89) PetscInt :: icell, ivertex, idir, irank, num_vertices
90) PetscInt :: remainder
91) PetscErrorCode :: ierr
92) PetscMPIInt :: status_mpi(MPI_STATUS_SIZE)
93) PetscMPIInt :: int_mpi
94) PetscInt :: fileid
95)
96) fileid = 86
97) input => InputCreate(fileid,filename,option)
98)
99) ! initial guess is 8 vertices per cell
100) unstructured_grid%max_nvert_per_cell = 8
101)
102) ! Format of unstructured grid file
103) ! type: H=hexahedron, T=tetrahedron, W=wedge, P=pyramid
104) ! vertn(H) = 8
105) ! vertn(T) = 4
106) ! vertn(W) = 6
107) ! vertn(P) = 5
108) ! -----------------------------------------------------------------
109) ! num_cells num_vertices (integers)
110) ! type vert1 vert2 vert3 ... vertn ! for cell 1 (integers)
111) ! type vert1 vert2 vert3 ... vertn ! for cell 2
112) ! ...
113) ! ...
114) ! type vert1 vert2 vert3 ... vertn ! for cell num_cells
115) ! xcoord ycoord zcoord ! coordinates of vertex 1 (real)
116) ! xcoord ycoord zcoord ! coordinates of vertex 2 (real)
117) ! ...
118) ! xcoord ycoord zcoord ! coordinates of vertex num_vertices (real)
119) ! -----------------------------------------------------------------
120)
121) hint = 'Unstructured Grid'
122)
123) call InputReadPflotranString(input,option)
124) string = 'unstructured grid'
125) call InputReadStringErrorMsg(input,option,hint)
126)
127) ! read num_cells
128) call InputReadInt(input,option,unstructured_grid%nmax)
129) call InputErrorMsg(input,option,'number of cells',hint)
130) ! read num_vertices
131) call InputReadInt(input,option,unstructured_grid%num_vertices_global)
132) call InputErrorMsg(input,option,'number of vertices',hint)
133)
134) ! divide cells across ranks
135) num_cells_local = unstructured_grid%nmax/option%mycommsize
136) num_cells_local_save = num_cells_local
137) remainder = unstructured_grid%nmax - &
138) num_cells_local*option%mycommsize
139) if (option%myrank < remainder) num_cells_local = &
140) num_cells_local + 1
141)
142) ! allocate array to store vertices for each cell
143) allocate(unstructured_grid%cell_vertices(unstructured_grid%max_nvert_per_cell, &
144) num_cells_local))
145) unstructured_grid%cell_vertices = UNINITIALIZED_INTEGER
146)
147) ! for now, read all cells from ASCII file through io_rank and communicate
148) ! to other ranks
149) if (option%myrank == option%io_rank) then
150) allocate(temp_int_array(unstructured_grid%max_nvert_per_cell, &
151) num_cells_local_save+1))
152) ! read for other processors
153) do irank = 0, option%mycommsize-1
154) temp_int_array = UNINITIALIZED_INTEGER
155) num_to_read = num_cells_local_save
156) if (irank < remainder) num_to_read = num_to_read + 1
157) do icell = 1, num_to_read
158) ! read in the vertices defining the grid cell
159) call InputReadPflotranString(input,option)
160) call InputReadStringErrorMsg(input,option,hint)
161) call InputReadWord(input,option,word,PETSC_TRUE)
162) call InputErrorMsg(input,option,'element type',hint)
163) call StringToUpper(word)
164) select case(word)
165) case('H')
166) num_vertices = 8
167) case('W')
168) num_vertices = 6
169) case('P')
170) num_vertices = 5
171) case('T')
172) num_vertices = 4
173) case('Q')
174) num_vertices = 4
175) end select
176) do ivertex = 1, num_vertices
177) call InputReadInt(input,option,temp_int_array(ivertex,icell))
178) call InputErrorMsg(input,option,'vertex id',hint)
179) enddo
180) enddo
181)
182) ! if the cells reside on io_rank
183) if (irank == option%io_rank) then
184) #if UGRID_DEBUG
185) write(string,*) num_cells_local
186) string = trim(adjustl(string)) // ' cells stored on p0'
187) print *, trim(string)
188) #endif
189) unstructured_grid%cell_vertices(:,1:num_cells_local) = &
190) temp_int_array(:,1:num_cells_local)
191) else
192) ! otherwise communicate to other ranks
193) #if UGRID_DEBUG
194) write(string,*) num_to_read
195) write(word,*) irank
196) string = trim(adjustl(string)) // ' cells sent from p0 to p' // &
197) trim(adjustl(word))
198) print *, trim(string)
199) #endif
200) int_mpi = num_to_read*unstructured_grid%max_nvert_per_cell
201) call MPI_Send(temp_int_array,int_mpi,MPIU_INTEGER,irank, &
202) num_to_read,option%mycomm,ierr)
203) endif
204) enddo
205) deallocate(temp_int_array)
206) else
207) ! other ranks post the recv
208) #if UGRID_DEBUG
209) write(string,*) num_cells_local
210) write(word,*) option%myrank
211) string = trim(adjustl(string)) // ' cells received from p0 at p' // &
212) trim(adjustl(word))
213) print *, trim(string)
214) #endif
215) int_mpi = num_cells_local*unstructured_grid%max_nvert_per_cell
216) call MPI_Recv(unstructured_grid%cell_vertices,int_mpi, &
217) MPIU_INTEGER,option%io_rank, &
218) MPI_ANY_TAG,option%mycomm,status_mpi,ierr)
219) endif
220)
221)
222) ! divide vertices across ranks
223) num_vertices_local = unstructured_grid%num_vertices_global/ &
224) option%mycommsize
225) num_vertices_local_save = num_vertices_local
226) remainder = unstructured_grid%num_vertices_global - &
227) num_vertices_local*option%mycommsize
228) if (option%myrank < remainder) num_vertices_local = &
229) num_vertices_local + 1
230)
231) allocate(vertex_coordinates(3,num_vertices_local))
232) vertex_coordinates = 0.d0
233)
234) ! just like above, but this time for vertex coordinates
235) if (option%myrank == option%io_rank) then
236) allocate(temp_real_array(3,num_vertices_local_save+1))
237) ! read for other processors
238) do irank = 0, option%mycommsize-1
239) num_to_read = num_vertices_local_save
240) if (irank < remainder) num_to_read = num_to_read + 1
241) do ivertex = 1, num_to_read
242) call InputReadPflotranString(input,option)
243) call InputReadStringErrorMsg(input,option,hint)
244) do idir = 1, 3
245) call InputReadDouble(input,option,temp_real_array(idir,ivertex))
246) call InputErrorMsg(input,option,'vertex coordinate',hint)
247) enddo
248) enddo
249)
250) if (irank == option%io_rank) then
251) vertex_coordinates(:,1:num_vertices_local) = &
252) temp_real_array(:,1:num_vertices_local)
253) else
254) int_mpi = num_to_read*3
255) call MPI_Send(temp_real_array,int_mpi,MPI_DOUBLE_PRECISION,irank, &
256) num_to_read,option%mycomm,ierr)
257) endif
258) enddo
259) deallocate(temp_real_array)
260) else
261) int_mpi = num_vertices_local*3
262) call MPI_Recv(vertex_coordinates, &
263) int_mpi, &
264) MPI_DOUBLE_PRECISION,option%io_rank, &
265) MPI_ANY_TAG,option%mycomm,status_mpi,ierr)
266) endif
267)
268) ! fill the vertices data structure
269) allocate(unstructured_grid%vertices(num_vertices_local))
270) do ivertex = 1, num_vertices_local
271) unstructured_grid%vertices(ivertex)%id = 0
272) unstructured_grid%vertices(ivertex)%x = vertex_coordinates(1,ivertex)
273) unstructured_grid%vertices(ivertex)%y = vertex_coordinates(2,ivertex)
274) unstructured_grid%vertices(ivertex)%z = vertex_coordinates(3,ivertex)
275) enddo
276) deallocate(vertex_coordinates)
277)
278) unstructured_grid%nlmax = num_cells_local
279) unstructured_grid%num_vertices_local = num_vertices_local
280)
281) call InputDestroy(input)
282)
283) end subroutine UGridRead
284)
285) ! ************************************************************************** !
286)
287) subroutine UGridReadSurfGrid(unstructured_grid,filename,surf_filename,option)
288) !
289) ! UGridRead: Reads an unstructured grid
290) !
291) ! Author: Gautam Bisht
292) ! Date: 01/09/2012
293) !
294)
295) use Input_Aux_module
296) use Option_module
297) use String_module
298)
299) implicit none
300)
301) type(grid_unstructured_type) :: unstructured_grid
302) character(len=MAXSTRINGLENGTH) :: filename
303) character(len=MAXSTRINGLENGTH) :: surf_filename
304) type(option_type) :: option
305)
306) type(input_type), pointer :: input
307) character(len=MAXSTRINGLENGTH) :: string, hint
308) character(len=MAXWORDLENGTH) :: word
309) PetscInt :: num_cells_local_save
310) PetscInt :: num_cells_local
311) PetscInt :: num_vertices_local_save
312) PetscInt :: num_vertices_local
313) PetscInt :: num_to_read
314) PetscInt, allocatable :: temp_int_array(:,:)
315) PetscReal, allocatable :: temp_real_array(:,:)
316) PetscReal, allocatable :: vertex_coordinates(:,:)
317)
318) PetscInt :: icell, ivertex, idir, irank, num_vertices
319) PetscInt :: remainder
320) PetscErrorCode :: ierr
321) PetscMPIInt :: status_mpi(MPI_STATUS_SIZE)
322) PetscMPIInt :: int_mpi
323) PetscInt :: fileid
324)
325) fileid = 86
326) input => InputCreate(fileid,filename,option)
327)
328) ! initial guess is 8 vertices per cell
329) unstructured_grid%max_nvert_per_cell = 8
330)
331) ! Format of unstructured grid file
332) ! type: H=hexahedron, T=tetrahedron, W=wedge, P=pyramid
333) ! vertn(H) = 8
334) ! vertn(T) = 4
335) ! vertn(W) = 6
336) ! vertn(P) = 5
337) ! -----------------------------------------------------------------
338) ! num_cells num_vertices (integers)
339) ! type vert1 vert2 vert3 ... vertn ! for cell 1 (integers)
340) ! type vert1 vert2 vert3 ... vertn ! for cell 2
341) ! ...
342) ! ...
343) ! type vert1 vert2 vert3 ... vertn ! for cell num_cells
344) ! xcoord ycoord zcoord ! coordinates of vertex 1 (real)
345) ! xcoord ycoord zcoord ! coordinates of vertex 2 (real)
346) ! ...
347) ! xcoord ycoord zcoord ! coordinates of vertex num_vertices (real)
348) ! -----------------------------------------------------------------
349)
350) hint = 'Unstructured Grid'
351)
352) call InputReadPflotranString(input,option)
353) string = 'unstructured grid'
354) call InputReadStringErrorMsg(input,option,hint)
355)
356) ! read num_cells
357) call InputReadInt(input,option,unstructured_grid%nmax)
358) call InputErrorMsg(input,option,'number of cells',hint)
359) ! read num_vertices
360) call InputReadInt(input,option,unstructured_grid%num_vertices_global)
361) call InputErrorMsg(input,option,'number of vertices',hint)
362)
363) ! divide cells across ranks
364) !num_cells_local = unstructured_grid%nmax/option%mycommsize
365) !num_cells_local_save = num_cells_local
366) !remainder = unstructured_grid%nmax - &
367) ! num_cells_local*option%mycommsize
368) !if (option%myrank < remainder) num_cells_local = &
369) ! num_cells_local + 1
370)
371) ! allocate array to store vertices for each cell
372) !allocate(unstructured_grid%cell_vertices(unstructured_grid%max_nvert_per_cell, &
373) ! num_cells_local))
374) !unstructured_grid%cell_vertices = UNINITIALIZED_INTEGER
375)
376) ! for now, read all cells from ASCII file through io_rank and communicate
377) ! to other ranks
378) if (option%myrank == option%io_rank) then
379) allocate(temp_int_array(unstructured_grid%max_nvert_per_cell, &
380) unstructured_grid%nmax))
381) ! read for other processors
382) temp_int_array = UNINITIALIZED_INTEGER
383) num_to_read = unstructured_grid%nmax
384) do icell = 1, num_to_read
385) ! read in the vertices defining the grid cell
386) call InputReadPflotranString(input,option)
387) call InputReadStringErrorMsg(input,option,hint)
388) call InputReadWord(input,option,word,PETSC_TRUE)
389) call InputErrorMsg(input,option,'element type',hint)
390) call StringToUpper(word)
391) select case(word)
392) case('H')
393) num_vertices = 8
394) case('W')
395) num_vertices = 6
396) case('P')
397) num_vertices = 5
398) case('T')
399) num_vertices = 4
400) case('Q')
401) num_vertices = 4
402) end select
403) do ivertex = 1, num_vertices
404) call InputReadInt(input,option,temp_int_array(ivertex,icell))
405) call InputErrorMsg(input,option,'vertex id',hint)
406) enddo
407) enddo
408) endif
409)
410)
411) ! divide vertices across ranks
412) num_vertices_local = unstructured_grid%num_vertices_global/ &
413) option%mycommsize
414) num_vertices_local_save = num_vertices_local
415) remainder = unstructured_grid%num_vertices_global - &
416) num_vertices_local*option%mycommsize
417) if (option%myrank < remainder) num_vertices_local = &
418) num_vertices_local + 1
419)
420) allocate(vertex_coordinates(3,num_vertices_local))
421) vertex_coordinates = 0.d0
422)
423) ! just like above, but this time for vertex coordinates
424) if (option%myrank == option%io_rank) then
425) allocate(temp_real_array(3,num_vertices_local_save+1))
426) ! read for other processors
427) do irank = 0, option%mycommsize-1
428) num_to_read = num_vertices_local_save
429) if (irank < remainder) num_to_read = num_to_read + 1
430) do ivertex = 1, num_to_read
431) call InputReadPflotranString(input,option)
432) call InputReadStringErrorMsg(input,option,hint)
433) do idir = 1, 3
434) call InputReadDouble(input,option,temp_real_array(idir,ivertex))
435) call InputErrorMsg(input,option,'vertex coordinate',hint)
436) enddo
437) enddo
438)
439) if (irank == option%io_rank) then
440) vertex_coordinates(:,1:num_vertices_local) = &
441) temp_real_array(:,1:num_vertices_local)
442) else
443) int_mpi = num_to_read*3
444) call MPI_Send(temp_real_array,int_mpi,MPI_DOUBLE_PRECISION,irank, &
445) num_to_read,option%mycomm,ierr)
446) endif
447) enddo
448) deallocate(temp_real_array)
449) else
450) int_mpi = num_vertices_local*3
451) call MPI_Recv(vertex_coordinates, &
452) int_mpi, &
453) MPI_DOUBLE_PRECISION,option%io_rank, &
454) MPI_ANY_TAG,option%mycomm,status_mpi,ierr)
455) endif
456)
457) ! fill the vertices data structure
458) allocate(unstructured_grid%vertices(num_vertices_local))
459) do ivertex = 1, num_vertices_local
460) unstructured_grid%vertices(ivertex)%id = 0
461) unstructured_grid%vertices(ivertex)%x = vertex_coordinates(1,ivertex)
462) unstructured_grid%vertices(ivertex)%y = vertex_coordinates(2,ivertex)
463) unstructured_grid%vertices(ivertex)%z = vertex_coordinates(3,ivertex)
464) enddo
465) deallocate(vertex_coordinates)
466)
467) !unstructured_grid%nlmax = num_cells_local
468) unstructured_grid%num_vertices_local = num_vertices_local
469)
470) call InputDestroy(input)
471) if (option%myrank == option%io_rank) deallocate(temp_int_array)
472)
473)
474) input => InputCreate(fileid,surf_filename,option)
475) call InputReadPflotranString(input,option)
476) string = 'unstructured sideset'
477) call InputReadStringErrorMsg(input,option,hint)
478)
479) ! read num_cells
480) call InputReadInt(input,option,unstructured_grid%nmax)
481) call InputErrorMsg(input,option,'number of cells',hint)
482)
483) ! divide cells across ranks
484) num_cells_local = unstructured_grid%nmax/option%mycommsize
485) num_cells_local_save = num_cells_local
486) remainder = unstructured_grid%nmax - &
487) num_cells_local*option%mycommsize
488) if (option%myrank < remainder) num_cells_local = &
489) num_cells_local + 1
490)
491) ! allocate array to store vertices for each faces
492) allocate(unstructured_grid%cell_vertices(unstructured_grid%max_nvert_per_cell, &
493) num_cells_local))
494) unstructured_grid%cell_vertices = UNINITIALIZED_INTEGER
495)
496) ! for now, read all faces from ASCII file through io_rank and communicate
497) ! to other ranks
498) if (option%myrank == option%io_rank) then
499) allocate(temp_int_array(unstructured_grid%max_nvert_per_cell, &
500) num_cells_local_save+1))
501) ! read for other processors
502) do irank = 0, option%mycommsize-1
503) temp_int_array = UNINITIALIZED_INTEGER
504) num_to_read = num_cells_local_save
505) if (irank < remainder) num_to_read = num_to_read + 1
506)
507) do icell = 1, num_to_read
508) ! read in the vertices defining the cell face
509) call InputReadPflotranString(input,option)
510) call InputReadStringErrorMsg(input,option,hint)
511) call InputReadWord(input,option,word,PETSC_TRUE)
512) call InputErrorMsg(input,option,'element type',hint)
513) call StringToUpper(word)
514) select case(word)
515) case('Q')
516) num_vertices = 4
517) case('T')
518) num_vertices = 3
519) end select
520) do ivertex = 1, num_vertices
521) call InputReadInt(input,option,temp_int_array(ivertex,icell))
522) call InputErrorMsg(input,option,'vertex id',hint)
523) enddo
524) enddo
525)
526) ! if the faces reside on io_rank
527) if (irank == option%io_rank) then
528) #if UGRID_DEBUG
529) write(string,*) num_cells_local
530) string = trim(adjustl(string)) // ' cells stored on p0'
531) print *, trim(string)
532) #endif
533) unstructured_grid%cell_vertices(:,1:num_cells_local) = &
534) temp_int_array(:,1:num_cells_local)
535) else
536) ! otherwise communicate to other ranks
537) #if UGRID_DEBUG
538) write(string,*) num_to_read
539) write(word,*) irank
540) string = trim(adjustl(string)) // ' cells sent from p0 to p' // &
541) trim(adjustl(word))
542) print *, trim(string)
543) #endif
544) int_mpi = num_to_read*unstructured_grid%max_nvert_per_cell
545) call MPI_Send(temp_int_array,int_mpi,MPIU_INTEGER,irank, &
546) num_to_read,option%mycomm,ierr)
547) endif
548) enddo
549) deallocate(temp_int_array)
550) else
551) ! other ranks post the recv
552) #if UGRID_DEBUG
553) write(string,*) num_cells_local
554) write(word,*) option%myrank
555) string = trim(adjustl(string)) // ' cells received from p0 at p' // &
556) trim(adjustl(word))
557) print *, trim(string)
558) #endif
559) int_mpi = num_cells_local*unstructured_grid%max_nvert_per_cell
560) call MPI_Recv(unstructured_grid%cell_vertices,int_mpi, &
561) MPIU_INTEGER,option%io_rank, &
562) MPI_ANY_TAG,option%mycomm,status_mpi,ierr)
563) endif
564)
565) unstructured_grid%nlmax = num_cells_local
566)
567) call InputDestroy(input)
568)
569) end subroutine UGridReadSurfGrid
570)
571) #if defined(PETSC_HAVE_HDF5)
572)
573) ! ************************************************************************** !
574)
575) subroutine UGridReadHDF5SurfGrid(unstructured_grid,filename,option)
576) !
577) ! This routine reads unstructured grid from HDF5 for surface mesh.
578) !
579) ! Author: Gautam Bisht, ORNL
580) ! Date: 06/01/12
581) !
582)
583) #if defined(PETSC_HAVE_HDF5)
584) use hdf5
585) #endif
586)
587) ! 64-bit stuff
588) #ifdef PETSC_USE_64BIT_INDICES
589) #define HDF_NATIVE_INTEGER H5T_NATIVE_INTEGER
590) #else
591) #define HDF_NATIVE_INTEGER H5T_NATIVE_INTEGER
592) #endif
593)
594) use Input_Aux_module
595) use Option_module
596) use HDF5_Aux_module
597)
598) implicit none
599)
600) type(grid_unstructured_type) :: unstructured_grid
601) type(option_type) :: option
602) character(len=MAXSTRINGLENGTH) :: filename
603) character(len=MAXSTRINGLENGTH) :: group_name
604) character(len=MAXSTRINGLENGTH) :: dataset_name
605)
606) PetscMPIInt :: hdf5_err
607) PetscMPIInt :: rank_mpi
608) PetscInt :: istart, iend, ii, jj
609) PetscInt :: num_cells_local
610) PetscInt :: num_cells_local_save
611) PetscInt :: num_vertices_local
612) PetscInt :: num_vertices_local_save
613) PetscInt :: remainder
614) PetscInt, pointer :: int_buffer(:,:)
615) PetscReal, pointer :: double_buffer(:,:)
616) PetscInt, parameter :: max_nvert_per_cell = 8
617) PetscErrorCode :: ierr
618)
619) #if defined(PETSC_HAVE_HDF5)
620) integer(HID_T) :: file_id
621) integer(HID_T) :: ndims
622) integer(HID_T) :: grp_id, grp_id2
623) integer(HID_T) :: prop_id
624) integer(HID_T) :: data_set_id
625) integer(HID_T) :: file_space_id
626) integer(HID_T) :: data_space_id
627) integer(HID_T) :: memory_space_id
628) integer(HSIZE_T) :: num_data_in_file
629) integer(HSIZE_T), allocatable :: dims_h5(:), max_dims_h5(:)
630) integer(HSIZE_T) :: offset(2), length(2), stride(2), block(2), dims(2)
631) #endif
632)
633) ! Initialize FORTRAN predefined datatypes
634) call h5open_f(hdf5_err)
635)
636) ! Setup file access property with parallel I/O access
637) call h5pcreate_f(H5P_FILE_ACCESS_F, prop_id, hdf5_err)
638)
639) #ifndef SERIAL_HDF5
640) call h5pset_fapl_mpio_f(prop_id,option%mycomm, MPI_INFO_NULL, hdf5_err)
641) #endif
642)
643) ! Open the file collectively
644) call HDF5OpenFileReadOnly(filename,file_id,prop_id,option)
645) call h5pclose_f(prop_id, hdf5_err)
646)
647) !
648) ! Regions/top
649) !
650)
651) ! Open group
652) group_name = "/Regions/top/Vertex Ids"
653) option%io_buffer = 'Opening group: ' // trim(group_name)
654) call printMsg(option)
655)
656) ! Open dataset
657) call h5dopen_f(file_id, "/Regions/top/Vertex Ids", data_set_id, hdf5_err)
658)
659) ! Get dataset's dataspace
660) call h5dget_space_f(data_set_id, data_space_id, hdf5_err)
661)
662) ! Get number of dimensions and check
663) call h5sget_simple_extent_ndims_f(data_space_id, ndims, hdf5_err)
664) if (ndims /= 2) then
665) option%io_buffer='Dimension of Domain/Cells dataset in ' // trim(filename) // &
666) ' is not equal to 2.'
667) call printErrMsg(option)
668) endif
669)
670) ! Allocate memory
671) allocate(dims_h5(ndims))
672) allocate(max_dims_h5(ndims))
673)
674) ! Get dimensions of dataset
675) call h5sget_simple_extent_dims_f(data_space_id, dims_h5, max_dims_h5, &
676) hdf5_err)
677)
678) ! Determine the number of cells each that will be saved on each processor
679) unstructured_grid%nmax = INT(dims_h5(2))
680) num_cells_local = unstructured_grid%nmax/option%mycommsize
681) num_cells_local_save = num_cells_local
682) remainder = unstructured_grid%nmax - &
683) num_cells_local*option%mycommsize
684) if (option%myrank < remainder) num_cells_local = &
685) num_cells_local + 1
686)
687) ! Find istart and iend
688) istart = 0
689) iend = 0
690) call MPI_Exscan(num_cells_local, istart, ONE_INTEGER_MPI, &
691) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
692) call MPI_Scan(num_cells_local, iend, ONE_INTEGER_MPI, &
693) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
694)
695) ! Determine the length and offset of data to be read by each processor
696) length(1) = INT(dims_h5(1))
697) length(2) = iend-istart
698) offset(1) = 0
699) offset(2) = istart
700)
701) !
702) rank_mpi = 2
703) memory_space_id = -1
704)
705) ! Create data space for dataset
706) call h5screate_simple_f(rank_mpi, length, memory_space_id, hdf5_err)
707)
708) ! Select hyperslab
709) call h5dget_space_f(data_set_id, data_space_id, hdf5_err)
710) call h5sselect_hyperslab_f(data_space_id, H5S_SELECT_SET_F, offset, length, &
711) hdf5_err)
712)
713) ! Initialize data buffer
714) allocate(int_buffer(length(1), length(2)))
715)
716) ! Create property list
717) call h5pcreate_f(H5P_DATASET_XFER_F, prop_id, hdf5_err)
718) #ifndef SERIAL_HDF5
719) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err)
720) #endif
721)
722) ! Read the dataset collectively
723) call h5dread_f(data_set_id, H5T_NATIVE_INTEGER, int_buffer, &
724) dims_h5, hdf5_err, memory_space_id, data_space_id)
725)
726) ! allocate array to store vertices for each cell
727) allocate(unstructured_grid%cell_vertices(max_nvert_per_cell, &
728) num_cells_local))
729) unstructured_grid%cell_vertices = -1
730)
731) do ii = 1, num_cells_local
732) do jj = 1, INT(dims_h5(1))
733) if (int_buffer(jj, ii) > 0) then
734) unstructured_grid%cell_vertices(jj, ii) = int_buffer(jj, ii)
735) end if
736) enddo
737) enddo
738)
739) call h5dclose_f(data_set_id, hdf5_err)
740)
741) deallocate(int_buffer)
742) nullify(int_buffer)
743) deallocate(dims_h5)
744) deallocate(max_dims_h5)
745)
746) !
747) ! Domain/Vertices
748) !
749)
750) ! Open dataset
751) call h5dopen_f(file_id, "Domain/Vertices", data_set_id, hdf5_err)
752)
753) ! Get dataset's dataspace
754) call h5dget_space_f(data_set_id, data_space_id, hdf5_err)
755)
756) ! Get number of dimensions and check
757) call h5sget_simple_extent_ndims_f(data_space_id, ndims, hdf5_err)
758) if (ndims /= 2) then
759) option%io_buffer='Dimension of Domain/Vertices dataset in ' // trim(filename) // &
760) ' is not equal to 2.'
761) call printErrMsg(option)
762) endif
763)
764) ! Allocate memory
765) allocate(dims_h5(ndims))
766) allocate(max_dims_h5(ndims))
767)
768) ! Get dimensions of dataset
769) call h5sget_simple_extent_dims_f(data_space_id, dims_h5, max_dims_h5, &
770) hdf5_err)
771)
772) ! Determine the number of cells each that will be saved on each processor
773) unstructured_grid%num_vertices_global = INT(dims_h5(2))
774) num_vertices_local = &
775) unstructured_grid%num_vertices_global/ &
776) option%mycommsize
777) num_cells_local_save = num_vertices_local
778) remainder = unstructured_grid%num_vertices_global - &
779) num_vertices_local*option%mycommsize
780) if (option%myrank < remainder) num_vertices_local = &
781) num_vertices_local + 1
782)
783) ! Find istart and iend
784) istart = 0
785) iend = 0
786) call MPI_Exscan(num_vertices_local, istart, ONE_INTEGER_MPI, &
787) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
788) call MPI_Scan(num_vertices_local, iend, ONE_INTEGER_MPI, &
789) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
790)
791) ! Determine the length and offset of data to be read by each processor
792) length(1) = dims_h5(1)
793) length(2) = iend-istart
794) offset(1) = 0
795) offset(2) = istart
796)
797) !
798) rank_mpi = 2
799) memory_space_id = -1
800)
801) ! Create data space for dataset
802) call h5screate_simple_f(rank_mpi, length, memory_space_id, hdf5_err)
803)
804) ! Select hyperslab
805) call h5dget_space_f(data_set_id, data_space_id, hdf5_err)
806) call h5sselect_hyperslab_f(data_space_id, H5S_SELECT_SET_F, offset, length, &
807) hdf5_err)
808)
809) ! Initialize data buffer
810) allocate(double_buffer(length(1), length(2)))
811)
812) ! Create property list
813) call h5pcreate_f(H5P_DATASET_XFER_F, prop_id, hdf5_err)
814) #ifndef SERIAL_HDF5
815) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err)
816) #endif
817)
818) ! Read the dataset collectively
819) call h5dread_f(data_set_id, H5T_NATIVE_DOUBLE, double_buffer, &
820) dims_h5, hdf5_err, memory_space_id, data_space_id)
821)
822) call h5dclose_f(data_set_id, hdf5_err)
823) !call h5gclose_f(grp_id, hdf5_err)
824) call h5fclose_f(file_id, hdf5_err)
825) call h5close_f(hdf5_err)
826)
827)
828) ! fill the vertices data structure
829) allocate(unstructured_grid%vertices(num_vertices_local))
830) do ii = 1, num_vertices_local
831) unstructured_grid%vertices(ii)%id = 0
832) unstructured_grid%vertices(ii)%x = double_buffer(1, ii)
833) unstructured_grid%vertices(ii)%y = double_buffer(2, ii)
834) unstructured_grid%vertices(ii)%z = double_buffer(3, ii)
835) enddo
836)
837)
838) deallocate(double_buffer)
839) nullify(double_buffer)
840) deallocate(dims_h5)
841) deallocate(max_dims_h5)
842)
843) unstructured_grid%max_nvert_per_cell = max_nvert_per_cell
844) unstructured_grid%nlmax = num_cells_local
845) unstructured_grid%num_vertices_local = num_vertices_local
846)
847) end subroutine UGridReadHDF5SurfGrid
848)
849) #endif
850) ! End PETSC_HAVE_HDF5
851)
852) #if defined(PETSC_HAVE_HDF5)
853)
854) ! ************************************************************************** !
855)
856) subroutine UGridReadHDF5(unstructured_grid,filename,option)
857) !
858) ! Reads an unstructured grid from HDF5
859) !
860) ! Author: Gautam Bisht
861) ! Date: 04/25/11
862) !
863)
864) #if defined(PETSC_HAVE_HDF5)
865) use hdf5
866) #endif
867)
868) ! 64-bit stuff
869) #ifdef PETSC_USE_64BIT_INDICES
870) #define HDF_NATIVE_INTEGER H5T_NATIVE_INTEGER
871) #else
872) #define HDF_NATIVE_INTEGER H5T_NATIVE_INTEGER
873) #endif
874)
875) use Input_Aux_module
876) use Option_module
877) use HDF5_Aux_module
878)
879) implicit none
880)
881) type(grid_unstructured_type) :: unstructured_grid
882) character(len=MAXSTRINGLENGTH) :: filename
883) type(option_type) :: option
884)
885) character(len=MAXSTRINGLENGTH) :: group_name
886) character(len=MAXSTRINGLENGTH) :: dataset_name
887) character(len=MAXSTRINGLENGTH) :: string
888) PetscMPIInt :: hdf5_err
889) PetscMPIInt :: rank_mpi
890) PetscInt :: istart, iend, ii, jj
891) PetscInt :: num_cells_local
892) PetscInt :: num_cells_local_save
893) PetscInt :: num_vertices_local
894) PetscInt :: num_vertices_local_save
895) PetscInt :: remainder
896) PetscInt, pointer :: int_buffer(:,:)
897) PetscReal, pointer :: double_buffer(:,:)
898) PetscInt, parameter :: max_nvert_per_cell = 8
899) PetscInt :: error_count
900) PetscErrorCode :: ierr
901)
902) #if defined(PETSC_HAVE_HDF5)
903) integer(HID_T) :: file_id
904) integer(HID_T) :: ndims
905) integer(HID_T) :: grp_id, grp_id2
906) integer(HID_T) :: prop_id
907) integer(HID_T) :: data_set_id
908) integer(HID_T) :: file_space_id
909) integer(HID_T) :: data_space_id
910) integer(HID_T) :: memory_space_id
911) integer(HSIZE_T) :: num_data_in_file
912) integer(HSIZE_T), allocatable :: dims_h5(:), max_dims_h5(:)
913) integer(HSIZE_T) :: offset(2), length(2), stride(2), block(2), dims(2)
914) #endif
915)
916) ! Initialize FORTRAN predefined datatypes
917) call h5open_f(hdf5_err)
918)
919) ! Setup file access property with parallel I/O access
920) call h5pcreate_f(H5P_FILE_ACCESS_F, prop_id, hdf5_err)
921)
922) #ifndef SERIAL_HDF5
923) call h5pset_fapl_mpio_f(prop_id,option%mycomm, MPI_INFO_NULL, hdf5_err)
924) #endif
925)
926) ! Open the file collectively
927) call HDF5OpenFileReadOnly(filename,file_id,prop_id,option)
928) call h5pclose_f(prop_id, hdf5_err)
929)
930) !
931) ! Domain/Cells
932) !
933)
934) ! Open group
935) group_name = "Domain"
936) option%io_buffer = 'Opening group: ' // trim(group_name)
937) call printMsg(option)
938)
939) ! Open dataset
940) call h5dopen_f(file_id, "Domain/Cells", data_set_id, hdf5_err)
941)
942) ! Get dataset's dataspace
943) call h5dget_space_f(data_set_id, data_space_id, hdf5_err)
944)
945) ! Get number of dimensions and check
946) call h5sget_simple_extent_ndims_f(data_space_id, ndims, hdf5_err)
947) if (ndims /= 2) then
948) option%io_buffer='Dimension of Domain/Cells dataset in ' // trim(filename) // &
949) ' is not equal to 2.'
950) call printErrMsg(option)
951) endif
952)
953) ! Allocate memory
954) allocate(dims_h5(ndims))
955) allocate(max_dims_h5(ndims))
956)
957) ! Get dimensions of dataset
958) call h5sget_simple_extent_dims_f(data_space_id, dims_h5, max_dims_h5, &
959) hdf5_err)
960)
961) ! Determine the number of cells each that will be saved on each processor
962) unstructured_grid%nmax = INT(dims_h5(2))
963) num_cells_local = unstructured_grid%nmax/option%mycommsize
964) num_cells_local_save = num_cells_local
965) remainder = unstructured_grid%nmax - &
966) num_cells_local*option%mycommsize
967) if (option%myrank < remainder) num_cells_local = &
968) num_cells_local + 1
969)
970) ! Find istart and iend
971) istart = 0
972) iend = 0
973) call MPI_Exscan(num_cells_local, istart, ONE_INTEGER_MPI, &
974) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
975) call MPI_Scan(num_cells_local, iend, ONE_INTEGER_MPI, &
976) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
977)
978) ! Determine the length and offset of data to be read by each processor
979) length(1) = dims_h5(1)
980) length(2) = iend-istart
981) offset(1) = 0
982) offset(2) = istart
983)
984) !
985) rank_mpi = 2
986) memory_space_id = -1
987)
988) ! Create data space for dataset
989) call h5screate_simple_f(rank_mpi, length, memory_space_id, hdf5_err)
990)
991) ! Select hyperslab
992) call h5dget_space_f(data_set_id, data_space_id, hdf5_err)
993) call h5sselect_hyperslab_f(data_space_id, H5S_SELECT_SET_F, offset, length, &
994) hdf5_err)
995)
996) ! Initialize data buffer
997) allocate(int_buffer(length(1), length(2)))
998) int_buffer = UNINITIALIZED_INTEGER
999)
1000) ! Create property list
1001) call h5pcreate_f(H5P_DATASET_XFER_F, prop_id, hdf5_err)
1002) #ifndef SERIAL_HDF5
1003) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err)
1004) #endif
1005)
1006) ! Read the dataset collectively
1007) call h5dread_f(data_set_id, H5T_NATIVE_INTEGER, int_buffer, &
1008) dims_h5, hdf5_err, memory_space_id, data_space_id)
1009)
1010) ! allocate array to store vertices for each cell
1011) allocate(unstructured_grid%cell_vertices(max_nvert_per_cell, &
1012) num_cells_local))
1013) unstructured_grid%cell_vertices = -1
1014)
1015) ! check for incorrectly assigned cell types
1016) error_count = 0
1017) do ii = 1, num_cells_local
1018) select case(int_buffer(1,ii))
1019) case(4,5,6,8)
1020) case default
1021) write(string,*) int_buffer(1,ii)
1022) option%io_buffer = 'Unknown cell type : ' // trim(adjustl(string))
1023) error_count = error_count + 1
1024) if (error_count < 10) then
1025) call printMsgByRank(option)
1026) endif
1027) end select
1028) enddo
1029) call MPI_Allreduce(MPI_IN_PLACE,error_count,ONE_INTEGER_MPI,MPI_INTEGER, &
1030) MPI_MAX,option%mycomm,ierr)
1031) if (error_count > 0) then
1032) option%io_buffer = 'Unknown cell types in ' // trim(filename) // '.'
1033) call printErrMsg(option)
1034) endif
1035)
1036) do ii = 1, num_cells_local
1037) do jj = 2, int_buffer(1,ii) + 1
1038) unstructured_grid%cell_vertices(jj-1, ii) = int_buffer(jj, ii)
1039) enddo
1040) enddo
1041)
1042) call h5dclose_f(data_set_id, hdf5_err)
1043)
1044) deallocate(int_buffer)
1045) nullify(int_buffer)
1046) deallocate(dims_h5)
1047) deallocate(max_dims_h5)
1048)
1049) !
1050) ! Domain/Vertices
1051) !
1052)
1053) ! Open dataset
1054) call h5dopen_f(file_id, "Domain/Vertices", data_set_id, hdf5_err)
1055)
1056) ! Get dataset's dataspace
1057) call h5dget_space_f(data_set_id, data_space_id, hdf5_err)
1058)
1059) ! Get number of dimensions and check
1060) call h5sget_simple_extent_ndims_f(data_space_id, ndims, hdf5_err)
1061) if (ndims /= 2) then
1062) option%io_buffer='Dimension of Domain/Vertices dataset in ' // trim(filename) // &
1063) ' is not equal to 2.'
1064) call printErrMsg(option)
1065) endif
1066)
1067) ! Allocate memory
1068) allocate(dims_h5(ndims))
1069) allocate(max_dims_h5(ndims))
1070)
1071) ! Get dimensions of dataset
1072) call h5sget_simple_extent_dims_f(data_space_id, dims_h5, max_dims_h5, &
1073) hdf5_err)
1074)
1075) ! Determine the number of cells each that will be saved on each processor
1076) unstructured_grid%num_vertices_global = INT(dims_h5(2))
1077) num_vertices_local = &
1078) unstructured_grid%num_vertices_global/ &
1079) option%mycommsize
1080) num_cells_local_save = num_vertices_local
1081) remainder = unstructured_grid%num_vertices_global - &
1082) num_vertices_local*option%mycommsize
1083) if (option%myrank < remainder) num_vertices_local = &
1084) num_vertices_local + 1
1085)
1086) ! Find istart and iend
1087) istart = 0
1088) iend = 0
1089) call MPI_Exscan(num_vertices_local, istart, ONE_INTEGER_MPI, &
1090) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
1091) call MPI_Scan(num_vertices_local, iend, ONE_INTEGER_MPI, &
1092) MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
1093)
1094) ! Determine the length and offset of data to be read by each processor
1095) length(1) = dims_h5(1)
1096) length(2) = iend-istart
1097) offset(1) = 0
1098) offset(2) = istart
1099)
1100) !
1101) rank_mpi = 2
1102) memory_space_id = -1
1103)
1104) ! Create data space for dataset
1105) call h5screate_simple_f(rank_mpi, length, memory_space_id, hdf5_err)
1106)
1107) ! Select hyperslab
1108) call h5dget_space_f(data_set_id, data_space_id, hdf5_err)
1109) call h5sselect_hyperslab_f(data_space_id, H5S_SELECT_SET_F, offset, length, &
1110) hdf5_err)
1111)
1112) ! Initialize data buffer
1113) allocate(double_buffer(length(1), length(2)))
1114) double_buffer = UNINITIALIZED_DOUBLE
1115)
1116) ! Create property list
1117) call h5pcreate_f(H5P_DATASET_XFER_F, prop_id, hdf5_err)
1118) #ifndef SERIAL_HDF5
1119) call h5pset_dxpl_mpio_f(prop_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err)
1120) #endif
1121)
1122) ! Read the dataset collectively
1123) call h5dread_f(data_set_id, H5T_NATIVE_DOUBLE, double_buffer, &
1124) dims_h5, hdf5_err, memory_space_id, data_space_id)
1125)
1126) call h5dclose_f(data_set_id, hdf5_err)
1127) !call h5gclose_f(grp_id, hdf5_err)
1128) call h5fclose_f(file_id, hdf5_err)
1129) call h5close_f(hdf5_err)
1130)
1131)
1132) ! fill the vertices data structure
1133) allocate(unstructured_grid%vertices(num_vertices_local))
1134) do ii = 1, num_vertices_local
1135) unstructured_grid%vertices(ii)%id = 0
1136) unstructured_grid%vertices(ii)%x = double_buffer(1, ii)
1137) unstructured_grid%vertices(ii)%y = double_buffer(2, ii)
1138) unstructured_grid%vertices(ii)%z = double_buffer(3, ii)
1139) enddo
1140)
1141) deallocate(double_buffer)
1142) nullify(double_buffer)
1143) deallocate(dims_h5)
1144) deallocate(max_dims_h5)
1145)
1146) unstructured_grid%max_nvert_per_cell = max_nvert_per_cell
1147) unstructured_grid%nlmax = num_cells_local
1148) unstructured_grid%num_vertices_local = num_vertices_local
1149)
1150) end subroutine UGridReadHDF5
1151)
1152) #endif
1153) ! End PETSC_HAVE_HDF5
1154)
1155) #if defined(SCORPIO)
1156)
1157) ! ************************************************************************** !
1158)
1159) subroutine UGridReadHDF5PIOLib(unstructured_grid, filename, &
1160) option)
1161) !
1162) ! UGridReadHDF5PIOLib: Reads an unstructured grid from HDF5
1163) ! Author: Gautam Bisht
1164) ! Date: 05/13/11
1165) !
1166) #if defined(PETSC_HAVE_HDF5)
1167) use hdf5
1168) #endif
1169)
1170) !#include "petsc/finclude/petscsys.h"
1171)
1172) ! 64-bit stuff
1173) #ifdef PETSC_USE_64BIT_INDICES
1174) #define HDF_NATIVE_INTEGER H5T_NATIVE_INTEGER
1175) #else
1176) #define HDF_NATIVE_INTEGER H5T_NATIVE_INTEGER
1177) #endif
1178)
1179) use Input_Aux_module
1180) use Option_module
1181) use HDF5_Aux_module
1182)
1183) implicit none
1184)
1185) type(grid_unstructured_type) :: unstructured_grid
1186) type(option_type) :: option
1187) character(len=MAXSTRINGLENGTH) :: filename
1188) character(len=MAXSTRINGLENGTH) :: group_name
1189) character(len=MAXSTRINGLENGTH) :: dataset_name
1190)
1191) PetscInt,pointer :: int_buffer(:,:)
1192) PetscReal,pointer :: double_buffer(:,:)
1193) PetscInt :: ii, jj
1194) PetscInt :: dims(2), dataset_dims(2)
1195) PetscInt, parameter :: max_nvert_per_cell = 8
1196) PetscInt :: num_cells_local
1197)
1198) character(len=MAXSTRINGLENGTH) :: cell_dataset_name = &
1199) '/Domain/Cells'//CHAR(0)
1200) character(len=MAXSTRINGLENGTH) :: vert_dataset_name = &
1201) '/Domain/Vertices'//CHAR(0)
1202)
1203) ! Read Domain/Cells
1204) call HDF5ReadDatasetInteger2D(filename, &
1205) cell_dataset_name, &
1206) SCORPIO_NONUNIFORM_CONTIGUOUS_READ, &
1207) option, &
1208) int_buffer, &
1209) dims, &
1210) dataset_dims)
1211)
1212) ! Allocate array to store vertices for each cell
1213) num_cells_local = dims(2)
1214) unstructured_grid%nmax = dataset_dims(2)
1215) allocate(unstructured_grid%cell_vertices(max_nvert_per_cell, &
1216) num_cells_local))
1217) unstructured_grid%cell_vertices = -1
1218)
1219) ! Fill the cell data structure
1220) do ii = 1, num_cells_local
1221) do jj = 2, int_buffer(1, ii) + 1
1222) unstructured_grid%cell_vertices(jj-1, ii) = int_buffer(jj, ii)
1223) enddo
1224) enddo
1225) deallocate(int_buffer)
1226) nullify(int_buffer)
1227)
1228) ! Read Vertices
1229) call HDF5ReadDatasetReal2D(filename, &
1230) vert_dataset_name, &
1231) SCORPIO_NONUNIFORM_CONTIGUOUS_READ, &
1232) option, &
1233) double_buffer, &
1234) dims, &
1235) dataset_dims)
1236)
1237) unstructured_grid%num_vertices_local = dims(2)
1238) unstructured_grid%num_vertices_global= dataset_dims(2)
1239) allocate(unstructured_grid%vertices(unstructured_grid%num_vertices_local))
1240) ! fill the vertices data structure
1241) do ii = 1, unstructured_grid%num_vertices_local
1242) unstructured_grid%vertices(ii)%id = 0
1243) unstructured_grid%vertices(ii)%x = double_buffer(1, ii)
1244) unstructured_grid%vertices(ii)%y = double_buffer(2, ii)
1245) unstructured_grid%vertices(ii)%z = double_buffer(3, ii)
1246) enddo
1247) deallocate(double_buffer)
1248) nullify(double_buffer)
1249)
1250) unstructured_grid%max_nvert_per_cell = max_nvert_per_cell
1251) unstructured_grid%nlmax = num_cells_local
1252)
1253) end subroutine UGridReadHDF5PIOLib
1254)
1255) #endif
1256)
1257) ! ************************************************************************** !
1258)
1259) subroutine UGridDecompose(unstructured_grid,option)
1260) !
1261) ! Decomposes an unstructured grid across ranks
1262) !
1263) ! Author: Glenn Hammond
1264) ! Date: 09/30/09
1265) !
1266)
1267) use Option_module
1268) use Utility_module, only: reallocateIntArray, SearchOrderedArray
1269)
1270) implicit none
1271)
1272) #include "petsc/finclude/petscvec.h"
1273) #include "petsc/finclude/petscvec.h90"
1274) #include "petsc/finclude/petscmat.h"
1275) #include "petsc/finclude/petscmat.h90"
1276) #include "petsc/finclude/petscdm.h"
1277) #include "petsc/finclude/petscdm.h90"
1278) #include "petsc/finclude/petscis.h"
1279) #include "petsc/finclude/petscis.h90"
1280) #include "petsc/finclude/petscviewer.h"
1281)
1282) type(grid_unstructured_type) :: unstructured_grid
1283) type(option_type) :: option
1284)
1285) PetscInt :: local_id, local_id2
1286) PetscInt :: ghosted_id
1287) PetscInt :: ivertex
1288) PetscInt :: vertex_id
1289) PetscInt :: count, vertex_count
1290) PetscInt :: vertex_offset, global_vertex_offset
1291) PetscInt :: stride
1292) PetscInt, allocatable :: local_vertices(:)
1293) PetscInt, allocatable :: local_vertex_offset(:)
1294) PetscInt :: index_format_flag, num_common_vertices
1295) PetscReal, pointer :: vec_ptr(:)
1296) PetscInt, pointer :: ia_ptr(:), ja_ptr(:)
1297) PetscInt :: num_rows, num_cols, istart, iend, icol
1298) PetscBool :: success
1299) character(len=MAXSTRINGLENGTH) :: string
1300) PetscErrorCode :: ierr
1301)
1302) PetscViewer :: viewer
1303) Mat :: Adj_mat
1304) Mat :: Dual_mat
1305) MatPartitioning :: Part
1306) Vec :: elements_natural
1307) Vec :: elements_local
1308) Vec :: elements_old
1309) Vec :: vertices_old
1310) Vec :: vertices_new
1311) IS :: is_new
1312) IS :: is_scatter
1313) IS :: is_gather
1314)
1315) VecScatter :: vec_scatter
1316)
1317) PetscInt :: vertex_ids_offset
1318) PetscInt :: dual_offset
1319) PetscInt :: natural_id_offset
1320)
1321) PetscInt :: max_int_count
1322) PetscInt :: temp_int
1323) PetscInt :: min_value
1324) PetscInt :: num_cells_local_new
1325) PetscInt :: num_cells_local_old
1326) PetscInt :: global_offset_old
1327) PetscInt, allocatable :: int_array(:)
1328) PetscInt, allocatable :: int_array2(:)
1329) PetscInt, allocatable :: int_array3(:)
1330) PetscInt, allocatable :: int_array4(:)
1331) PetscInt, allocatable :: needed_vertices_petsc(:)
1332) PetscInt, pointer :: int_array_pointer(:)
1333)
1334) PetscInt :: idual, dual_id
1335) PetscInt :: iflag
1336) PetscBool :: found
1337)
1338) ! cell distribution across processors (size = num_cores + 1)
1339) ! core i owns cells cell_distribution(i):cell_distribution(i+1), note
1340) ! the zero-based indexing
1341) ! allocate(cell_distribution(option%mycommsize+1))
1342) ! call MPI_Scan(unstructured_grid%nlmax,
1343) ! cell_distribution(1) = 0
1344) ! cell_distribution(2:) = unstructured_grid%num_cells
1345) ! num_local_cells = cell_distribution(option%myrank+1)- &
1346) ! cell_distribution(option%myrank+2)
1347)
1348) num_cells_local_old = unstructured_grid%nlmax
1349)
1350) ! recalculate maximum number of vertices for any given cell
1351) temp_int = 0
1352) min_value = 2 ! min value should be either 0 or 1 after global reduction
1353) do local_id = 1, num_cells_local_old
1354) vertex_count = 0
1355) do ivertex = 1, unstructured_grid%max_nvert_per_cell
1356) ! at this point, cell vertex can be 0
1357) if (unstructured_grid%cell_vertices(ivertex,local_id) < 0) exit
1358) if (unstructured_grid%cell_vertices(ivertex,local_id) < min_value) then
1359) min_value = unstructured_grid%cell_vertices(ivertex,local_id)
1360) endif
1361) vertex_count = vertex_count+1
1362) enddo
1363) if (vertex_count > temp_int) temp_int = vertex_count
1364) enddo
1365) call MPI_Allreduce(temp_int,unstructured_grid%max_nvert_per_cell, &
1366) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_MAX,option%mycomm,ierr)
1367) call MPI_Allreduce(min_value,index_format_flag, &
1368) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_MIN,option%mycomm,ierr)
1369)
1370) ! let's make it Fortran indexing
1371) do local_id = 1, num_cells_local_old
1372) do ivertex = 1, unstructured_grid%max_nvert_per_cell
1373) ! at this point we may be zero-based
1374) if (unstructured_grid%cell_vertices(ivertex,local_id) < 0) then
1375) ! change no_value (UNINITIALIZED_INTEGER) to '0'
1376) unstructured_grid%cell_vertices(ivertex,local_id) = 0
1377) else
1378) if (index_format_flag == 0) then
1379) ! let's make it Fortran indexing
1380) unstructured_grid%cell_vertices(ivertex,local_id) = &
1381) unstructured_grid%cell_vertices(ivertex,local_id) + 1
1382) endif
1383) endif
1384) enddo
1385) enddo
1386)
1387) #if UGRID_DEBUG
1388) write(string,*) unstructured_grid%max_nvert_per_cell
1389) option%io_buffer = 'Maximum number of vertices per cell: ' // adjustl(string)
1390) call printMsg(option)
1391) write(string,*) index_format_flag
1392) option%io_buffer = 'Vertex indexing starts at: ' // adjustl(string)
1393) call printMsg(option)
1394) if (index_format_flag == 0) then
1395) option%io_buffer = 'Changing vertex indexing to 1-based.'
1396) call printMsg(option)
1397) endif
1398) #endif
1399)
1400) num_cells_local_old = unstructured_grid%nlmax
1401) allocate(local_vertices(unstructured_grid%max_nvert_per_cell* &
1402) num_cells_local_old))
1403) allocate(local_vertex_offset(num_cells_local_old+1))
1404) local_vertices = 0
1405) local_vertex_offset = 0
1406) count = 0
1407) local_vertex_offset(1) = 0
1408) do local_id = 1, num_cells_local_old
1409) do ivertex = 1, unstructured_grid%max_nvert_per_cell
1410) if (unstructured_grid%cell_vertices(ivertex,local_id) == 0) exit
1411) count = count + 1
1412) ! local vertices must be zero-based for MatCreateMPIAdj; thus subtract 1
1413) local_vertices(count) = &
1414) unstructured_grid%cell_vertices(ivertex,local_id) - 1
1415) enddo
1416) local_vertex_offset(local_id+1) = count
1417) enddo
1418)
1419) select case (unstructured_grid%grid_type)
1420) case(TWO_DIM_GRID)
1421) num_common_vertices = 2 ! cells must share at least this number of vertices
1422) case(THREE_DIM_GRID)
1423) num_common_vertices = 3 ! cells must share at least this number of vertices
1424) case default
1425) option%io_buffer = 'Grid type not recognized '
1426) call printErrMsg(option)
1427) end select
1428)
1429) ! determine the global offset from 0 for cells on this rank
1430) global_offset_old = 0
1431) call MPI_Exscan(num_cells_local_old,global_offset_old, &
1432) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
1433)
1434) ! create an adjacency matrix for calculating the duals (connnections)
1435) #if UGRID_DEBUG
1436) call printMsg(option,'Adjacency matrix')
1437) #endif
1438)
1439) call MatCreateMPIAdj(option%mycomm,num_cells_local_old, &
1440) unstructured_grid%num_vertices_global, &
1441) local_vertex_offset, &
1442) local_vertices,PETSC_NULL_INTEGER,Adj_mat, &
1443) ierr);CHKERRQ(ierr)
1444)
1445) ! do not free local_vertices; MatAdjDestroy will do it
1446) ! do not free local_vertex_offset; MatAdjDestroy will do it
1447)
1448) #if UGRID_DEBUG
1449) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
1450) call PetscViewerASCIIOpen(option%mycomm,'Adj_subsurf.out',viewer, &
1451) ierr);CHKERRQ(ierr)
1452) else
1453) call PetscViewerASCIIOpen(option%mycomm,'Adj_surf.out',viewer, &
1454) ierr);CHKERRQ(ierr)
1455) endif
1456) call MatView(Adj_mat,viewer,ierr);CHKERRQ(ierr)
1457) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1458) #endif
1459)
1460) #if UGRID_DEBUG
1461) call printMsg(option,'Dual matrix')
1462) #endif
1463)
1464) #if defined(PETSC_HAVE_PARMETIS)
1465) call MatMeshToCellGraph(Adj_mat,num_common_vertices,Dual_mat, &
1466) ierr);CHKERRQ(ierr)
1467) #endif
1468) call MatDestroy(Adj_mat,ierr);CHKERRQ(ierr)
1469)
1470) #if UGRID_DEBUG
1471) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
1472) call PetscViewerASCIIOpen(option%mycomm,'Dual_subsurf.out',viewer, &
1473) ierr);CHKERRQ(ierr)
1474) else
1475) call PetscViewerASCIIOpen(option%mycomm,'Dual_surf.out',viewer, &
1476) ierr);CHKERRQ(ierr)
1477) endif
1478) call MatView(Dual_mat,viewer,ierr);CHKERRQ(ierr)
1479) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1480) #endif
1481)
1482) call UGridPartition(unstructured_grid,option,Dual_mat,is_new, &
1483) num_cells_local_new)
1484)
1485) if (allocated(local_vertices)) deallocate(local_vertices)
1486) if (allocated(local_vertex_offset)) deallocate(local_vertex_offset)
1487)
1488) ! second argument of ZERO_INTEGER means to use 0-based indexing
1489) ! MagGetRowIJF90 returns row and column pointers for compressed matrix data
1490) call MatGetRowIJF90(Dual_mat,ZERO_INTEGER,PETSC_FALSE,PETSC_FALSE,num_rows, &
1491) ia_ptr,ja_ptr,success,ierr);CHKERRQ(ierr)
1492)
1493) if (.not.success .or. num_rows /= num_cells_local_old) then
1494) print *, option%myrank, num_rows, success, num_cells_local_old
1495) option%io_buffer = 'Error getting IJ row indices from dual matrix'
1496) call printErrMsg(option)
1497) endif
1498)
1499) ! calculate maximum number of connections for any given cell
1500) unstructured_grid%max_ndual_per_cell = 0
1501) do local_id = 1, num_cells_local_old
1502) istart = ia_ptr(local_id)
1503) iend = ia_ptr(local_id+1)-1
1504) num_cols = iend-istart+1
1505) if (num_cols > unstructured_grid%max_ndual_per_cell) &
1506) unstructured_grid%max_ndual_per_cell = num_cols
1507) enddo
1508) temp_int = unstructured_grid%max_ndual_per_cell
1509) call MPI_Allreduce(temp_int,unstructured_grid%max_ndual_per_cell, &
1510) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_MAX,option%mycomm,ierr)
1511)
1512) #if UGRID_DEBUG
1513) write(string,*) unstructured_grid%max_ndual_per_cell
1514) option%io_buffer = 'Maximum number of duals per cell: ' // adjustl(string)
1515) call printMsg(option)
1516) #endif
1517)
1518) if (unstructured_grid%max_ndual_per_cell > 0) then
1519) call MatRestoreRowIJF90(Dual_mat,ZERO_INTEGER,PETSC_FALSE,PETSC_FALSE, &
1520) num_rows,ia_ptr,ja_ptr,success,ierr);CHKERRQ(ierr)
1521) endif
1522)
1523) ! in order to redistributed vertex/cell data among ranks, I package it
1524) ! in a crude way within a strided petsc vec and pass it. The stride
1525) ! determines the size of each cells "packaged" data
1526) vertex_ids_offset = 1 + 1 ! +1 for -777
1527) dual_offset = vertex_ids_offset + unstructured_grid%max_nvert_per_cell + 1 ! +1 for -888
1528) stride = dual_offset+ unstructured_grid%max_ndual_per_cell + 1 ! +1 for -999999
1529) natural_id_offset = 1
1530)
1531) ! Information for each cell is packed in a strided petsc vec
1532) ! The information is ordered within each stride as follows:
1533) ! -cell_N ! global cell id (negative indicates 1-based)
1534) ! -777 ! separator between cell id and vertex ids for cell_N
1535) ! vertex1 ! in cell_N
1536) ! vertex2
1537) ! ...
1538) ! vertexN
1539) ! -888 ! separator between vertex and dual ids
1540) ! dual1 ! dual ids between cell_N and others
1541) ! dual2
1542) ! ...
1543) ! dualN
1544) ! -999999 ! separator indicating end of information for cell_N
1545)
1546) ! the purpose of -777, -888, and -999999 is to allow one to use cells of
1547) ! various geometry. Currently, the max # vertices = 8 and max # duals = 6.
1548) ! But this will be generalized in the future.
1549)
1550) call UGridCreateOldVec(unstructured_grid,option,elements_old, &
1551) num_cells_local_old, &
1552) is_new,is_scatter,stride)
1553)
1554) ! 0 = 0-based indexing
1555) ! MagGetRowIJF90 returns row and column pointers for compressed matrix data
1556) call MatGetRowIJF90(Dual_mat,ZERO_INTEGER,PETSC_FALSE,PETSC_FALSE,num_rows, &
1557) ia_ptr,ja_ptr,success,ierr);CHKERRQ(ierr)
1558)
1559) call VecGetArrayF90(elements_old,vec_ptr,ierr);CHKERRQ(ierr)
1560) count = 0
1561) vertex_count = 0
1562) do local_id = 1, num_cells_local_old
1563) count = count + 1
1564) ! set global cell id
1565) ! negate to indicate cell id with 1-based numbering (-0 = 0)
1566) vec_ptr(count) = -(global_offset_old+local_id)
1567) count = count + 1
1568) ! add the separator
1569) vec_ptr(count) = -777 ! help differentiate
1570) ! add the vertex ids
1571) do ivertex = 1, unstructured_grid%max_nvert_per_cell
1572) count = count + 1
1573) vertex_count = vertex_count + 1
1574) ! increment for 1-based ordering
1575) vec_ptr(count) = unstructured_grid%cell_vertices(ivertex,local_id)
1576) enddo
1577)
1578)
1579) count = count + 1
1580) ! another vertex/dual separator
1581) vec_ptr(count) = -888 ! help differentiate
1582)
1583) ! add the dual ids
1584) istart = ia_ptr(local_id)
1585) iend = ia_ptr(local_id+1)-1
1586) num_cols = iend-istart+1
1587) if (num_cols > unstructured_grid%max_ndual_per_cell) then
1588) option%io_buffer = &
1589) 'Number of columns in Dual matrix is larger then max_ndual_per_cell.'
1590) call printErrMsgByRank(option)
1591) endif
1592) do icol = 1, unstructured_grid%max_ndual_per_cell
1593) count = count + 1
1594) if (icol <= num_cols) then
1595) ! increment for 1-based ordering
1596) vec_ptr(count) = ja_ptr(icol+istart) + 1
1597) else
1598) vec_ptr(count) = 0
1599) endif
1600) enddo
1601) count = count + 1
1602) ! final separator
1603) vec_ptr(count) = -999999 ! help differentiate
1604) enddo
1605) call VecRestoreArrayF90(elements_old,vec_ptr,ierr);CHKERRQ(ierr)
1606)
1607) if (unstructured_grid%max_ndual_per_cell > 0) then
1608) call MatRestoreRowIJF90(Dual_mat,ZERO_INTEGER,PETSC_FALSE,PETSC_FALSE, &
1609) num_rows,ia_ptr,ja_ptr,success,ierr);CHKERRQ(ierr)
1610) endif
1611) call MatDestroy(Dual_mat,ierr);CHKERRQ(ierr)
1612)
1613)
1614) call UGridNaturalToPetsc(unstructured_grid,option, &
1615) elements_old,elements_local, &
1616) num_cells_local_new,stride,dual_offset, &
1617) natural_id_offset,is_scatter)
1618)
1619) ! make a list of local vertices
1620) max_int_count = 2*unstructured_grid%ngmax
1621) allocate(int_array_pointer(max_int_count))
1622) int_array_pointer = 0
1623) vertex_count = 0
1624) ! yep - load them all into a petsc vector
1625) ! note that the vertices are still in natural numbering
1626) call VecGetArrayF90(elements_local,vec_ptr,ierr);CHKERRQ(ierr)
1627) do local_id=1, unstructured_grid%ngmax
1628) do ivertex = 1, unstructured_grid%max_nvert_per_cell
1629) vertex_id = int(vec_ptr(ivertex + vertex_ids_offset + (local_id-1)*stride))
1630) if (vertex_id < 1) exit
1631) vertex_count = vertex_count + 1
1632) if (vertex_count > max_int_count) then
1633) call reallocateIntArray(int_array_pointer,max_int_count)
1634) endif
1635) vec_ptr(ivertex + vertex_ids_offset + (local_id-1)*stride) = vertex_count
1636) int_array_pointer(vertex_count) = vertex_id
1637) enddo
1638) enddo
1639) call VecRestoreArrayF90(elements_local,vec_ptr,ierr);CHKERRQ(ierr)
1640)
1641) ! sort the vertex ids
1642) allocate(int_array(vertex_count))
1643) int_array(1:vertex_count) = int_array_pointer(1:vertex_count)
1644) allocate(int_array2(vertex_count))
1645) do ivertex = 1, vertex_count
1646) int_array2(ivertex) = ivertex
1647) enddo
1648) deallocate(int_array_pointer)
1649) nullify(int_array_pointer)
1650) int_array2 = int_array2-1
1651) call PetscSortIntWithPermutation(vertex_count,int_array,int_array2, &
1652) ierr);CHKERRQ(ierr)
1653) int_array2 = int_array2+1
1654)
1655) ! remove duplicates
1656) allocate(int_array3(vertex_count))
1657) allocate(int_array4(vertex_count))
1658) int_array3 = 0
1659) int_array4 = 0
1660) int_array3(1) = int_array(int_array2(1))
1661) count = 1
1662) int_array4(int_array2(1)) = count
1663) do ivertex = 2, vertex_count
1664) vertex_id = int_array(int_array2(ivertex))
1665) if (vertex_id > int_array3(count)) then
1666) count = count + 1
1667) int_array3(count) = vertex_id
1668) endif
1669) int_array4(int_array2(ivertex)) = count
1670) enddo
1671) vertex_count = count
1672) deallocate(int_array)
1673)
1674) allocate(unstructured_grid%vertex_ids_natural(vertex_count))
1675) unstructured_grid%vertex_ids_natural = int_array3(1:vertex_count)
1676)
1677) ! now load all the vertices needed to define all the local cells
1678) ! on the processor
1679) allocate(needed_vertices_petsc(vertex_count))
1680) needed_vertices_petsc(1:vertex_count) = int_array3(1:vertex_count)
1681)
1682) ! allocate the array that will store the vertex ids for each cell.
1683) ! remember that max_nvert_per_cell is the max # of vertices in a cell
1684) ! currently hardwired to 8.
1685) deallocate(unstructured_grid%cell_vertices)
1686) allocate(unstructured_grid%cell_vertices( &
1687) 0:unstructured_grid%max_nvert_per_cell,unstructured_grid%ngmax))
1688) unstructured_grid%cell_vertices = 0
1689)
1690) ! permute the local ids calculated earlier in the int_array4
1691) call VecGetArrayF90(elements_local,vec_ptr,ierr);CHKERRQ(ierr)
1692) do ghosted_id = 1, unstructured_grid%ngmax
1693) do ivertex = 1, unstructured_grid%max_nvert_per_cell
1694) ! extract the original vertex id
1695) vertex_id = int(vec_ptr(ivertex + vertex_ids_offset + (ghosted_id-1)*stride))
1696) if (vertex_id < 1) exit
1697) count = unstructured_grid%cell_vertices(0,ghosted_id)+1
1698) unstructured_grid%cell_vertices(count,ghosted_id) = &
1699) int_array4(vertex_id)
1700) unstructured_grid%cell_vertices(0,ghosted_id) = count
1701) ! load the permuted value back into the petsc vector
1702) vec_ptr(ivertex + vertex_ids_offset + (ghosted_id-1)*stride) = &
1703) int_array4(vertex_id)
1704) enddo
1705) enddo
1706) call VecRestoreArrayF90(elements_local,vec_ptr,ierr);CHKERRQ(ierr)
1707) deallocate(int_array2)
1708) deallocate(int_array3)
1709) deallocate(int_array4)
1710)
1711) #if UGRID_DEBUG
1712) write(string,*) option%myrank
1713) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
1714) string = 'elements_vert_local' // trim(adjustl(string)) // '_subsurf.out'
1715) else
1716) string = 'elements_vert_local' // trim(adjustl(string)) // '_surf.out'
1717) endif
1718) call PetscViewerASCIIOpen(PETSC_COMM_SELF,trim(string),viewer, &
1719) ierr);CHKERRQ(ierr)
1720) call VecView(elements_local,viewer,ierr);CHKERRQ(ierr)
1721) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1722) #endif
1723) call VecDestroy(elements_local,ierr);CHKERRQ(ierr)
1724)
1725) ! now we need to work on aligning the original vertex coordinates with
1726) ! the current ordering or permuted/rearranged ordering.
1727)
1728) ! IS for gather operation - need local numbering
1729) allocate(int_array(vertex_count))
1730) ! vertex_count = # of local vertices (I believe ghosted+non-ghosted)
1731) do ivertex = 1, vertex_count
1732) int_array(ivertex) = ivertex-1
1733) enddo
1734)
1735) ! include cell ids (use block ids, not indices)
1736) call ISCreateBlock(option%mycomm,3,vertex_count, &
1737) int_array,PETSC_COPY_VALUES,is_gather,ierr);CHKERRQ(ierr)
1738) deallocate(int_array)
1739)
1740) ! create a parallel petsc vector with a stride of 3.
1741) !call VecCreateMPI(option%mycomm,unstructured_grid%num_vertices_local*3, &
1742) ! PETSC_DETERMINE,vertices_old,ierr)
1743) call VecCreate(option%mycomm,vertices_old,ierr);CHKERRQ(ierr)
1744) call VecSetSizes(vertices_old,unstructured_grid%num_vertices_local*3, &
1745) PETSC_DECIDE,ierr);CHKERRQ(ierr)
1746) call VecSetBlockSize(vertices_old,3,ierr);CHKERRQ(ierr)
1747) call VecSetFromOptions(vertices_old,ierr);CHKERRQ(ierr)
1748)
1749) ! create serial petsc vector with a stride of 3
1750) !call VecCreateSeq(PETSC_COMM_SELF,vertex_count*3,vertices_new,ierr)
1751) call VecCreate(PETSC_COMM_SELF,vertices_new,ierr);CHKERRQ(ierr)
1752) call VecSetSizes(vertices_new,vertex_count*3,PETSC_DECIDE, &
1753) ierr);CHKERRQ(ierr)
1754) call VecSetBlockSize(vertices_new,3,ierr);CHKERRQ(ierr)
1755) call VecSetFromOptions(vertices_new,ierr);CHKERRQ(ierr)
1756)
1757) ! call VecCreate(option%mycomm,vertices_new,ierr)
1758) ! call VecSetSizes(vertices_new, &
1759) ! vertex_count*3,PETSC_DECIDE,ierr)
1760) ! call VecSetFromOptions(vertices_new,ierr)
1761)
1762) ! call VecCreate(option%mycomm,vertices_old,ierr)
1763) ! call VecSetSizes(vertices_old, &
1764) ! 3*unstructured_grid%num_vertices_local,PETSC_DECIDE,ierr)
1765) ! call VecSetFromOptions(vertices_old,ierr)
1766) ! load up the coordinates
1767) call VecGetArrayF90(vertices_old,vec_ptr,ierr);CHKERRQ(ierr)
1768) do ivertex = 1, unstructured_grid%num_vertices_local
1769) vec_ptr((ivertex-1)*3+1) = unstructured_grid%vertices(ivertex)%x
1770) vec_ptr((ivertex-1)*3+2) = unstructured_grid%vertices(ivertex)%y
1771) vec_ptr((ivertex-1)*3+3) = unstructured_grid%vertices(ivertex)%z
1772) enddo
1773) call VecRestoreArrayF90(vertices_old,vec_ptr,ierr);CHKERRQ(ierr)
1774) deallocate(unstructured_grid%vertices)
1775) nullify(unstructured_grid%vertices)
1776)
1777) ! IS for scatter - provide petsc global numbering
1778) allocate(int_array(vertex_count))
1779) do ivertex = 1, vertex_count
1780) int_array(ivertex) = (needed_vertices_petsc(ivertex)-1)
1781) enddo
1782) ! include cell ids
1783) call ISCreateBlock(option%mycomm,3,vertex_count, &
1784) int_array,PETSC_COPY_VALUES,is_scatter, &
1785) ierr);CHKERRQ(ierr)
1786) deallocate(int_array)
1787)
1788) ! resize vertex array to new size
1789) unstructured_grid%num_vertices_natural = unstructured_grid%num_vertices_local
1790) unstructured_grid%num_vertices_local = vertex_count
1791) allocate(unstructured_grid%vertices(vertex_count))
1792) do ivertex = 1, vertex_count
1793) unstructured_grid%vertices(ivertex)%x = 0.d0
1794) unstructured_grid%vertices(ivertex)%y = 0.d0
1795) unstructured_grid%vertices(ivertex)%z = 0.d0
1796) enddo
1797)
1798) #if UGRID_DEBUG
1799) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
1800) call PetscViewerASCIIOpen(option%mycomm,'is_scatter_vert_old_to_new_subsurf.out',viewer, &
1801) ierr);CHKERRQ(ierr)
1802) else
1803) call PetscViewerASCIIOpen(option%mycomm,'is_scatter_vert_old_to_new_surf.out',viewer, &
1804) ierr);CHKERRQ(ierr)
1805) endif
1806) call ISView(is_scatter,viewer,ierr);CHKERRQ(ierr)
1807) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1808) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
1809) call PetscViewerASCIIOpen(option%mycomm,'is_gather_vert_old_to_new_subsurf.out',viewer, &
1810) ierr);CHKERRQ(ierr)
1811) else
1812) call PetscViewerASCIIOpen(option%mycomm,'is_gather_vert_old_to_new_surf.out',viewer, &
1813) ierr);CHKERRQ(ierr)
1814) endif
1815) call ISView(is_gather,viewer,ierr);CHKERRQ(ierr)
1816) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1817) #endif
1818)
1819) call VecScatterCreate(vertices_old,is_scatter,vertices_new,is_gather, &
1820) vec_scatter,ierr);CHKERRQ(ierr)
1821) call ISDestroy(is_scatter,ierr);CHKERRQ(ierr)
1822) call ISDestroy(is_gather,ierr);CHKERRQ(ierr)
1823) call VecScatterBegin(vec_scatter,vertices_old,vertices_new, &
1824) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1825) call VecScatterEnd(vec_scatter,vertices_old,vertices_new, &
1826) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1827) call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
1828)
1829) #if UGRID_DEBUG
1830) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
1831) call PetscViewerASCIIOpen(option%mycomm,'vertex_coord_old_subsurf.out',viewer, &
1832) ierr);CHKERRQ(ierr)
1833) else
1834) call PetscViewerASCIIOpen(option%mycomm,'vertex_coord_old_surf.out',viewer, &
1835) ierr);CHKERRQ(ierr)
1836) endif
1837) call VecView(vertices_old,viewer,ierr);CHKERRQ(ierr)
1838) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1839) #endif
1840)
1841) call VecDestroy(vertices_old,ierr);CHKERRQ(ierr)
1842)
1843)
1844) call VecGetArrayF90(vertices_new,vec_ptr,ierr);CHKERRQ(ierr)
1845) do ivertex = 1, unstructured_grid%num_vertices_local
1846) unstructured_grid%vertices(ivertex)%id = needed_vertices_petsc(ivertex)
1847) unstructured_grid%vertices(ivertex)%x = vec_ptr((ivertex-1)*3+1)
1848) unstructured_grid%vertices(ivertex)%y = vec_ptr((ivertex-1)*3+2)
1849) unstructured_grid%vertices(ivertex)%z = vec_ptr((ivertex-1)*3+3)
1850) enddo
1851) call VecRestoreArrayF90(vertices_new,vec_ptr,ierr);CHKERRQ(ierr)
1852)
1853) #if UGRID_DEBUG
1854) write(string,*) option%myrank
1855) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
1856) string = 'vertex_coord_new' // trim(adjustl(string)) // '_subsurf.out'
1857) else
1858) string = 'vertex_coord_new' // trim(adjustl(string)) // '_surf.out'
1859) endif
1860) call PetscViewerASCIIOpen(PETSC_COMM_SELF,trim(string),viewer, &
1861) ierr);CHKERRQ(ierr)
1862) call VecView(vertices_new,viewer,ierr);CHKERRQ(ierr)
1863) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1864) #endif
1865)
1866) call VecDestroy(vertices_new,ierr);CHKERRQ(ierr)
1867)
1868) #if UGRID_DEBUG
1869) call printMsg(option,'Setting cell types')
1870) #endif
1871)
1872) allocate(unstructured_grid%cell_type(unstructured_grid%ngmax))
1873)
1874) select case(unstructured_grid%grid_type)
1875) case(THREE_DIM_GRID)
1876) do ghosted_id = 1, unstructured_grid%ngmax
1877) ! Determine number of faces and cell-type of the current cell
1878) select case(unstructured_grid%cell_vertices(0,ghosted_id))
1879) case(8)
1880) unstructured_grid%cell_type(ghosted_id) = HEX_TYPE
1881) case(6)
1882) unstructured_grid%cell_type(ghosted_id) = WEDGE_TYPE
1883) case(5)
1884) unstructured_grid%cell_type(ghosted_id) = PYR_TYPE
1885) case(4)
1886) unstructured_grid%cell_type(ghosted_id) = TET_TYPE
1887) case default
1888) option%io_buffer = 'Cell type not recognized: '
1889) call printErrMsg(option)
1890) end select
1891) enddo
1892) case(TWO_DIM_GRID)
1893) do ghosted_id = 1, unstructured_grid%ngmax
1894) select case(unstructured_grid%cell_vertices(0,ghosted_id))
1895) case(4)
1896) unstructured_grid%cell_type = QUAD_TYPE
1897) case(3)
1898) unstructured_grid%cell_type = TRI_TYPE
1899) case default
1900) option%io_buffer = 'Cell type not recognized: '
1901) call printErrMsg(option)
1902) end select
1903) end do
1904) case default
1905) option%io_buffer = 'Grid type not recognized: '
1906) call printErrMsg(option)
1907) end select
1908)
1909) end subroutine UGridDecompose
1910)
1911) ! ************************************************************************** !
1912)
1913) function UGridComputeInternConnect(unstructured_grid,grid_x,grid_y,grid_z, &
1914) option)
1915) !
1916) ! computes internal connectivity of an
1917) ! unstructured grid
1918) !
1919) ! Author: Glenn Hammond
1920) ! Date: 10/21/09
1921) !
1922)
1923) use Connection_module
1924) use Option_module
1925) use Utility_module, only : DotProduct, CrossProduct
1926)
1927) implicit none
1928)
1929) type(connection_set_type), pointer :: UGridComputeInternConnect
1930) type(option_type) :: option
1931) PetscReal :: grid_x(*), grid_y(*), grid_z(*)
1932) type(grid_unstructured_type) :: unstructured_grid
1933)
1934) type(connection_set_type), pointer :: connections
1935) PetscInt :: nconn, iconn
1936) PetscInt :: idual, dual_id
1937)
1938) PetscInt, allocatable :: face_to_vertex(:,:)
1939) PetscInt, allocatable :: cell_to_face(:,:)
1940) PetscInt, allocatable :: face_to_cell(:,:)
1941) PetscInt, allocatable :: vertex_to_cell(:,:)
1942) PetscInt, allocatable :: temp_int(:)
1943) PetscInt, allocatable :: temp_int_2d(:,:)
1944) PetscBool, allocatable :: local_boundary_face(:)
1945) PetscInt :: num_match
1946) PetscInt :: found_count
1947) PetscBool :: found
1948) PetscBool :: match_found
1949) PetscInt :: face_count
1950) PetscInt :: count, i
1951) PetscInt :: iface, iface2, iside
1952) PetscInt :: face_id, face_id2
1953) PetscInt :: ghosted_id, ghosted_id2
1954) PetscInt :: local_id, local_id2
1955) PetscInt :: cell_id, cell_id2
1956) PetscInt :: dual_local_id
1957) PetscInt :: ivertex, ivertex2
1958) PetscInt :: vertex_id, vertex_id2
1959) PetscInt :: vertex_ids4(4)
1960) PetscInt :: nfaces, nfaces2, nvertices, nvertices2, cell_type, cell_type2
1961) PetscInt :: face_type, face_type2
1962) PetscBool :: face_found, vertex_found
1963)
1964) PetscReal :: v1(3), v2(3), v3(3), n1(3), n2(3), n_up_dn(3)
1965) PetscReal :: vcross(3), magnitude
1966) PetscReal :: area1, area2
1967) PetscReal :: dist_up, dist_dn
1968) PetscInt :: ivert
1969)
1970) type(plane_type) :: plane1, plane2
1971) type(point_type) :: point1, point2, point3, point4
1972) type(point_type) :: point_up, point_dn
1973) type(point_type) :: intercept1, intercept2, intercept
1974)
1975) character(len=MAXSTRINGLENGTH) :: string
1976)
1977) ! create mappings of [cells,faces,vertices] to [cells,faces,vertices]
1978) allocate(face_to_vertex(MAX_VERT_PER_FACE, &
1979) MAX_FACE_PER_CELL* &
1980) unstructured_grid%ngmax))
1981) face_to_vertex = 0
1982) allocate(cell_to_face(MAX_FACE_PER_CELL, &
1983) unstructured_grid%ngmax))
1984) cell_to_face = 0
1985) allocate(face_to_cell(2,MAX_FACE_PER_CELL* &
1986) unstructured_grid%ngmax))
1987) face_to_cell = 0
1988) allocate(vertex_to_cell(0:unstructured_grid%max_cells_sharing_a_vertex, &
1989) unstructured_grid%num_vertices_local))
1990) vertex_to_cell = 0
1991)
1992) allocate(unstructured_grid%face_to_vertex_natural(MAX_VERT_PER_FACE, &
1993) MAX_FACE_PER_CELL*unstructured_grid%ngmax))
1994) unstructured_grid%face_to_vertex_natural = 0
1995)
1996) face_count = 0
1997) do ghosted_id = 1, unstructured_grid%ngmax
1998) cell_type = unstructured_grid%cell_type(ghosted_id)
1999) nfaces = UCellGetNFaces(cell_type,option)
2000) do iface = 1, nfaces
2001) face_count = face_count + 1
2002) cell_to_face(iface,ghosted_id) = face_count
2003) face_to_cell(1,face_count) = ghosted_id
2004) call UCellGetNFaceVertsandVerts(option,cell_type,iface,nvertices, &
2005) vertex_ids4)
2006) do ivertex = 1, nvertices
2007) face_to_vertex(ivertex,face_count) = &
2008) unstructured_grid%cell_vertices(vertex_ids4(ivertex),ghosted_id)
2009) if (face_to_vertex(ivertex,face_count) > 0) then
2010) unstructured_grid%face_to_vertex_natural(ivertex,face_count) = &
2011) unstructured_grid%vertex_ids_natural(face_to_vertex(ivertex,face_count))
2012) endif
2013) enddo
2014) enddo
2015) enddo
2016)
2017) !
2018) ! Remove duplicate faces:
2019) !
2020) ! A cell (cell_id) and Neighboring-Cell (cell_id2) will only share ONE face.
2021) ! Find the face that cell_id ane cell_id2 share and remove it.
2022) !
2023) ! Method:
2024) ! - Pick i-th face (iface) of cell_id and check if ALL the vertices of
2025) ! the iface are present in cell_id2. If all the vertices of iface are
2026) ! not present in cell_id2, move to the next face.
2027) ! - After finding the iface, now find iface2 in cell_id2 that
2028) ! corresponds to iface.
2029) ! - Check to ensure that atleast on face of cell_id is shared
2030) ! with cell_id2.
2031) !
2032) !
2033) !
2034) ! NOTE: For a cell_type = WEDGE_TYPE, faces 1-3 have 4 vertices; while
2035) ! faces 4-5 have 3 vertices
2036) !
2037) do local_id = 1, unstructured_grid%nlmax
2038) ! Selet a cell and find number of vertices
2039) cell_id = local_id
2040) ! cell_type is ghosted, but local cells are in the first nlmax entries
2041) cell_type = unstructured_grid%cell_type(local_id)
2042) nfaces = UCellGetNFaces(cell_type,option)
2043) do idual = 1, unstructured_grid%cell_neighbors_local_ghosted(0,local_id)
2044) ! Select a neighboring cell
2045) ! ghosted neighbors have a negative id
2046) cell_id2 = &
2047) abs(unstructured_grid%cell_neighbors_local_ghosted(idual,local_id))
2048) cell_type2 = unstructured_grid%cell_type(cell_id2)
2049) ! If cell-id is neighbor is lower, skip it
2050) if (cell_id2 <= cell_id) cycle
2051) ! Find the number of vertices for neighboring cell
2052) nfaces2 = UCellGetNFaces(cell_type2,option)
2053) ! Initialize
2054) face_found = PETSC_FALSE
2055) do iface = 1, nfaces
2056) ! Select a face and find number of vertices forming the face
2057) face_id = cell_to_face(iface,cell_id)
2058) nvertices = UCellGetNFaceVertices(cell_type,iface,option)
2059) do ivertex = 1, nvertices
2060) ! Select a vertex and initialize vertex_found
2061) vertex_id = face_to_vertex(ivertex,face_id) ! face_to_vertex is 1-based indexing
2062) vertex_found = PETSC_FALSE
2063) do ivertex2 = 1, unstructured_grid%cell_vertices(0,cell_id2)
2064) vertex_id2 = unstructured_grid%cell_vertices(ivertex2,cell_id2)
2065) if (vertex_id == vertex_id2) then
2066) vertex_found = PETSC_TRUE
2067) exit
2068) endif
2069) enddo
2070) !
2071) ! If ivertex of iface of the Cell is not present as vertices of the
2072) ! Neighboring-Cell, then iface is not the shared face. Skip iterating
2073) ! over the remaing vertices of iface
2074) if (.not.vertex_found) exit
2075) enddo
2076)
2077) if (vertex_found) then
2078) ! All the vertices of iface are present in the Neighboring cells.
2079) ! Thus, iface is the shared face.
2080) face_found = PETSC_TRUE
2081)
2082) ! Now, we have to find iface2 that corresponds to iface
2083) do iface2 = 1, nfaces2
2084) face_id2 = cell_to_face(iface2,cell_id2)
2085) !geh nvertices2 = 4
2086) !gehcomment: I believe that cell_type and iface on next line shoudl be the "2" versions
2087) !geh if ((cell_type == WEDGE_TYPE).and.(iface.gt.3)) nvertices2 = 3
2088) nvertices2 = UCellGetNFaceVertices(cell_type2,iface2,option)
2089) ! Both iface and iface2 need to have same number of vertices
2090) if (nvertices == nvertices2) then
2091) ! Count the number of vertices of iface which match vertices
2092) ! of iface2
2093) num_match = 0
2094) do ivertex = 1,nvertices
2095) vertex_id = face_to_vertex(ivertex,face_id)
2096) vertex_found = PETSC_FALSE ! gehbug - used to be PETSC_TRUE
2097)
2098) do ivertex2 = 1, nvertices2 ! gehbug - used to be nvertices
2099) vertex_id2 = face_to_vertex(ivertex2,face_id2)
2100) if (vertex_id == vertex_id2) then
2101) vertex_found = PETSC_TRUE
2102) num_match = num_match + 1
2103) vertex_ids4(num_match) = vertex_id
2104) exit
2105) endif
2106) enddo
2107) !
2108) ! If vertex_id of face_id not found as one of vertices of face_id2,
2109) ! face_id2 is not shared between cells
2110) if (.not.vertex_found) exit
2111) enddo
2112) if (num_match == nvertices) then
2113) ! remove duplicate face
2114) !geh: I believe that face_id2 will always be removed
2115) if (face_id2 > face_id) then
2116) #ifdef UGRID_DEBUG
2117) write(string,*) option%myrank, face_id2, ' -> ', face_id
2118) option%io_buffer = 'Duplicated face removed:' // trim(string)
2119) call printMsg(option)
2120) #endif
2121) cell_to_face(iface2,cell_id2) = face_id
2122) ! flag face_id2 as removed
2123) face_to_cell(1,face_id2) = -face_to_cell(1,face_id2)
2124) ! add cell_id2 to face_ids list
2125) face_to_cell(2,face_id) = cell_id2
2126) else
2127) #ifdef UGRID_DEBUG
2128) write(string,*) option%myrank, face_id, ' -> ', face_id2
2129) option%io_buffer = 'Duplicated face removed:' // trim(string)
2130) call printMsg(option)
2131) #endif
2132) cell_to_face(iface,cell_id) = face_id2
2133) ! flag face_id as removed
2134) face_to_cell(1,face_id) = -face_to_cell(1,face_id)
2135) ! add cell_id to face_ids2 list
2136) face_to_cell(2,face_id2) = cell_id
2137) endif
2138) exit
2139) endif
2140) endif
2141) enddo
2142) exit
2143) endif
2144) enddo ! iface-loop
2145)
2146) ! Check that one shared face was found between the Cell and Neighboring-Cell
2147) if (.not.face_found) then
2148) write(string,*) option%myrank
2149) string = '(' // trim(adjustl(string)) // ')'
2150) write(*,'(a,'' local_id = '',i3,'' natural_id = '',i3,'' vertices: '',8i3)') &
2151) trim(string), &
2152) cell_id,unstructured_grid%cell_ids_natural(cell_id), &
2153) (unstructured_grid%vertex_ids_natural( &
2154) unstructured_grid%cell_vertices(ivertex,cell_id)), &
2155) ivertex=1,unstructured_grid%cell_vertices(0,cell_id))
2156) write(*,'(a,'' local_id2 = '',i3,'' natural_id2 = '',i3,'' vertices2: '',8i3)') &
2157) trim(string), &
2158) cell_id2,unstructured_grid%cell_ids_natural(cell_id2), &
2159) (unstructured_grid%vertex_ids_natural( &
2160) unstructured_grid%cell_vertices(ivertex2,cell_id2)), &
2161) ivertex2=1,unstructured_grid%cell_vertices(0,cell_id2))
2162) option%io_buffer='No shared face found.'
2163) call printErrMsgByRank(option)
2164) endif
2165) enddo ! idual-loop
2166) enddo ! local_id-loop
2167)
2168) ! count up the # of faces
2169) face_count = 0
2170) do iface = 1, size(face_to_cell,2)
2171) if (face_to_cell(1,iface) > 0) &
2172) face_count = face_count + 1
2173) enddo
2174) allocate(unstructured_grid%face_to_vertex(MAX_VERT_PER_FACE,face_count))
2175) face_count = 0
2176) do iface = 1, size(face_to_cell,2)
2177) if (face_to_cell(1,iface) > 0) then
2178) face_count = face_count + 1
2179) unstructured_grid%face_to_vertex(:,face_count) = face_to_vertex(:,iface)
2180) endif
2181) enddo
2182) deallocate(face_to_vertex)
2183) ! reallocate face_to_cell to proper size
2184) allocate(temp_int_2d(2,face_count))
2185) allocate(temp_int(size(face_to_cell,2)))
2186) temp_int = 0
2187) face_count = 0
2188) do iface = 1, size(face_to_cell,2)
2189) if (face_to_cell(1,iface) > 0) then
2190) face_count = face_count + 1
2191) temp_int_2d(:,face_count) = face_to_cell(:,iface)
2192) temp_int(iface) = face_count
2193) endif
2194) enddo
2195) deallocate(face_to_cell)
2196) allocate(face_to_cell(2,face_count))
2197) face_to_cell = temp_int_2d
2198) deallocate(temp_int_2d)
2199)
2200)
2201) ! remap faces in cells using temp_int from above
2202) do iface = 1, size(face_to_cell,2)
2203) face_id = iface
2204) do i = 1,2
2205) cell_id = face_to_cell(i,face_id)
2206) ! check for exterior face
2207) if (cell_id < 1) cycle
2208) found = PETSC_FALSE
2209) cell_type = unstructured_grid%cell_type(cell_id)
2210) nfaces = UCellGetNFaces(cell_type,option)
2211) do iface2 = 1, nfaces
2212) face_id2 = cell_to_face(iface2,cell_id)
2213) if (face_id < 0) cycle
2214) if (face_id == temp_int(face_id2)) then
2215) found = PETSC_TRUE
2216) cell_to_face(iface2,cell_id) = face_id
2217) exit
2218) endif
2219) enddo
2220) if (.not.found) then
2221) option%io_buffer = 'Remapping of cell face id unsuccessful'
2222) call printErrMsg(option)
2223) endif
2224) enddo
2225) enddo
2226) deallocate(temp_int)
2227)
2228) do ghosted_id = 1, unstructured_grid%ngmax
2229) do ivertex = 1, unstructured_grid%cell_vertices(0,ghosted_id)
2230) vertex_id = unstructured_grid%cell_vertices(ivertex,ghosted_id)
2231) if ( vertex_id <= 0) cycle
2232) count = vertex_to_cell(0,vertex_id) + 1
2233) if (count > unstructured_grid%max_cells_sharing_a_vertex) then
2234) write(string,*) 'Vertex can be shared by at most by ', &
2235) unstructured_grid%max_cells_sharing_a_vertex, &
2236) ' cells. Rank = ', option%myrank, ' vertex_id = ', vertex_id, ' exceeds it.'
2237) option%io_buffer = string
2238) call printErrMsg(option)
2239) endif
2240) vertex_to_cell(count,vertex_id) = ghosted_id
2241) vertex_to_cell(0,vertex_id) = count
2242) enddo
2243) enddo
2244)
2245) nconn = 0
2246) do local_id = 1, unstructured_grid%nlmax
2247) do idual = 1, unstructured_grid%cell_neighbors_local_ghosted(0,local_id)
2248) dual_id = unstructured_grid%cell_neighbors_local_ghosted(idual,local_id)
2249) ! count all ghosted connections (dual_id < 0)
2250) ! only count connection with cells of larger ids to avoid double counts
2251) !geh: we need to cound all local connection, but just once (local_id < dual_id) and all
2252) ! ghosted connections (dual_id < 0)
2253) if (dual_id < 0 .or. local_id < dual_id) then
2254) !geh: Nope if (dual_id > 0 .and. local_id < dual_id) then !sp
2255) nconn = nconn + 1
2256) endif
2257) enddo
2258) enddo
2259)
2260)
2261) connections => ConnectionCreate(nconn,INTERNAL_CONNECTION_TYPE)
2262)
2263) allocate(unstructured_grid%face_area(face_count))
2264) allocate(unstructured_grid%connection_to_face(nconn))
2265) unstructured_grid%connection_to_face = 0
2266)
2267) ! loop over connection again
2268) iconn = 0
2269) do local_id = 1, unstructured_grid%nlmax
2270) do idual = 1, unstructured_grid%cell_neighbors_local_ghosted(0,local_id)
2271) dual_local_id = &
2272) unstructured_grid%cell_neighbors_local_ghosted(idual,local_id)
2273) ! abs(dual_local_id) to accommodate connections to ghost cells where
2274) ! the dual id is < 0.
2275) if (local_id < abs(dual_local_id)) then
2276) iconn = iconn + 1
2277) ! find face
2278) found = PETSC_FALSE
2279) do iface = 1, unstructured_grid%cell_vertices(0,local_id)
2280) face_id = cell_to_face(iface,local_id)
2281) do iside = 1,2
2282) cell_id2 = face_to_cell(iside,face_id)
2283) if (cell_id2 == abs(dual_local_id)) then
2284) found = PETSC_TRUE
2285) exit
2286) endif
2287) enddo
2288) if (found) exit
2289) enddo
2290) if (found) then
2291) unstructured_grid%connection_to_face(iconn) = face_id
2292) else
2293) write(string,*) option%myrank,local_id,dual_local_id
2294) option%io_buffer = 'face not found in connection loop' // trim(string)
2295) call printErrMsg(option)
2296) endif
2297) face_type = &
2298) UCellGetFaceType(unstructured_grid%cell_type(local_id),iface,option)
2299) found = PETSC_FALSE
2300) do iface2 = 1, unstructured_grid%cell_vertices(0,cell_id2)
2301) if (cell_to_face(iface,local_id) == &
2302) cell_to_face(iface2,cell_id2)) then
2303) found = PETSC_TRUE
2304) exit
2305) endif
2306) enddo
2307) if (found) then
2308) face_type2 = &
2309) UCellGetFaceType(unstructured_grid%cell_type(cell_id2), &
2310) iface2,option)
2311) if (face_type /= face_type2) then
2312) write(string,*) option%myrank, local_id, cell_id2
2313) option%io_buffer = 'face types do not match' // trim(string)
2314) call printErrMsg(option)
2315) endif
2316) else
2317) write(string,*) option%myrank, iface, cell_id2
2318) option%io_buffer = 'global face not found' // trim(string)
2319) call printErrMsg(option)
2320) endif
2321) connections%id_up(iconn) = local_id
2322) connections%id_dn(iconn) = abs(dual_local_id)
2323) connections%face_id(iconn) = cell_to_face(iface,local_id)
2324) if (face_type == LINE_FACE_TYPE) then
2325)
2326) point_up%x = grid_x(local_id)
2327) point_up%y = grid_y(local_id)
2328) point_up%z = grid_z(local_id)
2329) point_dn%x = grid_x(abs(dual_local_id))
2330) point_dn%y = grid_y(abs(dual_local_id))
2331) point_dn%z = grid_z(abs(dual_local_id))
2332) point1 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(1,face_id))
2333) point2 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(2,face_id))
2334)
2335) call UcellGetLineIntercept(point1,point2,point_up,intercept1)
2336) call UcellGetLineIntercept(point1,point2,point_dn,intercept2)
2337) intercept%x = 0.5d0*(intercept1%x + intercept2%x)
2338) intercept%y = 0.5d0*(intercept1%y + intercept2%y)
2339) intercept%z = 0.5d0*(intercept1%z + intercept2%z)
2340)
2341) !v1(1) = point_dn%x-point_up%x
2342) !v1(2) = point_dn%y-point_up%y
2343) !v1(3) = point_dn%z-point_up%z
2344) v1(1) = point1%x-point2%x
2345) v1(2) = point1%y-point2%y
2346) v1(3) = point1%z-point2%z
2347)
2348) area1 = sqrt(DotProduct(v1,v1))
2349) area2 = 0.d0
2350) else
2351)
2352) ! need to add the surface areas, distance, etc.
2353) point1 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(1,face_id))
2354) point2 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(2,face_id))
2355) point3 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(3,face_id))
2356) if (face_type == QUAD_FACE_TYPE) then
2357) point4 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(4,face_id))
2358) endif
2359)
2360) call UCellComputePlane(plane1,point1,point2,point3)
2361)
2362) point_up%x = grid_x(local_id)
2363) point_up%y = grid_y(local_id)
2364) point_up%z = grid_z(local_id)
2365) point_dn%x = grid_x(abs(dual_local_id))
2366) point_dn%y = grid_y(abs(dual_local_id))
2367) point_dn%z = grid_z(abs(dual_local_id))
2368) v1(1) = point_dn%x-point_up%x
2369) v1(2) = point_dn%y-point_up%y
2370) v1(3) = point_dn%z-point_up%z
2371) n_up_dn = v1 / sqrt(DotProduct(v1,v1))
2372) call UCellGetPlaneIntercept(plane1,point_up,point_dn,intercept1)
2373)
2374) v1(1) = point3%x-point2%x
2375) v1(2) = point3%y-point2%y
2376) v1(3) = point3%z-point2%z
2377) v2(1) = point1%x-point2%x
2378) v2(2) = point1%y-point2%y
2379) v2(3) = point1%z-point2%z
2380) !geh: area = 0.5 * |v1 x v2|
2381) vcross = CrossProduct(v1,v2)
2382) !geh: but then we have to project the area onto the vector between
2383) ! the cell centers (n_up_dn)
2384) magnitude = sqrt(DotProduct(vcross,vcross))
2385) n1 = vcross/magnitude
2386) area1 = 0.5d0*magnitude
2387) area1 = dabs(area1*DotProduct(n1,n_up_dn))
2388) !geh: The below does not project onto the vector between cell centers.
2389) !gehbug area1 = 0.5d0*sqrt(DotProduct(n1,n1))
2390)
2391) if (face_type == QUAD_FACE_TYPE) then
2392) call UCellComputePlane(plane2,point3,point4,point1)
2393) call UCellGetPlaneIntercept(plane2,point_up,point_dn,intercept2)
2394) v1(1) = point1%x-point4%x
2395) v1(2) = point1%y-point4%y
2396) v1(3) = point1%z-point4%z
2397) v2(1) = point3%x-point4%x
2398) v2(2) = point3%y-point4%y
2399) v2(3) = point3%z-point4%z
2400) magnitude = sqrt(DotProduct(vcross,vcross))
2401) n2 = vcross/magnitude
2402) area2 = 0.5d0*magnitude
2403) area2 = dabs(area2*DotProduct(n2,n_up_dn))
2404) else
2405) area2 = 0.d0
2406) endif
2407)
2408) if (face_type == QUAD_FACE_TYPE) then
2409) intercept%x = 0.5d0*(intercept1%x + intercept2%x)
2410) intercept%y = 0.5d0*(intercept1%y + intercept2%y)
2411) intercept%z = 0.5d0*(intercept1%z + intercept2%z)
2412) else
2413) intercept%x = intercept1%x
2414) intercept%y = intercept1%y
2415) intercept%z = intercept1%z
2416) endif
2417) endif
2418)
2419) !geh: this is very crude, but for now use average location of intercept
2420) v1(1) = intercept%x-point_up%x
2421) v1(2) = intercept%y-point_up%y
2422) v1(3) = intercept%z-point_up%z
2423) v2(1) = point_dn%x-intercept%x
2424) v2(2) = point_dn%y-intercept%y
2425) v2(3) = point_dn%z-intercept%z
2426) dist_up = sqrt(DotProduct(v1,v1))
2427) dist_dn = sqrt(DotProduct(v2,v2))
2428)
2429) connections%dist(-1:3,iconn) = 0.d0
2430) connections%dist(-1,iconn) = dist_up/(dist_up+dist_dn)
2431) connections%dist(0,iconn) = dist_up + dist_dn
2432) v3 = v1 + v2
2433) connections%dist(1:3,iconn) = v3/sqrt(DotProduct(v3,v3))
2434) connections%area(iconn) = area1 + area2
2435) connections%intercp(1,iconn) = intercept%x
2436) connections%intercp(2,iconn) = intercept%y
2437) connections%intercp(3,iconn) = intercept%z
2438)
2439) endif
2440) enddo
2441) enddo
2442)
2443) ! Save area and centroid of faces
2444) allocate(unstructured_grid%face_centroid(face_count))
2445) do iface = 1,face_count
2446) unstructured_grid%face_centroid(iface)%id = 0
2447) enddo
2448)
2449) do local_id = 1, unstructured_grid%nlmax
2450) do iface = 1,MAX_FACE_PER_CELL
2451) face_id = cell_to_face(iface, local_id)
2452) if (face_id == 0) cycle
2453) if ( unstructured_grid%face_centroid(face_id)%id == 0) then
2454) count = 0
2455) unstructured_grid%face_centroid(face_id)%x = 0.d0
2456) unstructured_grid%face_centroid(face_id)%y = 0.d0
2457) unstructured_grid%face_centroid(face_id)%z = 0.d0
2458)
2459) if (unstructured_grid%face_to_vertex(3,face_id) == 0) then
2460) face_type = LINE_FACE_TYPE
2461) else
2462) if (unstructured_grid%face_to_vertex(4,face_id) == 0) then
2463) face_type = TRI_FACE_TYPE
2464) else
2465) face_type = QUAD_FACE_TYPE
2466) endif
2467) endif
2468)
2469) if (face_type == LINE_FACE_TYPE) then
2470)
2471) point1 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(1,face_id))
2472) point2 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(2,face_id))
2473)
2474) v1(1) = point1%x-point2%x
2475) v1(2) = point1%y-point2%y
2476) v1(3) = point1%z-point2%z
2477)
2478) area1 = sqrt(DotProduct(v1,v1))
2479) area2 = 0.d0
2480) else
2481)
2482) point1 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(1,face_id))
2483) point2 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(2,face_id))
2484) point3 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(3,face_id))
2485) if (face_type == QUAD_FACE_TYPE) then
2486) point4 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(4,face_id))
2487) else
2488) point4 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(3,face_id))
2489) endif
2490) v1(1) = point3%x-point2%x
2491) v1(2) = point3%y-point2%y
2492) v1(3) = point3%z-point2%z
2493) v2(1) = point1%x-point2%x
2494) v2(2) = point1%y-point2%y
2495) v2(3) = point1%z-point2%z
2496) n1 = CrossProduct(v1,v2)
2497) area1 = 0.5d0*sqrt(DotProduct(n1,n1))
2498)
2499) v1(1) = point1%x-point4%x
2500) v1(2) = point1%y-point4%y
2501) v1(3) = point1%z-point4%z
2502) v2(1) = point3%x-point4%x
2503) v2(2) = point3%y-point4%y
2504) v2(3) = point3%z-point4%z
2505) n2 = CrossProduct(v1,v2)
2506) area2 = 0.5d0*sqrt(DotProduct(n2,n2))
2507) endif
2508)
2509) unstructured_grid%face_area(face_id) = area1 + area2
2510)
2511) do ivert = 1,MAX_VERT_PER_FACE
2512) vertex_id = unstructured_grid%face_to_vertex(ivert,face_id)
2513) if (vertex_id.ne.0) then
2514) unstructured_grid%face_centroid(face_id)%x = &
2515) unstructured_grid%face_centroid(face_id)%x + &
2516) unstructured_grid%vertices(vertex_id)%x
2517) unstructured_grid%face_centroid(face_id)%y = &
2518) unstructured_grid%face_centroid(face_id)%y + &
2519) unstructured_grid%vertices(vertex_id)%y
2520) unstructured_grid%face_centroid(face_id)%z = &
2521) unstructured_grid%face_centroid(face_id)%z + &
2522) unstructured_grid%vertices(vertex_id)%z
2523) count = count +1
2524) endif
2525) enddo
2526) unstructured_grid%face_centroid(face_id)%id = face_id
2527) unstructured_grid%face_centroid(face_id)%x = &
2528) unstructured_grid%face_centroid(face_id)%x/count
2529) unstructured_grid%face_centroid(face_id)%y = &
2530) unstructured_grid%face_centroid(face_id)%y/count
2531) unstructured_grid%face_centroid(face_id)%z = &
2532) unstructured_grid%face_centroid(face_id)%z/count
2533) endif
2534) enddo
2535) enddo
2536)
2537) allocate(unstructured_grid%face_to_cell_ghosted(size(face_to_cell,1), &
2538) size(face_to_cell,2)))
2539) unstructured_grid%face_to_cell_ghosted = face_to_cell
2540) allocate(unstructured_grid%cell_to_face_ghosted(size(cell_to_face,1), &
2541) size(cell_to_face,2)))
2542) unstructured_grid%cell_to_face_ghosted(:,:) = cell_to_face(:,:)
2543)
2544) deallocate(cell_to_face)
2545) deallocate(face_to_cell)
2546) deallocate(vertex_to_cell)
2547)
2548) UGridComputeInternConnect => connections
2549)
2550) end function UGridComputeInternConnect
2551)
2552) ! ************************************************************************** !
2553)
2554) subroutine UGridPopulateConnection(unstructured_grid, connection, iface_cell, &
2555) iconn, ghosted_id, option)
2556) !
2557) ! Computes details of connection (area, dist, etc)
2558) !
2559) ! Author: Gautam Bisht
2560) ! Date: 10/30/09
2561) !
2562)
2563) use Connection_module
2564) use Utility_module, only : DotProduct
2565) use Option_module
2566) use Grid_Unstructured_Cell_module
2567)
2568) implicit none
2569)
2570) type(grid_unstructured_type) :: unstructured_grid
2571) type(connection_set_type) :: connection
2572) PetscInt :: iface_cell
2573) PetscInt :: iconn
2574) PetscInt :: ghosted_id
2575) type(option_type) :: option
2576)
2577) PetscErrorCode :: ierr
2578)
2579) PetscInt :: face_id
2580) PetscInt :: ivert,vert_id
2581) PetscInt :: face_type
2582) PetscReal :: v1(3),v2(3),n_dist(3), dist
2583) type(point_type) :: vertex_8(8)
2584) type(plane_type) :: plane
2585) type(point_type) :: point, vertex1, vertex2, vertex3, intercept
2586) character(len=MAXWORDLENGTH) :: word
2587)
2588)
2589) select case(connection%itype)
2590) case(BOUNDARY_CONNECTION_TYPE)
2591) if (iface_cell == 0) then
2592) write(word,*) ghosted_id
2593) option%io_buffer = 'Face id undefined for cell ' // &
2594) trim(adjustl(word)) // &
2595) ' in boundary condition. Should this be a source/sink?'
2596) call printErrMsgByRank(option)
2597) endif
2598) ! Compute cell centeroid
2599) v2 = 0.d0
2600) do ivert = 1, unstructured_grid%cell_vertices(0, ghosted_id)
2601) vert_id = unstructured_grid%cell_vertices(ivert, ghosted_id)
2602) vertex_8(ivert)%x = unstructured_grid%vertices(vert_id)%x
2603) vertex_8(ivert)%y = unstructured_grid%vertices(vert_id)%y
2604) vertex_8(ivert)%z = unstructured_grid%vertices(vert_id)%z
2605) enddo
2606) v2 = UCellComputeCentroid(unstructured_grid%cell_type(ghosted_id), &
2607) vertex_8,option)
2608) ! Instead of connecting centroid with face center, calculate the shortest
2609) ! distance between the centroid and face and use that distance - geh
2610) #if 0
2611) ! Get face-centroid vector
2612) face_id = unstructured_grid%cell_to_face_ghosted(iface_cell, ghosted_id)
2613) v1(1) = unstructured_grid%face_centroid(face_id)%x
2614) v1(2) = unstructured_grid%face_centroid(face_id)%y
2615) v1(3) = unstructured_grid%face_centroid(face_id)%z
2616)
2617) #endif
2618) !TODO(geh): add support for a quad face
2619) !TODO(geh): replace %face_to_vertex array with function that returns vertices
2620) ! based on cell type and iface
2621) point%x = v2(1)
2622) point%y = v2(2)
2623) point%z = v2(3)
2624) face_id = unstructured_grid%cell_to_face_ghosted(iface_cell, ghosted_id)
2625) face_type = UCellGetFaceType(unstructured_grid%cell_type(ghosted_id),face_id,option)
2626) vertex1 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(1,face_id))
2627) vertex2 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(2,face_id))
2628) if (face_type == LINE_FACE_TYPE) then
2629) call UCellGetLineIntercept(vertex1,vertex2,point,intercept)
2630) else
2631) vertex3 = unstructured_grid%vertices(unstructured_grid%face_to_vertex(3,face_id))
2632) call UCellComputePlane(plane,vertex1,vertex2,vertex3)
2633) call UCellProjectPointOntoPlane(plane,point,intercept)
2634) endif
2635)
2636) ! Compute distance vector: cell_center - face_centroid
2637) v1(1) = v2(1) - intercept%x
2638) v1(2) = v2(2) - intercept%y
2639) v1(3) = v2(3) - intercept%z
2640)
2641) dist = sqrt(DotProduct(v1, v1))
2642) n_dist = v1/dist
2643) connection%dist(0, iconn) = dist
2644) connection%dist(1, iconn) = n_dist(1)
2645) connection%dist(2, iconn) = n_dist(2)
2646) connection%dist(3, iconn) = n_dist(3)
2647) connection%area(iconn) = unstructured_grid%face_area(face_id)
2648) connection%intercp(1,iconn)= intercept%x
2649) connection%intercp(2,iconn)= intercept%y
2650) connection%intercp(3,iconn)= intercept%z
2651) connection%face_id(iconn) = face_id
2652)
2653) end select
2654)
2655) end subroutine UGridPopulateConnection
2656)
2657) ! ************************************************************************** !
2658)
2659) subroutine UGridComputeCoord(unstructured_grid,option, &
2660) grid_x,grid_y,grid_z, &
2661) x_min,x_max,y_min,y_max,z_min,z_max)
2662) !
2663) ! Computes coordinates in x,y,z of unstructured grid cells
2664) ! 11/2/10 Major rewrite to extend coordinates to ghost cells SP and GEH
2665) !
2666) ! Author: Glenn Hammond
2667) ! Date: 10/30/09
2668) !
2669)
2670) use Option_module
2671)
2672) implicit none
2673)
2674) type(grid_unstructured_type) :: unstructured_grid
2675) type(option_type) :: option
2676) PetscReal :: grid_x(:), grid_y(:), grid_z(:)
2677) PetscReal :: x_min, x_max, y_min, y_max, z_min, z_max
2678)
2679) PetscInt :: ghosted_id
2680) PetscInt :: ivertex
2681) PetscInt :: vertex_id
2682) type(point_type) :: vertex_8(8)
2683) PetscReal :: centroid(3)
2684) PetscErrorCode :: ierr
2685)
2686) do ghosted_id = 1, unstructured_grid%ngmax
2687) do ivertex = 1, unstructured_grid%cell_vertices(0,ghosted_id)
2688) vertex_id = unstructured_grid%cell_vertices(ivertex,ghosted_id)
2689) vertex_8(ivertex)%x = &
2690) unstructured_grid%vertices(vertex_id)%x
2691) vertex_8(ivertex)%y = &
2692) unstructured_grid%vertices(vertex_id)%y
2693) vertex_8(ivertex)%z = &
2694) unstructured_grid%vertices(vertex_id)%z
2695) enddo
2696) centroid = UCellComputeCentroid(unstructured_grid%cell_type(ghosted_id), &
2697) vertex_8,option)
2698) grid_x(ghosted_id) = centroid(1)
2699) grid_y(ghosted_id) = centroid(2)
2700) grid_z(ghosted_id) = centroid(3)
2701) enddo
2702)
2703) do ivertex = 1, unstructured_grid%num_vertices_local
2704) if (x_max < unstructured_grid%vertices(ivertex)%x) &
2705) x_max = unstructured_grid%vertices(ivertex)%x
2706) if (x_min > unstructured_grid%vertices(ivertex)%x) &
2707) x_min = unstructured_grid%vertices(ivertex)%x
2708) if (y_max < unstructured_grid%vertices(ivertex)%y) &
2709) y_max = unstructured_grid%vertices(ivertex)%y
2710) if (y_min > unstructured_grid%vertices(ivertex)%y) &
2711) y_min = unstructured_grid%vertices(ivertex)%y
2712) if (z_max < unstructured_grid%vertices(ivertex)%z) &
2713) z_max = unstructured_grid%vertices(ivertex)%z
2714) if (z_min > unstructured_grid%vertices(ivertex)%z) &
2715) z_min = unstructured_grid%vertices(ivertex)%z
2716) enddo
2717)
2718) end subroutine UGridComputeCoord
2719)
2720) ! ************************************************************************** !
2721)
2722) subroutine UGridComputeVolumes(unstructured_grid,option,volume)
2723) !
2724) ! Computes volume of unstructured grid cells
2725) !
2726) ! Author: Glenn Hammond
2727) ! Date: 11/06/09
2728) !
2729)
2730) use Option_module
2731)
2732) implicit none
2733)
2734) type(grid_unstructured_type) :: unstructured_grid
2735) type(option_type) :: option
2736) Vec :: volume
2737)
2738)
2739) PetscInt :: local_id
2740) PetscInt :: ghosted_id
2741) PetscInt :: ivertex
2742) PetscInt :: vertex_id
2743) type(point_type) :: vertex_8(8)
2744) PetscReal, pointer :: volume_p(:)
2745) PetscErrorCode :: ierr
2746)
2747) call VecGetArrayF90(volume,volume_p,ierr);CHKERRQ(ierr)
2748)
2749) do local_id = 1, unstructured_grid%nlmax
2750) ! ghosted_id = local_id on unstructured grids
2751) ghosted_id = local_id
2752) do ivertex = 1, unstructured_grid%cell_vertices(0,ghosted_id)
2753) vertex_id = unstructured_grid%cell_vertices(ivertex,ghosted_id)
2754) vertex_8(ivertex)%x = &
2755) unstructured_grid%vertices(vertex_id)%x
2756) vertex_8(ivertex)%y = &
2757) unstructured_grid%vertices(vertex_id)%y
2758) vertex_8(ivertex)%z = &
2759) unstructured_grid%vertices(vertex_id)%z
2760) enddo
2761) volume_p(local_id) = UCellComputeVolume(unstructured_grid%cell_type( &
2762) ghosted_id),vertex_8,option)
2763) enddo
2764)
2765) call VecRestoreArrayF90(volume,volume_p,ierr);CHKERRQ(ierr)
2766)
2767) end subroutine UGridComputeVolumes
2768)
2769) ! ************************************************************************** !
2770)
2771) subroutine UGridComputeAreas(unstructured_grid,option,area)
2772) !
2773) ! Computes area of unstructured grid cells
2774) !
2775) ! Author: Gautam Bisht
2776) ! Date: 03/07/2012
2777) !
2778)
2779) use Option_module
2780)
2781) implicit none
2782)
2783) type(grid_unstructured_type) :: unstructured_grid
2784) type(option_type) :: option
2785) Vec :: area
2786)
2787)
2788) PetscInt :: local_id
2789) PetscInt :: ghosted_id
2790) PetscInt :: ivertex
2791) PetscInt :: vertex_id
2792) type(point_type) :: vertex_4(4)
2793) PetscReal, pointer :: area_p(:)
2794) PetscErrorCode :: ierr
2795)
2796) call VecGetArrayF90(area,area_p,ierr);CHKERRQ(ierr)
2797)
2798) do local_id = 1, unstructured_grid%nlmax
2799) ! ghosted_id = local_id on unstructured grids
2800) ghosted_id = local_id
2801) if (unstructured_grid%cell_vertices(0,ghosted_id) > 4 ) then
2802) option%io_buffer = 'ERROR: In UGridComputeAreas the no. of vertices > 4'
2803) call printErrMsg(option)
2804) endif
2805) do ivertex = 1, unstructured_grid%cell_vertices(0,ghosted_id)
2806) vertex_id = unstructured_grid%cell_vertices(ivertex,ghosted_id)
2807) vertex_4(ivertex)%x = &
2808) unstructured_grid%vertices(vertex_id)%x
2809) vertex_4(ivertex)%y = &
2810) unstructured_grid%vertices(vertex_id)%y
2811) vertex_4(ivertex)%z = &
2812) unstructured_grid%vertices(vertex_id)%z
2813) enddo
2814) area_p(local_id) = UCellComputeArea(unstructured_grid%cell_type( &
2815) ghosted_id),vertex_4,option)
2816) enddo
2817)
2818) call VecRestoreArrayF90(area,area_p,ierr);CHKERRQ(ierr)
2819)
2820) end subroutine UGridComputeAreas
2821)
2822) ! ************************************************************************** !
2823)
2824) subroutine UGridComputeQuality(unstructured_grid,option)
2825) !
2826) ! Computes quality of unstructured grid cells
2827) ! geh: Yes, this is very primitive as mesh quality can be based on any
2828) ! number of metrics (e.g., see http://cubit.sandia.gov/help-version8/
2829) ! Chapter_5/Mesh_Quality_Assessment.html). However, the current edge
2830) ! length-based formula gives a ballpark estimate.
2831) !
2832) ! Author: Glenn Hammond
2833) ! Date: 01/17/12
2834) !
2835)
2836) use Option_module
2837)
2838) implicit none
2839)
2840) type(grid_unstructured_type) :: unstructured_grid
2841) type(option_type) :: option
2842)
2843) PetscInt :: local_id
2844) PetscInt :: ghosted_id
2845) PetscInt :: ivertex
2846) PetscInt :: vertex_id
2847) type(point_type) :: vertex_8(8)
2848) PetscReal :: quality, mean_quality, max_quality, min_quality
2849) PetscErrorCode :: ierr
2850)
2851) mean_quality = 0.d0
2852) max_quality = -1.d20
2853) min_quality = 1.d20
2854)
2855) do local_id = 1, unstructured_grid%nlmax
2856) ! ghosted_id = local_id on unstructured grids
2857) ghosted_id = local_id
2858) do ivertex = 1, unstructured_grid%cell_vertices(0,ghosted_id)
2859) vertex_id = unstructured_grid%cell_vertices(ivertex,ghosted_id)
2860) vertex_8(ivertex)%x = &
2861) unstructured_grid%vertices(vertex_id)%x
2862) vertex_8(ivertex)%y = &
2863) unstructured_grid%vertices(vertex_id)%y
2864) vertex_8(ivertex)%z = &
2865) unstructured_grid%vertices(vertex_id)%z
2866) enddo
2867) quality = UCellQuality(unstructured_grid%cell_type( &
2868) ghosted_id),vertex_8,option)
2869) if (quality < min_quality) min_quality = quality
2870) if (quality > max_quality) max_quality = quality
2871) mean_quality = mean_quality + quality
2872) enddo
2873)
2874) call MPI_Allreduce(MPI_IN_PLACE,mean_quality,ONE_INTEGER_MPI, &
2875) MPI_DOUBLE_PRECISION,MPI_SUM,option%mycomm,ierr)
2876) mean_quality = mean_quality / unstructured_grid%nmax
2877)
2878) call MPI_Allreduce(MPI_IN_PLACE,max_quality,ONE_INTEGER_MPI, &
2879) MPI_DOUBLE_PRECISION,MPI_MAX,option%mycomm,ierr)
2880)
2881) call MPI_Allreduce(MPI_IN_PLACE,min_quality,ONE_INTEGER_MPI, &
2882) MPI_DOUBLE_PRECISION,MPI_MIN,option%mycomm,ierr)
2883)
2884) if (OptionPrintToScreen(option)) then
2885) write(*,'(/," ---------- Mesh Quality ----------", &
2886) & /," Mean Quality: ",es10.2, &
2887) & /," Max Quality : ",es10.2, &
2888) & /," Min Quality : ",es10.2, &
2889) & /," ----------------------------------",/)') &
2890) mean_quality, max_quality, min_quality
2891) endif
2892)
2893) end subroutine UGridComputeQuality
2894)
2895) ! ************************************************************************** !
2896)
2897) subroutine UGridEnsureRightHandRule(unstructured_grid,x,y,z,nG2A,nl2G,option)
2898) !
2899) ! Rearranges order of vertices within each cell
2900) ! so that when the right hand rule is applied to a
2901) ! face, the thumb points away from the centroid
2902) !
2903) ! Author: Glenn Hammond
2904) ! Date: 10/24/11
2905) !
2906)
2907) use Option_module
2908) use Utility_module, only : DotProduct, CrossProduct
2909)
2910) implicit none
2911)
2912) type(grid_unstructured_type) :: unstructured_grid
2913) PetscReal :: x(:), y(:), z(:)
2914) PetscInt :: nG2A(:)
2915) PetscInt :: nL2G(:)
2916) type(option_type) :: option
2917)
2918) PetscInt :: local_id
2919) PetscInt :: ghosted_id
2920) type(point_type) :: point, point1, point2, point3
2921) type(plane_type) :: plane1
2922) PetscReal :: v1(3),v2(3),vcross(3),magnitude
2923) PetscReal :: distance
2924) PetscInt :: cell_vertex_ids_before(8), cell_vertex_ids_after(8)
2925) PetscInt :: face_vertex_ids(4)
2926) type(point_type) :: vertex_8(8)
2927) PetscInt :: ivertex, vertex_id
2928) PetscInt :: num_vertices, iface, cell_type, num_faces, face_type, i
2929) PetscInt :: num_face_vertices
2930) character(len=MAXSTRINGLENGTH) :: string
2931) PetscBool :: error_found
2932)
2933) error_found = PETSC_FALSE
2934) do local_id = 1, unstructured_grid%nlmax
2935) ghosted_id = local_id
2936) cell_type = unstructured_grid%cell_type(local_id)
2937) num_vertices = UCellGetNVertices(cell_type,option)
2938) cell_vertex_ids_before(1:num_vertices) = &
2939) unstructured_grid%cell_vertices(1:num_vertices,ghosted_id)
2940) cell_vertex_ids_after = cell_vertex_ids_before
2941) ! point is the centroid of cell
2942) point%x = x(ghosted_id)
2943) point%y = y(ghosted_id)
2944) point%z = z(ghosted_id)
2945) num_faces = UCellGetNFaces(cell_type,option)
2946) do iface = 1, num_faces
2947) face_type = UCellGetFaceType(cell_type,iface,option)
2948) num_face_vertices = UCellGetNFaceVertices(cell_type,iface,option)
2949) call UCellGetFaceVertices(option,cell_type,iface,face_vertex_ids)
2950) ! Need to find distance of a point (centroid) from a line (formed by
2951) ! joining vertices of a line)
2952) point1 = &
2953) unstructured_grid%vertices(cell_vertex_ids_before(face_vertex_ids(1)))
2954) point2 = &
2955) unstructured_grid%vertices(cell_vertex_ids_before(face_vertex_ids(2)))
2956) if (face_type == LINE_FACE_TYPE) then
2957) point3%x = point2%x
2958) point3%y = point2%y
2959) point3%z = point2%z + 1.d0
2960) else
2961) point3 = &
2962) unstructured_grid%vertices(cell_vertex_ids_before(face_vertex_ids(3)))
2963) endif
2964)
2965) call UCellComputePlane(plane1,point1,point2,point3)
2966) distance = UCellComputeDistanceFromPlane(plane1,point)
2967)
2968) if (distance > 0.d0) then
2969) ! need to swap so that distance is negative (point lies below plane)
2970) if (cell_type == TRI_TYPE .or. cell_type == QUAD_TYPE) then
2971) ! Error message for 2D cell type
2972) option%io_buffer = 'Cell:'
2973) write(string,'(i13)') nG2A(nL2G(local_id))
2974) option%io_buffer = trim(option%io_buffer) // ' ' // &
2975) trim(adjustl(string)) // ' of type "' // &
2976) trim(UCellTypeToWord(cell_type,option)) // '" with vertices:'
2977) do i = 1, num_vertices
2978) write(string,'(i13)') &
2979) unstructured_grid%vertex_ids_natural(cell_vertex_ids_before(i))
2980) option%io_buffer = trim(option%io_buffer) // ' ' // &
2981) trim(adjustl(string))
2982) enddo
2983) option%io_buffer = trim(option%io_buffer) // &
2984) ' violates right hand rule at face "' // &
2985) trim(UCellFaceTypeToWord(face_type,option)) // &
2986) '" based on face vertices:'
2987) do i = 1, num_face_vertices
2988) write(string,'(i13)') face_vertex_ids(i)
2989) option%io_buffer = trim(option%io_buffer) // ' ' // &
2990) trim(adjustl(string))
2991) enddo
2992) do ivertex = 1, unstructured_grid%cell_vertices(0,ghosted_id)
2993) vertex_id = unstructured_grid%cell_vertices(ivertex,ghosted_id)
2994) vertex_8(ivertex)%x = &
2995) unstructured_grid%vertices(vertex_id)%x
2996) vertex_8(ivertex)%y = &
2997) unstructured_grid%vertices(vertex_id)%y
2998) vertex_8(ivertex)%z = &
2999) unstructured_grid%vertices(vertex_id)%z
3000) enddo
3001) write(string,'(es12.4)') &
3002) UCellComputeArea(cell_type,vertex_8,option)
3003) option%io_buffer = trim(option%io_buffer) // ' and area: ' // &
3004) trim(adjustl(string)) // '.'
3005) call printMsgAnyRank(option)
3006) error_found = PETSC_TRUE
3007) else
3008) ! Error message for 3D cell type
3009) option%io_buffer = 'Cell:'
3010) write(string,'(i13)') nG2A(nL2G(local_id))
3011) option%io_buffer = trim(option%io_buffer) // ' ' // &
3012) trim(adjustl(string)) // ' of type "' // &
3013) trim(UCellTypeToWord(cell_type,option)) // '" with vertices:'
3014) do i = 1, num_vertices
3015) write(string,'(i13)') &
3016) unstructured_grid%vertex_ids_natural(cell_vertex_ids_before(i))
3017) option%io_buffer = trim(option%io_buffer) // ' ' // &
3018) trim(adjustl(string))
3019) enddo
3020) option%io_buffer = trim(option%io_buffer) // &
3021) ' violates right hand rule at face "' // &
3022) trim(UCellFaceTypeToWord(face_type,option)) // &
3023) '" based on face vertices:'
3024) do i = 1, num_face_vertices
3025) write(string,'(i13)') face_vertex_ids(i)
3026) option%io_buffer = trim(option%io_buffer) // ' ' // &
3027) trim(adjustl(string))
3028) enddo
3029) do ivertex = 1, unstructured_grid%cell_vertices(0,ghosted_id)
3030) vertex_id = unstructured_grid%cell_vertices(ivertex,ghosted_id)
3031) vertex_8(ivertex)%x = &
3032) unstructured_grid%vertices(vertex_id)%x
3033) vertex_8(ivertex)%y = &
3034) unstructured_grid%vertices(vertex_id)%y
3035) vertex_8(ivertex)%z = &
3036) unstructured_grid%vertices(vertex_id)%z
3037) enddo
3038) write(string,'(es12.4)') &
3039) UCellComputeVolume(cell_type,vertex_8,option)
3040) option%io_buffer = trim(option%io_buffer) // ' and volume: ' // &
3041) trim(adjustl(string)) // '.'
3042) call printMsgAnyRank(option)
3043) error_found = PETSC_TRUE
3044) endif
3045) endif
3046) enddo
3047) enddo
3048)
3049) if (error_found) then
3050) option%io_buffer = 'Cells founds that violate right hand rule.'
3051) call printErrMsgByRank(option)
3052) endif
3053)
3054) end subroutine UGridEnsureRightHandRule
3055)
3056) ! ************************************************************************** !
3057)
3058) subroutine UGridGetCellFromPoint(x,y,z,unstructured_grid,option,icell)
3059) !
3060) ! Returns the cell that encompasses a point in space
3061) !
3062) ! Author: Glenn Hammond
3063) ! Date: 10/24/09
3064) !
3065)
3066) use Option_module
3067)
3068) implicit none
3069)
3070) PetscReal :: x, y, z
3071) PetscInt :: icell
3072) type(grid_unstructured_type) :: unstructured_grid
3073) type(option_type) :: option
3074)
3075) PetscInt :: cell_type, num_faces, iface, face_type
3076) PetscInt :: vertex_ids(4)
3077) type(plane_type) :: plane1, plane2
3078) type(point_type) :: point, point1, point2, point3, point4
3079) PetscInt :: local_id, ghosted_id
3080) PetscReal :: distance
3081) PetscBool :: inside
3082)
3083) icell = 0
3084)
3085) point%x = x
3086) point%y = y
3087) point%z = z
3088)
3089) do local_id = 1, unstructured_grid%nlmax
3090) ghosted_id = local_id ! ghosted ids are same for first nlocal cells
3091) cell_type = unstructured_grid%cell_type(ghosted_id)
3092) num_faces = UCellGetNFaces(cell_type,option)
3093)
3094) ! vertices should be ordered counter-clockwise so that a cross product
3095) ! of the two vectors v1-v2 and v1-v3 points outward.
3096) ! if the distance from the point to the planes making up the faces is always
3097) ! negative using counter-clockwise ordering, the point is within the volume
3098) ! encompassed by the faces.
3099) inside = PETSC_TRUE
3100) do iface = 1, num_faces
3101) face_type = UCellGetFaceType(cell_type,iface,option)
3102) call UCellGetFaceVertices(option,cell_type,iface,vertex_ids)
3103) point1 = unstructured_grid%vertices(unstructured_grid%cell_vertices(vertex_ids(1),ghosted_id))
3104) point2 = unstructured_grid%vertices(unstructured_grid%cell_vertices(vertex_ids(2),ghosted_id))
3105) point3 = unstructured_grid%vertices(unstructured_grid%cell_vertices(vertex_ids(3),ghosted_id))
3106) call UCellComputePlane(plane1,point1,point2,point3)
3107) distance = UCellComputeDistanceFromPlane(plane1,point)
3108) if (distance > 0.d0) then
3109) inside = PETSC_FALSE
3110) exit
3111) endif
3112) if (face_type == QUAD_FACE_TYPE) then
3113) point4 = unstructured_grid%vertices(unstructured_grid%cell_vertices(vertex_ids(4),ghosted_id))
3114) call UCellComputePlane(plane2,point3,point4,point1)
3115) distance = UCellComputeDistanceFromPlane(plane2,point)
3116) if (distance > 0.d0) then
3117) inside = PETSC_FALSE
3118) exit
3119) endif
3120) endif
3121) enddo
3122)
3123) if (inside) then
3124) icell = local_id
3125) exit
3126) endif
3127)
3128) enddo
3129)
3130) end subroutine UGridGetCellFromPoint
3131)
3132) ! ************************************************************************** !
3133)
3134) subroutine UGridGetCellsInRectangle(x_min,x_max,y_min,y_max,z_min,z_max, &
3135) unstructured_grid,option,num_cells, &
3136) cell_ids,cell_face_ids)
3137) !
3138) ! Returns the cell that encompasses a point in space
3139) !
3140) ! Author: Glenn Hammond
3141) ! Date: 10/24/09
3142) !
3143) use Option_module
3144) use Utility_module, only : reallocateIntArray
3145)
3146) implicit none
3147)
3148) PetscReal :: x_min, x_max, y_min, y_max, z_min, z_max
3149) type(grid_unstructured_type) :: unstructured_grid
3150) type(option_type) :: option
3151) PetscInt :: num_cells
3152) PetscInt, pointer :: cell_ids(:)
3153) PetscInt, pointer :: cell_face_ids(:)
3154)
3155) PetscInt :: cell_type, num_faces, iface, face_type
3156) PetscInt :: vertex_ids(4)
3157) PetscInt :: num_vertices, ivertex
3158) PetscInt :: local_id, ghosted_id
3159) type(point_type) :: point
3160)
3161) PetscReal :: x_min_adj, x_max_adj, y_min_adj, y_max_adj, z_min_adj, z_max_adj
3162) PetscReal :: pert
3163) PetscBool :: in_rectangle
3164)
3165) PetscInt, pointer :: temp_cell_array(:), temp_face_array(:)
3166) PetscInt :: temp_array_size
3167)
3168) temp_array_size = 100
3169) allocate(temp_cell_array(temp_array_size))
3170) allocate(temp_face_array(temp_array_size))
3171) temp_cell_array = 0
3172) temp_face_array = 0
3173)
3174) ! enlarge box slightly
3175) pert = max(1.d-8*(x_max-x_min),1.d-8)
3176) x_min_adj = x_min - pert
3177) x_max_adj = x_max + pert
3178) pert = max(1.d-8*(y_max-y_min),1.d-8)
3179) y_min_adj = y_min - pert
3180) y_max_adj = y_max + pert
3181) pert = max(1.d-8*(z_max-z_min),1.d-8)
3182) z_min_adj = z_min - pert
3183) z_max_adj = z_max + pert
3184)
3185) do local_id = 1, unstructured_grid%nlmax
3186) ghosted_id = local_id ! ghosted ids are same for first nlocal cells
3187) cell_type = unstructured_grid%cell_type(ghosted_id)
3188) num_faces = UCellGetNFaces(cell_type,option)
3189) do iface = 1, num_faces
3190) face_type = UCellGetFaceType(cell_type,iface,option)
3191) num_vertices = UCellGetNFaceVertices(cell_type,iface,option)
3192) call UCellGetFaceVertices(option,cell_type,iface,vertex_ids)
3193) in_rectangle = PETSC_TRUE
3194) do ivertex = 1, num_vertices
3195) point = unstructured_grid%vertices(unstructured_grid%cell_vertices(vertex_ids(ivertex),ghosted_id))
3196) if (point%x < x_min_adj .or. &
3197) point%x > x_max_adj .or. &
3198) point%y < y_min_adj .or. &
3199) point%y > y_max_adj .or. &
3200) point%z < z_min_adj .or. &
3201) point%z > z_max_adj) then
3202) in_rectangle = PETSC_FALSE
3203) exit
3204) endif
3205) enddo
3206)
3207) if (in_rectangle) then
3208) num_cells = num_cells + 1
3209) if (num_cells > temp_array_size) then
3210) call reallocateIntArray(temp_cell_array,temp_array_size)
3211) temp_array_size = temp_array_size / 2 ! convert back for next call
3212) call reallocateIntArray(temp_face_array,temp_array_size)
3213) endif
3214) temp_cell_array(num_cells) = local_id
3215) temp_face_array(num_cells) = iface
3216) endif
3217)
3218) enddo
3219) enddo
3220)
3221) allocate(cell_ids(num_cells))
3222) allocate(cell_face_ids(num_cells))
3223) cell_ids = temp_cell_array(1:num_cells)
3224) cell_face_ids = temp_face_array(1:num_cells)
3225) deallocate(temp_cell_array)
3226) nullify(temp_cell_array)
3227) deallocate(temp_face_array)
3228) nullify(temp_face_array)
3229)
3230) end subroutine UGridGetCellsInRectangle
3231)
3232) ! ************************************************************************** !
3233)
3234) subroutine UGridMapSideSet(unstructured_grid,face_vertices,n_ss_faces, &
3235) region_name,option,cell_ids,face_ids)
3236) !
3237) ! Maps a global boundary side set to the faces of local
3238) ! ghosted cells
3239) !
3240) ! Author: Glenn Hammond
3241) ! Date: 12/16/11
3242) !
3243)
3244) use Option_module
3245)
3246) implicit none
3247)
3248) #include "petsc/finclude/petscvec.h"
3249) #include "petsc/finclude/petscvec.h90"
3250) #include "petsc/finclude/petscmat.h"
3251) #include "petsc/finclude/petscmat.h90"
3252)
3253) type(grid_unstructured_type) :: unstructured_grid
3254) PetscInt :: face_vertices(:,:)
3255) PetscInt :: n_ss_faces
3256) character(len=MAXWORDLENGTH) :: region_name
3257) type(option_type) :: option
3258) PetscInt, pointer :: cell_ids(:)
3259) PetscInt, pointer :: face_ids(:)
3260)
3261) Mat :: Mat_vert_to_face
3262) Vec :: Vertex_vec, Face_vec
3263) PetscViewer :: viewer
3264) character(len=MAXSTRINGLENGTH) :: string
3265) PetscInt :: int_array4(4)
3266) PetscInt :: int_array4_0(4,1)
3267) PetscReal :: real_array4(4)
3268) PetscInt, allocatable :: boundary_faces(:)
3269) PetscInt, allocatable :: temp_int(:,:)
3270) PetscInt :: boundary_face_count
3271) PetscInt :: mapped_face_count
3272) PetscInt :: nfaces, nvertices
3273) PetscInt :: iface, iface2
3274) PetscInt :: face_id, face_id2
3275) PetscInt :: local_id
3276) PetscInt :: cell_type
3277) PetscReal, pointer :: vec_ptr(:)
3278) PetscInt :: ivertex, cell_id, vertex_id_local
3279) PetscErrorCode :: ierr
3280) PetscReal :: min_verts_req
3281) PetscInt :: largest_vert_id, v_id_n
3282) Vec :: sideset_vert_vec
3283) PetscInt,pointer ::int_array(:)
3284) PetscInt :: offset
3285) IS :: is_tmp1, is_tmp2
3286) VecScatter :: scatter_gton
3287)
3288)
3289) ! fill matrix with boundary faces of local cells
3290) ! count up the number of boundary faces
3291) boundary_face_count = 0
3292) do local_id = 1, unstructured_grid%nlmax
3293) nfaces = UCellGetNFaces(unstructured_grid%cell_type(local_id),option)
3294) do iface = 1, nfaces
3295) face_id = unstructured_grid%cell_to_face_ghosted(iface,local_id)
3296) if (unstructured_grid%face_to_cell_ghosted(2,face_id) < 1) then
3297) ! boundary face, since not connected to 2 cells
3298) boundary_face_count = boundary_face_count + 1
3299) endif
3300) enddo
3301) enddo
3302)
3303) call MatCreateAIJ(option%mycomm, &
3304) boundary_face_count, &
3305) PETSC_DETERMINE, &
3306) PETSC_DETERMINE, &
3307) unstructured_grid%num_vertices_global, &
3308) 4, &
3309) PETSC_NULL_INTEGER, &
3310) 4, &
3311) PETSC_NULL_INTEGER, &
3312) Mat_vert_to_face, &
3313) ierr);CHKERRQ(ierr)
3314) call MatZeroEntries(Mat_vert_to_face,ierr);CHKERRQ(ierr)
3315) real_array4 = 1.d0
3316)
3317) offset=0
3318) call MPI_Exscan(boundary_face_count,offset, &
3319) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
3320)
3321) allocate(boundary_faces(boundary_face_count))
3322) boundary_faces = 0
3323) boundary_face_count = 0
3324) do local_id = 1, unstructured_grid%nlmax
3325) cell_type = unstructured_grid%cell_type(local_id)
3326) nfaces = UCellGetNFaces(cell_type,option)
3327) do iface = 1, nfaces
3328) face_id = unstructured_grid%cell_to_face_ghosted(iface,local_id)
3329) if (unstructured_grid%face_to_cell_ghosted(2,face_id) < 1) then
3330) ! boundary face, since not connected to 2 cells
3331) boundary_face_count = boundary_face_count + 1
3332) boundary_faces(boundary_face_count) = face_id
3333) call UCellGetNFaceVertsandVerts(option,cell_type,iface,nvertices, &
3334) int_array4)
3335)
3336) ! For this matrix:
3337) ! irow = local face id
3338) ! icol = natural (global) vertex id
3339) do ivertex = 1, nvertices
3340) vertex_id_local = &
3341) unstructured_grid%cell_vertices(int_array4(ivertex),local_id)
3342) int_array4_0(ivertex,1) = &
3343) unstructured_grid%vertex_ids_natural(vertex_id_local)-1
3344) enddo
3345) call MatSetValues(Mat_vert_to_face,1,boundary_face_count-1+offset, &
3346) nvertices,int_array4_0,real_array4, &
3347) INSERT_VALUES,ierr);CHKERRQ(ierr)
3348) endif
3349) enddo
3350) enddo
3351)
3352) call MatAssemblyBegin(Mat_vert_to_face,MAT_FINAL_ASSEMBLY, &
3353) ierr);CHKERRQ(ierr)
3354) call MatAssemblyEnd(Mat_vert_to_face,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3355)
3356) #if UGRID_DEBUG
3357) write(string,*) option%myrank
3358) string = adjustl(string)
3359) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
3360) string = 'Mat_vert_to_face_' // trim(region_name) // '_global' // &
3361) '_subsurf.out'
3362) else
3363) string = 'Mat_vert_to_face_' // trim(region_name) // '_global' // &
3364) '_surf.out'
3365) endif
3366) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
3367) call MatView(Mat_vert_to_face,viewer,ierr);CHKERRQ(ierr)
3368) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3369) #endif
3370)
3371) call VecCreateMPI(option%mycomm,PETSC_DETERMINE, &
3372) unstructured_grid%num_vertices_global, &
3373) Vertex_vec,ierr);CHKERRQ(ierr)
3374) call VecZeroEntries(Vertex_vec,ierr);CHKERRQ(ierr)
3375) call VecAssemblyBegin(Vertex_vec,ierr);CHKERRQ(ierr)
3376) call VecAssemblyEnd(Vertex_vec,ierr);CHKERRQ(ierr)
3377)
3378) ! For this vector:
3379) ! irow = natural (global) vertex id
3380) nvertices = 0
3381) do iface = 1, n_ss_faces
3382) do ivertex = 1, size(face_vertices,1)
3383) if (face_vertices(ivertex,iface) > 0) then
3384) nvertices = nvertices + 1
3385) endif
3386) enddo
3387) enddo
3388)
3389) offset=0
3390) call MPI_Exscan(nvertices,offset, &
3391) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
3392)
3393) allocate(int_array(nvertices))
3394) do local_id = 1, nvertices
3395) int_array(local_id) = (local_id-1)+offset
3396) enddo
3397) call ISCreateGeneral(option%mycomm,nvertices, &
3398) int_array,PETSC_COPY_VALUES,is_tmp1,ierr);CHKERRQ(ierr)
3399)
3400) #if UGRID_DEBUG
3401) write(string,*) option%myrank
3402) string = adjustl(string)
3403) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
3404) string = 'is_tmp1_' // trim(region_name) // '_subsurf.out'
3405) else
3406) string = 'is_tmp1_' // trim(region_name) // '_surf.out'
3407) endif
3408) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
3409) call ISView(is_tmp1,viewer,ierr);CHKERRQ(ierr)
3410) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3411) #endif
3412)
3413) nvertices = 0
3414) do iface = 1, n_ss_faces
3415) do ivertex = 1, size(face_vertices,1)
3416) if (face_vertices(ivertex,iface) > 0) then
3417) nvertices = nvertices + 1
3418) int_array(nvertices) = face_vertices(ivertex,iface)-1
3419) endif
3420) enddo
3421) enddo
3422)
3423) call ISCreateGeneral(option%mycomm,nvertices, &
3424) int_array,PETSC_COPY_VALUES,is_tmp2,ierr);CHKERRQ(ierr)
3425) deallocate(int_array)
3426)
3427) #if UGRID_DEBUG
3428) write(string,*) option%myrank
3429) string = adjustl(string)
3430) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
3431) string = 'is_tmp2_' // trim(region_name) // '_subsurf.out'
3432) else
3433) string = 'is_tmp2_' // trim(region_name) // '_surf.out'
3434) endif
3435) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
3436) call ISView(is_tmp2,viewer,ierr);CHKERRQ(ierr)
3437) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3438) #endif
3439)
3440) call VecCreateMPI(option%mycomm,nvertices, PETSC_DETERMINE, &
3441) sideset_vert_vec,ierr);CHKERRQ(ierr)
3442) call VecSet(sideset_vert_vec,1.d0,ierr);CHKERRQ(ierr)
3443)
3444) call VecScatterCreate(sideset_vert_vec,is_tmp1, &
3445) Vertex_vec,is_tmp2,scatter_gton,ierr);CHKERRQ(ierr)
3446) call ISDestroy(is_tmp1,ierr);CHKERRQ(ierr)
3447) call ISDestroy(is_tmp2,ierr);CHKERRQ(ierr)
3448)
3449) #if UGRID_DEBUG
3450) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
3451) string = 'scatter_gton_' // trim(region_name) // '_subsurf.out'
3452) else
3453) string = 'scatter_gton_' // trim(region_name) // '_surf.out'
3454) endif
3455) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
3456) ierr);CHKERRQ(ierr)
3457) call VecScatterView(scatter_gton,viewer,ierr);CHKERRQ(ierr)
3458) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3459) #endif
3460)
3461) call VecScatterBegin(scatter_gton,sideset_vert_vec,Vertex_vec, &
3462) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
3463) call VecScatterEnd(scatter_gton,sideset_vert_vec,Vertex_vec, &
3464) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
3465) call VecScatterDestroy(scatter_gton,ierr);CHKERRQ(ierr)
3466)
3467) #if UGRID_DEBUG
3468) write(string,*) option%myrank
3469) string = adjustl(string)
3470) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
3471) string = 'Vertex_vec_' // trim(region_name) // '_global' // &
3472) '_subsurf.out'
3473) else
3474) string = 'Vertex_vec_' // trim(region_name) // '_global' // &
3475) '_surf.out'
3476) endif
3477) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
3478) call VecView(Vertex_vec,viewer,ierr);CHKERRQ(ierr)
3479) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3480) #endif
3481)
3482) call VecCreateMPI(option%mycomm,boundary_face_count,PETSC_DETERMINE,Face_vec, &
3483) ierr);CHKERRQ(ierr)
3484) call MatMult(Mat_vert_to_face,Vertex_vec,Face_vec,ierr);CHKERRQ(ierr)
3485)
3486) #if UGRID_DEBUG
3487) write(string,*) option%myrank
3488) if (unstructured_grid%grid_type == THREE_DIM_GRID) then
3489) string = 'Face_vec_' // trim(region_name) // '_global_subsurf.out'
3490) else
3491) string = 'Face_vec_' // trim(region_name) // '_global_surf.out'
3492) endif
3493) call PetscViewerASCIIOpen(option%mycomm,string,viewer,ierr);CHKERRQ(ierr)
3494) call VecView(Face_vec,viewer,ierr);CHKERRQ(ierr)
3495) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3496) #endif
3497)
3498) allocate(temp_int(MAX_FACE_PER_CELL,boundary_face_count))
3499) temp_int = 0
3500)
3501) mapped_face_count = 0
3502) if ( unstructured_grid%grid_type == THREE_DIM_GRID) then
3503) min_verts_req = 3.d0
3504) else
3505) min_verts_req = 2.d0
3506) endif
3507)
3508) call VecGetArrayF90(Face_vec,vec_ptr,ierr);CHKERRQ(ierr)
3509) ! resulting vec contains the number of natural vertices in the sideset that
3510) ! intersect a local face
3511) do iface = 1, boundary_face_count
3512) face_id = boundary_faces(iface)
3513) if (vec_ptr(iface) >= min_verts_req) then ! 3 or more vertices in sideset
3514) ! need to ensure that the right number of vertices are included
3515) cell_id = unstructured_grid%face_to_cell_ghosted(1,face_id)
3516) cell_type = unstructured_grid%cell_type(cell_id)
3517) nfaces = UCellGetNFaces(cell_type,option)
3518) nvertices = 0
3519) do iface2 = 1, nfaces
3520) face_id2 = unstructured_grid%cell_to_face_ghosted(iface2,cell_id)
3521) if (face_id == face_id2) then
3522) nvertices = UCellGetNFaceVertices(cell_type,iface2,option)
3523) exit
3524) endif
3525) enddo
3526) if (nvertices == 0) then ! the case if not found
3527) option%io_buffer = 'Face not found in UGridMapSideSet'
3528) call printErrMsgByRank(option)
3529) endif
3530) if (abs(nvertices - vec_ptr(iface)) < 0.5d0) then
3531) mapped_face_count = mapped_face_count + 1
3532) temp_int(1,mapped_face_count) = cell_id
3533) temp_int(2,mapped_face_count) = iface2
3534) endif
3535) endif
3536) enddo
3537) call VecRestoreArrayF90(Face_vec,vec_ptr,ierr);CHKERRQ(ierr)
3538) deallocate(boundary_faces)
3539)
3540) allocate(cell_ids(mapped_face_count))
3541) allocate(face_ids(mapped_face_count))
3542)
3543) cell_ids(:) = temp_int(1,1:mapped_face_count)
3544) face_ids(:) = temp_int(2,1:mapped_face_count)
3545)
3546) call MatDestroy(Mat_vert_to_face,ierr);CHKERRQ(ierr)
3547) call VecDestroy(Face_vec,ierr);CHKERRQ(ierr)
3548) call VecDestroy(Vertex_vec,ierr);CHKERRQ(ierr)
3549) call VecDestroy(sideset_vert_vec,ierr);CHKERRQ(ierr)
3550)
3551) end subroutine UGridMapSideSet
3552)
3553) ! ************************************************************************** !
3554)
3555) subroutine UGridMapBoundFacesInPolVol(unstructured_grid,polygonal_volume, &
3556) region_name,option, &
3557) cell_ids,face_ids)
3558) !
3559) ! Maps all global boundary cell faces within a
3560) ! polygonal volume to a region
3561) !
3562) ! Author: Glenn Hammond
3563) ! Date: 12/16/11
3564) !
3565) use Option_module
3566) use Geometry_module
3567)
3568) implicit none
3569)
3570) type(grid_unstructured_type) :: unstructured_grid
3571) type(polygonal_volume_type) :: polygonal_volume
3572) character(len=MAXWORDLENGTH) :: region_name
3573) type(option_type) :: option
3574) PetscInt, pointer :: cell_ids(:)
3575) PetscInt, pointer :: face_ids(:)
3576)
3577) PetscInt :: ivertex
3578) PetscInt :: iface, face_id
3579) PetscInt :: iface2, face_id2
3580) PetscInt :: nfaces
3581) PetscInt :: cell_id, cell_type
3582) PetscInt :: vertex_id
3583) type(point_type) :: vertex
3584) PetscInt :: mapped_face_count
3585) PetscBool :: found
3586) PetscInt :: boundary_face_count
3587) PetscInt, pointer :: boundary_faces(:)
3588)
3589) nullify(boundary_faces)
3590)
3591) call UGridGetBoundaryFaces(unstructured_grid,option,boundary_faces)
3592)
3593) if (associated(boundary_faces)) then
3594)
3595) boundary_face_count = size(boundary_faces)
3596)
3597) mapped_face_count = 0
3598) do iface = 1, boundary_face_count
3599) face_id = boundary_faces(iface)
3600) found = GeometryPointInPolygonalVolume( &
3601) unstructured_grid%face_centroid(face_id)%x, &
3602) unstructured_grid%face_centroid(face_id)%y, &
3603) unstructured_grid%face_centroid(face_id)%z, &
3604) polygonal_volume,option)
3605) if (found) then
3606) mapped_face_count = mapped_face_count + 1
3607) ! if inside, shift the face earlier in the array to same array space
3608) boundary_faces(mapped_face_count) = boundary_faces(iface)
3609) endif
3610) enddo
3611)
3612) if (mapped_face_count > 0) then
3613) allocate(cell_ids(mapped_face_count))
3614) cell_ids = 0
3615) allocate(face_ids(mapped_face_count))
3616) face_ids = 0
3617) do iface = 1, mapped_face_count
3618) face_id = boundary_faces(iface)
3619) cell_id = &
3620) unstructured_grid%face_to_cell_ghosted(1,face_id)
3621) cell_type = unstructured_grid%cell_type(cell_id)
3622) nfaces = UCellGetNFaces(cell_type,option)
3623) found = PETSC_FALSE
3624) do iface2 = 1, nfaces
3625) face_id2 = unstructured_grid%cell_to_face_ghosted(iface2,cell_id)
3626) if (face_id == face_id2) then
3627) found = PETSC_TRUE
3628) exit
3629) endif
3630) enddo
3631) if (.not.found) then
3632) option%io_buffer = &
3633) 'Boundary face mismatch in UGridMapBoundFacesInPolVol()'
3634) call printErrMsg(option)
3635) else
3636) cell_ids(iface) = cell_id
3637) face_ids(iface) = iface2
3638) endif
3639) enddo
3640) endif
3641)
3642) deallocate(boundary_faces)
3643) nullify(boundary_faces)
3644)
3645) endif
3646)
3647) end subroutine UGridMapBoundFacesInPolVol
3648)
3649) ! ************************************************************************** !
3650)
3651) subroutine UGridGetBoundaryFaces(unstructured_grid,option,boundary_faces)
3652) !
3653) ! Returns an array of ids for cell faces on boundary
3654) !
3655) ! Author: Glenn Hammond
3656) ! Date: 01/12/12
3657) !
3658)
3659) use Option_module
3660)
3661) implicit none
3662)
3663) #include "petsc/finclude/petscvec.h"
3664) #include "petsc/finclude/petscvec.h90"
3665) #include "petsc/finclude/petscmat.h"
3666) #include "petsc/finclude/petscmat.h90"
3667)
3668) type(grid_unstructured_type) :: unstructured_grid
3669) PetscInt, pointer :: boundary_faces(:)
3670) type(option_type) :: option
3671)
3672) PetscInt :: boundary_face_count
3673) PetscInt :: nfaces
3674) PetscInt :: iface
3675) PetscInt :: face_id
3676) PetscInt :: local_id
3677) PetscInt :: cell_type
3678) PetscErrorCode :: ierr
3679)
3680) ! fill matrix with boundary faces of local cells
3681) ! count up the number of boundary faces
3682) boundary_face_count = 0
3683) do local_id = 1, unstructured_grid%nlmax
3684) nfaces = UCellGetNFaces(unstructured_grid%cell_type(local_id),option)
3685) do iface = 1, nfaces
3686) face_id = unstructured_grid%cell_to_face_ghosted(iface,local_id)
3687) if (unstructured_grid%face_to_cell_ghosted(2,face_id) < 1) then
3688) ! boundary face, since not connected to 2 cells
3689) boundary_face_count = boundary_face_count + 1
3690) endif
3691) enddo
3692) enddo
3693)
3694) if (boundary_face_count > 0) then
3695) allocate(boundary_faces(boundary_face_count))
3696) boundary_faces = 0
3697) boundary_face_count = 0
3698) do local_id = 1, unstructured_grid%nlmax
3699) cell_type = unstructured_grid%cell_type(local_id)
3700) nfaces = UCellGetNFaces(cell_type,option)
3701) do iface = 1, nfaces
3702) face_id = unstructured_grid%cell_to_face_ghosted(iface,local_id)
3703) if (unstructured_grid%face_to_cell_ghosted(2,face_id) < 1) then
3704) ! boundary face, since not connected to 2 cells
3705) boundary_face_count = boundary_face_count + 1
3706) boundary_faces(boundary_face_count) = face_id
3707) endif
3708) enddo
3709) enddo
3710) endif
3711)
3712) end subroutine UGridGetBoundaryFaces
3713)
3714) ! ************************************************************************** !
3715)
3716) subroutine UGridGrowStencilSupport(unstructured_grid,stencil_width, &
3717) ghosted_level,option)
3718) !
3719) ! This routine will update the mesh to accomodate larger stencil width.
3720) ! -1) Stencil support will be increased by one cell at a time.
3721) ! -2) Find updated list of local+ghost cells (Note: Only the list of
3722) ! ghost cells get updated).
3723) ! -3) Find the 'new' ghost cells from the updated list found in (2)
3724) ! -4) Lastly update the mesh
3725) !
3726) ! Author: Gautam Bisht, LBNL
3727) ! Date: 09/17/12
3728) !
3729)
3730) use Option_module
3731)
3732) implicit none
3733)
3734) #include "petsc/finclude/petscvec.h"
3735) #include "petsc/finclude/petscvec.h90"
3736) #include "petsc/finclude/petscmat.h"
3737) #include "petsc/finclude/petscmat.h90"
3738)
3739) type(grid_unstructured_type) :: unstructured_grid
3740) type(option_type) :: option
3741) PetscInt :: stencil_width
3742) PetscInt, pointer :: ghosted_level(:)
3743)
3744) Mat :: Mat_vert_to_cell !
3745) Mat :: Mat_vert_to_proc !
3746) Mat :: Mat_proc_to_vert !
3747)
3748) PetscInt :: offset
3749) PetscInt :: local_id,ghosted_id
3750) PetscInt :: ivertex
3751) PetscInt :: cell_type
3752) PetscInt :: nvertices
3753) PetscInt :: vertex_id_local
3754) PetscInt :: vertex_id_nat
3755) PetscInt :: ngmax_new
3756) PetscInt :: swidth
3757)
3758) PetscInt, pointer :: ia_p(:), ja_p(:)
3759) PetscInt :: nrow,rstart,rend,icol(1)
3760) PetscOffset :: iia,jja,aaa,iicol,jj
3761) PetscBool :: done
3762) PetscScalar :: aa(1)
3763)
3764) PetscReal, allocatable :: real_arrayV(:)
3765) PetscInt, allocatable :: int_arrayV(:)
3766) PetscInt, allocatable :: cell_ids_natural(:)
3767) PetscInt, allocatable :: cell_ids_petsc(:)
3768) PetscInt, allocatable :: int_array(:)
3769) PetscInt, allocatable :: cids_new(:)
3770) PetscInt, pointer :: ghosted_level_new(:)
3771)
3772) Vec :: Vec_cids_local
3773) PetscReal, pointer :: vec_ptr(:)
3774)
3775) PetscErrorCode :: ierr
3776) PetscViewer :: viewer
3777)
3778) IS :: is_from
3779) IS :: is_to
3780)
3781) VecScatter :: vec_scatter
3782)
3783) PetscInt :: nghost_new
3784) PetscInt,allocatable :: ghost_cids_new(:)
3785) PetscInt,allocatable :: ghost_cids_new_petsc(:)
3786)
3787) ! There are no ghost cells when running with a single processor, so get out
3788) ! of here
3789) if (option%mycommsize==1) return
3790)
3791) allocate(real_arrayV(unstructured_grid%max_nvert_per_cell))
3792) allocate(int_arrayV(unstructured_grid%max_nvert_per_cell))
3793) real_arrayV=1.d0
3794)
3795) ! Allocate memory for a matrix to saves mesh connectivity
3796) ! size(Mat_vert_to_cell) = global_num_cell x global_num_vertices
3797) call MatCreateAIJ(option%mycomm, &
3798) unstructured_grid%nlmax, &
3799) PETSC_DETERMINE, &
3800) PETSC_DETERMINE, &
3801) unstructured_grid%num_vertices_global, &
3802) unstructured_grid%max_nvert_per_cell, &
3803) PETSC_NULL_INTEGER, &
3804) unstructured_grid%max_nvert_per_cell, &
3805) PETSC_NULL_INTEGER, &
3806) Mat_vert_to_cell, &
3807) ierr);CHKERRQ(ierr)
3808)
3809) call MatZeroEntries(Mat_vert_to_cell,ierr);CHKERRQ(ierr)
3810)
3811) offset=0
3812) call MPI_Exscan(unstructured_grid%nlmax,offset, &
3813) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
3814)
3815) ! Create the mesh connectivity matrix
3816) do local_id=1,unstructured_grid%nlmax
3817) cell_type = unstructured_grid%cell_type(local_id)
3818) nvertices=UCellGetNVertices(cell_type,option)
3819) do ivertex=1,nvertices
3820) vertex_id_local=unstructured_grid%cell_vertices(ivertex,local_id)
3821) vertex_id_nat=unstructured_grid%vertex_ids_natural(vertex_id_local)
3822) int_arrayV(ivertex)=vertex_id_nat-1
3823) enddo
3824) call MatSetValues(Mat_vert_to_cell,1,local_id-1+offset, &
3825) nvertices,int_arrayV,real_arrayV, &
3826) INSERT_VALUES,ierr);CHKERRQ(ierr)
3827) enddo
3828)
3829) call MatAssemblyBegin(Mat_vert_to_cell,MAT_FINAL_ASSEMBLY, &
3830) ierr);CHKERRQ(ierr)
3831) call MatAssemblyEnd(Mat_vert_to_cell,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3832)
3833) ! Create a vector which has natural cell ids in PETSc order
3834) call VecCreateMPI(option%mycomm,unstructured_grid%nlmax, &
3835) PETSC_DETERMINE, &
3836) Vec_cids_local,ierr);CHKERRQ(ierr)
3837)
3838) call VecGetArrayF90(Vec_cids_local,vec_ptr,ierr);CHKERRQ(ierr)
3839) do local_id = 1,unstructured_grid%nlmax
3840) vec_ptr(local_id) = unstructured_grid%cell_ids_natural(local_id)
3841) enddo
3842) call VecRestoreArrayF90(Vec_cids_local,vec_ptr,ierr);CHKERRQ(ierr)
3843)
3844) ! Now begin expanding stencil support
3845) do swidth = 1,stencil_width
3846)
3847) ! Create a matrix that saves natural id of vertices present on each
3848) ! processor
3849) call MatCreateAIJ(option%mycomm, &
3850) 1, &
3851) PETSC_DETERMINE, &
3852) PETSC_DETERMINE, &
3853) unstructured_grid%num_vertices_global, &
3854) unstructured_grid%num_vertices_global, &
3855) PETSC_NULL_INTEGER, &
3856) unstructured_grid%num_vertices_global, &
3857) PETSC_NULL_INTEGER, &
3858) Mat_vert_to_proc, &
3859) ierr);CHKERRQ(ierr)
3860)
3861) call MatZeroEntries(Mat_vert_to_proc,ierr);CHKERRQ(ierr)
3862)
3863) if (swidth==1) then
3864) ! When the stencil width counter = 1, loop over only local cells present
3865) do local_id=1,unstructured_grid%nlmax
3866) cell_type = unstructured_grid%cell_type(local_id)
3867) nvertices=UCellGetNVertices(cell_type,option)
3868) do ivertex=1,nvertices
3869) vertex_id_local=unstructured_grid%cell_vertices(ivertex,local_id)
3870) vertex_id_nat=unstructured_grid%vertex_ids_natural(vertex_id_local)
3871) call MatSetValues(Mat_vert_to_proc,1,option%myrank, &
3872) 1,vertex_id_nat-1,1.d0,INSERT_VALUES, &
3873) ierr);CHKERRQ(ierr)
3874) enddo
3875) enddo
3876) else
3877) ! When the stencil width counter is > 1, loop over ghosted cells
3878) do ghosted_id=1,unstructured_grid%ngmax
3879) cell_type = unstructured_grid%cell_type(ghosted_id)
3880) nvertices=UCellGetNVertices(cell_type,option)
3881) do ivertex=1,nvertices
3882) vertex_id_local=unstructured_grid%cell_vertices(ivertex,ghosted_id)
3883) vertex_id_nat=unstructured_grid%vertex_ids_natural(vertex_id_local)
3884) call MatSetValues(Mat_vert_to_proc,1,option%myrank, &
3885) 1,vertex_id_nat-1,1.d0,INSERT_VALUES, &
3886) ierr);CHKERRQ(ierr)
3887) enddo
3888) enddo
3889) endif
3890)
3891) ! Assemble the matrix
3892) call MatAssemblyBegin(Mat_vert_to_proc,MAT_FINAL_ASSEMBLY, &
3893) ierr);CHKERRQ(ierr)
3894) call MatAssemblyEnd(Mat_vert_to_proc,MAT_FINAL_ASSEMBLY, &
3895) ierr);CHKERRQ(ierr)
3896)
3897) ! Transpose the matrix
3898) call MatTranspose(Mat_vert_to_proc,MAT_INITIAL_MATRIX, &
3899) Mat_proc_to_vert,ierr);CHKERRQ(ierr)
3900) call MatDestroy(Mat_vert_to_proc,ierr);CHKERRQ(ierr)
3901)
3902) ! Find the number and natural ids of cells (local+ghost) when stencil width
3903) ! is increased by one.
3904) call UGridFindCellIDsAfterGrowingStencilWidthByOne( &
3905) Mat_vert_to_cell, &
3906) Mat_proc_to_vert, &
3907) Vec_cids_local, &
3908) cids_new, &
3909) ngmax_new, &
3910) option)
3911)
3912) ! Find additional ghost cells
3913) call UGridFindNewGhostCellIDsAfterGrowingStencilWidth(unstructured_grid,&
3914) cids_new, &
3915) ngmax_new, &
3916) ghost_cids_new, &
3917) ghost_cids_new_petsc, &
3918) nghost_new, &
3919) option)
3920)
3921) ! Update the mesh by adding the new ghost cells
3922) call UGridUpdateMeshAfterGrowingStencilWidth(unstructured_grid,&
3923) ghost_cids_new,ghost_cids_new_petsc,nghost_new,option)
3924)
3925) ! Update ghosted_level array
3926) if (swidth==1) then
3927) ! In this case, ghosted_level will have only two values:
3928) ! 0 - local cells
3929) ! 1 - ghost cells
3930) allocate(ghosted_level(unstructured_grid%ngmax))
3931) do local_id=1,unstructured_grid%nlmax
3932) ghosted_level(local_id)=0
3933) enddo
3934)
3935) do ghosted_id=unstructured_grid%nlmax+1,unstructured_grid%ngmax
3936) ghosted_level(ghosted_id)=1
3937) enddo
3938) else
3939)
3940) ! ghosted_level of all new ghost cells will be 'swidth'
3941) allocate(ghosted_level_new(unstructured_grid%ngmax))
3942) do ghosted_id=1,unstructured_grid%ngmax-nghost_new
3943) ghosted_level_new(ghosted_id)=ghosted_level(ghosted_id)
3944) enddo
3945)
3946) do ghosted_id=unstructured_grid%ngmax-nghost_new+1,unstructured_grid%ngmax
3947) ghosted_level_new(ghosted_id)=swidth
3948) enddo
3949)
3950) deallocate(ghosted_level)
3951) allocate(ghosted_level(unstructured_grid%ngmax))
3952) ghosted_level=ghosted_level_new
3953) deallocate(ghosted_level_new)
3954) endif
3955)
3956) ! Free up the memory
3957) call MatDestroy(Mat_vert_to_proc,ierr);CHKERRQ(ierr)
3958) call MatDestroy(Mat_proc_to_vert,ierr);CHKERRQ(ierr)
3959) deallocate(ghost_cids_new)
3960) deallocate(ghost_cids_new_petsc)
3961) deallocate(cids_new)
3962)
3963) enddo
3964)
3965) call MatDestroy(Mat_vert_to_cell,ierr);CHKERRQ(ierr)
3966) call VecDestroy(Vec_cids_local,ierr);CHKERRQ(ierr)
3967)
3968) end subroutine UGridGrowStencilSupport
3969)
3970) ! ************************************************************************** !
3971)
3972) subroutine UGridFindCellIDsAfterGrowingStencilWidthByOne(Mat_vert_to_cell, &
3973) Mat_proc_to_vert, &
3974) Vec_cids_local, &
3975) cids_new, &
3976) ngmax_new, &
3977) option)
3978) !
3979) ! This routine finds the cells that are required on a given processor, if
3980) ! stencil width is increased by one.
3981) ! - It used the same algorithm used in UGridMapSidesets, but instead of a
3982) ! matrix-vector product, matrix-matrix product is used in this subroutine.
3983) ! - Returns a list of natural ids of all cells (local+ghost)
3984) !
3985) ! Author: Gautam Bisht, LBNL
3986) ! Date: 09/17/12
3987) !
3988)
3989) use Option_module
3990)
3991) implicit none
3992)
3993) #include "petsc/finclude/petscvec.h"
3994) #include "petsc/finclude/petscvec.h90"
3995) #include "petsc/finclude/petscmat.h"
3996) #include "petsc/finclude/petscmat.h90"
3997)
3998) type(option_type) :: option
3999) Mat :: Mat_vert_to_cell
4000) Vec :: Vec_cids_local
4001) !PetscInt, intent(out) :: ngmax_new
4002) PetscInt :: ngmax_new
4003)
4004) Mat :: Mat_proc_to_vert !
4005) Mat :: Mat_cell_to_proc !
4006) Mat :: Mat_proc_to_cell !
4007) Mat :: Mat_cell_to_proc_loc
4008)
4009) PetscInt :: offset
4010) PetscInt :: local_id
4011) PetscInt :: ivertex
4012) PetscInt :: cell_type
4013) PetscInt :: nvertices
4014) PetscInt :: vertex_id_local
4015) PetscInt :: vertex_id_nat
4016)
4017) PetscInt, pointer :: ia_p(:), ja_p(:)
4018) PetscInt :: nrow,rstart,rend,icol(1)
4019) PetscOffset :: iia,jja,aaa,iicol,jj
4020) PetscBool :: done
4021) PetscScalar :: aa(1)
4022)
4023) PetscReal, allocatable :: real_arrayV(:)
4024) PetscInt, allocatable :: int_arrayV(:)
4025) PetscInt, allocatable :: cell_ids_natural(:)
4026) PetscInt, allocatable :: cell_ids_petsc(:)
4027) PetscInt, allocatable :: int_array(:)
4028) PetscInt, allocatable :: cids_new(:)
4029)
4030) Vec :: Vec_cids_ghosted
4031) PetscReal, pointer :: vec_ptr(:)
4032)
4033) PetscErrorCode :: ierr
4034)
4035) IS :: is_from
4036) IS :: is_to
4037)
4038) VecScatter :: vec_scatter
4039)
4040) ! Perform a matrix-matrix multiplication
4041) call MatMatMult(Mat_vert_to_cell,Mat_proc_to_vert, &
4042) MAT_INITIAL_MATRIX,PETSC_DEFAULT_REAL,Mat_proc_to_cell, &
4043) ierr);CHKERRQ(ierr)
4044)
4045) ! Transpose of the result gives: cell ids that are needed after growing stencil
4046) ! width by one
4047) call MatTranspose(Mat_proc_to_cell,MAT_INITIAL_MATRIX, &
4048) Mat_cell_to_proc,ierr);CHKERRQ(ierr)
4049) call MatDestroy(Mat_proc_to_cell,ierr);CHKERRQ(ierr)
4050)
4051) if (option%mycommsize > 1) then
4052) ! From the MPI-Matrix get the local-matrix
4053) call MatMPIAIJGetLocalMat(Mat_cell_to_proc,MAT_INITIAL_MATRIX,Mat_cell_to_proc_loc, &
4054) ierr);CHKERRQ(ierr)
4055) ! Get i and j indices of the local-matrix
4056) call MatGetRowIJF90(Mat_cell_to_proc_loc, ONE_INTEGER, PETSC_FALSE, PETSC_FALSE, &
4057) nrow, ia_p, ja_p, done, ierr);CHKERRQ(ierr)
4058) ! Get values stored in the local-matrix
4059) call MatSeqAIJGetArray(Mat_cell_to_proc_loc, aa, aaa, ierr);CHKERRQ(ierr)
4060) else
4061) ! Get i and j indices of the local-matrix
4062) call MatGetRowIJF90(Mat_cell_to_proc, ONE_INTEGER, PETSC_FALSE, PETSC_FALSE, &
4063) nrow, ia_p, ja_p, done, ierr);CHKERRQ(ierr)
4064) ! Get values stored in the local-matrix
4065) call MatSeqAIJGetArray(Mat_cell_to_proc, aa, aaa, ierr);CHKERRQ(ierr)
4066) endif
4067)
4068) ! Obtain the PETSc index of all cells required.
4069) ! Note: We get PETSc index because the rows of Mat_vert_to_cell correspond to
4070) ! PETSc index of cells.
4071) ngmax_new = ia_p(2)-ia_p(1)
4072) allocate(cell_ids_petsc(ngmax_new))
4073) do jj=ia_p(1),ia_p(2)-1
4074) cell_ids_petsc(jj)=ja_p(jj)
4075) enddo
4076)
4077) ! Now, find natural ids of all cells required from PETSc index. This is done
4078) ! by scattering the 'Vec_cids_local'
4079)
4080) ! Create MPI vector to save natural ids of cells required
4081) call VecCreateMPI(option%mycomm,ngmax_new,PETSC_DETERMINE,Vec_cids_ghosted, &
4082) ierr);CHKERRQ(ierr)
4083)
4084) offset=0
4085) call MPI_Exscan(ngmax_new,offset, &
4086) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
4087)
4088) allocate(int_array(ngmax_new))
4089) do jj=1,ngmax_new
4090) int_array(jj)=INT(jj+offset)
4091) enddo
4092) int_array=int_array-1
4093)
4094) ! Create a index set to scatter to
4095) call ISCreateGeneral(option%mycomm,ngmax_new, &
4096) int_array,PETSC_COPY_VALUES,is_to,ierr);CHKERRQ(ierr)
4097) deallocate(int_array)
4098)
4099) ! Create a index set to scatter from
4100) cell_ids_petsc = cell_ids_petsc - 1
4101) call ISCreateGeneral(option%mycomm,ngmax_new, &
4102) cell_ids_petsc,PETSC_COPY_VALUES,is_from, &
4103) ierr);CHKERRQ(ierr)
4104) cell_ids_petsc = cell_ids_petsc + 1
4105)
4106) ! Create a vec-scatter contex
4107) call VecScatterCreate(Vec_cids_local,is_from,Vec_cids_ghosted,is_to, &
4108) vec_scatter,ierr);CHKERRQ(ierr)
4109) call ISDestroy(is_from,ierr);CHKERRQ(ierr)
4110) call ISDestroy(is_to,ierr);CHKERRQ(ierr)
4111)
4112) ! Scatter the data
4113) call VecScatterBegin(vec_scatter,Vec_cids_local,Vec_cids_ghosted, &
4114) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4115) call VecScatterEnd(vec_scatter,Vec_cids_local,Vec_cids_ghosted, &
4116) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4117) call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
4118)
4119) ! Save the natural ids of all cells required after growning the stencil
4120) ! width by one.
4121) allocate(cids_new(ngmax_new))
4122) call VecGetArrayF90(Vec_cids_ghosted,vec_ptr,ierr);CHKERRQ(ierr)
4123) do jj=1,ngmax_new
4124) cids_new(jj) = INT(vec_ptr(jj))
4125) enddo
4126) call VecRestoreArrayF90(Vec_cids_ghosted,vec_ptr,ierr);CHKERRQ(ierr)
4127)
4128) call MatDestroy(Mat_cell_to_proc,ierr);CHKERRQ(ierr)
4129) call MatDestroy(Mat_cell_to_proc_loc,ierr);CHKERRQ(ierr)
4130) call VecDestroy(Vec_cids_ghosted,ierr);CHKERRQ(ierr)
4131)
4132) end subroutine UGridFindCellIDsAfterGrowingStencilWidthByOne
4133)
4134) ! ************************************************************************** !
4135)
4136) subroutine UGridFindNewGhostCellIDsAfterGrowingStencilWidth(unstructured_grid, &
4137) cids_new, &
4138) ngmax_new, &
4139) ghost_cids_new, &
4140) ghost_cids_new_petsc, &
4141) nghost_new, &
4142) option)
4143) !
4144) ! This routine finds new ghosts cells needed to be saved on a local processor
4145) ! after stencil width is increased.
4146) ! - Returns the natural index of new ghosts cells.
4147) ! - Also, returns the PETSc index of new ghosts cells. (Required for creating
4148) ! gather/scater contexts in UGridCreateUGDM)
4149) !
4150) ! Author: Gautam Bisht, LBNL
4151) ! Date: 09/17/12
4152) !
4153)
4154) use Option_module
4155)
4156) implicit none
4157)
4158) #include "petsc/finclude/petscvec.h"
4159) #include "petsc/finclude/petscvec.h90"
4160) #include "petsc/finclude/petscmat.h"
4161) #include "petsc/finclude/petscmat.h90"
4162)
4163) type(grid_unstructured_type) :: unstructured_grid
4164) PetscInt :: cids_new(:)
4165) type(option_type) :: option
4166) PetscInt :: ngmax_new
4167)
4168) ! local
4169) PetscInt :: count
4170) PetscInt :: ii
4171) PetscInt :: ghosted_id,local_id,nat_id
4172) PetscInt :: nghost_new
4173) PetscInt :: offset
4174) PetscInt,allocatable :: ghost_cids_new(:)
4175) PetscInt,allocatable :: ghost_cids_new_petsc(:)
4176)
4177) PetscInt,allocatable :: int_array1(:)
4178) PetscInt,allocatable :: int_array2(:)
4179) PetscScalar,pointer :: tmp_scl_array(:)
4180) PetscReal, pointer :: vec_ptr(:)
4181) PetscErrorCode :: ierr
4182)
4183) Vec :: cids_petsc
4184) Vec :: ghosts_petsc
4185) Vec :: cells_on_proc
4186) Vec :: cids_on_proc
4187) IS :: is_from
4188) IS :: is_to
4189) VecScatter :: vec_scatter
4190)
4191) ! Step-1: Find additional ghost cells
4192)
4193) ! 1.0) Find which cells in 'cids_new' are local or ghost
4194) call VecCreateMPI(option%mycomm,unstructured_grid%nlmax,PETSC_DETERMINE,cells_on_proc, &
4195) ierr);CHKERRQ(ierr)
4196)
4197) allocate(int_array1(unstructured_grid%nlmax))
4198) allocate(tmp_scl_array(unstructured_grid%nlmax))
4199) do ii=1,unstructured_grid%nlmax
4200) int_array1(ii)=unstructured_grid%cell_ids_natural(ii)
4201) tmp_scl_array(ii)=option%myrank
4202) enddo
4203) int_array1=int_array1-1
4204)
4205) call VecSetValues(cells_on_proc,unstructured_grid%nlmax,int_array1,tmp_scl_array,INSERT_VALUES, &
4206) ierr);CHKERRQ(ierr)
4207) deallocate(int_array1)
4208) deallocate(tmp_scl_array)
4209) call VecAssemblyBegin(cells_on_proc,ierr);CHKERRQ(ierr)
4210) call VecAssemblyEnd(cells_on_proc,ierr);CHKERRQ(ierr)
4211)
4212) allocate(int_array1(ngmax_new))
4213) int_array1=cids_new-1
4214) call ISCreateGeneral(option%mycomm,ngmax_new, &
4215) int_array1,PETSC_COPY_VALUES,is_from, &
4216) ierr);CHKERRQ(ierr)
4217) deallocate(int_array1)
4218)
4219) call VecCreateMPI(option%mycomm,ngmax_new,PETSC_DETERMINE,cids_on_proc, &
4220) ierr);CHKERRQ(ierr)
4221)
4222) offset=0
4223) call MPI_Exscan(ngmax_new,offset, &
4224) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
4225)
4226) allocate(int_array1(ngmax_new))
4227) do ii=1,ngmax_new
4228) int_array1(ii)=ii-1+offset
4229) enddo
4230) call ISCreateGeneral(option%mycomm,ngmax_new, &
4231) int_array1,PETSC_COPY_VALUES,is_to,ierr);CHKERRQ(ierr)
4232)
4233) call VecScatterCreate(cells_on_proc,is_from,cids_on_proc,is_to,vec_scatter, &
4234) ierr);CHKERRQ(ierr)
4235) call ISDestroy(is_from,ierr);CHKERRQ(ierr)
4236) call ISDestroy(is_to,ierr);CHKERRQ(ierr)
4237)
4238) call VecScatterBegin(vec_scatter,cells_on_proc,cids_on_proc, &
4239) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4240) call VecScatterEnd(vec_scatter,cells_on_proc,cids_on_proc, &
4241) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4242) call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
4243) call VecDestroy(cells_on_proc,ierr);CHKERRQ(ierr)
4244)
4245) deallocate(int_array1)
4246)
4247)
4248) ! 1.1) Create an array containing cell-ids of 'exisiting' ghost cells +
4249) ! ghost cells from 'cids_new'
4250) !
4251) count = ngmax_new-unstructured_grid%nlmax + &
4252) unstructured_grid%ngmax - unstructured_grid%nlmax
4253) allocate(int_array1(count))
4254) allocate(int_array2(count))
4255)
4256) count=0
4257) do ii=1,unstructured_grid%ngmax-unstructured_grid%nlmax
4258) count=count+1
4259) ghosted_id=ii+unstructured_grid%nlmax
4260) int_array1(count)=unstructured_grid%cell_ids_natural(ghosted_id)
4261) int_array2(count)=count
4262) enddo
4263)
4264) call VecGetArrayF90(cids_on_proc,vec_ptr,ierr);CHKERRQ(ierr)
4265) do ii=1,ngmax_new
4266) if (vec_ptr(ii)/=option%myrank) then
4267) count=count+1
4268) int_array1(count)=cids_new(ii)
4269) int_array2(count)=count
4270) endif
4271) enddo
4272) call VecRestoreArrayF90(cids_on_proc,vec_ptr,ierr);CHKERRQ(ierr)
4273) call VecDestroy(cids_on_proc,ierr);CHKERRQ(ierr)
4274)
4275) ! 1.2) Sort the array
4276) int_array2 = int_array2-1
4277) call PetscSortIntWithPermutation(count,int_array1, &
4278) int_array2,ierr);CHKERRQ(ierr)
4279) int_array2 = int_array2+1
4280)
4281) ! 1.3) Count the entries in the sorted array which appear only once.
4282) nghost_new=0
4283) ii=1
4284) if (int_array1(int_array2(ii)) /= int_array1(int_array2(ii+1))) nghost_new=nghost_new+1
4285)
4286) do ii=2,count-1
4287) if ((int_array1(int_array2(ii)) /= int_array1(int_array2(ii-1))).and. &
4288) (int_array1(int_array2(ii)) /= int_array1(int_array2(ii+1))) ) nghost_new=nghost_new+1
4289) enddo
4290)
4291) ii=count
4292) if (int_array1(int_array2(ii)) /= int_array1(int_array2(ii-1))) nghost_new=nghost_new+1
4293)
4294) ! 1.4) Save the entries in the sorted array which appear only once.
4295) allocate(ghost_cids_new(nghost_new))
4296) nghost_new=0
4297) ii=1
4298) if (int_array1(int_array2(ii)) /= int_array1(int_array2(ii+1))) then
4299) nghost_new=nghost_new+1
4300) ghost_cids_new(nghost_new) = int_array1(int_array2(ii))
4301) endif
4302)
4303) do ii=2,count-1
4304) if ((int_array1(int_array2(ii)) /= int_array1(int_array2(ii-1))).and. &
4305) (int_array1(int_array2(ii)) /= int_array1(int_array2(ii+1))) ) then
4306) nghost_new=nghost_new+1
4307) ghost_cids_new(nghost_new) = int_array1(int_array2(ii))
4308) endif
4309) enddo
4310)
4311) ii=count
4312) if (int_array1(int_array2(ii)) /= int_array1(int_array2(ii-1))) then
4313) nghost_new=nghost_new+1
4314) ghost_cids_new(nghost_new) = int_array1(int_array2(ii))
4315) endif
4316)
4317) deallocate(int_array1)
4318) deallocate(int_array2)
4319)
4320) ! Step-2: Find PETSc index of additional ghost cells
4321) call VecCreateMPI(option%mycomm, &
4322) unstructured_grid%nlmax, &
4323) PETSC_DETERMINE, &
4324) cids_petsc,ierr);CHKERRQ(ierr)
4325)
4326) offset=0
4327) call MPI_Exscan(unstructured_grid%nlmax,offset, &
4328) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
4329)
4330) allocate(int_array1(unstructured_grid%nlmax))
4331) allocate(tmp_scl_array(unstructured_grid%nlmax))
4332)
4333) do local_id=1,unstructured_grid%nlmax
4334) nat_id=unstructured_grid%cell_ids_natural(local_id)
4335) int_array1(local_id)=nat_id - 1
4336) tmp_scl_array(local_id)=local_id+offset+0.d0
4337) enddo
4338)
4339) call VecSetValues(cids_petsc,unstructured_grid%nlmax,int_array1,tmp_scl_array,INSERT_VALUES, &
4340) ierr);CHKERRQ(ierr)
4341) deallocate(int_array1)
4342) deallocate(tmp_scl_array)
4343)
4344) call VecAssemblyBegin(cids_petsc,ierr);CHKERRQ(ierr)
4345) call VecAssemblyEnd(cids_petsc,ierr);CHKERRQ(ierr)
4346)
4347) call VecCreateMPI(option%mycomm,nghost_new,PETSC_DETERMINE,ghosts_petsc, &
4348) ierr);CHKERRQ(ierr)
4349) allocate(int_array1(nghost_new))
4350)
4351) int_array1=ghost_cids_new-1
4352) call ISCreateGeneral(option%mycomm,nghost_new, &
4353) int_array1,PETSC_COPY_VALUES,is_from, &
4354) ierr);CHKERRQ(ierr)
4355)
4356) offset=0
4357) call MPI_Exscan(nghost_new,offset, &
4358) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
4359)
4360) do ii=1,nghost_new
4361) int_array1(ii)=ii-1+offset
4362) enddo
4363) call ISCreateGeneral(option%mycomm,nghost_new, &
4364) int_array1,PETSC_COPY_VALUES,is_to,ierr);CHKERRQ(ierr)
4365) deallocate(int_array1)
4366)
4367) call VecScatterCreate(cids_petsc,is_from,ghosts_petsc,is_to,vec_scatter, &
4368) ierr);CHKERRQ(ierr)
4369) call ISDestroy(is_from,ierr);CHKERRQ(ierr)
4370) call ISDestroy(is_to,ierr);CHKERRQ(ierr)
4371)
4372) call VecScatterBegin(vec_scatter,cids_petsc,ghosts_petsc, &
4373) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4374) call VecScatterEnd(vec_scatter,cids_petsc,ghosts_petsc, &
4375) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4376) call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
4377)
4378) allocate(ghost_cids_new_petsc(nghost_new))
4379) call VecGetArrayF90(ghosts_petsc,vec_ptr,ierr);CHKERRQ(ierr)
4380) do ii=1,nghost_new
4381) ghost_cids_new_petsc(ii)=INT(vec_ptr(ii))
4382) enddo
4383) call VecRestoreArrayF90(ghosts_petsc,vec_ptr,ierr);CHKERRQ(ierr)
4384)
4385) call VecDestroy(cids_petsc,ierr);CHKERRQ(ierr)
4386) call VecDestroy(ghosts_petsc,ierr);CHKERRQ(ierr)
4387)
4388) end subroutine UGridFindNewGhostCellIDsAfterGrowingStencilWidth
4389)
4390) ! ************************************************************************** !
4391)
4392) subroutine UGridUpdateMeshAfterGrowingStencilWidth(unstructured_grid, &
4393) ghost_cids_new,ghost_cids_new_petsc,nghost_new,option)
4394) !
4395) ! This routine updates the mesh after additional ghost cells have be found
4396) !
4397) ! Author: Gautam Bisht, LBNL
4398) ! Date: 09/17/12
4399) !
4400)
4401)
4402) use Option_module
4403)
4404) implicit none
4405)
4406) #include "petsc/finclude/petscvec.h"
4407) #include "petsc/finclude/petscvec.h90"
4408) #include "petsc/finclude/petscmat.h"
4409) #include "petsc/finclude/petscmat.h90"
4410)
4411) type(grid_unstructured_type) :: unstructured_grid
4412) type(option_type) :: option
4413) PetscInt :: ngmax_new
4414)
4415) ! local
4416) PetscInt :: count,count2
4417) PetscInt :: ii,jj
4418) PetscInt :: ivertex
4419) PetscInt :: ghosted_id
4420) PetscInt :: local_id
4421) PetscInt :: nghost_new
4422) PetscInt :: vertex_id_nat
4423) PetscInt :: vertex_id_loc
4424) PetscInt :: offset
4425) PetscInt :: nverts
4426) PetscInt :: nverts_new
4427) PetscInt :: cell_type
4428) PetscInt :: nvertices
4429)
4430) PetscReal, pointer :: vec_ptr(:)
4431) PetscViewer :: viewer
4432)
4433) PetscErrorCode :: ierr
4434)
4435) Vec :: elements_petsc
4436) Vec :: elements_ghost_cells
4437) ! Vec :: cids_nat
4438) ! Vec :: cids_nat2petsc
4439) ! Vec :: needed_ghosts_cids_petsc
4440) Vec :: vertices_nat
4441) Vec :: vertices_loc
4442)
4443) IS :: is_from
4444) IS :: is_to
4445) VecScatter :: vec_scatter
4446) PetscInt,allocatable :: ghost_cids_new(:)
4447) PetscInt,allocatable :: ghost_cids_new_petsc(:)
4448) PetscInt,allocatable :: int_array1(:)
4449) PetscInt,allocatable :: int_array2(:)
4450) PetscInt,allocatable :: int_array3(:)
4451) PetscInt,allocatable :: int_array4(:)
4452)
4453) PetscInt,allocatable :: cell_vertices(:,:)
4454) PetscInt,allocatable :: cell_ids_natural(:)
4455) PetscInt,allocatable :: ghost_cell_ids_petsc(:)
4456)
4457) PetscScalar,pointer :: tmp_scl_array(:)
4458)
4459) ! Step-1: Find the natural ids for vertices forming new ghost cells
4460)
4461) ! Create a vector listing the vertices forming each cell in PETSc-order
4462) call VecCreateMPI(option%mycomm, &
4463) unstructured_grid%nlmax*unstructured_grid%max_nvert_per_cell, &
4464) PETSC_DETERMINE, &
4465) elements_petsc,ierr);CHKERRQ(ierr)
4466)
4467) call VecGetArrayF90(elements_petsc,vec_ptr,ierr);CHKERRQ(ierr)
4468) vec_ptr = -9999
4469) do local_id=1,unstructured_grid%nlmax
4470) do ivertex = 1, unstructured_grid%cell_vertices(0,local_id)
4471) vertex_id_loc=unstructured_grid%cell_vertices(ivertex,local_id)
4472) vertex_id_nat=unstructured_grid%vertex_ids_natural(vertex_id_loc)
4473) vec_ptr((local_id-1)*unstructured_grid%max_nvert_per_cell+ivertex)=vertex_id_nat
4474) enddo
4475) enddo
4476) call VecRestoreArrayF90(elements_petsc,vec_ptr,ierr);CHKERRQ(ierr)
4477)
4478) offset=0
4479) call MPI_Exscan(nghost_new,offset, &
4480) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
4481)
4482) allocate(int_array1(nghost_new*unstructured_grid%max_nvert_per_cell))
4483)
4484) do ii=1,nghost_new
4485) do jj=1,unstructured_grid%max_nvert_per_cell
4486) int_array1((ii-1)*unstructured_grid%max_nvert_per_cell + jj) = &
4487) (ghost_cids_new_petsc(ii)-1)*unstructured_grid%max_nvert_per_cell + jj-1
4488) enddo
4489) enddo
4490)
4491) call ISCreateGeneral(option%mycomm,nghost_new*unstructured_grid%max_nvert_per_cell, &
4492) int_array1,PETSC_COPY_VALUES,is_from, &
4493) ierr);CHKERRQ(ierr)
4494) deallocate(int_array1)
4495)
4496) call VecCreateMPI(option%mycomm, &
4497) nghost_new*unstructured_grid%max_nvert_per_cell, &
4498) PETSC_DETERMINE, &
4499) elements_ghost_cells,ierr);CHKERRQ(ierr)
4500)
4501) allocate(int_array1(nghost_new*unstructured_grid%max_nvert_per_cell))
4502) do ii=1,nghost_new
4503) do jj=1,unstructured_grid%max_nvert_per_cell
4504) int_array1((ii-1)*unstructured_grid%max_nvert_per_cell + jj) = &
4505) (ii-1)*unstructured_grid%max_nvert_per_cell + jj-1 + &
4506) offset*unstructured_grid%max_nvert_per_cell
4507) enddo
4508) enddo
4509) call ISCreateGeneral(option%mycomm,nghost_new*unstructured_grid%max_nvert_per_cell, &
4510) int_array1,PETSC_COPY_VALUES,is_to,ierr);CHKERRQ(ierr)
4511)
4512) deallocate(int_array1)
4513)
4514) call VecScatterCreate(elements_petsc,is_from,elements_ghost_cells,is_to,vec_scatter, &
4515) ierr);CHKERRQ(ierr)
4516) call ISDestroy(is_from,ierr);CHKERRQ(ierr)
4517) call ISDestroy(is_to,ierr);CHKERRQ(ierr)
4518)
4519) call VecScatterBegin(vec_scatter,elements_petsc,elements_ghost_cells, &
4520) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4521) call VecScatterEnd(vec_scatter,elements_petsc,elements_ghost_cells, &
4522) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4523) call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
4524)
4525) ! Step-2: Given already existing vertices + vertices of new ghost
4526) ! cells, find additional vertices that need to be now saved.
4527) ! Once, the new vertices are found, all vertices will be reorder
4528) !
4529) ! Note: Algorithm is similar to the one used in UGridDecompose
4530)
4531) allocate(int_array1((unstructured_grid%ngmax+nghost_new)*unstructured_grid%max_nvert_per_cell))
4532) allocate(int_array2((unstructured_grid%ngmax+nghost_new)*unstructured_grid%max_nvert_per_cell))
4533)
4534) ! save vertices of local+ghost cells
4535) count=0
4536) do ghosted_id=1,unstructured_grid%ngmax
4537) cell_type = unstructured_grid%cell_type(ghosted_id)
4538) nvertices=UCellGetNVertices(cell_type,option)
4539) do ivertex=1,nvertices
4540) vertex_id_loc=unstructured_grid%cell_vertices(ivertex,ghosted_id)
4541) vertex_id_nat=unstructured_grid%vertex_ids_natural(vertex_id_loc)
4542)
4543) count=count+1
4544) int_array1(count) = vertex_id_nat
4545) int_array2(count) = count
4546) enddo
4547) enddo
4548)
4549) ! save vertices of new ghost cells
4550) call VecGetArrayF90(elements_ghost_cells,vec_ptr,ierr);CHKERRQ(ierr)
4551) do ii =1,nghost_new
4552) do jj=1,unstructured_grid%max_nvert_per_cell
4553) if (vec_ptr((ii-1)*unstructured_grid%max_nvert_per_cell+jj)/=-9999) then
4554) count=count+1
4555) int_array1(count)=INT(vec_ptr((ii-1)*unstructured_grid%max_nvert_per_cell+jj))
4556) int_array2(count)=count
4557) endif
4558) enddo
4559) enddo
4560) call VecRestoreArrayF90(elements_ghost_cells,vec_ptr,ierr);CHKERRQ(ierr)
4561)
4562) int_array2 = int_array2-1
4563) call PetscSortIntWithPermutation(count,int_array1,int_array2, &
4564) ierr);CHKERRQ(ierr)
4565) int_array2 = int_array2+1
4566)
4567) ! remove duplicates
4568) allocate(int_array3(count))
4569) allocate(int_array4(count))
4570)
4571) int_array3 = 0
4572) int_array4 = 0
4573) int_array3(1) = int_array1(int_array2(1))
4574) count2 = 1
4575) int_array4(int_array2(1)) = count2
4576) do ii = 2, count
4577) jj = int_array1(int_array2(ii))
4578) if (jj > int_array3(count2)) then
4579) count2 = count2 + 1
4580) int_array3(count2) = jj
4581) endif
4582) int_array4(int_array2(ii)) = count2
4583) enddo
4584)
4585) deallocate(int_array1)
4586)
4587) allocate(cell_vertices(0:unstructured_grid%max_nvert_per_cell,unstructured_grid%ngmax+nghost_new))
4588) cell_vertices=0
4589)
4590) ! Update vertices for local+ghost cells
4591) count=0
4592) do ghosted_id=1,unstructured_grid%ngmax
4593) cell_type = unstructured_grid%cell_type(ghosted_id)
4594) nvertices = UCellGetNVertices(cell_type,option)
4595) cell_vertices(0,ghosted_id)=nvertices
4596) do ivertex=1,nvertices
4597) count=count+1
4598) cell_vertices(ivertex,ghosted_id)=int_array4(count)
4599) enddo
4600) enddo
4601)
4602) call VecGetArrayF90(elements_ghost_cells,vec_ptr,ierr);CHKERRQ(ierr)
4603) do ii =1,nghost_new
4604) do jj=1,unstructured_grid%max_nvert_per_cell
4605) if (vec_ptr((ii-1)*unstructured_grid%max_nvert_per_cell+jj)/=-9999) then
4606) count=count+1
4607) cell_vertices(jj,ii+unstructured_grid%ngmax)=int_array4(count)
4608) cell_vertices(0 ,ii+unstructured_grid%ngmax)=cell_vertices(0 ,ii+unstructured_grid%ngmax)+1
4609) endif
4610) enddo
4611) enddo
4612) call VecRestoreArrayF90(elements_ghost_cells,vec_ptr,ierr);CHKERRQ(ierr)
4613)
4614) ! Make local copies of array which need to be updated.
4615)
4616) ! cells
4617) allocate(cell_ids_natural(unstructured_grid%ngmax+nghost_new))
4618) allocate(ghost_cell_ids_petsc(unstructured_grid%num_ghost_cells+nghost_new))
4619)
4620) cell_ids_natural(1:unstructured_grid%ngmax)=unstructured_grid%cell_ids_natural(:)
4621) ghost_cell_ids_petsc(1:unstructured_grid%num_ghost_cells)=unstructured_grid%ghost_cell_ids_petsc(:)
4622)
4623) do ii=1,nghost_new
4624) cell_ids_natural(ii+unstructured_grid%ngmax)=ghost_cids_new(ii)
4625) ghost_cell_ids_petsc(ii+unstructured_grid%num_ghost_cells)=ghost_cids_new_petsc(ii)
4626) enddo
4627)
4628) ! Save location of vertices needed on a given processor
4629) call VecCreateMPI(option%mycomm, &
4630) PETSC_DETERMINE, &
4631) unstructured_grid%num_vertices_global*3, &
4632) vertices_nat,ierr);CHKERRQ(ierr)
4633)
4634) allocate(tmp_scl_array(unstructured_grid%num_vertices_local*3))
4635) allocate(int_array1(unstructured_grid%num_vertices_local*3))
4636) count=0
4637) do ivertex=1,unstructured_grid%num_vertices_local
4638) count=count+1
4639) tmp_scl_array(count)=unstructured_grid%vertices(ivertex)%x
4640) int_array1(count)=(unstructured_grid%vertex_ids_natural(ivertex)-1)*3+0
4641)
4642) count=count+1
4643) tmp_scl_array(count)=unstructured_grid%vertices(ivertex)%y
4644) int_array1(count)=(unstructured_grid%vertex_ids_natural(ivertex)-1)*3+1
4645)
4646) count=count+1
4647) tmp_scl_array(count)=unstructured_grid%vertices(ivertex)%z
4648) int_array1(count)=(unstructured_grid%vertex_ids_natural(ivertex)-1)*3+2
4649) enddo
4650)
4651) call VecSetValues(vertices_nat,count,int_array1, &
4652) tmp_scl_array,INSERT_VALUES,ierr);CHKERRQ(ierr)
4653) call VecAssemblyBegin(vertices_nat,ierr);CHKERRQ(ierr)
4654) call VecAssemblyEnd(vertices_nat,ierr);CHKERRQ(ierr)
4655)
4656) deallocate(int_array1)
4657) deallocate(tmp_scl_array)
4658)
4659) allocate(int_array1(count2*3))
4660) do ii=1,count2
4661) int_array1((ii-1)*3+1)=(int_array3(ii)-1)*3
4662) int_array1((ii-1)*3+2)=(int_array3(ii)-1)*3+1
4663) int_array1((ii-1)*3+3)=(int_array3(ii)-1)*3+2
4664) enddo
4665)
4666) call ISCreateGeneral(option%mycomm,count2*3, &
4667) int_array1,PETSC_COPY_VALUES,is_from, &
4668) ierr);CHKERRQ(ierr)
4669) deallocate(int_array1)
4670)
4671) offset=0
4672) call MPI_Exscan(count2*3,offset, &
4673) ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
4674)
4675) allocate(int_array1(count2*3))
4676) do ii=1,count2*3
4677) int_array1(ii)=ii-1+offset
4678) enddo
4679) call ISCreateGeneral(option%mycomm,count2*3, &
4680) int_array1,PETSC_COPY_VALUES,is_to,ierr);CHKERRQ(ierr)
4681)
4682) call VecCreateMPI(option%mycomm, &
4683) count2*3, &
4684) PETSC_DETERMINE, &
4685) vertices_loc,ierr);CHKERRQ(ierr)
4686)
4687) call VecScatterCreate(vertices_nat,is_from,vertices_loc,is_to,vec_scatter, &
4688) ierr);CHKERRQ(ierr)
4689) call ISDestroy(is_from,ierr);CHKERRQ(ierr)
4690) call ISDestroy(is_to,ierr);CHKERRQ(ierr)
4691)
4692) call VecScatterBegin(vec_scatter,vertices_nat,vertices_loc, &
4693) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4694) call VecScatterEnd(vec_scatter,vertices_nat,vertices_loc, &
4695) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
4696) call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
4697) call VecDestroy(vertices_nat,ierr);CHKERRQ(ierr)
4698)
4699) ! Update the mesh
4700)
4701) ! cell update
4702) unstructured_grid%ngmax = unstructured_grid%ngmax+nghost_new
4703)
4704) deallocate(unstructured_grid%cell_vertices)
4705) allocate(unstructured_grid%cell_vertices(0:unstructured_grid%max_nvert_per_cell,unstructured_grid%ngmax))
4706) unstructured_grid%cell_vertices = cell_vertices
4707) deallocate(cell_vertices)
4708)
4709) deallocate(unstructured_grid%cell_ids_natural)
4710) allocate(unstructured_grid%cell_ids_natural(unstructured_grid%ngmax))
4711) unstructured_grid%cell_ids_natural=cell_ids_natural
4712) deallocate(cell_ids_natural)
4713)
4714) ! vertex update
4715) deallocate(unstructured_grid%vertex_ids_natural)
4716) allocate(unstructured_grid%vertex_ids_natural(count2))
4717) unstructured_grid%vertex_ids_natural(:)=int_array3(1:count2)
4718) unstructured_grid%num_vertices_local=count2
4719)
4720) deallocate(unstructured_grid%vertices)
4721) allocate(unstructured_grid%vertices(count2))
4722)
4723) call VecGetArrayF90(vertices_loc,vec_ptr,ierr);CHKERRQ(ierr)
4724) unstructured_grid%num_vertices_local=count2
4725) do ii=1,count2
4726) unstructured_grid%vertices(ii)%id = int_array3(ii)
4727) unstructured_grid%vertices(ii)%x = vec_ptr((ii-1)*3+1)
4728) unstructured_grid%vertices(ii)%y = vec_ptr((ii-1)*3+2)
4729) unstructured_grid%vertices(ii)%z = vec_ptr((ii-1)*3+3)
4730) enddo
4731) call VecRestoreArrayF90(vertices_loc,vec_ptr,ierr);CHKERRQ(ierr)
4732) call VecDestroy(vertices_loc,ierr);CHKERRQ(ierr)
4733)
4734) ! ghost cell update
4735) unstructured_grid%num_ghost_cells=unstructured_grid%ngmax-unstructured_grid%nlmax
4736) deallocate(unstructured_grid%ghost_cell_ids_petsc)
4737) allocate(unstructured_grid%ghost_cell_ids_petsc(unstructured_grid%num_ghost_cells))
4738) unstructured_grid%ghost_cell_ids_petsc=ghost_cell_ids_petsc
4739) deallocate(ghost_cell_ids_petsc)
4740)
4741) ! cell type update
4742) deallocate(unstructured_grid%cell_type)
4743) allocate(unstructured_grid%cell_type(unstructured_grid%ngmax))
4744)
4745) select case(unstructured_grid%grid_type)
4746) case(THREE_DIM_GRID)
4747) do ghosted_id = 1, unstructured_grid%ngmax
4748) ! Determine number of faces and cell-type of the current cell
4749) select case(unstructured_grid%cell_vertices(0,ghosted_id))
4750) case(8)
4751) unstructured_grid%cell_type(ghosted_id) = HEX_TYPE
4752) case(6)
4753) unstructured_grid%cell_type(ghosted_id) = WEDGE_TYPE
4754) case(5)
4755) unstructured_grid%cell_type(ghosted_id) = PYR_TYPE
4756) case(4)
4757) unstructured_grid%cell_type(ghosted_id) = TET_TYPE
4758) case default
4759) option%io_buffer = 'Cell type not recognized: '
4760) call printErrMsg(option)
4761) end select
4762) enddo
4763) case(TWO_DIM_GRID)
4764) do ghosted_id = 1, unstructured_grid%ngmax
4765) select case(unstructured_grid%cell_vertices(0,ghosted_id))
4766) case(4)
4767) unstructured_grid%cell_type = QUAD_TYPE
4768) case(3)
4769) unstructured_grid%cell_type = TRI_TYPE
4770) case default
4771) option%io_buffer = 'Cell type not recognized: '
4772) call printErrMsg(option)
4773) end select
4774) end do
4775) case default
4776) option%io_buffer = 'Grid type not recognized: '
4777) call printErrMsg(option)
4778) end select
4779)
4780) call VecDestroy(elements_petsc,ierr);CHKERRQ(ierr)
4781) call VecDestroy(elements_ghost_cells,ierr);CHKERRQ(ierr)
4782)
4783) end subroutine UGridUpdateMeshAfterGrowingStencilWidth
4784)
4785)
4786) end module Grid_Unstructured_module