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