states_elec_group.F90

Go to the documentation of this file.

!! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch
!!
!! 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 states_elec_group_oct_m
  use batch_oct_m
  use debug_oct_m
  use global_oct_m
  use messages_oct_m
  use profiling_oct_m
  use states_elec_dim_oct_m
  use wfs_elec_oct_m
  use mpi_oct_m
 
  implicit none
 
  private
 
  public ::                           &
    states_elec_group_t,                   &
    states_elec_group_end,                 &
    states_elec_group_copy
 
  !
  type states_elec_group_t
    ! Components are public by default
    type(wfs_elec_t), allocatable :: psib(:, :)
    integer                  :: nblocks
    integer                  :: block_start
    integer                  :: block_end
    integer, allocatable     :: iblock(:)
    integer, allocatable     :: block_range(:, :)
    integer, allocatable     :: block_size(:)
    logical, allocatable     :: block_is_local(:, :)
    integer, allocatable     :: block_node(:,:)
    type(MPI_Win), allocatable :: rma_win(:, :)
    logical                  :: block_initialized = .false. 
  end type states_elec_group_t
 
contains
 
  ! ---------------------------------------------------------
  !
  subroutine states_elec_group_end(this, d)
    type(states_elec_group_t), intent(inout) :: this
    type(states_elec_dim_t),   intent(in)    :: d
 
    integer :: ib, iq
 
    push_sub(states_elec_group_end)
 
    if (this%block_initialized) then
      do ib = 1, this%nblocks
        do iq = d%kpt%start, d%kpt%end
          if (this%block_is_local(ib, iq)) then
            call this%psib(ib, iq)%end()
          end if
        end do
      end do
 
      safe_deallocate_a(this%psib)
 
      safe_deallocate_a(this%iblock)
      safe_deallocate_a(this%block_range)
      safe_deallocate_a(this%block_size)
      safe_deallocate_a(this%block_is_local)
      safe_deallocate_a(this%block_node)
      safe_deallocate_a(this%rma_win)
      this%block_initialized = .false.
    end if
 
    pop_sub(states_elec_group_end)
  end subroutine states_elec_group_end
 
  !---------------------------------------------------------
  !
  subroutine states_elec_group_copy(d, group_in, group_out, copy_data, special)
    type(states_elec_dim_t),   intent(in)    :: d
    type(states_elec_group_t), intent(in)    :: group_in
    type(states_elec_group_t), intent(inout) :: group_out
    logical, optional,         intent(in)    :: copy_data
    logical, optional,         intent(in)    :: special
 
    integer :: qn_start, qn_end, ib, iqn
 
    push_sub(states_elec_group_copy)
 
    call states_elec_group_end(group_out, d)
 
    group_out%nblocks           = group_in%nblocks
    group_out%block_start       = group_in%block_start
    group_out%block_end         = group_in%block_end
    group_out%block_initialized = group_in%block_initialized
 
    if (group_out%block_initialized) then
 
      assert(allocated(group_in%psib))
 
      qn_start = d%kpt%start
      qn_end   = d%kpt%end
 
      safe_allocate(group_out%psib(1:group_out%nblocks, qn_start:qn_end))
 
      do iqn = qn_start, qn_end
        do ib = group_out%block_start, group_out%block_end
          call group_in%psib(ib, iqn)%copy_to(group_out%psib(ib, iqn), &
            copy_data = optional_default(copy_data, .true.), special = special)
        end do
      end do
 
      safe_allocate_source_a(group_out%iblock, group_in%iblock)
      safe_allocate_source_a(group_out%block_range, group_in%block_range)
      safe_allocate_source_a(group_out%block_size, group_in%block_size)
      safe_allocate_source_a(group_out%block_is_local, group_in%block_is_local)
      safe_allocate_source_a(group_out%block_node, group_in%block_node)
      !TODO: Fix this. This wont duplicate MPI window resources
      safe_allocate_source_a(group_out%rma_win, group_in%rma_win)
 
    end if
 
    pop_sub(states_elec_group_copy)
  end subroutine states_elec_group_copy
 
end module states_elec_group_oct_m
 
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: