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