1!
2! Copyright (C) 1996-2016	The SIESTA group
3!  This file is distributed under the terms of the
4!  GNU General Public License: see COPYING in the top directory
5!  or http://www.gnu.org/copyleft/gpl.txt.
6! See Docs/Contributors.txt for a list of contributors.
7!
8module densematrix
9!
10!  Contains the dense matrix arrays used within SIESTA
11!
12  use precision
13
14  implicit none
15
16  private
17
18  ! Ensure they are initialially nullified
19  real(dp), public, pointer :: Haux(:) => null()
20  real(dp), public, pointer :: Saux(:) => null()
21  real(dp), public, pointer :: psi(:) => null()
22
23  public :: allocDenseMatrix
24  public :: resetDenseMatrix
25
26contains
27
28  subroutine allocDenseMatrix(nHaux, nSaux, npsi)
29    use alloc, only : re_alloc
30    integer, intent(in) :: nHaux, nSaux, npsi
31
32    !> If the arrays are already allocated with the same
33    !> bounds nothing will be done
34    call re_alloc(Haux, 1, nHaux, 'Haux', 'densematrix', copy=.false., shrink=.false.)
35    call re_alloc(Saux, 1, nSaux, 'Saux', 'densematrix', copy=.false., shrink=.false.)
36    call re_alloc(psi, 1, npsi, 'psi', 'densematrix', copy=.false., shrink=.false.)
37
38  end subroutine allocDenseMatrix
39
40  !> Deallocates auxiliary arrays.
41  !> Note that it is safe to call the routine even if
42  !> (some) arrays are not associated. Nothing will be
43  !> done in that case.
44  subroutine resetDenseMatrix(dealloc_Haux, dealloc_Saux, dealloc_psi)
45    use alloc, only : de_alloc
46
47    !> This flag is used in connection with the OMM
48    !> module: it needs diagon-computed eigenvectors
49    !> as seeds for the first few iterations.
50    !> [[diagon]] will not deallocate psi in that case
51    logical, intent(in), optional :: dealloc_Haux, dealloc_Saux, dealloc_psi
52
53    logical :: ldealloc
54
55    ldealloc = .true.
56    if ( present(dealloc_Haux) ) ldealloc = dealloc_Haux
57    if ( ldealloc ) then
58      call de_alloc(Haux, 'Haux', 'densematrix')
59      nullify(Haux)
60    end if
61
62    ldealloc = .true.
63    if ( present(dealloc_Saux) ) ldealloc = dealloc_Saux
64    if ( ldealloc ) then
65      call de_alloc(Saux, 'Saux', 'densematrix')
66      nullify(Saux)
67    end if
68
69    ldealloc = .true.
70    if ( present(dealloc_psi) ) ldealloc = dealloc_psi
71    if ( ldealloc ) then
72      call de_alloc(psi, 'psi', 'densematrix')
73      nullify(psi)
74    end if
75
76  end subroutine resetDenseMatrix
77
78end module densematrix
79