matrix_buffer.F90       coverage:  0.00 %func     0.00 %block


     1) module Matrix_Buffer_module
     2) 
     3)   use Grid_module
     4)  
     5)   use PFLOTRAN_Constants_module
     6) 
     7)   implicit none
     8) 
     9)   private
    10) 
    11) #include "petsc/finclude/petscsys.h"
    12) #include "petsc/finclude/petscmat.h"
    13) #include "petsc/finclude/petscmat.h90"
    14) #include "petsc/finclude/petscvec.h"
    15) #include "petsc/finclude/petscvec.h90"
    16)   
    17) 
    18)   type, public :: matrix_buffer_type
    19)     PetscInt :: matrix_type
    20)     type(grid_type), pointer :: grid
    21)     PetscInt :: i_width
    22)     PetscInt :: j_width
    23)     PetscInt :: k_width
    24)     PetscInt, pointer :: icol(:,:)
    25)     PetscReal, pointer :: values(:,:)
    26)   end type matrix_buffer_type
    27) 
    28)   PetscInt, parameter, public :: AIJ = 1
    29)   PetscInt, parameter, public :: HYPRESTRUCT = 2
    30) 
    31)   public :: MatrixBufferCreate, &
    32)             MatrixBufferInit, &
    33)             MatrixBufferDestroy, &
    34)             MatrixBufferZero, &
    35)             MatrixBufferAdd, &
    36)             MatrixBufferZeroRows, &
    37)             MatrixBufferSetValues
    38)  
    39) contains
    40) 
    41) ! ************************************************************************** !
    42) 
    43) function MatrixBufferCreate()
    44)   ! 
    45)   ! Creates a matrix object
    46)   ! 
    47)   ! Author: Glenn Hammond
    48)   ! Date: 05/13/09
    49)   ! 
    50)   
    51)   implicit none
    52) 
    53)   type(matrix_buffer_type), pointer :: MatrixBufferCreate
    54)   
    55)   type(matrix_buffer_type), pointer :: matrix_buffer
    56)   
    57)   allocate(matrix_buffer)
    58)   matrix_buffer%matrix_type = 0
    59)   nullify(matrix_buffer%grid)
    60)   matrix_buffer%i_width = 0
    61)   matrix_buffer%j_width = 0
    62)   matrix_buffer%k_width = 0
    63)   nullify(matrix_buffer%values)
    64)   nullify(matrix_buffer%icol)
    65)   MatrixBufferCreate => matrix_buffer
    66) 
    67) end function MatrixBufferCreate
    68) 
    69) ! ************************************************************************** !
    70) 
    71) subroutine MatrixBufferInit(A,matrix_buffer,grid)
    72)   ! 
    73)   ! Initializes matrix buffer object
    74)   ! 
    75)   ! Author: Glenn Hammond
    76)   ! Date: 05/13/09
    77)   ! 
    78) 
    79)   use Grid_Structured_module
    80) 
    81)   implicit none
    82) 
    83)   Mat :: A
    84)   type(matrix_buffer_type), pointer :: matrix_buffer  
    85)   type(grid_type), target :: grid
    86) 
    87)   MatType :: mat_type
    88)   PetscInt :: local_id, ghosted_id
    89)   PetscInt :: i, j, k
    90)   type(grid_structured_type), pointer :: structured_grid
    91)   PetscErrorCode :: ierr
    92) 
    93)   matrix_buffer%grid => grid
    94)   structured_grid => grid%structured_grid
    95) 
    96)   call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
    97) 
    98)   select case(mat_type)
    99)     case(MATMPIAIJ,MATSEQAIJ,MATMPIBAIJ,MATSEQBAIJ)
   100)       matrix_buffer%matrix_type = AIJ
   101)       matrix_buffer%i_width = 1
   102)       matrix_buffer%j_width = structured_grid%ngx 
   103)       matrix_buffer%k_width = structured_grid%ngxy
   104)       allocate(matrix_buffer%icol(7,structured_grid%ngmax))
   105)       allocate(matrix_buffer%values(7,structured_grid%ngmax))
   106)       ! compute fill indices
   107)       ! initialize all to zero
   108)       matrix_buffer%icol = 0 
   109)       local_id = 0
   110)       do k=structured_grid%kstart,structured_grid%kend
   111)         do j=structured_grid%jstart,structured_grid%jend
   112)           do i=structured_grid%istart,structured_grid%iend
   113)             local_id = local_id + 1
   114)             ghosted_id = grid%nL2G(local_id)
   115)             if (k > 0) then
   116)               matrix_buffer%icol(1,ghosted_id) = ghosted_id - structured_grid%ngxy
   117)             endif
   118)             if (j > 0) then
   119)               matrix_buffer%icol(2,ghosted_id) = ghosted_id - structured_grid%ngx
   120)             endif
   121)             if (i > 0) then
   122)               matrix_buffer%icol(3,ghosted_id) = ghosted_id - 1
   123)             endif
   124)             matrix_buffer%icol(4,ghosted_id) = ghosted_id
   125)             if (i < structured_grid%iend .or. &
   126)                 structured_grid%gxe-structured_grid%lxe > 0) then
   127)               matrix_buffer%icol(5,ghosted_id) = ghosted_id + 1
   128)             endif
   129)             if (j < structured_grid%jend .or. &
   130)                 structured_grid%gye-structured_grid%lye > 0) then
   131)               matrix_buffer%icol(6,ghosted_id) = ghosted_id + structured_grid%ngx
   132)             endif
   133)             if (k < structured_grid%kend .or. &
   134)                 structured_grid%gze-structured_grid%lze > 0) then
   135)               matrix_buffer%icol(7,ghosted_id) = ghosted_id + structured_grid%ngxy
   136)             endif
   137)           enddo
   138)         enddo
   139)       enddo
   140)       ! convert to zero-based
   141)       ! inactive entries will become -1, which is constistent with PETSc
   142)       matrix_buffer%icol = matrix_buffer%icol - 1 
   143)     case(MATHYPRESTRUCT)
   144)       matrix_buffer%matrix_type = HYPRESTRUCT
   145)       matrix_buffer%i_width = 1
   146)       matrix_buffer%j_width = structured_grid%ngx 
   147)       matrix_buffer%k_width = structured_grid%ngxy
   148)       allocate(matrix_buffer%values(7,structured_grid%ngmax))
   149)   end select
   150)   matrix_buffer%values = 0.d0
   151) 
   152) end subroutine MatrixBufferInit
   153) 
   154) ! ************************************************************************** !
   155) 
   156) subroutine MatrixBufferZero(matrix_buffer)
   157)   ! 
   158)   ! Zeros matrix buffer values
   159)   ! 
   160)   ! Author: Glenn Hammond
   161)   ! Date: 05/13/09
   162)   ! 
   163) 
   164)   implicit none
   165)   
   166)   type(matrix_buffer_type), pointer :: matrix_buffer  
   167) 
   168)   matrix_buffer%values = 0.d0
   169) 
   170) end subroutine MatrixBufferZero
   171) 
   172) ! ************************************************************************** !
   173) 
   174) subroutine MatrixBufferAdd(matrix_buffer,irow,icol,value)
   175)   ! 
   176)   ! Adds values to matrix buffer object
   177)   ! 
   178)   ! Author: Glenn Hammond
   179)   ! Date: 05/13/09
   180)   ! 
   181) 
   182)   implicit none
   183)   
   184)   type(matrix_buffer_type), pointer :: matrix_buffer  
   185)   PetscInt :: irow, icol
   186)   PetscReal :: value
   187)   
   188)   PetscInt :: index
   189) 
   190)   if (icol < 0) then
   191)     index = 4
   192)   else
   193)     index = irow-icol
   194)     if (index == 0) then
   195)       index = 4
   196)     else if (index == -matrix_buffer%i_width) then
   197)       index = 5
   198)     else if (index == matrix_buffer%i_width) then
   199)       index = 3
   200)     else if (index == -matrix_buffer%j_width) then
   201)       index = 6
   202)     else if (index == matrix_buffer%j_width) then
   203)       index = 2
   204)     else if (index == -matrix_buffer%k_width) then
   205)       index = 7
   206)     else if (index == matrix_buffer%k_width) then
   207)       index = 1
   208)     endif
   209)   endif
   210)   matrix_buffer%values(index,irow) = matrix_buffer%values(index,irow) + value
   211) 
   212) end subroutine MatrixBufferAdd
   213) 
   214) ! ************************************************************************** !
   215) 
   216) subroutine MatrixBufferZeroRows(matrix_buffer,nrows,rows)
   217)   ! 
   218)   ! Zeros rows in a matrix buffer object, placing 1
   219)   ! on the diagonal
   220)   ! 
   221)   ! Author: Glenn Hammond
   222)   ! Date: 05/14/09
   223)   ! 
   224) 
   225)   implicit none
   226)   
   227)   type(matrix_buffer_type), pointer :: matrix_buffer  
   228)   PetscInt :: nrows
   229)   PetscInt, pointer :: rows(:)
   230) 
   231)   PetscInt :: irow, irow_local
   232)   
   233)   select case(matrix_buffer%matrix_type)
   234)     case(AIJ)
   235)       do irow = 1, nrows
   236)         irow_local = matrix_buffer%grid%nG2L(rows(irow))
   237)         matrix_buffer%values(:,irow_local) = 0.d0
   238)         matrix_buffer%values(4,irow_local) = 1.d0
   239)       enddo
   240)     case(HYPRESTRUCT)
   241)       do irow = 1, nrows
   242)         matrix_buffer%values(:,rows(irow)) = 0.d0
   243)         matrix_buffer%values(4,rows(irow)) = 1.d0
   244)       enddo
   245)   end select
   246) 
   247) end subroutine MatrixBufferZeroRows
   248) 
   249) ! ************************************************************************** !
   250) 
   251) subroutine MatrixBufferSetValues(A,matrix_buffer)
   252)   ! 
   253)   ! Sets values in PETSc matrix
   254)   ! 
   255)   ! Author: Glenn Hammond
   256)   ! Date: 05/14/09
   257)   ! 
   258) 
   259)   implicit none
   260) 
   261)   Mat :: A
   262)   type(matrix_buffer_type), pointer :: matrix_buffer  
   263) 
   264)   select case(matrix_buffer%matrix_type)
   265)     case(AIJ)
   266)       call MatrixBufferSetValuesAij(A,matrix_buffer)
   267)     case(HYPRESTRUCT)
   268)       call MatrixBufferSetValuesHypre(A,matrix_buffer)
   269)   end select
   270) 
   271) end subroutine MatrixBufferSetValues
   272) 
   273) ! ************************************************************************** !
   274) 
   275) subroutine MatrixBufferSetValuesHypre(A,matrix_buffer)
   276)   ! 
   277)   ! Sets values in PETSc Hypre matrix
   278)   ! 
   279)   ! Author: Glenn Hammond
   280)   ! Date: 05/13/09
   281)   ! 
   282) 
   283)   implicit none
   284) 
   285)   Mat :: A
   286)   type(matrix_buffer_type), pointer :: matrix_buffer  
   287) 
   288)   PetscInt :: icol
   289)   PetscErrorCode :: ierr
   290) 
   291)   do icol = 1, 7
   292)     call MatSetValuesLocal(A,1,0,1,icol-1, &
   293)                            matrix_buffer%values(icol,:),INSERT_VALUES, &
   294)                            ierr);CHKERRQ(ierr)
   295)   enddo
   296) 
   297) end subroutine MatrixBufferSetValuesHypre
   298) 
   299) ! ************************************************************************** !
   300) 
   301) subroutine MatrixBufferSetValuesAij(A,matrix_buffer)
   302)   ! 
   303)   ! MatrixBufferSetValues: Sets values in PETSc Aij matrix
   304)   ! 
   305)   ! Author: Glenn Hammond
   306)   ! Date: 05/13/09
   307)   ! 
   308) 
   309)   implicit none
   310) 
   311)   Mat :: A
   312)   type(matrix_buffer_type), pointer :: matrix_buffer  
   313) 
   314)   PetscInt :: local_id, ghosted_id
   315)   PetscErrorCode :: ierr
   316) 
   317)   do local_id = 1, matrix_buffer%grid%nlmax
   318)     ghosted_id = matrix_buffer%grid%nL2G(local_id)
   319)     call MatSetValuesLocal(A,1,matrix_buffer%icol(4,ghosted_id), &
   320)                            size(matrix_buffer%icol,1), &
   321)                            matrix_buffer%icol(:,ghosted_id), &
   322)                            matrix_buffer%values(:,ghosted_id),INSERT_VALUES, &
   323)                            ierr);CHKERRQ(ierr)
   324)   enddo
   325) 
   326) end subroutine MatrixBufferSetValuesAij
   327) 
   328) ! ************************************************************************** !
   329) 
   330) subroutine MatrixBufferDestroy(matrix_buffer)
   331)   ! 
   332)   ! Destroys a matrix buffer object
   333)   ! 
   334)   ! Author: Glenn Hammond
   335)   ! Date: 05/13/09
   336)   ! 
   337) 
   338)   implicit none
   339)   
   340)   type(matrix_buffer_type), pointer :: matrix_buffer
   341)   
   342)   if (.not.associated(matrix_buffer)) return
   343)   
   344)   if (associated(matrix_buffer%values)) deallocate(matrix_buffer%values)
   345)   nullify(matrix_buffer%values)
   346)   if (associated(matrix_buffer%icol)) deallocate(matrix_buffer%icol)
   347)   nullify(matrix_buffer%icol)
   348)   
   349)   deallocate(matrix_buffer)
   350)   nullify(matrix_buffer)
   351)   
   352) end subroutine MatrixBufferDestroy
   353) 
   354) end module Matrix_Buffer_module

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