OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parit.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "comlock.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sum_6_float (jft, jlt, f, f6, n)
subroutine foat_to_6_float (jft, jlt, f, f6)
subroutine foat_to_7_float (f, f7)
subroutine double_flot_ieee (jft, jlt, i8, r8, i8f)
subroutine sum_6_float_sens (f, a, b, c, jft, jlt, f6, d, e, g, isensint)
subroutine sum_6_float_sect (f, a, b, jft, jlt, f6, d, e)

Function/Subroutine Documentation

◆ double_flot_ieee()

subroutine double_flot_ieee ( integer jft,
integer jlt,
integer*8, dimension(*) i8,
r8,
integer*8, dimension(3,*) i8f )

Definition at line 484 of file parit.F.

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
my_real
#define my_real
Definition cppsort.cpp:32

◆ foat_to_6_float()

subroutine foat_to_6_float ( integer jft,
integer jlt,
f,
double precision, dimension(6,*) f6 )

Definition at line 224 of file parit.F.

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

◆ foat_to_7_float()

subroutine foat_to_7_float ( double precision f,
double precision, dimension(7) f7 )

Definition at line 356 of file parit.F.

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

◆ sum_6_float()

subroutine sum_6_float ( integer jft,
integer jlt,
f,
double precision, dimension(n,6) f6,
integer n )

Definition at line 63 of file parit.F.

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

◆ sum_6_float_sect()

subroutine sum_6_float_sect ( f,
integer a,
integer b,
integer jft,
integer jlt,
double precision, dimension(d,e) f6,
integer d,
integer e )

Definition at line 698 of file parit.F.

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

◆ sum_6_float_sens()

subroutine sum_6_float_sens ( f,
integer a,
integer b,
integer c,
integer jft,
integer jlt,
double precision, dimension(d,e,g) f6,
integer d,
integer e,
integer g,
integer, dimension(*) isensint )

Definition at line 539 of file parit.F.

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