Télécharger fdt.eso

Retour à la liste

Numérotation des lignes :

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

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