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!|| sensor_energy_bilan ../engine/source/tools/sensor/sensor_energy_bilan.F
46!|| sensor_temp0 ../engine/source/tools/sensor/sensor_temp0.F
47!|| sms_pcg ../engine/source/ams/sms_pcg.F
48!|| sms_produt_h ../engine/source/ams/sms_proj.F
49!|| sms_rbe_1 ../engine/source/ams/sms_rbe2.F
50!|| sms_rbe_5 ../engine/source/ams/sms_rbe2.F
51!|| sms_rgwalc_bilan ../engine/source/ams/sms_rgwalc.F
52!|| sms_rgwall_bilan ../engine/source/ams/sms_rgwall.F
53!|| sms_rgwalp_bilan ../engine/source/ams/sms_rgwalp.F
54!|| sms_rgwals_bilan ../engine/source/ams/sms_rgwals.F
55!|| sms_rlink1 ../engine/source/ams/sms_rlink.F
56!|| sms_rlink2 ../engine/source/ams/sms_rlink.F
57!|| sms_rlink3 ../engine/source/ams/sms_rlink.f
58!|| spgauge ../engine/source/elements/sph/spgauge.F
59!|| telesc ../engine/source/constraints/general/cyl_joint/telesc.f
60!|| volpvgb ../engine/source/airbag/volpvg.F
61!|| volum0 ../engine/source/airbag/volum0.F
62!||====================================================================
63 SUBROUTINE sum_6_float(JFT ,JLT ,F, F6, N)
64C-----------------------------------------------
65C I m p l i c i t T y p e s
66C-----------------------------------------------
67#include "implicit_f.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER JFT, JLT, N
72 my_real
73 . f(*)
74 DOUBLE PRECISION F6(N,6)
75C-----------------------------------------------
76c
77c r=26 (foat_to_6_float): nombre de bits pour la retenu
78c autorise faire 2^r + ~= 67,000,000.
79c
80c m1: masque 1
81c ...
82c m6: masque 6
83c
84c m2 = m1 - 53 + r
85c m3 = m2 - 53 + r
86c m4 = m3 - 53 + r
87c m5 = m4 - 53 + r
88c m6 = m5 - 53 + r
89c
90c si r= 26 : mi = mi-1 - 27
91c
92c f1 = (f + 2^m1) - 2^m1
93c b = f - f1
94c f1 = (b + 2^m2) - 2^m2
95c d = b - f2
96c f3 = (d + 2^m3) - 2^m3
97c f4 = ((d - f3) + 2^m4) - 2^m4
98c ...
99c--------- calcul de fmax, fmin
100c fmax avec r bits zero = 2^(m1-r)
101c
102c fmin avec 53 bits significatif = 2^m6
103c fmin avec 1 bits significatif = 2^(m6-53)
104c
105c--------- fmax, fmin aprs exprimentation
106c fmax avec r bits zero ~= 2^(m1-2r)
107c
108c fmin avec 53 bits significatif ~= 2^(m6-r)
109c fmin avec 1 bits significatif ~= 2^(m6-53-r)
110c
111c 6 float r=26 m1=89 m6=-46
112c
113c fmax avec r bits zero ~= 2^37 =
114c fmin avec 53 bits significatif ~= 2^(m6-r)
115c fmin avec 1 bits significatif ~= 2^(m6-53-r)
116c-------------------------------------------------------
117c a = f + deuxp63
118c f4(1) = a - deuxp63
119c b = f - f4(1)
120c c = b + deuxp30
121c f4(2) = c - deuxp30
122c d = b - f4(2)
123c e = d + deuxpm3
124c f4(3) = e - deuxpm3
125c g = d - f4(3)
126c h = g + deuxpm36
127c f4(4) = h - deuxpm36
128C-----------------------------------------------
129C L o c a l C o m m o n
130C-----------------------------------------------
131C
132C Attention - Attention - Attention - Attention - Attention - Attention
133C
134C Commun pour casser l optimisation et thread private pour multithread
135C
136 COMMON /parit_var/temp1,temp2,temp3,temp4,temp5,temp6,temp7,
137 . temp11,temp12,temp13,temp14,temp15,temp16,
138 . temp17,reste
139!$OMP THREADPRIVATE(/PARIT_VAR/)
140 DOUBLE PRECISION TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
141 . TEMP11,TEMP12,TEMP13,TEMP14,TEMP15,TEMP16,
142 . TEMP17,RESTE
143C
144C Attention - Attention - Attention - Attention - Attention - Attention
145C
146C-----------------------------------------------
147C L o c a l V a r i a b l e s
148C-----------------------------------------------
149 INTEGER I
150 DOUBLE PRECISION R8DEUXP89,R8DEUXP62,R8DEUXP35,R8TWOP8
151 DOUBLE PRECISION R8DEUXPM19,R8DEUXPM46
152 DATA r8deuxp89 /'4580000000000000'x/
153 DATA r8deuxp62 /'43D0000000000000'x/
154 DATA r8deuxp35 /'4220000000000000'x/
155 DATA r8twop8 /'4070000000000000'x/
156 DATA r8deuxpm19/'3EC0000000000000'x/
157 DATA r8deuxpm46/'3D10000000000000'x/
158
159 DO i=jft,jlt
160
161 reste = f(i)
162
163 temp1 = reste + r8deuxp89
164 temp11 = temp1 - r8deuxp89
165 reste = reste - temp11
166
167 temp2 = reste + r8deuxp62
168 temp12 = temp2 - r8deuxp62
169 reste = reste - temp12
170
171 temp3 = reste + r8deuxp35
172 temp13 = temp3 - r8deuxp35
173 reste = reste - temp13
174
175 temp4 = reste + r8twop8
176 temp14 = temp4 - r8twop8
177 reste = reste - temp14
178
179 temp5 = reste + r8deuxpm19
180 temp15 = temp5 - r8deuxpm19
181 reste = reste - temp15
182
183 temp6 = reste + r8deuxpm46
184 temp16 = temp6 - r8deuxpm46
185
186 f6(1,1) = f6(1,1) + temp11
187 f6(1,2) = f6(1,2) + temp12
188 f6(1,3) = f6(1,3) + temp13
189 f6(1,4) = f6(1,4) + temp14
190 f6(1,5) = f6(1,5) + temp15
191 f6(1,6) = f6(1,6) + temp16
192
193 ENDDO
194
195 RETURN
196 END
197
198!||====================================================================
199!|| foat_to_6_float ../engine/source/system/parit.F
200!||--- called by ------------------------------------------------------
201!|| i20for3 ../engine/source/interfaces/int20/i20for3.F
202!|| i20for3e ../engine/source/interfaces/int20/i20for3.F
203!|| i21ass3 ../engine/source/interfaces/int21/i21ass3.F
204!|| inter_sh_offset_ini ../engine/source/interfaces/shell_offset/inter_offset_ini.F90
205!|| multi_i18_force_pon ../engine/source/interfaces/int18/multi_i18_force_pon.F
206!|| offset_nproj ../engine/source/interfaces/shell_offset/offset_nproj.F90
207!|| rbe2f ../engine/source/constraints/general/rbe2/rbe2f.F
208!|| rbe2fl ../engine/source/constraints/general/rbe2/rbe2f.F
209!|| rbe3t1 ../engine/source/constraints/general/rbe3/rbe3f.F
210!|| s10volnod3 ../engine/source/elements/solid/solide4_sfem/s10volnod3.F
211!|| s10volnodt3 ../engine/source/elements/solid/solide4_sfem/s10volnodt3.F
212!|| s4alesfem ../engine/source/elements/solid/solide4_sfem/s4alesfem.F
213!|| s4lagsfem ../engine/source/elements/solid/solide4_sfem/s4lagsfem.F
214!|| s4volnod3 ../engine/source/elements/solid/solide4_sfem/s4volnod3.F
215!|| s4volnod_sm ../engine/source/elements/solid/solide4_sfem/s4volnod_sm.F
216!|| sms_build_diag ../engine/source/ams/sms_build_diag.F
217!|| sms_mav_lt ../engine/source/ams/sms_pcg.F
218!|| sms_mav_lt2 ../engine/source/ams/sms_pcg.F
219!|| sms_produt3 ../engine/source/ams/sms_proj.F
220!|| sms_rbe3_prec ../engine/source/ams/sms_rbe3.F
221!|| sms_rbe3t1 ../engine/source/ams/sms_rbe3.F
222!|| splissv ../engine/source/elements/sph/splissv.F
223!||====================================================================
224 SUBROUTINE foat_to_6_float(JFT ,JLT ,F, F6)
225C-----------------------------------------------
226C I m p l i c i t T y p e s
227C-----------------------------------------------
228#include "implicit_f.inc"
229C-----------------------------------------------
230C D u m m y A r g u m e n t s
231C-----------------------------------------------
232 INTEGER JFT, JLT
233C REAL
234 my_real
235 . f(*)
236 DOUBLE PRECISION F6(6,*)
237C-----------------------------------------------
238c
239c r=26 (foat_to_6_float): nombre de bits pour la retenu
240c autorise faire 2^r + ~= 67,000,000.
241c
242c m1: masque 1
243c ...
244c m6: masque 6
245c
246c m2 = m1 - 53 + r
247c m3 = m2 - 53 + r
248c m4 = m3 - 53 + r
249c m5 = m4 - 53 + r
250c m6 = m5 - 53 + r
251c
252c si r= 26 : mi = mi-1 - 27
253c
254c f1 = (f + 2^m1) - 2^m1
255c b = f - f1
256c f1 = (b + 2^m2) - 2^m2
257c d = b - f2
258c f3 = (d + 2^m3) - 2^m3
259c f4 = ((d - f3) + 2^m4) - 2^m4
260c ...
261c--------- calcul de fmax, fmin
262c fmax avec r bits zero = 2^(m1-r)
263c
264c fmin avec 53 bits significatif = 2^m6
265c fmin avec 1 bits significatif = 2^(m6-53)
266c
267c--------- fmax, fmin aprs exprimentation
268c fmax avec r bits zero ~= 2^(m1-2r)
269c
270c fmin avec 53 bits significatif ~= 2^(m6-r)
271c fmin avec 1 bits significatif ~= 2^(m6-53-r)
272c
273c 6 float r=26 m1=89 m6=-46
274c
275c fmax avec r bits zero ~= 2^37 =
276c fmin avec 53 bits significatif ~= 2^(m6-r)
277c fmin avec 1 bits significatif ~= 2^(m6-53-r)
278c-------------------------------------------------------
279c a = f + deuxp63
280c f4(1) = a - deuxp63
281c b = f - f4(1)
282c c = b + deuxp30
283c f4(2) = c - deuxp30
284c d = b - f4(2)
285c e = d + deuxpm3
286c f4(3) = e - deuxpm3
287c g = d - f4(3)
288c h = g + deuxpm36
289c f4(4) = h - deuxpm36
290C-----------------------------------------------
291C L o c a l C o m m o n
292C-----------------------------------------------
293C
294C Attention - Attention - Attention - Attention - Attention - Attention
295C
296C Commun pour casser l optimisation et thread private pour multithread
297C
298 COMMON /parit_var/temp1,temp2,temp3,temp4,temp5,temp6,temp7,
299 . temp11,temp12,temp13,temp14,temp15,temp16,
300 . temp17,reste
301!$OMP THREADPRIVATE(/PARIT_VAR/)
302 DOUBLE PRECISION TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
303 . TEMP11,TEMP12,TEMP13,TEMP14,TEMP15,TEMP16,
304 . TEMP17,RESTE
305C
306C Attention - Attention - Attention - Attention - Attention - Attention
307C
308C-----------------------------------------------
309C L o c a l V a r i a b l e s
310C-----------------------------------------------
311 INTEGER I
312 DOUBLE PRECISION R8DEUXP89,R8DEUXP62,R8DEUXP35,R8TWOP8
313 DOUBLE PRECISION R8DEUXPM19,R8DEUXPM46
314 DATA r8deuxp89 /'4580000000000000'x/
315 DATA r8deuxp62 /'43D0000000000000'x/
316 DATA r8deuxp35 /'4220000000000000'x/
317 DATA r8twop8 /'4070000000000000'x/
318 DATA r8deuxpm19/'3EC0000000000000'x/
319 DATA r8deuxpm46/'3D10000000000000'x/
320
321 DO i=jft,jlt
322
323 reste = f(i)
324
325 temp1 = reste + r8deuxp89
326 f6(1,i) = temp1 - r8deuxp89
327 reste = reste - f6(1,i)
328
329 temp2 = reste + r8deuxp62
330 f6(2,i) = temp2 - r8deuxp62
331 reste = reste - f6(2,i)
332
333 temp3 = reste + r8deuxp35
334 f6(3,i) = temp3 - r8deuxp35
335 reste = reste - f6(3,i)
336
337 temp4 = reste + r8twop8
338 f6(4,i) = temp4 - r8twop8
339 reste = reste - f6(4,i)
340
341 temp5 = reste + r8deuxpm19
342 f6(5,i) = temp5 - r8deuxpm19
343 reste = reste - f6(5,i)
344
345 temp6 = reste + r8deuxpm46
346 f6(6,i) = temp6 - r8deuxpm46
347
348 ENDDO
349
350 RETURN
351 END
352
353!||====================================================================
354!|| foat_to_7_float ../engine/source/system/parit.F
355!||====================================================================
356 SUBROUTINE foat_to_7_float(F,F7)
357C-----------------------------------------------
358C I m p l i c i t T y p e s
359C-----------------------------------------------
360#include "implicit_f.inc"
361C-----------------------------------------------
362C D u m m y A r g u m e n t s
363C-----------------------------------------------
364 DOUBLE PRECISION F,F7(7)
365C-----------------------------------------------
366c
367c r=29 (foat_to_7_float): nombre de bits pour la retenu
368c autorise faire 2^r + ~= 537,000,000.
369c
370c m1: masque 1
371c ...
372c m6: masque 6
373c
374c m2 = m1 - 53 + r
375c m3 = m2 - 53 + r
376c m4 = m3 - 53 + r
377c m5 = m4 - 53 + r
378c m6 = m5 - 53 + r
379c m7 = m6 - 53 + r
380c
381c si r= 29 : mi = mi-1 - 24
382c
383c f1 = (f + 2^m1) - 2^m1
384c b = f - f1
385c f1 = (b + 2^m2) - 2^m2
386c d = b - f2
387c f3 = (d + 2^m3) - 2^m3
388c f4 = ((d - f3) + 2^m4) - 2^m4
389c ...
390c--------- calcul de fmax, fmin
391c calcul
392c fmax avec 0 bits zero = 2^m1
393c fmax avec r bits zero = 2^(m1-r)
394c
395c fmin avec 53 bits significatif = 2^m7
396c fmin avec 1 bits significatif = 2^(m7+53)
397c
398c fmax avec 0 bits zero = 5. 10^27
399c fmax avec r bits zero = 9. 10^18
400c fmin avec 53 bits significatif ~= 2.2 10^-16
401c fmin avec 1 bits significatif ~= 2.4 10^-32
402c-------------------------------------------------------
403c a = f + deuxp63
404c f4(1) = a - deuxp63
405c b = f - f4(1)
406c c = b + deuxp30
407c f4(2) = c - deuxp30
408c d = b - f4(2)
409c e = d + deuxpm3
410c f4(3) = e - deuxpm3
411c g = d - f4(3)
412c h = g + deuxpm36
413c f4(4) = h - deuxpm36
414C-----------------------------------------------
415C L o c a l C o m m o n
416C-----------------------------------------------
417C
418C Attention - Attention - Attention - Attention - Attention - Attention
419C
420C Commun pour casser l optimisation et thread private pour multithread
421C
422 COMMON /parit_var/temp1,temp2,temp3,temp4,temp5,temp6,temp7,
423 . temp11,temp12,temp13,temp14,temp15,temp16,
424 . temp17,reste
425!$OMP THREADPRIVATE(/PARIT_VAR/)
426 DOUBLE PRECISION TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
427 . TEMP11,TEMP12,TEMP13,TEMP14,TEMP15,TEMP16,
428 . TEMP17,RESTE
429C
430C Attention - Attention - Attention - Attention - Attention - Attention
431C
432C-----------------------------------------------
433C L o c a l V a r i a b l e s
434C-----------------------------------------------
435 DOUBLE PRECISION PE,PS
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): nombre de bits pour la retenu
559c autorise faire 2^r + ~= 67,000,000.
560c
561c m1: masque 1
562c ...
563c m6: masque 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 si 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--------- calcul de fmax, fmin
581c fmax avec r bits zero = 2^(m1-r)
582c
583c fmin avec 53 bits significatif = 2^m6
584c fmin avec 1 bits significatif = 2^(m6-53)
585c
586c--------- fmax, fmin aprs exprimentation
587c fmax avec r bits zero ~= 2^(m1-2r)
588c
589c fmin avec 53 bits significatif ~= 2^(m6-r)
590c fmin avec 1 bits significatif ~= 2^(m6-53-r)
591c
592c 6 float r=26 m1=89 m6=-46
593c
594c fmax avec r bits zero ~= 2^37 =
595c fmin avec 53 bits significatif ~= 2^(m6-r)
596c fmin avec 1 bits significatif ~= 2^(m6-53-r)
597c-------------------------------------------------------
598c a = f + deuxp63
599c f4(1) = a - deuxp63
600c b = f - f4(1)
601c c = b + deuxp30
602c f4(2) = c - deuxp30
603c d = b - f4(2)
604c e = d + deuxpm3
605c f4(3) = e - deuxpm3
606c g = d - f4(3)
607c h = g + deuxpm36
608c f4(4) = h - deuxpm36
609C-----------------------------------------------
610C L o c a l C o m m o n
611C-----------------------------------------------
612C
613C Attention - Attention - Attention - Attention - Attention - Attention
614C
615C Commun pour casser l optimisation et thread private pour 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 Attention - Attention - Attention - Attention - Attention - Attention
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): nombre de bits pour la retenu
716c autorise faire 2^r + ~= 67,000,000.
717c
718c m1: masque 1
719c ...
720c m6: masque 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 si 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--------- calcul de fmax, fmin
738c fmax avec r bits zero = 2^(m1-r)
739c
740c fmin avec 53 bits significatif = 2^m6
741c fmin avec 1 bits significatif = 2^(m6-53)
742c
743c--------- fmax, fmin aprs exprimentation
744c fmax avec r bits zero ~= 2^(m1-2r)
745c
746c fmin avec 53 bits significatif ~= 2^(m6-r)
747c fmin avec 1 bits significatif ~= 2^(m6-53-r)
748c
749c 6 float r=26 m1=89 m6=-46
750c
751c fmax avec r bits zero ~= 2^37 =
752c fmin avec 53 bits significatif ~= 2^(m6-r)
753c fmin avec 1 bits significatif ~= 2^(m6-53-r)
754c-------------------------------------------------------
755c a = f + deuxp63
756c f4(1) = a - deuxp63
757c b = f - f4(1)
758c c = b + deuxp30
759c f4(2) = c - deuxp30
760c d = b - f4(2)
761c e = d + deuxpm3
762c f4(3) = e - deuxpm3
763c g = d - f4(3)
764c h = g + deuxpm36
765c f4(4) = h - deuxpm36
766C-----------------------------------------------
767C L o c a l C o m m o n
768C-----------------------------------------------
769C
770C Attention - Attention - Attention - Attention - Attention - Attention
771C
772C Commun pour casser l optimisation et thread private pour 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 Attention - Attention - Attention - Attention - Attention - Attention
783C
784C-----------------------------------------------
785C L o c a l V a r i a b l e s
786C-----------------------------------------------
787 INTEGER I,J,K
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:357
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:64
foat_to_6_float
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:225
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
rbyact
subroutine rbyact(rby, m, lsn, nsl, ms, in, x, itab, skew, isph, iwa, npbyi, rbyi, lsni, pmain, icomm, weight, id)
Definition rbyact.F:41
rgwath
subroutine rgwath(x, v, w, rwl, nsw, nsn, msr, ms, fsav, ixs, ixq, elbuf_tab, iparg, pm, ntag, nelw, ne, temp, tstif, e, a, itied, weight, iad_elem, fr_elem, fr_wall)
Definition rgwath.F:42
rlink2
subroutine rlink2(ms, in, a, ar, v, vr, nsn, ic, icr, nod, skew, weight, frl6, iflag)
Definition rlink2.F:34
sms_rlink3
subroutine sms_rlink3(ms, x, a, v, nsn, ic, nod, xframe, weight, frl6, iflag, idown, pmain, frl, tag_lnk, itab)
Definition sms_rlink.F:636
telesc
subroutine telesc(n_joint, a, ar, v, vr, x, fs, ms, in, itask)
Definition telesc.F:35