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

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody