OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parit.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| sum_6_float ../engine/source/system/parit.F
25!||--- called by ------------------------------------------------------
26!|| airbagb ../engine/source/airbag/airbag2.F
27!|| airbagb1 ../engine/source/airbag/airbagb1.F
28!|| damping_vref_sum6_rby ../engine/source/assembly/damping_vref_sum6_rby.F90
29!|| dampvref_sum6 ../engine/source/assembly/dampvref_sum6.F
30!|| get_volume_area ../engine/source/airbag/get_volume_area.F90
31!|| poro ../engine/source/ale/porous/poro.f
32!|| rbyact ../engine/source/constraints/general/rbody/rbyact.F
33!|| rbypid ../engine/source/constraints/general/rbody/rbypid.F
34!|| rgbodfp ../engine/source/constraints/general/rbody/rgbodfp.F
35!|| rgwalc ../engine/source/constraints/general/rwall/rgwalc.F
36!|| rgwall ../engine/source/constraints/general/rwall/rgwall.F
37!|| rgwalp ../engine/source/constraints/general/rwall/rgwalp.F
38!|| rgwals ../engine/source/constraints/general/rwall/rgwals.f
39!|| rgwath ../engine/source/interfaces/int09/rgwath.F
40!|| rlink0 ../engine/source/constraints/general/rlink/rlink0.F
41!|| rlink1 ../engine/source/constraints/general/rlink/rlink1.F
42!|| rlink2 ../engine/source/constraints/general/rlink/rlink2.F
43!|| rlink3 ../engine/source/constraints/general/rlink/rlink10.F
44!|| rmatpon ../engine/source/materials/mat/mat013/rmatpon.F
45!|| rwall_fpen ../engine/source/constraints/general/rwall/rgwall_pen.F90
46!|| sensor_energy_bilan ../engine/source/tools/sensor/sensor_energy_bilan.F
47!|| sensor_temp0 ../engine/source/tools/sensor/sensor_temp0.F
48!|| sms_pcg ../engine/source/ams/sms_pcg.F
49!|| sms_produt_h ../engine/source/ams/sms_proj.F
50!|| sms_rbe_1 ../engine/source/ams/sms_rbe2.F
51!|| sms_rbe_5 ../engine/source/ams/sms_rbe2.F
52!|| sms_rgwalc_bilan ../engine/source/ams/sms_rgwalc.F
53!|| sms_rgwall_bilan ../engine/source/ams/sms_rgwall.F
54!|| sms_rgwalp_bilan ../engine/source/ams/sms_rgwalp.F
55!|| sms_rgwals_bilan ../engine/source/ams/sms_rgwals.F
56!|| sms_rlink1 ../engine/source/ams/sms_rlink.F
57!|| sms_rlink2 ../engine/source/ams/sms_rlink.F
58!|| sms_rlink3 ../engine/source/ams/sms_rlink.F
59!|| spgauge ../engine/source/elements/sph/spgauge.F
60!|| telesc ../engine/source/constraints/general/cyl_joint/telesc.F
61!|| volpvgb ../engine/source/airbag/volpvg.F
62!|| volum0 ../engine/source/airbag/volum0.F
63!||====================================================================
64 SUBROUTINE sum_6_float(JFT ,JLT ,F, F6, N)
65C-----------------------------------------------
66C I m p l i c i t T y p e s
67C-----------------------------------------------
68#include "implicit_f.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER JFT, JLT, N
73 my_real
74 . f(*)
75 DOUBLE PRECISION F6(N,6)
76C-----------------------------------------------
77c
78c r=26 (foat_to_6_float): number of bits for the carry
79c allows to make 2^R + ~ = 67,000,000.
80c
81c m1: mask 1
82c ...
83c m6: mask 6
84c
85c m2 = m1 - 53 + r
86c m3 = m2 - 53 + r
87c m4 = m3 - 53 + r
88c m5 = m4 - 53 + r
89c m6 = m5 - 53 + r
90c
91c if r= 26 : mi = mi-1 - 27
92c
93c f1 = (f + 2^m1) - 2^m1
94c b = f - f1
95c f1 = (b + 2^m2) - 2^m2
96c d = b - f2
97c f3 = (d + 2^m3) - 2^m3
98c f4 = ((d - f3) + 2^m4) - 2^m4
99c ...
100c--------- calculation of fmax, fmin
101c fmax with r bits zero = 2^(m1-r)
102c
103c Fmin with 53 significant bits = 2^m6
104c Fmin with 1 significant bits = 2^(M6-53)
105c
106c-------- FMAX, fmin after expression
107c fmax with r bits zero ~= 2^(m1-2r)
108c
109c Fmin with 53 significant bits ~ = 2^(M6-R)
110c Fmin with 1 significant bits ~ = 2^(M6-53-R)
111c
112c 6 float r=26 m1=89 m6=-46
113c
114c fmax with r bits zero ~= 2^37 =
115c Fmin with 53 significant bits ~ = 2^(M6-R)
116c Fmin with 1 significant bits ~ = 2^(M6-53-R)
117c-------------------------------------------------------
118c A = F + twoP63
119c F4 (1) = A - TwoP63
120c b = f - f4(1)
121c c '= b + twop30
122c F4 (2) = c'- twop30
123c d = b - f4(2)
124c E = d '+ twopm3
125c F4 (3) = E - TwoPM3
126c g = d - f4(3)
127c H = G + twoPM36
128c F4 (4) = H - TwoPM36
129C-----------------------------------------------
130C L o c a l C o m m o n
131C-----------------------------------------------
132C
133C Warning - Warning - Warning - Warning - Warning - Warning
134C
135C Common to break the optimization and thread private for multithread
136C
137 COMMON /parit_var/temp1,temp2,temp3,temp4,temp5,temp6,temp7,
138 . temp11,temp12,temp13,temp14,temp15,temp16,
139 . temp17,reste
140!$OMP THREADPRIVATE(/PARIT_VAR/)
141 DOUBLE PRECISION TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
142 . TEMP11,TEMP12,TEMP13,TEMP14,TEMP15,TEMP16,
143 . TEMP17,RESTE
144C
145C Warning - Warning - Warning - Warning - Warning - Warning
146C
147C-----------------------------------------------
148C L o c a l V a r i a b l e s
149C-----------------------------------------------
150 INTEGER I
151 DOUBLE PRECISION R8DEUXP89,R8DEUXP62,R8DEUXP35,R8TWOP8
152 DOUBLE PRECISION R8DEUXPM19,R8DEUXPM46
153 DATA r8deuxp89 /'4580000000000000'x/
154 DATA r8deuxp62 /'43D0000000000000'x/
155 DATA r8deuxp35 /'4220000000000000'x/
156 DATA r8twop8 /'4070000000000000'x/
157 DATA r8deuxpm19/'3EC0000000000000'x/
158 DATA r8deuxpm46/'3D10000000000000'x/
159
160 DO i=jft,jlt
161
162 reste = f(i)
163
164 temp1 = reste + r8deuxp89
165 temp11 = temp1 - r8deuxp89
166 reste = reste - temp11
167
168 temp2 = reste + r8deuxp62
169 temp12 = temp2 - r8deuxp62
170 reste = reste - temp12
171
172 temp3 = reste + r8deuxp35
173 temp13 = temp3 - r8deuxp35
174 reste = reste - temp13
175
176 temp4 = reste + r8twop8
177 temp14 = temp4 - r8twop8
178 reste = reste - temp14
179
180 temp5 = reste + r8deuxpm19
181 temp15 = temp5 - r8deuxpm19
182 reste = reste - temp15
183
184 temp6 = reste + r8deuxpm46
185 temp16 = temp6 - r8deuxpm46
186
187 f6(1,1) = f6(1,1) + temp11
188 f6(1,2) = f6(1,2) + temp12
189 f6(1,3) = f6(1,3) + temp13
190 f6(1,4) = f6(1,4) + temp14
191 f6(1,5) = f6(1,5) + temp15
192 f6(1,6) = f6(1,6) + temp16
193
194 ENDDO
195
196 RETURN
197 END
198
199!||====================================================================
200!|| foat_to_6_float ../engine/source/system/parit.F
201!||--- called by ------------------------------------------------------
202!|| i20for3 ../engine/source/interfaces/int20/i20for3.F
203!|| i20for3e ../engine/source/interfaces/int20/i20for3.F
204!|| i21ass3 ../engine/source/interfaces/int21/i21ass3.F
205!|| inter_sh_offset_ini ../engine/source/interfaces/shell_offset/inter_offset_ini.F90
206!|| multi_i18_force_pon ../engine/source/interfaces/int18/multi_i18_force_pon.F
207!|| offset_nproj ../engine/source/interfaces/shell_offset/offset_nproj.F90
208!|| rbe2f ../engine/source/constraints/general/rbe2/rbe2f.F
209!|| rbe2fl ../engine/source/constraints/general/rbe2/rbe2f.F
210!|| rbe3f ../engine/source/constraints/general/rbe3/rbe3f.F
211!|| s10volnod3 ../engine/source/elements/solid/solide4_sfem/s10volnod3.F
212!|| s10volnodt3 ../engine/source/elements/solid/solide4_sfem/s10volnodt3.F
213!|| s4alesfem ../engine/source/elements/solid/solide4_sfem/s4alesfem.f
214!|| s4lagsfem ../engine/source/elements/solid/solide4_sfem/s4lagsfem.F
215!|| s4volnod3 ../engine/source/elements/solid/solide4_sfem/s4volnod3.f
216!|| s4volnod_sm ../engine/source/elements/solid/solide4_sfem/s4volnod_sm.f
217!|| sms_build_diag ../engine/source/ams/sms_build_diag.F
218!|| sms_mav_lt ../engine/source/ams/sms_pcg.F
219!|| sms_mav_lt2 ../engine/source/ams/sms_pcg.F
220!|| sms_produt3 ../engine/source/ams/sms_proj.F
221!|| sms_rbe3_prec ../engine/source/ams/sms_rbe3.F
222!|| sms_rbe3t1 ../engine/source/ams/sms_rbe3.F
223!|| splissv ../engine/source/elements/sph/splissv.F
224!||====================================================================
225 SUBROUTINE foat_to_6_float(JFT ,JLT ,F, F6)
226C-----------------------------------------------
227C I m p l i c i t T y p e s
228C-----------------------------------------------
229#include "implicit_f.inc"
230C-----------------------------------------------
231C D u m m y A r g u m e n t s
232C-----------------------------------------------
233 INTEGER JFT, JLT
234C REAL
235 my_real
236 . f(*)
237 DOUBLE PRECISION F6(6,*)
238C-----------------------------------------------
239c
240c r=26 (foat_to_6_float): number of bits for the carry
241c allows to make 2^R + ~ = 67,000,000.
242c
243c m1: mask 1
244c ...
245c m6: mask 6
246c
247c m2 = m1 - 53 + r
248c m3 = m2 - 53 + r
249c m4 = m3 - 53 + r
250c m5 = m4 - 53 + r
251c m6 = m5 - 53 + r
252c
253c if r= 26 : mi = mi-1 - 27
254c
255c f1 = (f + 2^m1) - 2^m1
256c b = f - f1
257c f1 = (b + 2^m2) - 2^m2
258c d = b - f2
259c f3 = (d + 2^m3) - 2^m3
260c f4 = ((d - f3) + 2^m4) - 2^m4
261c ...
262c--------- calculation of fmax, fmin
263c fmax with r bits zero = 2^(m1-r)
264c
265c Fmin with 53 significant bits = 2^m6
266c Fmin with 1 significant bits = 2^(M6-53)
267c
268c-------- FMAX, fmin after expression
269c fmax with r bits zero ~= 2^(m1-2r)
270c
271c Fmin with 53 significant bits ~ = 2^(M6-R)
272c Fmin with 1 significant bits ~ = 2^(M6-53-R)
273c
274c 6 float r=26 m1=89 m6=-46
275c
276c fmax with r bits zero ~= 2^37 =
277c Fmin with 53 significant bits ~ = 2^(M6-R)
278c Fmin with 1 significant bits ~ = 2^(M6-53-R)
279c-------------------------------------------------------
280c A = F + twoP63
281c F4 (1) = A - TwoP63
282c b = f - f4(1)
283c c '= b + twop30
284c F4 (2) = c'- twop30
285c d = b - f4(2)
286c E = d '+ twopm3
287c F4 (3) = E - TwoPM3
288c g = d - f4(3)
289c H = G + twoPM36
290c F4 (4) = H - TwoPM36
291C-----------------------------------------------
292C L o c a l C o m m o n
293C-----------------------------------------------
294C
295C Warning - Warning - Warning - Warning - Warning - Warning
296C
297C Common to break the optimization and thread private for multithread
298C
299 COMMON /parit_var/temp1,temp2,temp3,temp4,temp5,temp6,temp7,
300 . temp11,temp12,temp13,temp14,temp15,temp16,
301 . temp17,reste
302!$OMP THREADPRIVATE(/PARIT_VAR/)
303 DOUBLE PRECISION TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
304 . TEMP11,TEMP12,TEMP13,TEMP14,TEMP15,TEMP16,
305 . TEMP17,RESTE
306C
307C Warning - Warning - Warning - Warning - Warning - Warning
308C
309C-----------------------------------------------
310C L o c a l V a r i a b l e s
311C-----------------------------------------------
312 INTEGER I
313 DOUBLE PRECISION R8DEUXP89,R8DEUXP62,R8DEUXP35,R8TWOP8
314 DOUBLE PRECISION R8DEUXPM19,R8DEUXPM46
315 DATA r8deuxp89 /'4580000000000000'x/
316 DATA r8deuxp62 /'43D0000000000000'x/
317 DATA r8deuxp35 /'4220000000000000'x/
318 DATA r8twop8 /'4070000000000000'x/
319 DATA r8deuxpm19/'3EC0000000000000'x/
320 DATA r8deuxpm46/'3D10000000000000'x/
321
322 DO i=jft,jlt
323
324 reste = f(i)
325
326 temp1 = reste + r8deuxp89
327 f6(1,i) = temp1 - r8deuxp89
328 reste = reste - f6(1,i)
329
330 temp2 = reste + r8deuxp62
331 f6(2,i) = temp2 - r8deuxp62
332 reste = reste - f6(2,i)
333
334 temp3 = reste + r8deuxp35
335 f6(3,i) = temp3 - r8deuxp35
336 reste = reste - f6(3,i)
337
338 temp4 = reste + r8twop8
339 f6(4,i) = temp4 - r8twop8
340 reste = reste - f6(4,i)
341
342 temp5 = reste + r8deuxpm19
343 f6(5,i) = temp5 - r8deuxpm19
344 reste = reste - f6(5,i)
345
346 temp6 = reste + r8deuxpm46
347 f6(6,i) = temp6 - r8deuxpm46
348
349 ENDDO
350
351 RETURN
352 END
353
354!||====================================================================
355!|| foat_to_7_float ../engine/source/system/parit.F
356!||====================================================================
357 SUBROUTINE foat_to_7_float(F,F7)
358C-----------------------------------------------
359C I m p l i c i t T y p e s
360C-----------------------------------------------
361#include "implicit_f.inc"
362C-----------------------------------------------
363C D u m m y A r g u m e n t s
364C-----------------------------------------------
365 DOUBLE PRECISION F,F7(7)
366C-----------------------------------------------
367c
368c r=29 (foat_to_7_float): number of bits for the carry
369c allows to make 2^R + ~ = 537,000,000.
370c
371c m1: mask 1
372c ...
373c m6: mask 6
374c
375c m2 = m1 - 53 + r
376c m3 = m2 - 53 + r
377c m4 = m3 - 53 + r
378c m5 = m4 - 53 + r
379c m6 = m5 - 53 + r
380c m7 = m6 - 53 + r
381c
382c if r= 29 : mi = mi-1 - 24
383c
384c f1 = (f + 2^m1) - 2^m1
385c b = f - f1
386c f1 = (b + 2^m2) - 2^m2
387c d = b - f2
388c f3 = (d + 2^m3) - 2^m3
389c f4 = ((d - f3) + 2^m4) - 2^m4
390c ...
391c--------- calculation of fmax, fmin
392c calculation
393c fmax with 0 bits zero = 2^m1
394c fmax with r bits zero = 2^(m1-r)
395c
396c Fmin with 53 significant bits = 2^m7
397c Fmin with 1 significant bits = 2^(m7+53)
398c
399c fmax with 0 bits zero = 5. 10^27
400c fmax with r bits zero = 9. 10^18
401c Fmin with 53 significant bits ~ = 2.2 10^-16
402c Fmin with 1 significant bits ~ = 2.4 10^-32
403c-------------------------------------------------------
404c A = F + twoP63
405c F4 (1) = A - TwoP63
406c b = f - f4(1)
407c c '= b + twop30
408c F4 (2) = c'- twop30
409c d = b - f4(2)
410c E = d '+ twopm3
411c F4 (3) = E - TwoPM3
412c g = d - f4(3)
413c H = G + twoPM36
414c F4 (4) = H - TwoPM36
415C-----------------------------------------------
416C L o c a l C o m m o n
417C-----------------------------------------------
418C
419C Warning - Warning - Warning - Warning - Warning - Warning
420C
421C Common to break the optimization and thread private for multithread
422C
423 COMMON /parit_var/temp1,temp2,temp3,temp4,temp5,temp6,temp7,
424 . temp11,temp12,temp13,temp14,temp15,temp16,
425 . temp17,reste
426!$OMP THREADPRIVATE(/PARIT_VAR/)
427 DOUBLE PRECISION TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
428 . TEMP11,TEMP12,TEMP13,TEMP14,TEMP15,TEMP16,
429 . TEMP17,RESTE
430C
431C Warning - Warning - Warning - Warning - Warning - Warning
432C
433C-----------------------------------------------
434C L o c a l V a r i a b l e s
435C-----------------------------------------------
436 DOUBLE PRECISION DEUXP92,DEUXP68,DEUXP44 ,DEUXP20,DEUXPM4,
437 . DEUXPM28,DEUXPM52
438 DATA deuxp92 /'45B0000000000000'x/
439 DATA deuxp68 /'4430000000000000'x/
440 DATA deuxp44 /'42B0000000000000'x/
441 DATA deuxp20 /'4130000000000000'x/
442 DATA deuxpm4 /'3FB0000000000000'x/
443 DATA deuxpm28/'3E30000000000000'x/
444 DATA deuxpm52/'3CB0000000000000'x/
445
446 temp1 = f + deuxp92
447 f7(1) = temp1 - deuxp92
448 reste = f - f7(1)
449
450 temp2 = reste + deuxp68
451 f7(2) = temp2 - deuxp68
452 reste = reste - f7(2)
453
454 temp3 = reste + deuxp44
455 f7(3) = temp3 - deuxp44
456 reste = reste - f7(3)
457
458 temp4 = reste + deuxp20
459 f7(4) = temp4 - deuxp20
460 reste = reste - f7(4)
461
462 temp5 = reste + deuxpm4
463 f7(5) = temp5 - deuxpm4
464 reste = reste - f7(5)
465
466 temp6 = reste + deuxpm28
467 f7(6) = temp6 - deuxpm28
468 reste = reste - f7(6)
469
470 temp7 = reste + deuxpm52
471 f7(7) = temp7 - deuxpm52
472
473 RETURN
474 END
475
476
477!||====================================================================
478!|| double_flot_ieee ../engine/source/system/parit.F
479!||--- called by ------------------------------------------------------
480!|| cupdt3f ../engine/source/elements/shell/coque/cupdt3.F
481!|| i7ass3 ../engine/source/interfaces/int07/i7ass3.F
482!|| i7ass35 ../engine/source/interfaces/int07/i7ass3.F
483!||====================================================================
484 SUBROUTINE double_flot_ieee(JFT ,JLT ,I8 ,R8, I8F)
485C-----------------------------------------------
486C I m p l i c i t T y p e s
487C-----------------------------------------------
488#include "implicit_f.inc"
489C-----------------------------------------------
490C G l o b a l P a r a m e t e r s
491C-----------------------------------------------
492#include "mvsiz_p.inc"
493C-----------------------------------------------
494C D u m m y A r g u m e n t s
495C-----------------------------------------------
496 INTEGER JFT, JLT
497 integer*8 I8(*),I8F(3,*)
498 my_real
499 . r8(mvsiz)
500C-----------------------------------------------
501C L o c a l V a r i a b l e s
502C-----------------------------------------------
503c___________________________________________________
504 double precision
505 . r8_local,r8_deuxp43,aa
506 INTEGER*8 I8_DEUXP43
507 DATA i8_deuxp43 /'80000000000'x/
508 DATA r8_deuxp43 /'42A0000000000000'x/
509 INTEGER I
510c___________________________________________________
511C-----------------------------------------------
512C
513 DO i=jft,jlt
514c___________________________________________________
515 i8f(1,i) = r8(i)
516 aa = i8f(1,i)
517 r8_local = (r8(i) - aa) * r8_deuxp43
518 i8f(2,i) = r8_local
519 aa = i8f(2,i)
520 r8_local = (r8_local - aa) * r8_deuxp43
521 i8f(3,i) = r8_local + 0.5
522 ENDDO
523c___________________________________________________
524 RETURN
525 END
526!||====================================================================
527!|| sum_6_float_sens ../engine/source/system/parit.F
528!||--- called by ------------------------------------------------------
529!|| i10mainf ../engine/source/interfaces/int10/i10mainf.F
530!|| i11mainf ../engine/source/interfaces/int11/i11mainf.F
531!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
532!|| i21mainf ../engine/source/interfaces/int21/i21mainf.F
533!|| i22mainf ../engine/source/interfaces/int22/i22mainf.F
534!|| i23mainf ../engine/source/interfaces/int23/i23mainf.F
535!|| i24mainf ../engine/source/interfaces/int24/i24main.F
536!|| i25mainf ../engine/source/interfaces/int25/i25mainf.F
537!|| i7mainf ../engine/source/interfaces/int07/i7mainf.F
538!||====================================================================
539 SUBROUTINE sum_6_float_sens(F, A, B, C, JFT ,JLT , F6, D, E, G, ISENSINT)
540C-----------------------------------------------
541C I m p l i c i t T y p e s
542C-----------------------------------------------
543#include "implicit_f.inc"
544C-----------------------------------------------
545C C o m m o n B l o c k s
546C-----------------------------------------------
547#include "comlock.inc"
548C-----------------------------------------------
549C D u m m y A r g u m e n t s
550C-----------------------------------------------
551 INTEGER JFT, JLT, A, B, C, D, E, G, ISENSINT(*)
552C REAL
553 my_real
554 . f(a,b,c)
555 DOUBLE PRECISION F6(D,E,G)
556C-----------------------------------------------
557c
558c r=26 (foat_to_6_float): number of bits for the carry
559c allows to make 2^R + ~ = 67,000,000.
560c
561c m1: mask 1
562c ...
563c m6: mask 6
564c
565c m2 = m1 - 53 + r
566c m3 = m2 - 53 + r
567c m4 = m3 - 53 + r
568c m5 = m4 - 53 + r
569c m6 = m5 - 53 + r
570c
571c if r= 26 : mi = mi-1 - 27
572c
573c f1 = (f + 2^m1) - 2^m1
574c b = f - f1
575c f1 = (b + 2^m2) - 2^m2
576c d = b - f2
577c f3 = (d + 2^m3) - 2^m3
578c f4 = ((d - f3) + 2^m4) - 2^m4
579c ...
580c--------- calculation of fmax, fmin
581c fmax with r bits zero = 2^(m1-r)
582c
583c Fmin with 53 significant bits = 2^m6
584c Fmin with 1 significant bits = 2^(M6-53)
585c
586c-------- FMAX, fmin after expression
587c fmax with r bits zero ~= 2^(m1-2r)
588c
589c Fmin with 53 significant bits ~ = 2^(M6-R)
590c Fmin with 1 significant bits ~ = 2^(M6-53-R)
591c
592c 6 float r=26 m1=89 m6=-46
593c
594c fmax with r bits zero ~= 2^37 =
595c Fmin with 53 significant bits ~ = 2^(M6-R)
596c Fmin with 1 significant bits ~ = 2^(M6-53-R)
597c-------------------------------------------------------
598c A = F + twoP63
599c F4 (1) = A - TwoP63
600c b = f - f4(1)
601c c '= b + twop30
602c F4 (2) = c'- twop30
603c d = b - f4(2)
604c E = d '+ twopm3
605c F4 (3) = E - TwoPM3
606c g = d - f4(3)
607c H = G + twoPM36
608c F4 (4) = H - TwoPM36
609C-----------------------------------------------
610C L o c a l C o m m o n
611C-----------------------------------------------
612C
613C Warning - Warning - Warning - Warning - Warning - Warning
614C
615C Common to break the optimization and thread private for multithread
616C
617 COMMON /parit_var/temp1,temp2,temp3,temp4,temp5,temp6,temp7,
618 . temp11,temp12,temp13,temp14,temp15,temp16,
619 . temp17,reste
620!$OMP THREADPRIVATE(/PARIT_VAR/)
621 DOUBLE PRECISION TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
622 . TEMP11,TEMP12,TEMP13,TEMP14,TEMP15,TEMP16,
623 . TEMP17,RESTE
624C
625C Warning - Warning - Warning - Warning - Warning - Warning
626C
627C-----------------------------------------------
628C L o c a l V a r i a b l e s
629C-----------------------------------------------
630 INTEGER I,J,K
631 DOUBLE PRECISION R8DEUXP89,R8DEUXP62,R8DEUXP35,R8TWOP8
632 DOUBLE PRECISION R8DEUXPM19,R8DEUXPM46
633 DATA r8deuxp89 /'4580000000000000'x/
634 DATA r8deuxp62 /'43D0000000000000'x/
635 DATA r8deuxp35 /'4220000000000000'x/
636 DATA r8twop8 /'4070000000000000'x/
637 DATA r8deuxpm19/'3EC0000000000000'x/
638 DATA r8deuxpm46/'3D10000000000000'x/
639
640 DO i= 1,a
641 IF(isensint(i) /=0)THEN
642 DO j= 1,b
643 DO k=jft,jlt
644
645 reste = f(i,j,k)
646
647 temp1 = reste + r8deuxp89
648 temp11 = temp1 - r8deuxp89
649 reste = reste - temp11
650
651 temp2 = reste + r8deuxp62
652 temp12 = temp2 - r8deuxp62
653 reste = reste - temp12
654
655 temp3 = reste + r8deuxp35
656 temp13 = temp3 - r8deuxp35
657 reste = reste - temp13
658
659 temp4 = reste + r8twop8
660 temp14 = temp4 - r8twop8
661 reste = reste - temp14
662
663 temp5 = reste + r8deuxpm19
664 temp15 = temp5 - r8deuxpm19
665 reste = reste - temp15
666
667 temp6 = reste + r8deuxpm46
668 temp16 = temp6 - r8deuxpm46
669
670#include "lockon.inc"
671 f6(j,1,isensint(i)) = f6(j,1,isensint(i)) + temp11
672 f6(j,2,isensint(i)) = f6(j,2,isensint(i)) + temp12
673 f6(j,3,isensint(i)) = f6(j,3,isensint(i)) + temp13
674 f6(j,4,isensint(i)) = f6(j,4,isensint(i)) + temp14
675 f6(j,5,isensint(i)) = f6(j,5,isensint(i)) + temp15
676 f6(j,6,isensint(i)) = f6(j,6,isensint(i)) + temp16
677#include "lockoff.inc"
678
679 ENDDO
680 ENDDO
681 ENDIF
682 ENDDO
683
684 RETURN
685 END
686!||====================================================================
687!|| sum_6_float_sect ../engine/source/system/parit.F
688!||--- called by ------------------------------------------------------
689!|| section_3n ../engine/source/tools/sect/section_3n.F
690!|| section_c ../engine/source/tools/sect/section_c.F
691!|| section_p ../engine/source/tools/sect/section_p.F
692!|| section_r ../engine/source/tools/sect/section_r.F
693!|| section_s ../engine/source/tools/sect/section_s.F
694!|| section_s4 ../engine/source/tools/sect/section_s4.F
695!|| section_s6 ../engine/source/tools/sect/section_s6.F
696!|| section_t ../engine/source/tools/sect/section_t.F
697!||====================================================================
698 SUBROUTINE sum_6_float_sect(F, A, B, JFT ,JLT , F6, D, E)
699C-----------------------------------------------
700C I m p l i c i t T y p e s
701C-----------------------------------------------
702#include "implicit_f.inc"
703C-----------------------------------------------
704C C o m m o n B l o c k s
705C-----------------------------------------------
706#include "comlock.inc"
707C-----------------------------------------------
708C D u m m y A r g u m e n t s
709C-----------------------------------------------
710 INTEGER JFT, JLT, A, B, D, E
711 my_real f(a,b)
712 DOUBLE PRECISION F6(D,E)
713C-----------------------------------------------
714c
715c r=26 (foat_to_6_float): number of bits for the carry
716c allows to make 2^R + ~ = 67,000,000.
717c
718c m1: mask 1
719c ...
720c m6: mask 6
721c
722c m2 = m1 - 53 + r
723c m3 = m2 - 53 + r
724c m4 = m3 - 53 + r
725c m5 = m4 - 53 + r
726c m6 = m5 - 53 + r
727c
728c if r= 26 : mi = mi-1 - 27
729c
730c f1 = (f + 2^m1) - 2^m1
731c b = f - f1
732c f1 = (b + 2^m2) - 2^m2
733c d = b - f2
734c f3 = (d + 2^m3) - 2^m3
735c f4 = ((d - f3) + 2^m4) - 2^m4
736c ...
737c--------- calculation of fmax, fmin
738c fmax with r bits zero = 2^(m1-r)
739c
740c Fmin with 53 significant bits = 2^m6
741c Fmin with 1 significant bits = 2^(M6-53)
742c
743c-------- FMAX, fmin after expression
744c fmax with r bits zero ~= 2^(m1-2r)
745c
746c Fmin with 53 significant bits ~ = 2^(M6-R)
747c Fmin with 1 significant bits ~ = 2^(M6-53-R)
748c
749c 6 float r=26 m1=89 m6=-46
750c
751c fmax with r bits zero ~= 2^37 =
752c Fmin with 53 significant bits ~ = 2^(M6-R)
753c Fmin with 1 significant bits ~ = 2^(M6-53-R)
754c-------------------------------------------------------
755c A = F + twoP63
756c F4 (1) = A - TwoP63
757c b = f - f4(1)
758c c '= b + twop30
759c F4 (2) = c'- twop30
760c d = b - f4(2)
761c E = d '+ twopm3
762c F4 (3) = E - TwoPM3
763c g = d - f4(3)
764c H = G + twoPM36
765c F4 (4) = H - TwoPM36
766C-----------------------------------------------
767C L o c a l C o m m o n
768C-----------------------------------------------
769C
770C Warning - Warning - Warning - Warning - Warning - Warning
771C
772C Common to break the optimization and thread private for multithread
773C
774 COMMON /parit_var/temp1,temp2,temp3,temp4,temp5,temp6,temp7,
775 . temp11,temp12,temp13,temp14,temp15,temp16,
776 . temp17,reste
777!$OMP THREADPRIVATE(/PARIT_VAR/)
778 DOUBLE PRECISION TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
779 . TEMP11,TEMP12,TEMP13,TEMP14,TEMP15,TEMP16,
780 . TEMP17,RESTE
781C
782C Warning - Warning - Warning - Warning - Warning - Warning
783C
784C-----------------------------------------------
785C L o c a l V a r i a b l e s
786C-----------------------------------------------
787 INTEGER I,J
788 DOUBLE PRECISION R8DEUXP89,R8DEUXP62,R8DEUXP35,R8TWOP8
789 DOUBLE PRECISION R8DEUXPM19,R8DEUXPM46
790 DATA r8deuxp89 /'4580000000000000'x/
791 DATA r8deuxp62 /'43D0000000000000'x/
792 DATA r8deuxp35 /'4220000000000000'x/
793 DATA r8twop8 /'4070000000000000'x/
794 DATA r8deuxpm19/'3EC0000000000000'x/
795 DATA r8deuxpm46/'3D10000000000000'x/
796 DO i= 1,a
797 DO j=jft,jlt
798
799 reste = f(i,j)
800
801 temp1 = reste + r8deuxp89
802 temp11 = temp1 - r8deuxp89
803 reste = reste - temp11
804
805 temp2 = reste + r8deuxp62
806 temp12 = temp2 - r8deuxp62
807 reste = reste - temp12
808
809 temp3 = reste + r8deuxp35
810 temp13 = temp3 - r8deuxp35
811 reste = reste - temp13
812
813 temp4 = reste + r8twop8
814 temp14 = temp4 - r8twop8
815 reste = reste - temp14
816
817 temp5 = reste + r8deuxpm19
818 temp15 = temp5 - r8deuxpm19
819 reste = reste - temp15
820
821 temp6 = reste + r8deuxpm46
822 temp16 = temp6 - r8deuxpm46
823
824#include "lockon.inc"
825 f6(i,1) = f6(i,1) + temp11
826 f6(i,2) = f6(i,2) + temp12
827 f6(i,3) = f6(i,3) + temp13
828 f6(i,4) = f6(i,4) + temp14
829 f6(i,5) = f6(i,5) + temp15
830 f6(i,6) = f6(i,6) + temp16
831#include "lockoff.inc"
832
833 ENDDO
834 ENDDO
835
836 RETURN
837 END
my_real
#define my_real
Definition cppsort.cpp:32
foat_to_7_float
subroutine foat_to_7_float(f, f7)
Definition parit.F:358
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:65
foat_to_6_float
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:226
sum_6_float_sect
subroutine sum_6_float_sect(f, a, b, jft, jlt, f6, d, e)
Definition parit.F:699
sum_6_float_sens
subroutine sum_6_float_sens(f, a, b, c, jft, jlt, f6, d, e, g, isensint)
Definition parit.F:540
double_flot_ieee
subroutine double_flot_ieee(jft, jlt, i8, r8, i8f)
Definition parit.F:485
poro
subroutine poro(geo, nodpor, ms, x, v, w, af, am, skew, weight, nporgeo)
Definition poro.F:40
rgwals
subroutine rgwals(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, icont, frwl6, imp_s, nt_rw, iddl, ikc, ndof, nodnx_sms, weight_md, wfext, wfext_md)
Definition rgwals.F:36
s4alesfem
subroutine s4alesfem(iparg, ixs, x, elbuf_tab, sfem_nodvar, s_sfem_nodvar, pm, iad_elem, fr_elem)
Definition s4alesfem.F:39
s4volnod3
subroutine s4volnod3(volnod6, x, nc1, nc2, nc3, nc4, offg, xdp, nel, ismstr)
Definition s4volnod3.F:35
s4volnod_sm
subroutine s4volnod_sm(volnod6, v, nc1, nc2, nc3, nc4, vol0, amu, offg, sav, nel, ismstr)
Definition s4volnod_sm.F:34