1 | PROGRAM MAIN
|
---|
2 | IMPLICIT NONE
|
---|
3 | INTEGER I,J,K,NTIME,TYP,M
|
---|
4 | DOUBLE PRECISION X,ALP
|
---|
5 | PARAMETER MM = 500000
|
---|
6 | C COMMON /XXVEC/ DOUBLE PRECISION V1(MM),V2(MM),V3(MM),V4(MM)
|
---|
7 | DOUBLE PRECISION V1(MM),V2(MM),V3(MM),V4(MM)
|
---|
8 |
|
---|
9 |
|
---|
10 | NTIME = 1000
|
---|
11 | C TYP = 2 boucle normale - copy/addition
|
---|
12 | C TYP = 3 utilisation de blas
|
---|
13 | TYP = 2
|
---|
14 | M = 50000
|
---|
15 | ALP = 2.726
|
---|
16 | PRINT *,' Remplissage V1,V2 M=', M, ' NTimes=', NTIME,' Typ=',TYP
|
---|
17 | IF (TYP.EQ.2) PRINT *,' TYP=2 --- SANS BLAS'
|
---|
18 | IF (TYP.EQ.3) PRINT *,' TYP=3 --- Appel BLAS'
|
---|
19 | DO I=1,M
|
---|
20 | X = FLOAT(I)*0.00314
|
---|
21 | V1(I) = SIN(X)
|
---|
22 | V2(I) = COS(X)
|
---|
23 | ENDDO
|
---|
24 |
|
---|
25 | PRINT *, 'Appel Addition V3 = V1*V2'
|
---|
26 |
|
---|
27 | DO K=1,NTIME
|
---|
28 | CALL VECADD(TYP,V1,V2,V3,M,ALP)
|
---|
29 | ENDDO
|
---|
30 |
|
---|
31 | DO J=1,3
|
---|
32 | PRINT *, 'J, V1,V2 , V3 = ', J,V1(J),V2(J),V3(J)
|
---|
33 | ENDDO
|
---|
34 | DO J=991,993
|
---|
35 | PRINT *, 'J, V1,V2 , V3 = ', J,V1(J),V2(J),V3(J)
|
---|
36 | ENDDO
|
---|
37 | PRINT *, 'Fin programme Test-Addition'
|
---|
38 | STOP
|
---|
39 | END
|
---|
40 |
|
---|
41 | SUBROUTINE VECADD(TYP,V1,V2,V3,N,ALP)
|
---|
42 | INTEGER V1(*), V2(*), V3(*)
|
---|
43 | DOUBLE PRECISION ALP
|
---|
44 | INTEGER TYP,N,TYPO
|
---|
45 | TYPO = 0
|
---|
46 | IF (TYP.EQ.1) THEN
|
---|
47 | CALL VECADDI(V1,V2,V3,N,TYPO,ALP)
|
---|
48 | ELSE
|
---|
49 | IF (TYP.EQ.2) THEN
|
---|
50 | CALL VECADDD2(V1,V2,V3,N,TYPO,ALP)
|
---|
51 | ELSE
|
---|
52 | CALL VECADDD(V1,V2,V3,N,TYPO,ALP)
|
---|
53 | ENDIF
|
---|
54 | ENDIF
|
---|
55 | IF ((TYPO.NE.TYP).OR.(TYPO.EQ.0)) THEN
|
---|
56 | PRINT *, 'ERREUR TYP-OPeration ' , TYP, TYPO
|
---|
57 | STOP
|
---|
58 | ENDIF
|
---|
59 | RETURN
|
---|
60 | END
|
---|
61 |
|
---|
62 | SUBROUTINE VECADDD(V1,V2,V3,N,TYP,ALP)
|
---|
63 | DOUBLE PRECISION V1(*), V2(*), V3(*),ALP
|
---|
64 | INTEGER N,I,TYP
|
---|
65 | INTEGER INCX,INCY
|
---|
66 | INCX = 1
|
---|
67 | INCY = 1
|
---|
68 | CALL DCOPY(N, V2, INCX, V3, INCY)
|
---|
69 | CALL DAXPY(N, ALP, V1, INCX, V3, INCY)
|
---|
70 | TYP = 3
|
---|
71 | RETURN
|
---|
72 | END
|
---|
73 |
|
---|
74 | SUBROUTINE VECADDD2(V1,V2,V3,N,TYP,ALP)
|
---|
75 | DOUBLE PRECISION V1(*), V2(*), V3(*)
|
---|
76 | INTEGER N,I,TYP
|
---|
77 | DO I=1,N
|
---|
78 | C V3(I) = V1(I)+V2(I)
|
---|
79 | V3(I) = V2(I)
|
---|
80 | ENDDO
|
---|
81 | DO I=1,N
|
---|
82 | V3(I) = V1(I)*ALP+V3(I)
|
---|
83 | ENDDO
|
---|
84 | TYP = 2
|
---|
85 | RETURN
|
---|
86 | END
|
---|
87 |
|
---|
88 | SUBROUTINE VECADDI(V1,V2,V3,N,TYP,ALP)
|
---|
89 | INTEGER V1(*), V2(*), V3(*)
|
---|
90 | INTEGER N,I,TYP
|
---|
91 | DOUBLE PRECISION ALP
|
---|
92 | DO I=1,N
|
---|
93 | V3(I) = V1(I)+V2(I)
|
---|
94 | ENDDO
|
---|
95 | TYP = 1
|
---|
96 | RETURN
|
---|
97 | END
|
---|
98 |
|
---|
99 | SUBROUTINE VECADDF(V1,V2,V3,N,TYP)
|
---|
100 | REAL V1(*), V2(*), V3(*)
|
---|
101 | INTEGER N,I,TYP
|
---|
102 | CALL SCOPY(N, V2, 1, V3, 1)
|
---|
103 | CALL SAXPY(N, 1., V1, 1, V3, 1)
|
---|
104 | TYP = 2
|
---|
105 | RETURN
|
---|
106 | END
|
---|