1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5! ************************************************************************************************** 6!> \brief General overlap type integrals containers 7!> \par History 8!> - rewrite of PPNL and OCE integrals 9! ************************************************************************************************** 10MODULE sap_kind_types 11 12 USE kinds, ONLY: dp 13 USE util, ONLY: locate,& 14 sort 15#include "./base/base_uses.f90" 16 17 IMPLICIT NONE 18 19 PRIVATE 20 21 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'sap_kind_types' 22 23 TYPE clist_type 24 INTEGER :: catom, nsgf_cnt 25 INTEGER, DIMENSION(:), POINTER :: sgf_list 26 INTEGER, DIMENSION(3) :: cell 27 LOGICAL :: sgf_soft_only 28 REAL(KIND=dp) :: maxac, maxach 29 REAL(KIND=dp), DIMENSION(3) :: rac 30 REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: acint 31 REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: achint 32 END TYPE clist_type 33 34 TYPE alist_type 35 INTEGER :: aatom 36 INTEGER :: nclist 37 TYPE(clist_type), DIMENSION(:), POINTER :: clist 38 END TYPE alist_type 39 40 TYPE sap_int_type 41 INTEGER :: a_kind, p_kind 42 INTEGER :: nalist 43 TYPE(alist_type), DIMENSION(:), POINTER :: alist 44 INTEGER, DIMENSION(:), POINTER :: asort, aindex 45 END TYPE sap_int_type 46 47 PUBLIC :: sap_int_type, clist_type, alist_type, & 48 release_sap_int, get_alist, alist_pre_align_blk, & 49 alist_post_align_blk, sap_sort 50 51CONTAINS 52 53!========================================================================================================== 54 55! ************************************************************************************************** 56!> \brief ... 57!> \param sap_int ... 58! ************************************************************************************************** 59 SUBROUTINE release_sap_int(sap_int) 60 61 TYPE(sap_int_type), DIMENSION(:), POINTER :: sap_int 62 63 CHARACTER(LEN=*), PARAMETER :: routineN = 'release_sap_int', & 64 routineP = moduleN//':'//routineN 65 66 INTEGER :: i, j, k 67 TYPE(clist_type), POINTER :: clist 68 69 CPASSERT(ASSOCIATED(sap_int)) 70 71 DO i = 1, SIZE(sap_int) 72 IF (ASSOCIATED(sap_int(i)%alist)) THEN 73 DO j = 1, SIZE(sap_int(i)%alist) 74 IF (ASSOCIATED(sap_int(i)%alist(j)%clist)) THEN 75 DO k = 1, SIZE(sap_int(i)%alist(j)%clist) 76 clist => sap_int(i)%alist(j)%clist(k) 77 IF (ASSOCIATED(clist%acint)) THEN 78 DEALLOCATE (clist%acint) 79 END IF 80 IF (ASSOCIATED(clist%sgf_list)) THEN 81 DEALLOCATE (clist%sgf_list) 82 END IF 83 IF (ASSOCIATED(clist%achint)) THEN 84 DEALLOCATE (clist%achint) 85 END IF 86 END DO 87 DEALLOCATE (sap_int(i)%alist(j)%clist) 88 END IF 89 END DO 90 DEALLOCATE (sap_int(i)%alist) 91 END IF 92 IF (ASSOCIATED(sap_int(i)%asort)) THEN 93 DEALLOCATE (sap_int(i)%asort) 94 END IF 95 IF (ASSOCIATED(sap_int(i)%aindex)) THEN 96 DEALLOCATE (sap_int(i)%aindex) 97 END IF 98 END DO 99 100 DEALLOCATE (sap_int) 101 102 END SUBROUTINE release_sap_int 103 104! ************************************************************************************************** 105!> \brief ... 106!> \param sap_int ... 107!> \param alist ... 108!> \param atom ... 109! ************************************************************************************************** 110 SUBROUTINE get_alist(sap_int, alist, atom) 111 112 TYPE(sap_int_type), INTENT(IN) :: sap_int 113 TYPE(alist_type), INTENT(OUT), POINTER :: alist 114 INTEGER, INTENT(IN) :: atom 115 116 CHARACTER(LEN=*), PARAMETER :: routineN = 'get_alist', routineP = moduleN//':'//routineN 117 118 INTEGER :: i 119 120 NULLIFY (alist) 121 i = locate(sap_int%asort, atom) 122 IF (i > 0 .AND. i <= SIZE(sap_int%alist)) THEN 123 i = sap_int%aindex(i) 124 alist => sap_int%alist(i) 125 ELSE IF (i == 0) THEN 126 NULLIFY (alist) 127 ELSE 128 CPABORT("") 129 END IF 130 131 END SUBROUTINE get_alist 132 133! ************************************************************************************************** 134!> \brief ... 135!> \param blk_in ... 136!> \param ldin ... 137!> \param blk_out ... 138!> \param ldout ... 139!> \param ilist ... 140!> \param in ... 141!> \param jlist ... 142!> \param jn ... 143! ************************************************************************************************** 144 SUBROUTINE alist_pre_align_blk(blk_in, ldin, blk_out, ldout, ilist, in, jlist, jn) 145 INTEGER, INTENT(IN) :: in, ilist(*), ldout 146 REAL(dp), INTENT(INOUT) :: blk_out(ldout, *) 147 INTEGER, INTENT(IN) :: ldin 148 REAL(dp), INTENT(IN) :: blk_in(ldin, *) 149 INTEGER, INTENT(IN) :: jlist(*), jn 150 151 INTEGER :: i, i0, i1, i2, i3, inn, inn1, j, j0 152 153 inn = MOD(in, 4) 154 inn1 = inn + 1 155 DO j = 1, jn 156 j0 = jlist(j) 157 DO i = 1, inn 158 i0 = ilist(i) 159 blk_out(i, j) = blk_in(i0, j0) 160 ENDDO 161 DO i = inn1, in, 4 162 i0 = ilist(i) 163 i1 = ilist(i + 1) 164 i2 = ilist(i + 2) 165 i3 = ilist(i + 3) 166 blk_out(i, j) = blk_in(i0, j0) 167 blk_out(i + 1, j) = blk_in(i1, j0) 168 blk_out(i + 2, j) = blk_in(i2, j0) 169 blk_out(i + 3, j) = blk_in(i3, j0) 170 ENDDO 171 ENDDO 172 END SUBROUTINE alist_pre_align_blk 173 174! ************************************************************************************************** 175!> \brief ... 176!> \param blk_in ... 177!> \param ldin ... 178!> \param blk_out ... 179!> \param ldout ... 180!> \param ilist ... 181!> \param in ... 182!> \param jlist ... 183!> \param jn ... 184! ************************************************************************************************** 185 SUBROUTINE alist_post_align_blk(blk_in, ldin, blk_out, ldout, ilist, in, jlist, jn) 186 INTEGER, INTENT(IN) :: in, ilist(*), ldout 187 REAL(dp), INTENT(INOUT) :: blk_out(ldout, *) 188 INTEGER, INTENT(IN) :: ldin 189 REAL(dp), INTENT(IN) :: blk_in(ldin, *) 190 INTEGER, INTENT(IN) :: jlist(*), jn 191 192 INTEGER :: i, i0, i1, i2, i3, inn, inn1, j, j0 193 194 inn = MOD(in, 4) 195 inn1 = inn + 1 196 DO j = 1, jn 197 j0 = jlist(j) 198 DO i = 1, inn 199 i0 = ilist(i) 200 blk_out(i0, j0) = blk_out(i0, j0) + blk_in(i, j) 201 ENDDO 202 DO i = inn1, in, 4 203 i0 = ilist(i) 204 i1 = ilist(i + 1) 205 i2 = ilist(i + 2) 206 i3 = ilist(i + 3) 207 blk_out(i0, j0) = blk_out(i0, j0) + blk_in(i, j) 208 blk_out(i1, j0) = blk_out(i1, j0) + blk_in(i + 1, j) 209 blk_out(i2, j0) = blk_out(i2, j0) + blk_in(i + 2, j) 210 blk_out(i3, j0) = blk_out(i3, j0) + blk_in(i + 3, j) 211 ENDDO 212 ENDDO 213 END SUBROUTINE alist_post_align_blk 214 215! ************************************************************************************************** 216!> \brief ... 217!> \param sap_int ... 218! ************************************************************************************************** 219 SUBROUTINE sap_sort(sap_int) 220 TYPE(sap_int_type), DIMENSION(:), POINTER :: sap_int 221 222 CHARACTER(LEN=*), PARAMETER :: routineN = 'sap_sort', routineP = moduleN//':'//routineN 223 224 INTEGER :: iac, na 225 226! *** Set up a sorting index 227 228 DO iac = 1, SIZE(sap_int) 229 IF (.NOT. ASSOCIATED(sap_int(iac)%alist)) CYCLE 230 na = SIZE(sap_int(iac)%alist) 231 ALLOCATE (sap_int(iac)%asort(na), sap_int(iac)%aindex(na)) 232 sap_int(iac)%asort(1:na) = sap_int(iac)%alist(1:na)%aatom 233 CALL sort(sap_int(iac)%asort, na, sap_int(iac)%aindex) 234 END DO 235 236 END SUBROUTINE sap_sort 237 238!========================================================================================================== 239 240END MODULE sap_kind_types 241