1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2020  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief Storage to keep precomputed surface Green's functions
8! **************************************************************************************************
9MODULE negf_green_cache
10   USE cp_cfm_types,                    ONLY: cp_cfm_p_type,&
11                                              cp_cfm_release
12   USE kinds,                           ONLY: dp
13   USE util,                            ONLY: sort
14#include "./base/base_uses.f90"
15
16   IMPLICIT NONE
17   PRIVATE
18
19   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'negf_green_cache'
20   LOGICAL, PARAMETER, PRIVATE          :: debug_this_module = .TRUE.
21
22   PUBLIC :: green_functions_cache_type
23
24   PUBLIC :: green_functions_cache_expand, &
25             green_functions_cache_reorder, &
26             green_functions_cache_release
27
28! **************************************************************************************************
29!> \brief Storage to keep surface Green's functions.
30!> \author Sergey Chulkov
31! **************************************************************************************************
32   TYPE green_functions_cache_type
33      !> retarded surface Green's functions [ncontacts, nnodes]
34      TYPE(cp_cfm_p_type), ALLOCATABLE, DIMENSION(:, :)   :: g_surf_contacts
35      !> list of points over the normalised interval [-1 .. 1].
36      !> Coordinates of actual point where Green's functions were evaluated
37      !> can be obtained by using an appropriate rescale_nodes_*() subroutine
38      !> from the module 'negf_integr_utils'.
39      REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: tnodes
40   END TYPE green_functions_cache_type
41
42CONTAINS
43! **************************************************************************************************
44!> \brief Reallocate storage so it can handle extra 'nnodes_extra' items for each contact.
45!> \param cache        storage to expand
46!> \param ncontacts    number of contacts
47!> \param nnodes_extra number of items to add
48!> \author Sergey Chulkov
49! **************************************************************************************************
50   SUBROUTINE green_functions_cache_expand(cache, ncontacts, nnodes_extra)
51      TYPE(green_functions_cache_type), INTENT(inout)    :: cache
52      INTEGER, INTENT(in)                                :: ncontacts, nnodes_extra
53
54      INTEGER                                            :: i, icontact, nentries_exist
55      LOGICAL                                            :: is_alloc
56      TYPE(cp_cfm_p_type), ALLOCATABLE, DIMENSION(:, :)  :: g_surf_contacts
57
58      is_alloc = ALLOCATED(cache%g_surf_contacts)
59
60      IF (is_alloc) THEN
61         CPASSERT(SIZE(cache%g_surf_contacts, 1) == ncontacts)
62         nentries_exist = SIZE(cache%g_surf_contacts, 2)
63
64      ELSE
65         nentries_exist = 0
66      END IF
67
68      ALLOCATE (g_surf_contacts(ncontacts, nentries_exist + nnodes_extra))
69
70      IF (is_alloc) THEN
71         DO i = 1, nentries_exist
72            DO icontact = 1, ncontacts
73               g_surf_contacts(icontact, i)%matrix => cache%g_surf_contacts(icontact, i)%matrix
74            END DO
75         END DO
76
77         DEALLOCATE (cache%g_surf_contacts)
78      END IF
79
80      DO i = 1, nnodes_extra
81         DO icontact = 1, ncontacts
82            NULLIFY (g_surf_contacts(icontact, nentries_exist + i)%matrix)
83         END DO
84      END DO
85
86      CALL MOVE_ALLOC(g_surf_contacts, cache%g_surf_contacts)
87   END SUBROUTINE green_functions_cache_expand
88
89! **************************************************************************************************
90!> \brief Sort cached items in ascending order.
91!> \param cache        storage to reorder
92!> \param tnodes       coordinate of items in storage
93!> \author Sergey Chulkov
94! **************************************************************************************************
95   SUBROUTINE green_functions_cache_reorder(cache, tnodes)
96      TYPE(green_functions_cache_type), INTENT(inout)    :: cache
97      REAL(kind=dp), DIMENSION(:), INTENT(in)            :: tnodes
98
99      INTEGER                                            :: icontact, ind_new, ind_old, ncontacts, &
100                                                            nnodes
101      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: indices
102      TYPE(cp_cfm_p_type), ALLOCATABLE, DIMENSION(:, :)  :: g_surf_contacts
103
104      nnodes = SIZE(tnodes)
105
106      CPASSERT(ALLOCATED(cache%g_surf_contacts))
107      CPASSERT(SIZE(cache%g_surf_contacts, 2) == nnodes)
108
109      ncontacts = SIZE(cache%g_surf_contacts, 1)
110
111      IF (ALLOCATED(cache%tnodes)) DEALLOCATE (cache%tnodes)
112
113      ALLOCATE (g_surf_contacts(ncontacts, nnodes))
114      ALLOCATE (cache%tnodes(nnodes))
115      ALLOCATE (indices(nnodes))
116
117      cache%tnodes(:) = tnodes(:)
118      CALL sort(cache%tnodes, nnodes, indices)
119
120      DO ind_new = 1, nnodes
121         ind_old = indices(ind_new)
122         DO icontact = 1, ncontacts
123            g_surf_contacts(icontact, ind_new)%matrix => cache%g_surf_contacts(icontact, ind_old)%matrix
124         END DO
125      END DO
126
127      DEALLOCATE (cache%g_surf_contacts)
128      CALL MOVE_ALLOC(g_surf_contacts, cache%g_surf_contacts)
129   END SUBROUTINE green_functions_cache_reorder
130
131! **************************************************************************************************
132!> \brief Release storage.
133!> \param cache        storage to release
134!> \author Sergey Chulkov
135! **************************************************************************************************
136   SUBROUTINE green_functions_cache_release(cache)
137      TYPE(green_functions_cache_type), INTENT(inout)    :: cache
138
139      INTEGER                                            :: icontact, ipoint, ncontacts
140
141      IF (ALLOCATED(cache%tnodes)) DEALLOCATE (cache%tnodes)
142
143      IF (ALLOCATED(cache%g_surf_contacts)) THEN
144         ncontacts = SIZE(cache%g_surf_contacts, 1)
145         DO ipoint = SIZE(cache%g_surf_contacts, 2), 1, -1
146            DO icontact = ncontacts, 1, -1
147               IF (ASSOCIATED(cache%g_surf_contacts(icontact, ipoint)%matrix)) &
148                  CALL cp_cfm_release(cache%g_surf_contacts(icontact, ipoint)%matrix)
149            END DO
150         END DO
151
152         DEALLOCATE (cache%g_surf_contacts)
153      END IF
154   END SUBROUTINE green_functions_cache_release
155END MODULE negf_green_cache
156
157