| 1 |       PROGRAM MAIN
 | 
|---|
| 2 |       IMPLICIT NONE
 | 
|---|
| 3 | C      PARAMETER M = 50000
 | 
|---|
| 4 |       DOUBLE PRECISION V1(50000),V2(50000),V3(50000)
 | 
|---|
| 5 |       INTEGER I,J,K,NTIME,TYP
 | 
|---|
| 6 |       DOUBLE PRECISION X
 | 
|---|
| 7 | 
 | 
|---|
| 8 |     
 | 
|---|
| 9 |       NTIME = 1000
 | 
|---|
| 10 |       TYP = 3
 | 
|---|
| 11 |       PRINT *,' Remplissage V1,V2 M=', 50000, ' NTimes=', NTIME,
 | 
|---|
| 12 |      + ' Typ=',TYP
 | 
|---|
| 13 |       DO I=1,50000
 | 
|---|
| 14 |         X = FLOAT(I)*0.00314
 | 
|---|
| 15 |         V1(I) = SIN(X)
 | 
|---|
| 16 |         V2(I) = COS(X)
 | 
|---|
| 17 |       ENDDO
 | 
|---|
| 18 | 
 | 
|---|
| 19 |       PRINT *, 'Appel multiplication V3 = V1*V2'
 | 
|---|
| 20 | 
 | 
|---|
| 21 |       DO K=1,NTIME
 | 
|---|
| 22 |         CALL VECMULT(TYP,V1,V2,V3,50000)
 | 
|---|
| 23 |       ENDDO
 | 
|---|
| 24 | 
 | 
|---|
| 25 |       DO J=1,3
 | 
|---|
| 26 |         PRINT *, 'J, V1,V2 , V3 = ', J,V1(J),V2(J),V3(J)
 | 
|---|
| 27 |       ENDDO 
 | 
|---|
| 28 |       DO J=991,993
 | 
|---|
| 29 |         PRINT *, 'J, V1,V2 , V3 = ', J,V1(J),V2(J),V3(J)
 | 
|---|
| 30 |       ENDDO 
 | 
|---|
| 31 |       PRINT *, 'Fin programme Test-Multiplication'
 | 
|---|
| 32 |       STOP
 | 
|---|
| 33 |       END
 | 
|---|
| 34 | 
 | 
|---|
| 35 |       SUBROUTINE VECMULT(TYP,V1,V2,V3,N)
 | 
|---|
| 36 |       INTEGER V1(*), V2(*), V3(*)
 | 
|---|
| 37 |       INTEGER TYP,N,TYPO
 | 
|---|
| 38 |       TYPO = 0
 | 
|---|
| 39 |       IF (TYP.EQ.1)  THEN
 | 
|---|
| 40 |         CALL VECMULTI(V1,V2,V3,N,TYPO)
 | 
|---|
| 41 |       ELSE
 | 
|---|
| 42 |         IF (TYP.EQ.2)  THEN
 | 
|---|
| 43 |           CALL VECMULTF(V1,V2,V3,N,TYPO)
 | 
|---|
| 44 |         ELSE 
 | 
|---|
| 45 |           CALL VECMULTD(V1,V2,V3,N,TYPO)
 | 
|---|
| 46 |         ENDIF
 | 
|---|
| 47 |       ENDIF
 | 
|---|
| 48 |       IF ((TYPO.NE.TYP).OR.(TYPO.EQ.0))  THEN
 | 
|---|
| 49 |         PRINT *, 'ERREUR TYP-OPeration ' , TYP, TYPO
 | 
|---|
| 50 |         STOP
 | 
|---|
| 51 |       ENDIF
 | 
|---|
| 52 |       RETURN
 | 
|---|
| 53 |       END
 | 
|---|
| 54 | 
 | 
|---|
| 55 |       SUBROUTINE VECMULTD(V1,V2,V3,N,TYP)
 | 
|---|
| 56 |       DOUBLE PRECISION V1(*), V2(*), V3(*)
 | 
|---|
| 57 |       INTEGER  N,I,TYP
 | 
|---|
| 58 |       DO I=1,N
 | 
|---|
| 59 |        V3(I) = V1(I)*V2(I)
 | 
|---|
| 60 |       ENDDO
 | 
|---|
| 61 |       TYP = 3
 | 
|---|
| 62 |       RETURN
 | 
|---|
| 63 |       END
 | 
|---|
| 64 | 
 | 
|---|
| 65 |       SUBROUTINE VECMULTI(V1,V2,V3,N,TYP)
 | 
|---|
| 66 |       INTEGER V1(*), V2(*), V3(*)
 | 
|---|
| 67 |       INTEGER  N,I,TYP
 | 
|---|
| 68 |       DO I=1,N
 | 
|---|
| 69 |        V3(I) = V1(I)*V2(I)
 | 
|---|
| 70 |       ENDDO
 | 
|---|
| 71 |       TYP = 1
 | 
|---|
| 72 |       RETURN
 | 
|---|
| 73 |       END
 | 
|---|
| 74 | 
 | 
|---|
| 75 |       SUBROUTINE VECMULTF(V1,V2,V3,N,TYP)
 | 
|---|
| 76 |       REAL V1(*), V2(*), V3(*)
 | 
|---|
| 77 |       INTEGER  N,I,TYP
 | 
|---|
| 78 |       DO I=1,N
 | 
|---|
| 79 |        V3(I) = V1(I)*V2(I)
 | 
|---|
| 80 |       ENDDO
 | 
|---|
| 81 |       TYP = 2
 | 
|---|
| 82 |       RETURN
 | 
|---|
| 83 |       END
 | 
|---|