C INOSC1    SOURCE    CHAT      05/01/13    00:38:32     5004           
CAP +AMAX en argument
      SUBROUTINE INOSC1(IPT,IPG,DFREQ,XSI,RMAX,TMAX,AMAX)
CAP
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
C     =====================================================
C                                                         =
C     CALCUL DU MAXIMUM DE LA REPONSE A UN SIGNAL D'UN    =
C     OSCILLATEUR AVEC CONDITIONS INITIALES EN VITESSE    =
C     ET EN DEPLACEMENT NULLES.                           =
C                                                         =
C     CREATION : 03/06/87                                 =
C     PROGRAMMEUR : MALAVAL                               =
C                                                         =
C     =====================================================
C
-INC CCOPTIO
-INC SMLREEL
-INC CCREEL
      LOGICAL PASCON
      MLREE1=IPT
      SEGACT MLREE1
      MLREE2=IPG
      SEGACT MLREE2
      NN=MLREE1.PROG(/1)
C
C     LE SIGNAL EST-IL A PAS CONSTANT ?
C
      PASCON=.TRUE.
      H=MLREE1.PROG(2)-MLREE1.PROG(1)
      DO 10 J=1,NN-2
      H1=MLREE1.PROG(J+2)-MLREE1.PROG(J+1)
      TEST=H1-H
      IF (TEST.GT.(1.E-6*H)) THEN
      PASCON=.FALSE.
      GOTO 11
      ENDIF
 10   CONTINUE
C
C     CALCUL DE CONSTANTES UTILES
C
 11   W=2*XPI*DFREQ
      W2=W*W
      A=W*SQRT(1-XSI*XSI)
      B=2*XSI/W
      C=(2*XSI*XSI-1)/A
      D=XSI*W
      E=W2/A
      F=D/A
      VITEP=0.D0
      DEPP=0.D0
      RMAX=0.D0
CAP
      ACCP=0.D0
      AMAX=0.D0
CAP
C     TMAX=0.D0
C     CREATION DE LA BOUCLE
C
      S=MLREE2.PROG(1)
      H1=MLREE1.PROG(1)
      DO 100 I=1,NN-1
C
C     DIFFERENCE ENTRE 2 ACCELERATIONS SUCCESSIVES : G
C
      T=MLREE2.PROG(I+1)
      G=T-S
      IF (PASCON.AND.I.NE.1) GOTO 12
C
C     DIFFERENCE ENTRE 2 TEMPS SUCCESSIFS : H
C
      H2=MLREE1.PROG(I+1)
      H=H2-H1
      P=EXP(-D*H)
      WH=A*H
      Q=COS(WH)
      R=SIN(WH)
C
C     CALCUL EXPLICITE DU DEPLACEMENT
C
      PSA=P/A
      UNSW2=1/W2
      QPFR=Q+F*R
*
12    O=G/H
      DEP=PSA*((A*Q+D*R)*DEPP+R*VITEP)
     |+UNSW2*(P*(O*(B*Q+C*R)-S*QPFR)+T-B*O)
      VITEP=PSA*((-W2)*R*DEPP+((-D)*R+A*Q)*
     |VITEP)+UNSW2*(P*((-O)*QPFR+S*E*R)+O)

      DEPP=DEP
CAP
      ACCP=-W2*DEP-2*D*VITEP
      ABSO1=ABS(ACCP)
      IF (ABSO1.GT.AMAX) AMAX=ABSO1
CAP
      ABSO=ABS(DEPP)
      IF (ABSO.GT.RMAX) THEN
           RMAX=ABSO
           TMAX=MLREE1.PROG(I)
      ENDIF
      S=T
      H1=H2
C
100   CONTINUE
      SEGDES MLREE1
      SEGDES MLREE2
      RETURN
      END