Download inosc1.eso

Back to the list

   1 : C INOSC1    SOURCE    CHAT      05/01/13    00:38:32     5004           
   2 : CAP +AMAX en argument
   3 :       SUBROUTINE INOSC1(IPT,IPG,DFREQ,XSI,RMAX,TMAX,AMAX)
   4 : CAP
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8(A-H,O-Z)
   7 : C
   8 : C     =====================================================
   9 : C                                                         =
  10 : C     CALCUL DU MAXIMUM DE LA REPONSE A UN SIGNAL D'UN    =
  11 : C     OSCILLATEUR AVEC CONDITIONS INITIALES EN VITESSE    =
  12 : C     ET EN DEPLACEMENT NULLES.                           =
  13 : C                                                         =
  14 : C     CREATION : 03/06/87                                 =
  15 : C     PROGRAMMEUR : MALAVAL                               =
  16 : C                                                         =
  17 : C     =====================================================
  18 : C
  19 : -INC CCOPTIO
  20 : -INC SMLREEL
  21 : -INC CCREEL
  22 :       LOGICAL PASCON
  23 :       MLREE1=IPT
  24 :       SEGACT MLREE1
  25 :       MLREE2=IPG
  26 :       SEGACT MLREE2
  27 :       NN=MLREE1.PROG(/1)
  28 : C
  29 : C     LE SIGNAL EST-IL A PAS CONSTANT ?
  30 : C
  31 :       PASCON=.TRUE.
  32 :       H=MLREE1.PROG(2)-MLREE1.PROG(1)
  33 :       DO 10 J=1,NN-2
  34 :       H1=MLREE1.PROG(J+2)-MLREE1.PROG(J+1)
  35 :       TEST=H1-H
  36 :       IF (TEST.GT.(1.E-6*H)) THEN
  37 :       PASCON=.FALSE.
  38 :       GOTO 11
  39 :       ENDIF
  40 :  10   CONTINUE
  41 : C
  42 : C     CALCUL DE CONSTANTES UTILES
  43 : C
  44 :  11   W=2*XPI*DFREQ
  45 :       W2=W*W
  46 :       A=W*SQRT(1-XSI*XSI)
  47 :       B=2*XSI/W
  48 :       C=(2*XSI*XSI-1)/A
  49 :       D=XSI*W
  50 :       E=W2/A
  51 :       F=D/A
  52 :       VITEP=0.D0
  53 :       DEPP=0.D0
  54 :       RMAX=0.D0
  55 : CAP
  56 :       ACCP=0.D0
  57 :       AMAX=0.D0
  58 : CAP
  59 : C     TMAX=0.D0
  60 : C     CREATION DE LA BOUCLE
  61 : C
  62 :       S=MLREE2.PROG(1)
  63 :       H1=MLREE1.PROG(1)
  64 :       DO 100 I=1,NN-1
  65 : C
  66 : C     DIFFERENCE ENTRE 2 ACCELERATIONS SUCCESSIVES : G
  67 : C
  68 :       T=MLREE2.PROG(I+1)
  69 :       G=T-S
  70 :       IF (PASCON.AND.I.NE.1) GOTO 12
  71 : C
  72 : C     DIFFERENCE ENTRE 2 TEMPS SUCCESSIFS : H
  73 : C
  74 :       H2=MLREE1.PROG(I+1)
  75 :       H=H2-H1
  76 :       P=EXP(-D*H)
  77 :       WH=A*H
  78 :       Q=COS(WH)
  79 :       R=SIN(WH)
  80 : C
  81 : C     CALCUL EXPLICITE DU DEPLACEMENT
  82 : C
  83 :       PSA=P/A
  84 :       UNSW2=1/W2
  85 :       QPFR=Q+F*R
  86 : *
  87 : 12    O=G/H
  88 :       DEP=PSA*((A*Q+D*R)*DEPP+R*VITEP)
  89 :      |+UNSW2*(P*(O*(B*Q+C*R)-S*QPFR)+T-B*O)
  90 :       VITEP=PSA*((-W2)*R*DEPP+((-D)*R+A*Q)*
  91 :      |VITEP)+UNSW2*(P*((-O)*QPFR+S*E*R)+O)
  92 : 
  93 :       DEPP=DEP
  94 : CAP
  95 :       ACCP=-W2*DEP-2*D*VITEP
  96 :       ABSO1=ABS(ACCP)
  97 :       IF (ABSO1.GT.AMAX) AMAX=ABSO1
  98 : CAP
  99 :       ABSO=ABS(DEPP)
 100 :       IF (ABSO.GT.RMAX) THEN
 101 :            RMAX=ABSO
 102 :            TMAX=MLREE1.PROG(I)
 103 :       ENDIF
 104 :       S=T
 105 :       H1=H2
 106 : C
 107 : 100   CONTINUE
 108 :       SEGDES MLREE1
 109 :       SEGDES MLREE2
 110 :       RETURN
 111 :       END
 112 :  
 113 :  
 114 :  
 115 :  

© Cast3M 2003 - All rights reserved.
Disclaimer