1 : C FDT SOURCE CHAT 07/10/29 21:19:37 5940
2 : SUBROUTINE FDT
3 : C
4 : C**************************************************************
5 : C
6 : C SUBROUTINE ASSOCIE A L OPERATEUR FDT
7 : C
8 : C 26/06/86 AUTEUR D. BROCHARD (VIBR POSTE 6994)
9 : C
10 : C CREATION D UN OBJET EVOLUTION A PARTIR D UN PROG (TIROIR)
11 : C
12 : C S Y N T A X E
13 : C -------------
14 : C
15 : C EVOL = FDT MOT ('CONS' DT FTI )
16 : C ( )
17 : C ('NOCO' ( 'COUP' TIFTI ) )
18 : C ( ( ) )
19 : C ( ( TFT ) )
20 : C ( )
21 : C ( PROG1 PROG2 )
22 : C
23 : C MOT TYPE DE DONNEE (ACCE,DEPL,ETC...)
24 : C CONS SIGNAL A PAS CONSTANT
25 : C DT OBJET FLOTTANT PAS DE TEMPS
26 : C FTI OBJET LISTREEL VALEUR DU SIGNAL
27 : C NOCO SIGNAL A PAS NON CONSTANT
28 : C COUP MOT INDI QUANT QUE LE SIGNAL EST RENTRE
29 : C SOUS LA FORME DE COUPLES TIFTI(OBJET LISTREEL)
30 : C TFT OBJET LISTREEL CONTENANT T(I),I=1,N PUIS
31 : C F(TI),I=1,N
32 : C PROG1,PROG2 OBJETS DE TYPE LISTREEL . L UN DES DEUX CONTIENT
33 : C UN SEUL NOMBRE:DT
34 : C SI DT > 0 SIGNAL A PAS CONSTANT DONT LES VALEURS
35 : C SONT DANS PROG2
36 : C SI DT < 0 SIGNAL A PAS NON CONSTANT VALEURS DANS
37 : C PROG2 : T(I),I=1,N PUIS F(TI),I=1,N
38 : C
39 : C
40 : C*******************************************************************
41 : C
42 : C
43 : C
44 : IMPLICIT INTEGER(I-N)
45 : IMPLICIT REAL*8 (A-H,O-Z)
46 : -INC CCOPTIO
47 : -INC CCGEOME
48 : -INC SMEVOLL
49 : -INC SMLREEL
50 : CHARACTER*72 TI
51 : CHARACTER*4 MOT1,MOT2,MOT3
52 : CHARACTER*4 NOMC(2)
53 : C
54 : DATA NOMC/'CONS','NOCO'/
55 : C
56 : C
57 : LNOMC=2
58 : C
58 : CALL LIRCHA(MOT1,1,IRETOU)
58 : CALL LIRCHA(MOT2,0,IRETOU)
59 : C
60 : C
61 : IF(IRETOU.EQ.0) GOTO 300
62 : C
62 : CALL PLACE(NOMC,LNOMC,IMOT,MOT2)
63 : C
64 : C
65 : IF(IMOT.EQ.0) GOTO 1000
66 : GOTO (101,102),IMOT
67 : C
68 : C
69 : 101 CONTINUE
70 : C
71 : C PAS CONSTANT DT FTI
72 : C
72 : CALL LIRREE(DFLOT,1,IRETOU)
73 : DT=DFLOT
73 : CALL LIROBJ('LISTREEL',IPO,1,IRETOU)
74 : MLREEL=IPO
75 : C
76 : C
77 : 350 CONTINUE
78 : SEGACT MLREEL
79 : LT=MLREEL.PROG(/1)
80 : JG=LT
81 : SEGINI MLREE1
82 : T=0.D0
83 : DO 110 I=1,LT
84 : MLREE1.PROG(I)=T
85 : T=T+DT
86 : 110 CONTINUE
87 : C
88 : C
89 : C
90 : IPX=MLREE1
91 : IPY=MLREEL
92 : SEGDES MLREEL,MLREE1
93 : GOTO 200
94 : C
95 : C
96 : 102 CONTINUE
97 : C
98 : C PAS NON CONSTANT
99 : C
99 : CALL LIRCHA(MOT3,0,IRETOU)
100 : C
101 : IF(IRETOU.EQ.0) GOTO 150
102 : C
103 : C ON A LU COUPLE LE PROG CONTIENT TI,FTI
104 : C
104 : CALL LIROBJ('LISTREEL',IPO,1,IRETOU)
105 : MLREEL=IPO
106 : SEGACT MLREEL
107 : LTFT=PROG(/1)
108 : LT=LTFT/2
109 : JG=LT
110 : SEGINI MLREE1
111 : SEGINI MLREE2
112 : C
113 : DO 103 I=1,LT
114 : I1=2*I-1
115 : I2=2*I
116 : MLREE1.PROG(I)=PROG(I1)
117 : MLREE2.PROG(I)=PROG(I2)
118 : 103 CONTINUE
119 : C
120 : C
121 : 160 CONTINUE
122 : LT1=MLREE1.PROG(/1)-1
123 : DO 104 I=1,LT1
124 : IF(MLREE1.PROG(I).GT.MLREE1.PROG(I+1)) GOTO 105
125 : 104 CONTINUE
126 : IPX=MLREE1
127 : IPY=MLREE2
128 : SEGDES MLREE1,MLREE2,MLREEL
129 : GOTO 200
130 : C
131 : C
132 : 105 CONTINUE
133 : C
134 : C ERREUR
135 : C
135 : CALL ERREUR(285)
136 : RETURN
137 : C
138 : C
139 : 150 CONTINUE
140 : C
141 : C ON LIT UN PROG CONTENANT TI,I=1,N PUIS FTI,I=1,N
142 : C
142 : CALL LIROBJ('LISTREEL',IPO,1,IRETOU)
143 : MLREEL=IPO
144 : 360 CONTINUE
145 : SEGACT MLREEL
146 : LTFT=PROG(/1)
147 : LT=LTFT/2
148 : JG=LT
149 : SEGINI MLREE1
150 : SEGINI MLREE2
151 : DO 151 I=1,LT
152 : I1=I+LT
153 : MLREE1.PROG(I)=PROG(I)
154 : MLREE2.PROG(I)=PROG(I1)
155 : 151 CONTINUE
156 : C
157 : C
158 : GOTO 160
159 : C
160 : C
161 : 300 CONTINUE
162 : C
163 : C TIROIR ON FOURNIT DEUX PROG UN DES DEUX CONTIENT DT
164 : C
164 : CALL LIROBJ('LISTREEL',IPA,1,IRETOU)
164 : CALL LIROBJ('LISTREEL',IPB,1,IRETOU)
165 : MLREE1=IPA
166 : MLREE2=IPB
167 : SEGACT MLREE1
168 : IF(MLREE1.PROG(/1).NE.1) GOTO 301
169 : 310 DT=MLREE1.PROG(1)
170 : SEGDES MLREE1
171 : MLREEL=MLREE2
172 : IF(DT.NE.0) GOTO 350
173 : GOTO 360
174 : C
175 : C
176 : 301 CONTINUE
177 : SEGDES MLREE1
178 : MLREE1=IPB
179 : MLREE2=IPA
180 : SEGACT MLREE1
181 : IF(MLREE1.PROG(/1).NE.1) GOTO 302
182 : GOTO 310
183 : C
184 : C
184 : 302 CALL ERREUR(294)
185 : RETURN
186 : 200 CONTINUE
187 : C
188 : C INITIALISATION DE L OBJET EVOLUTION
189 : C
190 : N=1
191 : SEGINI MEVOLL
192 : SEGINI KEVOLL
193 : TYPX='LISTREEL'
194 : TYPY='LISTREEL'
195 : IPROGX=IPX
196 : IPROGY=IPY
197 : NOMEVX='TEMPS SEC'
198 : NOMEVY=MOT1
199 : C
200 : ITYEVO='REEL'
201 : NUMEVX=IDCOUL
202 : NUMEVY='REEL'
203 : C
204 : SEGDES KEVOLL
205 : C
206 : TI(1:72)=TITREE
207 : IEVTEX=TI
208 : IEVOLL(1)=KEVOLL
209 : C
210 : SEGDES MEVOLL
211 : C
211 : CALL ECROBJ('EVOLUTIO',MEVOLL)
212 : RETURN
213 : C
214 : 1000 CONTINUE
215 : moterr(1:4)=mot2
215 : call erreur(7)
215 : CALL GINT2
216 : RETURN
217 : C
218 : END
219 :
220 :
221 :
222 :
223 :
224 :
225 :
226 :
© Cast3M 2003 - All rights reserved.
Disclaimer