| [991] | 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 | 
|---|
| [1727] | 13 | TYP = 3 | 
|---|
| [991] | 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 | 
|---|