1 : C OSCI SOURCE CHAT 07/10/29 21:25:23 5940 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 36 : CALL LIRMOT(MODOM,LMOT,IPLAC,0) 37 : IF (IPLAC.EQ.0) GOTO 10 38 : C 39 : 5 GOTO (1,2,3,31,32,4),IPLAC 40 : C 41 : 1 CONTINUE 42 : C 43 : C AMORTISSEMENT 44 : C 44 : CALL LIRREE (XSI,1,IRET) 45 : IAMOR=1 46 : GOTO 10 47 : C 48 : 2 CONTINUE 49 : C 50 : C FREQUENCE 51 : C 51 : CALL LIRREE (DFREQ,1,IRET) 52 : IFREQ=1 53 : GOTO 10 54 : C 55 : 3 CONTINUE 56 : C 57 : C TEMPS 58 : C 58 : CALL LIROBJ ('LISTREEL',IPT,1,IRET) 59 : ITEMP=1 60 : GOTO 10 61 : C 62 : 31 CONTINUE 63 : C 64 : C DEPLACEMENT INITIAL 65 : C 65 : CALL LIRREE (XDEP,1,IRET) 66 : IDEPL=1 67 : GOTO 10 68 : C 69 : 32 CONTINUE 70 : C 71 : C VITESSE INITIALE 72 : C 72 : CALL LIRREE (XVIT,1,IRET) 73 : IVITE=1 74 : GOTO 10 75 : C 76 : 4 CONTINUE 77 : C 78 : C COULEURS 79 : C 79 : CALL LIRMOT (NCOUL,NBCOUL,ICOUL1,0) 80 : IF (ICOUL1.EQ.0) ICOUL1=IDCOUL+1 81 : ICOUL1=ICOUL1-1 82 : C 83 : GOTO10 84 : C 85 : 10 CONTINUE 86 : C 87 : IF ( (IAMOR*IFREQ).EQ.0 ) THEN 87 : CALL ERREUR (26) 88 : RETURN 89 : ENDIF 90 : IF (XSI.LT.0.OR.XSI.GE.1) THEN 91 : MOTERR(1:8)='AMORTISS' 92 : REAERR(1)=XSI 93 : REAERR(2)=0. 94 : REAERR(3)=1. 94 : CALL ERREUR(42) 95 : RETURN 96 : ENDIF 97 : IF (IVITE.EQ.0) XVIT=0. 98 : IF (IDEPL.EQ.0) XDEP=0. 99 : C 100 : C TEMPS ET ACCELERATION DE L'OBJET EVOLUTION 101 : C 101 : CALL LIROBJ ('EVOLUTIO',IPOEVO,1,IRET) 102 : MEVOLL=IPOEVO 103 : SEGACT MEVOLL 104 : KEVOLL=IEVOLL(1) 105 : SEGACT KEVOLL 106 : IPTG=IPROGX 107 : IPGG=IPROGY 108 : SEGDES MEVOLL 109 : SEGDES KEVOLL 110 : IF (ITEMP.EQ.0) GOTO 60 111 : C 112 : C APPEL A LA SUBROUTINE D'INTERPOLATION 113 : C 113 : CALL INTE33(IPTG,IPGG,IPT,IPG) 114 : GOTO 70 115 : 60 IPT=IPTG 116 : IPG=IPGG 117 : C 118 : C APPEL A LA SUBROUTINE CONTENANT L'ALGORITHME 119 : C 119 : 70 CALL INOSCI(IPT,IPG,DFREQ,XSI,XDEP,XVIT,IPYD) 120 : C 121 : C CREATION D'UN OBJET EVOLUTION 122 : C 123 : SEGINI KEVOLL 124 : IPROGX=IPT 125 : IPROGY=IPYD 126 : NOMEVX='TEMPS' 127 : TYPX='LISTREEL' 128 : TYPY='LISTREEL' 129 : NOMEVY='DEPLACEMENT' 130 : NUMEVX=ICOUL1 131 : NUMEVY='REEL' 132 : C 133 : C 134 : N=1 135 : SEGINI MEVOLL 136 : IPSOL=MEVOLL 137 : IEVOLL(1)=KEVOLL 138 : TI(1:72)=TITREE 139 : IEVTEX=TI 140 : ITYEVO='REEL' 141 : KEVTEX=TI 142 : SEGDES KEVOLL 143 : SEGDES MEVOLL 144 : C 145 : C 145 : CALL ECROBJ ('EVOLUTIO',IPSOL) 146 : RETURN 147 : END 148 : 149 : 150 : 151 : 152 : 153 : 154 : 155 : 156 : 157 : 158 : 159 :
© Cast3M 2003 - All rights reserved.
Disclaimer