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