| 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 = 3 | 
|---|
| 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 | 
|---|