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