Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 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 32577 : 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 32577 : 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 32577 : na = SIZE(aval, 1)
59 32577 : nb = SIZE(aval, 2)
60 32577 : nc = SIZE(aval, 3)
61 32577 : nn = na*nb
62 32577 : cont%na = na
63 32577 : cont%nb = nb
64 32577 : cont%nc = nc
65 :
66 32577 : IF (nc > 0) THEN
67 2694516 : ALLOCATE (cont%ca(nc))
68 2629362 : DO i = 1, nc
69 2596785 : ca => cont%ca(i)
70 2596785 : NULLIFY (ca%cdp, ca%csp, ca%cip)
71 423617338 : xm = MAXVAL(ABS(aval(:, :, i)))
72 2596785 : IF (xm >= 1.0e-05_dp) THEN
73 263269 : ca%compression = 1
74 789807 : ALLOCATE (ca%cdp(nn))
75 263269 : ii = 0
76 3243215 : DO ib = 1, nb
77 39213726 : DO ia = 1, na
78 35970511 : ii = ii + 1
79 38950457 : ca%cdp(ii) = aval(ia, ib, i)
80 : END DO
81 : END DO
82 2333516 : ELSE IF (xm >= 1.0e-10_dp) THEN
83 493469 : ca%compression = 2
84 1480407 : ALLOCATE (ca%csp(nn))
85 493469 : ii = 0
86 6084891 : DO ib = 1, nb
87 74176463 : DO ia = 1, na
88 68091572 : ii = ii + 1
89 73682994 : ca%csp(ii) = REAL(aval(ia, ib, i), KIND=sp)
90 : END DO
91 : END DO
92 : ELSE
93 1840047 : ca%compression = 0
94 : END IF
95 2629362 : amax(i) = xm
96 : END DO
97 : END IF
98 :
99 32577 : END SUBROUTINE lri_comp
100 :
101 : ! **************************************************************************************************
102 : !> \brief ...
103 : !> \param cont ...
104 : !> \return ...
105 : ! **************************************************************************************************
106 32577 : 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 32577 : cmem = 0.0_dp
113 32577 : IF (ASSOCIATED(cont%ca)) THEN
114 2629362 : DO i = 1, SIZE(cont%ca)
115 2596785 : IF (ASSOCIATED(cont%ca(i)%cdp)) THEN
116 263269 : cmem = cmem + SIZE(cont%ca(i)%cdp)
117 : END IF
118 2596785 : IF (ASSOCIATED(cont%ca(i)%csp)) THEN
119 493469 : cmem = cmem + 0.5_dp*SIZE(cont%ca(i)%csp)
120 : END IF
121 2629362 : 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 32577 : END FUNCTION lri_cont_mem
128 : ! **************************************************************************************************
129 : !> \brief ...
130 : !> \param aval ...
131 : !> \param cont ...
132 : !> \param ival ...
133 : ! **************************************************************************************************
134 9363398 : 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 9363398 : na = SIZE(aval, 1)
143 9363398 : nb = SIZE(aval, 2)
144 9363398 : nn = na*nb
145 9363398 : CPASSERT(na == cont%na)
146 9363398 : CPASSERT(nb == cont%nb)
147 9363398 : CPASSERT(ival <= cont%nc)
148 :
149 9363398 : ca => cont%ca(ival)
150 : !
151 12155695 : SELECT CASE (ca%compression)
152 : CASE (0)
153 349631655 : aval(1:na, 1:nb) = 0.0_dp
154 : CASE (1)
155 : ii = 0
156 36618475 : DO ib = 1, nb
157 413986355 : DO ia = 1, na
158 377367880 : ii = ii + 1
159 410726492 : aval(ia, ib) = ca%cdp(ii)
160 : END DO
161 : END DO
162 : CASE (2)
163 : ii = 0
164 36068320 : DO ib = 1, nb
165 415930378 : DO ia = 1, na
166 379862058 : ii = ii + 1
167 412619140 : aval(ia, ib) = REAL(ca%csp(ii), KIND=dp)
168 : END DO
169 : END DO
170 : CASE DEFAULT
171 9363398 : CPABORT("lri_decomp_i: compression label invalid")
172 : END SELECT
173 :
174 9363398 : END SUBROUTINE lri_decomp_i
175 :
176 : END MODULE lri_compression
177 :
|
