source: Sophya/trunk/Eval/Speed/vectorF.f@ 3892

      PROGRAM MAIN
      IMPLICIT NONE
C      PARAMETER M = 50000
      DOUBLE PRECISION V1(50000),V2(50000),V3(50000)
      INTEGER I,J,K,NTIME,TYP
      DOUBLE PRECISION X

    
      NTIME = 1000
      TYP = 3
      PRINT *,' Remplissage V1,V2 M=', 50000, ' NTimes=', NTIME,
     + ' Typ=',TYP
      DO I=1,50000
        X = FLOAT(I)*0.00314
        V1(I) = SIN(X)
        V2(I) = COS(X)
      ENDDO

      PRINT *, 'Appel multiplication V3 = V1*V2'

      DO K=1,NTIME
        CALL VECMULT(TYP,V1,V2,V3,50000)
      ENDDO

      DO J=1,3
        PRINT *, 'J, V1,V2 , V3 = ', J,V1(J),V2(J),V3(J)
      ENDDO 
      DO J=991,993
        PRINT *, 'J, V1,V2 , V3 = ', J,V1(J),V2(J),V3(J)
      ENDDO 
      PRINT *, 'Fin programme Test-Multiplication'
      STOP
      END

      SUBROUTINE VECMULT(TYP,V1,V2,V3,N)
      INTEGER V1(*), V2(*), V3(*)
      INTEGER TYP,N,TYPO
      TYPO = 0
      IF (TYP.EQ.1)  THEN
        CALL VECMULTI(V1,V2,V3,N,TYPO)
      ELSE
        IF (TYP.EQ.2)  THEN
          CALL VECMULTF(V1,V2,V3,N,TYPO)
        ELSE 
          CALL VECMULTD(V1,V2,V3,N,TYPO)
        ENDIF
      ENDIF
      IF ((TYPO.NE.TYP).OR.(TYPO.EQ.0))  THEN
        PRINT *, 'ERREUR TYP-OPeration ' , TYP, TYPO
        STOP
      ENDIF
      RETURN
      END

      SUBROUTINE VECMULTD(V1,V2,V3,N,TYP)
      DOUBLE PRECISION V1(*), V2(*), V3(*)
      INTEGER  N,I,TYP
      DO I=1,N
       V3(I) = V1(I)*V2(I)
      ENDDO
      TYP = 3
      RETURN
      END

      SUBROUTINE VECMULTI(V1,V2,V3,N,TYP)
      INTEGER V1(*), V2(*), V3(*)
      INTEGER  N,I,TYP
      DO I=1,N
       V3(I) = V1(I)*V2(I)
      ENDDO
      TYP = 1
      RETURN
      END

      SUBROUTINE VECMULTF(V1,V2,V3,N,TYP)
      REAL V1(*), V2(*), V3(*)
      INTEGER  N,I,TYP
      DO I=1,N
       V3(I) = V1(I)*V2(I)
      ENDDO
      TYP = 2
      RETURN
      END