source: Sophya/branches/Reza/Eval/JET/fmtx.f@ 3861

Last change on this file since 3861 was 2362, checked in by ansari, 23 years ago

Creation du module JET, Test / evaluation de Expressions Template

Reza 17 Avril 2003

File size: 3.3 KB
Line 
1 PROGRAM MAIN
2 IMPLICIT NONE
3C PARAMETER M = 50000
4 DOUBLE PRECISION MX1(1000,500), MX2(1000,500), MX3(1000,500)
5 DOUBLE PRECISION MX4(1000,500), MX5(1000,500)
6 INTEGER I,J,K,NTIME,TYP
7 DOUBLE PRECISION X,Y,Z,C1,C2,C3
8
9 CALL FInitTim()
10 NTIME = 50
11 TYP = 3
12 PRINT *,' Remplissage MX1 MX2 (1000x500) - NTimes=', NTIME
13 DO K=1,NTIME
14 X = FLOAT(K)*0.00314
15 Y = SIN(X)
16 CALL FILLMTX(K,X,Y,MX1,MX2,MX3)
17 ENDDO
18
19 PRINT *, 'FIN Remplissage '
20 CALL FPrtTim(1)
21
22 DO K=1,NTIME
23 C1 = K*0.035
24 C2 = COS(C1)+0.04
25 C3 = SIN(C1*5.)
26 CALL OPERMTX(K, MX1, MX2, MX5, C1, C2, C3)
27 ENDDO
28 PRINT *, 'FIN MX5 = C1*MX1 + MX1 * MX2*C2 + MX2C3 '
29 CALL FPrtTim(2)
30
31 DO K=1,NTIME
32 C1 = K*0.055
33 C2 = COS(C1*1.6)+0.023
34 C3 = SIN(C1*2.5)
35 CALL OPADDMTX(K, MX1, MX2, MX3, MX5, C1, C2, C3)
36 ENDDO
37 PRINT *, 'FIN MX5 = C1*MX1 + C2*MX2 + C3*MX3 '
38 CALL FPrtTim(3)
39
40 DO K=1,NTIME
41 C1 = K*0.055
42 C2 = COS(C1*1.6)+0.023
43 C3 = SIN(C1*2.5)
44 CALL MTXBLAS(K, MX1, MX2, MX3, MX4, MX5, C1, C2, C3)
45 ENDDO
46 PRINT *, 'FIN MTXBLAS MX5 = C1*MX1 + C2*MX2 + C3*MX3 '
47 CALL FPrtTim(4)
48
49 PRINT *, ' ------ FIN programme ---------- '
50 END
51
52 SUBROUTINE FILLMTX(K, X,Y, MX1, MX2, MX3)
53 DOUBLE PRECISION X,Y
54 DOUBLE PRECISION MX1(1000,500), MX2(1000,500), MX3(1000,500)
55 INTEGER I,J,K
56 DO I=1,1000
57 DO J=1,500
58 MX1(I,J) = K*300.+10.*I+J+X
59 MX2(I,J) = K*550.+20.*I+2.*J+Y
60 MX3(I,J) = K*860.+40.*I+7.*J+Y*3.14
61 ENDDO
62 ENDDO
63 IF (K.EQ.5) PRINT *, 'FILLMTX - 5 -> ', MX1(12,14)
64 IF (K.EQ.15) PRINT *, 'FILLMTX - 15 -> ', MX2(12,15)
65
66 RETURN
67 END
68
69 SUBROUTINE OPERMTX(K, MX1, MX2, MX5, C1, C2, C3)
70 INTEGER I,J,K
71 DOUBLE PRECISION MX1(1000,500), MX2(1000,500)
72 DOUBLE PRECISION MX5(1000,500)
73 DOUBLE PRECISION C1,C2,C3
74 DO I=1,1000
75 DO J=1,500
76 MX5(I,J) = C1*MX1(I,J)+MX1(I,J)*(MX2(I,J)*C2)+MX2(I,J)*C3
77 ENDDO
78 ENDDO
79 IF (K.EQ.5) PRINT *, 'OPERMTX - 5 -> ', MX5(20,5)
80 IF (K.EQ.15) PRINT *, 'OPEEMTX - 15 -> ', MX5(20,15)
81 RETURN
82 END
83
84 SUBROUTINE OPADDMTX(K, MX1, MX2, MX3, MX5, C1, C2, C3)
85 INTEGER I,J,K
86 DOUBLE PRECISION MX1(1000,500), MX2(1000,500)
87 DOUBLE PRECISION MX3(1000,500), MX5(1000,500)
88 DOUBLE PRECISION C1,C2,C3
89 DO I=1,1000
90 DO J=1,500
91 MX5(I,J) = C1*MX1(I,J)+C2*MX2(I,J)+MX3(I,J)*C3
92 ENDDO
93 ENDDO
94 IF (K.EQ.5) PRINT *, 'OPADDMTX - 5 -> ', MX5(20,5)
95 IF (K.EQ.15) PRINT *, 'OPADDMTX - 15 -> ', MX5(20,15)
96
97 RETURN
98 END
99
100 SUBROUTINE MTXBLAS(K, MX1, MX2, MX3, MX4, MX5, C1, C2, C3)
101 INTEGER I,J,K,NTOT
102 DOUBLE PRECISION MX1(1000,500), MX2(1000,500)
103 DOUBLE PRECISION MX5(1000,500)
104 DOUBLE PRECISION C1,C2,C3
105 NTOT = 1000*500
106 CALL DVCAL(NTOT, C1, MX1, 1, MX5, 1)
107 CALL DZAXPY(NTOT, C2, MX2, 1, MX5, 1, MX4, 1)
108 CALL DZAXPY(NTOT, C3, MX3, 1, MX4, 1, MX5, 1)
109 IF (K.EQ.5) PRINT *, 'MTXBLAS - 5 -> ', MX5(20,5),
110 + ' NTot=' , NTOT
111 IF (K.EQ.15) PRINT *, 'MTXBLAS - 15 -> ', MX5(20,15),
112 + ' NTot=' , NTOT
113 RETURN
114 END
115
Note: See TracBrowser for help on using the repository browser.