projector_matrix.F90

Go to the documentation of this file.

!! Copyright (C) 2010 X. Andrade
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
module projector_matrix_oct_m
  use debug_oct_m
  use global_oct_m
  use messages_oct_m
  use profiling_oct_m
  use submesh_oct_m
 
  implicit none
 
  private
 
  public ::                     &
    projector_matrix_t,         &
    projector_matrix_allocate,  &
    projector_matrix_deallocate
 
  type projector_matrix_t
    ! Components are public by default
    real(real64),   allocatable :: dprojectors(:, :)
    complex(real64),   allocatable :: zprojectors(:, :)
    real(real64),   allocatable :: scal(:)
    integer              :: npoints
    integer              :: nprojs
    integer              :: nregions
    integer, allocatable :: regions(:)
    real(real64),   allocatable :: dmix(:, :)
    complex(real64),   allocatable :: zmix(:, :, :)
    logical              :: is_cmplx = .false.
 
    integer, pointer, contiguous :: map(:)
    real(real64),   pointer, contiguous :: position(:, :)
    real(real64),   allocatable :: sphere_weights(:)
  end type projector_matrix_t
 
contains
 
  ! -------------------------------------------------
  subroutine projector_matrix_allocate(this, nprojs, sphere, has_mix_matrix, is_cmplx)
    type(projector_matrix_t), intent(out) :: this
    integer,                  intent(in)  :: nprojs
    type(submesh_t),          intent(in)  :: sphere
    logical,                  intent(in)  :: has_mix_matrix
    logical, optional,        intent(in)  :: is_cmplx
 
    push_sub(projector_matrix_allocate)
 
    this%npoints = sphere%np
    this%nprojs = nprojs
    this%nregions = sphere%num_regions
    nullify(this%map)
    nullify(this%position)
 
    this%is_cmplx = optional_default(is_cmplx, .false.)
 
    safe_allocate(this%regions(1:this%nregions+1))
    if (this%is_cmplx) then
      safe_allocate(this%zprojectors(1:this%npoints, 1:nprojs))
    else
      safe_allocate(this%dprojectors(1:this%npoints, 1:nprojs))
    end if
    safe_allocate(this%scal(1:nprojs))
 
    if (has_mix_matrix) then
      if (this%is_cmplx) then
        safe_allocate(this%zmix(1:nprojs, 1:nprojs, 1:4))
      else
        safe_allocate(this%dmix(1:nprojs, 1:nprojs))
      end if
    end if
 
    pop_sub(projector_matrix_allocate)
  end subroutine projector_matrix_allocate
 
  ! -------------------------------------------------
 
  subroutine projector_matrix_deallocate(this)
    type(projector_matrix_t), intent(inout) :: this
 
    push_sub(projector_matrix_deallocate)
 
    safe_deallocate_a(this%regions)
    safe_deallocate_a(this%dprojectors)
    safe_deallocate_a(this%zprojectors)
    safe_deallocate_a(this%scal)
    safe_deallocate_a(this%sphere_weights)
    safe_deallocate_a(this%dmix)
    safe_deallocate_a(this%zmix)
 
    nullify(this%position)
    nullify(this%map)
    this%npoints = 0
    this%nprojs = 0
    this%nregions = 0
    this%is_cmplx = .false.
 
    pop_sub(projector_matrix_deallocate)
  end subroutine projector_matrix_deallocate
 
  ! -------------------------------------------------
 
end module projector_matrix_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: