1
2! Copyright (C) 2002-2017 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8! This module contains interfaces to call the c-routine clib/fletcher32.c
9! implementing the Fletcher-32 checksum algorithm as reported in
10! https://en.wikipedia.org/wiki/Fletcher%27s_checksum#Optimizations
11!
12! SdG September 3rd 2017
13!
14!------------------------------------------------------------------------------!
15    MODULE fletcher32_mod
16!------------------------------------------------------------------------------!
17    USE util_param,     ONLY : DP
18    !
19    IMPLICIT NONE
20    PRIVATE
21    integer(2) :: dat(1)
22
23    PUBLIC :: fletcher32_cksum, fletcher32
24!
25    INTERFACE fletcher32_cksum
26       MODULE PROCEDURE fletcher32_i1, fletcher32_r1, fletcher32_c1, fletcher32_z,  fletcher32_l,  &
27                        fletcher32_iv, fletcher32_rv, fletcher32_cv, fletcher32_zv, fletcher32_lv, &
28                        fletcher32_im, fletcher32_rm, fletcher32_cm,                fletcher32_lm, &
29                        fletcher32_it, fletcher32_rt, fletcher32_ct, &
30                        fletcher32_i4, fletcher32_r4, fletcher32_c4, &
31                                       fletcher32_r5, fletcher32_c5
32    END INTERFACE
33
34    INTERFACE
35       FUNCTION fletcher32( dat, dat_size ) BIND(C,name="fletcher32") RESULT(t)
36          USE ISO_C_BINDING
37          integer(kind=c_int16_t) :: dat(*)
38          integer(kind=c_int32_t) :: dat_size
39          integer(kind=c_int32_t) :: t
40       END FUNCTION fletcher32
41    END INTERFACE
42!
43!------------------------------------------------------------------------------!
44!
45    CONTAINS
46!
47!------------------------------------------------------------------------------!
48
49!..fletcher32_cksum
50!------------------------------------------------------------------------------!
51      SUBROUTINE fletcher32_i1(msg, cksum)
52         IMPLICIT NONE
53         INTEGER, INTENT(IN) :: msg
54         INTEGER, INTENT(OUT) :: cksum
55
56         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
57
58      END SUBROUTINE fletcher32_i1
59!
60!------------------------------------------------------------------------------!
61      SUBROUTINE fletcher32_iv(msg, cksum)
62         IMPLICIT NONE
63         INTEGER, INTENT(IN) :: msg(:)
64         INTEGER, INTENT(OUT) :: cksum
65
66         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
67
68      END SUBROUTINE fletcher32_iv
69!
70!------------------------------------------------------------------------------!
71      SUBROUTINE fletcher32_im( msg, cksum )
72         IMPLICIT NONE
73         INTEGER, INTENT(IN) :: msg(:,:)
74         INTEGER, INTENT(OUT) :: cksum
75
76         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
77
78      END SUBROUTINE fletcher32_im
79!
80!------------------------------------------------------------------------------!
81      SUBROUTINE fletcher32_it( msg, cksum )
82         IMPLICIT NONE
83         INTEGER, INTENT(IN) :: msg(:,:,:)
84         INTEGER, INTENT(OUT) :: cksum
85
86         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
87
88      END SUBROUTINE fletcher32_it
89!
90!------------------------------------------------------------------------------!
91      SUBROUTINE fletcher32_i4(msg, cksum )
92         IMPLICIT NONE
93         INTEGER, INTENT(IN) :: msg(:,:,:,:)
94         INTEGER, INTENT(OUT) :: cksum
95
96         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
97
98      END SUBROUTINE fletcher32_i4
99!
100!------------------------------------------------------------------------------!
101      SUBROUTINE fletcher32_r1( msg, cksum  )
102         IMPLICIT NONE
103         REAL(DP), INTENT(IN) :: msg
104         INTEGER, INTENT(OUT) :: cksum
105
106         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
107
108      END SUBROUTINE fletcher32_r1
109!
110!------------------------------------------------------------------------------!
111      SUBROUTINE fletcher32_rv(msg, cksum )
112         IMPLICIT NONE
113         REAL(DP), INTENT(IN) :: msg(:)
114         INTEGER, INTENT(OUT) :: cksum
115
116         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
117
118      END SUBROUTINE fletcher32_rv
119!
120!------------------------------------------------------------------------------!
121      SUBROUTINE fletcher32_rm(msg, cksum )
122         IMPLICIT NONE
123         REAL(DP), INTENT(IN) :: msg(:,:)
124         INTEGER, INTENT(OUT) :: cksum
125
126         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
127
128      END SUBROUTINE fletcher32_rm
129!
130!------------------------------------------------------------------------------!
131      SUBROUTINE fletcher32_rt(msg, cksum )
132         IMPLICIT NONE
133         REAL(DP), INTENT(IN) :: msg(:,:,:)
134         INTEGER, INTENT(OUT) :: cksum
135
136         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
137
138      END SUBROUTINE fletcher32_rt
139!
140!------------------------------------------------------------------------------!
141      SUBROUTINE fletcher32_r4(msg, cksum )
142         IMPLICIT NONE
143         REAL(DP), INTENT(IN) :: msg(:,:,:,:)
144         INTEGER, INTENT(OUT) :: cksum
145
146         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
147
148      END SUBROUTINE fletcher32_r4
149!
150!------------------------------------------------------------------------------!
151      SUBROUTINE fletcher32_r5(msg, cksum )
152         IMPLICIT NONE
153         REAL(DP), INTENT(IN) :: msg(:,:,:,:,:)
154         INTEGER, INTENT(OUT) :: cksum
155
156         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
157
158      END SUBROUTINE fletcher32_r5
159!
160!------------------------------------------------------------------------------!
161      SUBROUTINE fletcher32_c1(msg, cksum )
162         IMPLICIT NONE
163         COMPLEX(DP), INTENT(IN) :: msg
164         INTEGER, INTENT(OUT) :: cksum
165
166         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
167
168      END SUBROUTINE fletcher32_c1
169!
170!------------------------------------------------------------------------------!
171      SUBROUTINE fletcher32_cv(msg, cksum )
172         IMPLICIT NONE
173         COMPLEX(DP), INTENT(IN) :: msg(:)
174         INTEGER, INTENT(OUT) :: cksum
175
176         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
177
178      END SUBROUTINE fletcher32_cv
179!
180!------------------------------------------------------------------------------!
181      SUBROUTINE fletcher32_cm(msg, cksum )
182         IMPLICIT NONE
183         COMPLEX(DP), INTENT(IN) :: msg(:,:)
184         INTEGER, INTENT(OUT) :: cksum
185
186         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
187
188      END SUBROUTINE fletcher32_cm
189!
190!------------------------------------------------------------------------------!
191      SUBROUTINE fletcher32_ct(msg, cksum )
192         IMPLICIT NONE
193         COMPLEX(DP), INTENT(IN) :: msg(:,:,:)
194         INTEGER, INTENT(OUT) :: cksum
195
196         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
197
198      END SUBROUTINE fletcher32_ct
199!
200!------------------------------------------------------------------------------!
201      SUBROUTINE fletcher32_c4(msg, cksum )
202         IMPLICIT NONE
203         COMPLEX(DP), INTENT(IN) :: msg(:,:,:,:)
204         INTEGER, INTENT(OUT) :: cksum
205
206         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
207
208      END SUBROUTINE fletcher32_c4
209!
210!------------------------------------------------------------------------------!
211      SUBROUTINE fletcher32_c5(msg, cksum )
212         IMPLICIT NONE
213         COMPLEX(DP), INTENT(IN) :: msg(:,:,:,:,:)
214         INTEGER, INTENT(OUT) :: cksum
215
216         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
217
218      END SUBROUTINE fletcher32_c5
219!
220!------------------------------------------------------------------------------!
221      SUBROUTINE fletcher32_l(msg, cksum )
222         IMPLICIT NONE
223         LOGICAL, INTENT(IN) :: msg
224         INTEGER, INTENT(OUT) :: cksum
225
226         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
227
228      END SUBROUTINE fletcher32_l
229!
230!------------------------------------------------------------------------------!
231      SUBROUTINE fletcher32_lv(msg, cksum )
232         IMPLICIT NONE
233         LOGICAL, INTENT(IN) :: msg(:)
234         INTEGER, INTENT(OUT) :: cksum
235
236         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
237
238      END SUBROUTINE fletcher32_lv
239!
240!------------------------------------------------------------------------------!
241      SUBROUTINE fletcher32_lm(msg, cksum )
242         IMPLICIT NONE
243         LOGICAL, INTENT(IN) :: msg(:,:)
244         INTEGER, INTENT(OUT) :: cksum
245
246         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
247
248      END SUBROUTINE fletcher32_lm
249!
250!------------------------------------------------------------------------------!
251      SUBROUTINE fletcher32_z(msg, cksum )
252         IMPLICIT NONE
253         CHARACTER(len=*), INTENT(IN) :: msg
254         INTEGER, INTENT(OUT) :: cksum
255
256         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
257
258      END SUBROUTINE fletcher32_z
259!
260!------------------------------------------------------------------------------!
261      SUBROUTINE fletcher32_zv(msg, cksum )
262         IMPLICIT NONE
263         CHARACTER(len=*), INTENT(IN) :: msg(:)
264         INTEGER, INTENT(OUT) :: cksum
265
266         cksum = fletcher32(transfer(msg,dat),size(transfer(msg,dat)))
267
268      END SUBROUTINE fletcher32_zv
269!
270!------------------------------------------------------------------------------!
271    END MODULE fletcher32_mod
272!------------------------------------------------------------------------------!
273