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