Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief integral compression (fix point accuracy)
10 : !> \par History
11 : !> created JGH [11.2017]
12 : !> \authors JGH
13 : ! **************************************************************************************************
14 : MODULE lri_compression
15 : USE kinds, ONLY: dp,&
16 : sp
17 : USE lri_environment_types, ONLY: carray,&
18 : int_container
19 : #include "./base/base_uses.f90"
20 :
21 : IMPLICIT NONE
22 :
23 : PRIVATE
24 :
25 : ! **************************************************************************************************
26 :
27 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'lri_compression'
28 :
29 : PUBLIC :: lri_comp, lri_decomp_i, lri_cont_mem
30 :
31 : ! **************************************************************************************************
32 :
33 : CONTAINS
34 :
35 : ! **************************************************************************************************
36 : !> \brief ...
37 : !> \param aval ...
38 : !> \param amax ...
39 : !> \param cont ...
40 : ! **************************************************************************************************
41 18693 : SUBROUTINE lri_comp(aval, amax, cont)
42 : REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN) :: aval
43 : REAL(KIND=dp), DIMENSION(:), INTENT(OUT) :: amax
44 : TYPE(int_container), INTENT(INOUT) :: cont
45 :
46 : INTEGER :: i, ia, ib, ii, na, nb, nc, nn
47 : REAL(KIND=dp) :: xm
48 : TYPE(carray), POINTER :: ca
49 :
50 18693 : IF (ASSOCIATED(cont%ca)) THEN
51 0 : DO i = 1, SIZE(cont%ca)
52 0 : IF (ASSOCIATED(cont%ca(i)%cdp)) DEALLOCATE (cont%ca(i)%cdp)
53 0 : IF (ASSOCIATED(cont%ca(i)%csp)) DEALLOCATE (cont%ca(i)%csp)
54 0 : IF (ASSOCIATED(cont%ca(i)%cip)) DEALLOCATE (cont%ca(i)%cip)
55 : END DO
56 : END IF
57 :
58 18693 : na = SIZE(aval, 1)
59 18693 : nb = SIZE(aval, 2)
60 18693 : nc = SIZE(aval, 3)
61 18693 : nn = na*nb
62 18693 : cont%na = na
63 18693 : cont%nb = nb
64 18693 : cont%nc = nc
65 :
66 18693 : IF (nc > 0) THEN
67 1582424 : ALLOCATE (cont%ca(nc))
68 1545038 : DO i = 1, nc
69 1526345 : ca => cont%ca(i)
70 1526345 : NULLIFY (ca%cdp, ca%csp, ca%cip)
71 228395842 : xm = MAXVAL(ABS(aval(:, :, i)))
72 1526345 : IF (xm >= 1.0e-05_dp) THEN
73 166237 : ca%compression = 1
74 498711 : ALLOCATE (ca%cdp(nn))
75 166237 : ii = 0
76 1917055 : DO ib = 1, nb
77 22125894 : DO ia = 1, na
78 20208839 : ii = ii + 1
79 21959657 : ca%cdp(ii) = aval(ia, ib, i)
80 : END DO
81 : END DO
82 1360108 : ELSE IF (xm >= 1.0e-10_dp) THEN
83 313501 : ca%compression = 2
84 940503 : ALLOCATE (ca%csp(nn))
85 313501 : ii = 0
86 3565339 : DO ib = 1, nb
87 41242319 : DO ia = 1, na
88 37676980 : ii = ii + 1
89 40928818 : ca%csp(ii) = REAL(aval(ia, ib, i), KIND=sp)
90 : END DO
91 : END DO
92 : ELSE
93 1046607 : ca%compression = 0
94 : END IF
95 1545038 : amax(i) = xm
96 : END DO
97 : END IF
98 :
99 18693 : END SUBROUTINE lri_comp
100 :
101 : ! **************************************************************************************************
102 : !> \brief ...
103 : !> \param cont ...
104 : !> \return ...
105 : ! **************************************************************************************************
106 18693 : FUNCTION lri_cont_mem(cont) RESULT(cmem)
107 : TYPE(int_container), INTENT(IN) :: cont
108 : REAL(KIND=dp) :: cmem
109 :
110 : INTEGER :: i
111 :
112 18693 : cmem = 0.0_dp
113 18693 : IF (ASSOCIATED(cont%ca)) THEN
114 1545038 : DO i = 1, SIZE(cont%ca)
115 1526345 : IF (ASSOCIATED(cont%ca(i)%cdp)) THEN
116 166237 : cmem = cmem + SIZE(cont%ca(i)%cdp)
117 : END IF
118 1526345 : IF (ASSOCIATED(cont%ca(i)%csp)) THEN
119 313501 : cmem = cmem + 0.5_dp*SIZE(cont%ca(i)%csp)
120 : END IF
121 1545038 : IF (ASSOCIATED(cont%ca(i)%cip)) THEN
122 0 : cmem = cmem + SIZE(cont%ca(i)%cip)
123 : END IF
124 : END DO
125 : END IF
126 :
127 18693 : END FUNCTION lri_cont_mem
128 : ! **************************************************************************************************
129 : !> \brief ...
130 : !> \param aval ...
131 : !> \param cont ...
132 : !> \param ival ...
133 : ! **************************************************************************************************
134 6750865 : SUBROUTINE lri_decomp_i(aval, cont, ival)
135 : REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: aval
136 : TYPE(int_container), INTENT(INOUT) :: cont
137 : INTEGER :: ival
138 :
139 : INTEGER :: ia, ib, ii, na, nb, nn
140 : TYPE(carray), POINTER :: ca
141 :
142 6750865 : na = SIZE(aval, 1)
143 6750865 : nb = SIZE(aval, 2)
144 6750865 : nn = na*nb
145 6750865 : CPASSERT(na == cont%na)
146 6750865 : CPASSERT(nb == cont%nb)
147 6750865 : CPASSERT(ival <= cont%nc)
148 :
149 6750865 : ca => cont%ca(ival)
150 : !
151 8808019 : SELECT CASE (ca%compression)
152 : CASE (0)
153 214947270 : aval(1:na, 1:nb) = 0.0_dp
154 : CASE (1)
155 : ii = 0
156 24049523 : DO ib = 1, nb
157 253761259 : DO ia = 1, na
158 229711736 : ii = ii + 1
159 251439012 : aval(ia, ib) = ca%cdp(ii)
160 : END DO
161 : END DO
162 : CASE (2)
163 : ii = 0
164 22911468 : DO ib = 1, nb
165 243951432 : DO ia = 1, na
166 221039964 : ii = ii + 1
167 241579968 : aval(ia, ib) = REAL(ca%csp(ii), KIND=dp)
168 : END DO
169 : END DO
170 : CASE DEFAULT
171 6750865 : CPABORT("lri_decomp_i: compression label invalid")
172 : END SELECT
173 :
174 6750865 : END SUBROUTINE lri_decomp_i
175 :
176 : END MODULE lri_compression
177 :
|
