C OSCI      SOURCE    OF166741  25/02/20    21:17:24     12165          
      SUBROUTINE OSCI
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      CHARACTER*72 TI
C
C     ========================================================
C                                                            =
C     REPONSE D'UN OSCILLATEUR A UNE EXCITATION DONNEE       =
C                                                            =
C     SYNTAXE : EVOL = OSCI EVOL1   AMOR XSI   FREQ DFREQ    =
C                                                            =
C      (TEMP LTEMP) (DEPL XDEP) (VITE XVIT)  (COUL COOL)     =
C                                                            =
C     CREATION : 03/06/87                                    =
C     PROGRAMMEUR : MALAVAL                                  =
C                                                            =
C     ========================================================
C
-INC CCREEL

-INC PPARAM
-INC CCOPTIO
-INC SMEVOLL
-INC CCGEOME
      CHARACTER*4 MODOM(6)
      DATA MODOM/'AMOR','FREQ','TEMP','DEPL','VITE','COUL'/
      LMOT=6
      ITEMP=0
      IAMOR=0
      IFREQ=0
      IVITE=0
      IDEPL=0
      ICOUL1=IDCOUL
C
C     LECTURE DES MOTS
C
      DO 10 I=1,6
      CALL LIRMOT(MODOM,LMOT,IPLAC,0)
      IF (IPLAC.EQ.0) GOTO 10
C
  5   GOTO (1,2,3,31,32,4),IPLAC
C
  1   CONTINUE
C
C     AMORTISSEMENT
C
      CALL LIRREE (XSI,1,IRET)
      IAMOR=1
      GOTO 10
C
  2   CONTINUE
C
C     FREQUENCE
C
      CALL LIRREE (DFREQ,1,IRET)
      IFREQ=1
      GOTO 10
C
  3   CONTINUE
C
C     TEMPS
C
      CALL LIROBJ ('LISTREEL',IPT,1,IRET)
      ITEMP=1
      GOTO 10
C
  31  CONTINUE
C
C     DEPLACEMENT INITIAL
C
      CALL LIRREE (XDEP,1,IRET)
      IDEPL=1
      GOTO 10
C
  32  CONTINUE
C
C     VITESSE INITIALE
C
      CALL LIRREE (XVIT,1,IRET)
      IVITE=1
      GOTO 10
C
  4   CONTINUE
C
C     COULEURS
C
      CALL LIRMOT (NCOUL,NBCOUL,ICOUL1,0)
      IF (ICOUL1.EQ.0) ICOUL1=IDCOUL+1
      ICOUL1=ICOUL1-1
C
      GOTO10
C
  10  CONTINUE
C
      IF ( (IAMOR*IFREQ).EQ.0 ) THEN
           CALL ERREUR (26)
           RETURN
      ENDIF
      IF (XSI.LT.0.OR.XSI.GE.1) THEN
            MOTERR(1:8)='AMORTISS'
            REAERR(1)=XSI
            REAERR(2)=0.
            REAERR(3)=1.
            CALL ERREUR(42)
            RETURN
      ENDIF
      IF (IVITE.EQ.0) XVIT=0.
      IF (IDEPL.EQ.0) XDEP=0.
C
C     TEMPS ET ACCELERATION DE L'OBJET EVOLUTION
C
      CALL LIROBJ ('EVOLUTIO',IPOEVO,1,IRET)
      MEVOLL=IPOEVO
      SEGACT MEVOLL
      KEVOLL=IEVOLL(1)
      SEGACT KEVOLL
      IPTG=IPROGX
      IPGG=IPROGY
      SEGDES MEVOLL
      SEGDES KEVOLL
      IF (ITEMP.EQ.0) GOTO 60
C
C     APPEL A LA SUBROUTINE D'INTERPOLATION
C
      CALL INTE33(IPTG,IPGG,IPT,IPG)
      GOTO 70
  60  IPT=IPTG
      IPG=IPGG
C
C     APPEL A LA SUBROUTINE CONTENANT L'ALGORITHME
C
  70  CALL INOSCI(IPT,IPG,DFREQ,XSI,XDEP,XVIT,IPYD)
C
C     CREATION D'UN OBJET EVOLUTION
C
      SEGINI KEVOLL
      IPROGX=IPT
      IPROGY=IPYD
      NOMEVX='TEMPS'
      TYPX='LISTREEL'
      TYPY='LISTREEL'
      NOMEVY='DEPLACEMENT'
      NUMEVX=ICOUL1
      NUMEVY='REEL'
C
C
      N=1
      SEGINI MEVOLL
      IPSOL=MEVOLL
      IEVOLL(1)=KEVOLL
      TI(1:72)=TITREE
      IEVTEX=TI
      ITYEVO='REEL'
c       KEVTEX=TI
      KEVTEX='DEPL'
      SEGDES KEVOLL
      SEGDES MEVOLL
C
C
      CALL ECROBJ ('EVOLUTIO',IPSOL)
      RETURN
      END