Télécharger osci.eso

Retour à la liste

Numérotation des lignes :

  1. C OSCI SOURCE BP208322 16/11/18 21:19:42 9177
  2. SUBROUTINE OSCI
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. CHARACTER*72 TI
  6. C
  7. C ========================================================
  8. C =
  9. C REPONSE D'UN OSCILLATEUR A UNE EXCITATION DONNEE =
  10. C =
  11. C SYNTAXE : EVOL = OSCI EVOL1 AMOR XSI FREQ DFREQ =
  12. C =
  13. C (TEMP LTEMP) (DEPL XDEP) (VITE XVIT) (COUL COOL) =
  14. C =
  15. C CREATION : 03/06/87 =
  16. C PROGRAMMEUR : MALAVAL =
  17. C =
  18. C ========================================================
  19. C
  20. -INC CCREEL
  21. -INC CCOPTIO
  22. -INC SMEVOLL
  23. -INC CCGEOME
  24. CHARACTER*4 MODOM(6)
  25. DATA MODOM/'AMOR','FREQ','TEMP','DEPL','VITE','COUL'/
  26. LMOT=6
  27. ITEMP=0
  28. IAMOR=0
  29. IFREQ=0
  30. IVITE=0
  31. IDEPL=0
  32. ICOUL1=IDCOUL
  33. C
  34. C LECTURE DES MOTS
  35. C
  36. DO 10 I=1,6
  37. CALL LIRMOT(MODOM,LMOT,IPLAC,0)
  38. IF (IPLAC.EQ.0) GOTO 10
  39. C
  40. 5 GOTO (1,2,3,31,32,4),IPLAC
  41. C
  42. 1 CONTINUE
  43. C
  44. C AMORTISSEMENT
  45. C
  46. CALL LIRREE (XSI,1,IRET)
  47. IAMOR=1
  48. GOTO 10
  49. C
  50. 2 CONTINUE
  51. C
  52. C FREQUENCE
  53. C
  54. CALL LIRREE (DFREQ,1,IRET)
  55. IFREQ=1
  56. GOTO 10
  57. C
  58. 3 CONTINUE
  59. C
  60. C TEMPS
  61. C
  62. CALL LIROBJ ('LISTREEL',IPT,1,IRET)
  63. ITEMP=1
  64. GOTO 10
  65. C
  66. 31 CONTINUE
  67. C
  68. C DEPLACEMENT INITIAL
  69. C
  70. CALL LIRREE (XDEP,1,IRET)
  71. IDEPL=1
  72. GOTO 10
  73. C
  74. 32 CONTINUE
  75. C
  76. C VITESSE INITIALE
  77. C
  78. CALL LIRREE (XVIT,1,IRET)
  79. IVITE=1
  80. GOTO 10
  81. C
  82. 4 CONTINUE
  83. C
  84. C COULEURS
  85. C
  86. CALL LIRMOT (NCOUL,NBCOUL,ICOUL1,0)
  87. IF (ICOUL1.EQ.0) ICOUL1=IDCOUL+1
  88. ICOUL1=ICOUL1-1
  89. C
  90. GOTO10
  91. C
  92. 10 CONTINUE
  93. C
  94. IF ( (IAMOR*IFREQ).EQ.0 ) THEN
  95. CALL ERREUR (26)
  96. RETURN
  97. ENDIF
  98. IF (XSI.LT.0.OR.XSI.GE.1) THEN
  99. MOTERR(1:8)='AMORTISS'
  100. REAERR(1)=XSI
  101. REAERR(2)=0.
  102. REAERR(3)=1.
  103. CALL ERREUR(42)
  104. RETURN
  105. ENDIF
  106. IF (IVITE.EQ.0) XVIT=0.
  107. IF (IDEPL.EQ.0) XDEP=0.
  108. C
  109. C TEMPS ET ACCELERATION DE L'OBJET EVOLUTION
  110. C
  111. CALL LIROBJ ('EVOLUTIO',IPOEVO,1,IRET)
  112. MEVOLL=IPOEVO
  113. SEGACT MEVOLL
  114. KEVOLL=IEVOLL(1)
  115. SEGACT KEVOLL
  116. IPTG=IPROGX
  117. IPGG=IPROGY
  118. SEGDES MEVOLL
  119. SEGDES KEVOLL
  120. IF (ITEMP.EQ.0) GOTO 60
  121. C
  122. C APPEL A LA SUBROUTINE D'INTERPOLATION
  123. C
  124. CALL INTE33(IPTG,IPGG,IPT,IPG)
  125. GOTO 70
  126. 60 IPT=IPTG
  127. IPG=IPGG
  128. C
  129. C APPEL A LA SUBROUTINE CONTENANT L'ALGORITHME
  130. C
  131. 70 CALL INOSCI(IPT,IPG,DFREQ,XSI,XDEP,XVIT,IPYD)
  132. C
  133. C CREATION D'UN OBJET EVOLUTION
  134. C
  135. SEGINI KEVOLL
  136. IPROGX=IPT
  137. IPROGY=IPYD
  138. NOMEVX='TEMPS'
  139. TYPX='LISTREEL'
  140. TYPY='LISTREEL'
  141. NOMEVY='DEPLACEMENT'
  142. NUMEVX=ICOUL1
  143. NUMEVY='REEL'
  144. C
  145. C
  146. N=1
  147. SEGINI MEVOLL
  148. IPSOL=MEVOLL
  149. IEVOLL(1)=KEVOLL
  150. TI(1:72)=TITREE
  151. IEVTEX=TI
  152. ITYEVO='REEL'
  153. c KEVTEX=TI
  154. KEVTEX='DEPL'
  155. SEGDES KEVOLL
  156. SEGDES MEVOLL
  157. C
  158. C
  159. CALL ECROBJ ('EVOLUTIO',IPSOL)
  160. RETURN
  161. END
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  

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