OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
debug_mod Module Reference

Functions/Subroutines

pure integer function sp_checksum (a, siz1, siz2)
pure integer function dp_checksum (a, siz1, siz2)
pure integer function int_checksum (a, siz1, siz2)

Variables

integer, dimension(:), allocatable itab_debug
 User Node Identifiers.
integer nc_debug
 Engine Cycle number.

Function/Subroutine Documentation

◆ dp_checksum()

pure integer function debug_mod::dp_checksum ( double precision, dimension(siz2,siz1), intent(in) a,
integer, intent(in) siz1,
integer, intent(in) siz2 )

Definition at line 110 of file debug_mod.F.

111C Prints Adler 32 checksum of A(1:SIZ2,1:SIZ1) in *1.out file
112C-----------------------------------------------
113C I m p l i c i t T y p e s
114C-----------------------------------------------
115#include "implicit_f.inc"
116C-----------------------------------------------
117C C o m m o n B l o c k s
118C-----------------------------------------------
119#include "com01_c.inc"
120#include "com04_c.inc"
121#include "task_c.inc"
122#include "spmd_c.inc"
123#include "chara_c.inc"
124#include "units_c.inc"
125C-----------------------------------------------
126C-----------------------------------------------
127C D u m m y A r g u m e n t s
128C-----------------------------------------------
129 INTEGER, INTENT(IN) :: SIZ1,SIZ2
130 DOUBLE PRECISION, INTENT(IN) :: A(SIZ2,SIZ1)
131C-----------------------------------------------
132C L o c a l V a r i a b l e s
133C-----------------------------------------------
134 INTEGER, DIMENSION(:), ALLOCATABLE :: TMP
135 INTEGER :: I,CHECKSUM,ROOT,S1,S2,TWO_POWER_16
136 INTEGER :: PREC ! simple or double precision
137 INTEGER :: SIZ
138C-----------------------------------------------
139 root = 65521
140 two_power_16 = 65536
141 s1 = 1
142 s2 = 0
143 prec = 2
144C If A is in simple precision
145 IF(sizeof(a(1,1)) == 4) prec = 1
146 siz = siz1*siz2 * prec
147 ALLOCATE(tmp(siz))
148 tmp(1:siz) = 0
149c Convert A in integer
150 tmp = transfer(a(1:siz2,1:siz1),s1,siz)
151 DO i = 1,siz
152 s1 = mod(s1 + tmp(i),root)
153 s2 = mod(s1 + s2 ,root)
154 ENDDO
155C (s2 << 16) | s1
156 checksum = ior(s2 * two_power_16,s1)
157 DEALLOCATE(tmp)

◆ int_checksum()

pure integer function debug_mod::int_checksum ( integer, dimension(siz2,siz1), intent(in) a,
integer, intent(in) siz1,
integer, intent(in) siz2 )

Definition at line 166 of file debug_mod.F.

167C Prints Adler 32 checksum of A(1:SIZ2,1:SIZ1) in *1.out file
168C-----------------------------------------------
169C I m p l i c i t T y p e s
170C-----------------------------------------------
171#include "implicit_f.inc"
172C-----------------------------------------------
173C C o m m o n B l o c k s
174C-----------------------------------------------
175#include "com01_c.inc"
176#include "com04_c.inc"
177#include "task_c.inc"
178#include "spmd_c.inc"
179#include "chara_c.inc"
180#include "units_c.inc"
181C-----------------------------------------------
182C-----------------------------------------------
183C D u m m y A r g u m e n t s
184C-----------------------------------------------
185 INTEGER, INTENT(IN) :: SIZ1,SIZ2
186 INTEGER, INTENT(IN) :: A(SIZ2,SIZ1)
187C-----------------------------------------------
188C L o c a l V a r i a b l e s
189C-----------------------------------------------
190 INTEGER, DIMENSION(:), ALLOCATABLE :: TMP
191 INTEGER :: I,CHECKSUM,ROOT,S1,S2,TWO_POWER_16
192 INTEGER :: PREC ! simple or double precision
193 INTEGER :: SIZ
194C-----------------------------------------------
195 root = 65521
196 two_power_16 = 65536
197 s1 = 1
198 s2 = 0
199 prec = 2
200C If A is in simple precision
201 IF(sizeof(a(1,1)) == 4) prec = 1
202 siz = siz1*siz2 * prec
203 ALLOCATE(tmp(siz))
204 tmp(1:siz) = 0
205c Convert A in integer
206 tmp = transfer(a(1:siz2,1:siz1),s1,siz)
207 DO i = 1,siz
208 s1 = mod(s1 + tmp(i),root)
209 s2 = mod(s1 + s2 ,root)
210 ENDDO
211C (s2 << 16) | s1
212 checksum = ior(s2 * two_power_16,s1)
213 DEALLOCATE(tmp)

◆ sp_checksum()

pure integer function debug_mod::sp_checksum ( real*4, dimension(siz2,siz1), intent(in) a,
integer, intent(in) siz1,
integer, intent(in) siz2 )

Definition at line 57 of file debug_mod.F.

58C Prints Adler 32 checksum of A(1:SIZ2,1:SIZ1) in *1.out file
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63#include "r4r8_p.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "com01_c.inc"
68#include "com04_c.inc"
69#include "task_c.inc"
70#include "spmd_c.inc"
71#include "chara_c.inc"
72#include "units_c.inc"
73C-----------------------------------------------
74C-----------------------------------------------
75C D u m m y A r g u m e n t s
76C-----------------------------------------------
77 INTEGER, INTENT(IN) :: SIZ1,SIZ2
78 real*4, INTENT(IN) :: a(siz2,siz1)
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER, DIMENSION(:), ALLOCATABLE :: TMP
83 INTEGER :: I,CHECKSUM,ROOT,S1,S2,TWO_POWER_16
84 INTEGER :: PREC ! simple or double precision
85 INTEGER :: SIZ
86C-----------------------------------------------
87 root = 65521
88 two_power_16 = 65536
89 s1 = 1
90 s2 = 0
91 prec = 2
92C If A is in simple precision
93 IF(sizeof(a(1,1)) == 4) prec = 1
94 siz = siz1*siz2 * prec
95 ALLOCATE(tmp(siz))
96 tmp(1:siz) = 0
97c Convert A in integer
98 tmp = transfer(a(1:siz2,1:siz1),s1,siz)
99 DO i = 1,siz
100 s1 = mod(s1 + tmp(i),root)
101 s2 = mod(s1 + s2 ,root)
102 ENDDO
103C (s2 << 16) | s1
104 checksum = ior(s2 * two_power_16,s1)
105 DEALLOCATE(tmp)

Variable Documentation

◆ itab_debug

integer, dimension(:), allocatable debug_mod::itab_debug

User Node Identifiers.

Definition at line 48 of file debug_mod.F.

48 INTEGER, DIMENSION(:),ALLOCATABLE :: ITAB_DEBUG !< User Node Identifiers

◆ nc_debug

integer debug_mod::nc_debug

Engine Cycle number.

Definition at line 49 of file debug_mod.F.

49 INTEGER :: NC_DEBUG !< Engine Cycle number