Télécharger fdt.eso

Retour à la liste

Numérotation des lignes :

fdt
  1. C FDT SOURCE BP208322 16/11/18 21:17:04 9177
  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.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. -INC CCGEOME
  50. -INC SMEVOLL
  51. -INC SMLREEL
  52. CHARACTER*72 TI
  53. CHARACTER*4 MOT1,MOT2,MOT3
  54. CHARACTER*4 NOMC(2)
  55. C
  56. DATA NOMC/'CONS','NOCO'/
  57. C
  58. C
  59. LNOMC=2
  60. C
  61. CALL LIRCHA(MOT1,1,IRETOU)
  62. CALL LIRCHA(MOT2,0,IRETOU)
  63. C
  64. C
  65. IF(IRETOU.EQ.0) GOTO 300
  66. C
  67. CALL PLACE(NOMC,LNOMC,IMOT,MOT2)
  68. C
  69. C
  70. IF(IMOT.EQ.0) GOTO 1000
  71. GOTO (101,102),IMOT
  72. C
  73. C
  74. 101 CONTINUE
  75. C
  76. C PAS CONSTANT DT FTI
  77. C
  78. CALL LIRREE(DFLOT,1,IRETOU)
  79. DT=DFLOT
  80. CALL LIROBJ('LISTREEL',IPO,1,IRETOU)
  81. MLREEL=IPO
  82. C
  83. C
  84. 350 CONTINUE
  85. SEGACT MLREEL
  86. LT=MLREEL.PROG(/1)
  87. JG=LT
  88. SEGINI MLREE1
  89. T=0.D0
  90. DO 110 I=1,LT
  91. MLREE1.PROG(I)=T
  92. T=T+DT
  93. 110 CONTINUE
  94. C
  95. C
  96. C
  97. IPX=MLREE1
  98. IPY=MLREEL
  99. SEGDES MLREEL,MLREE1
  100. GOTO 200
  101. C
  102. C
  103. 102 CONTINUE
  104. C
  105. C PAS NON CONSTANT
  106. C
  107. CALL LIRCHA(MOT3,0,IRETOU)
  108. C
  109. IF(IRETOU.EQ.0) GOTO 150
  110. C
  111. C ON A LU COUPLE LE PROG CONTIENT TI,FTI
  112. C
  113. CALL LIROBJ('LISTREEL',IPO,1,IRETOU)
  114. MLREEL=IPO
  115. SEGACT MLREEL
  116. LTFT=PROG(/1)
  117. LT=LTFT/2
  118. JG=LT
  119. SEGINI MLREE1
  120. SEGINI MLREE2
  121. C
  122. DO 103 I=1,LT
  123. I1=2*I-1
  124. I2=2*I
  125. MLREE1.PROG(I)=PROG(I1)
  126. MLREE2.PROG(I)=PROG(I2)
  127. 103 CONTINUE
  128. C
  129. C
  130. 160 CONTINUE
  131. LT1=MLREE1.PROG(/1)-1
  132. DO 104 I=1,LT1
  133. IF(MLREE1.PROG(I).GT.MLREE1.PROG(I+1)) GOTO 105
  134. 104 CONTINUE
  135. IPX=MLREE1
  136. IPY=MLREE2
  137. SEGDES MLREE1,MLREE2,MLREEL
  138. GOTO 200
  139. C
  140. C
  141. 105 CONTINUE
  142. C
  143. C ERREUR
  144. C
  145. CALL ERREUR(285)
  146. RETURN
  147. C
  148. C
  149. 150 CONTINUE
  150. C
  151. C ON LIT UN PROG CONTENANT TI,I=1,N PUIS FTI,I=1,N
  152. C
  153. CALL LIROBJ('LISTREEL',IPO,1,IRETOU)
  154. MLREEL=IPO
  155. 360 CONTINUE
  156. SEGACT MLREEL
  157. LTFT=PROG(/1)
  158. LT=LTFT/2
  159. JG=LT
  160. SEGINI MLREE1
  161. SEGINI MLREE2
  162. DO 151 I=1,LT
  163. I1=I+LT
  164. MLREE1.PROG(I)=PROG(I)
  165. MLREE2.PROG(I)=PROG(I1)
  166. 151 CONTINUE
  167. C
  168. C
  169. GOTO 160
  170. C
  171. C
  172. 300 CONTINUE
  173. C
  174. C TIROIR ON FOURNIT DEUX PROG UN DES DEUX CONTIENT DT
  175. C
  176. CALL LIROBJ('LISTREEL',IPA,1,IRETOU)
  177. CALL LIROBJ('LISTREEL',IPB,1,IRETOU)
  178. MLREE1=IPA
  179. MLREE2=IPB
  180. SEGACT MLREE1
  181. IF(MLREE1.PROG(/1).NE.1) GOTO 301
  182. 310 DT=MLREE1.PROG(1)
  183. SEGDES MLREE1
  184. MLREEL=MLREE2
  185. IF(DT.NE.0) GOTO 350
  186. GOTO 360
  187. C
  188. C
  189. 301 CONTINUE
  190. SEGDES MLREE1
  191. MLREE1=IPB
  192. MLREE2=IPA
  193. SEGACT MLREE1
  194. IF(MLREE1.PROG(/1).NE.1) GOTO 302
  195. GOTO 310
  196. C
  197. C
  198. 302 CALL ERREUR(294)
  199. RETURN
  200. 200 CONTINUE
  201. C
  202. C INITIALISATION DE L OBJET EVOLUTION
  203. C
  204. N=1
  205. SEGINI MEVOLL
  206. SEGINI KEVOLL
  207. TYPX='LISTREEL'
  208. TYPY='LISTREEL'
  209. IPROGX=IPX
  210. IPROGY=IPY
  211. NOMEVX='TEMPS SEC'
  212. NOMEVY=MOT1
  213. C
  214. ITYEVO='REEL'
  215. NUMEVX=IDCOUL
  216. NUMEVY='REEL'
  217. C
  218. SEGDES KEVOLL
  219. C
  220. TI(1:72)=TITREE
  221. IEVTEX=TI
  222. IEVOLL(1)=KEVOLL
  223. C
  224. SEGDES MEVOLL
  225. C
  226. CALL ECROBJ('EVOLUTIO',MEVOLL)
  227. RETURN
  228. C
  229. 1000 CONTINUE
  230. moterr(1:4)=mot2
  231. call erreur(7)
  232. CALL GINT2
  233. RETURN
  234. C
  235. END
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales