Download inosci.eso

Back to the list

   1 : C INOSCI    SOURCE    CHAT      05/01/13    00:38:39     5004           
   2 :       SUBROUTINE INOSCI(IPT,IPG,DFREQ,XSI,XDEP,XVIT,IPYD)                                 
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   5 : C                                                                               
   6 : C     =====================================================                     
   7 : C                                                         =                     
   8 : C     EXECUTION DU CALCUL DE LA REPONSE A UN SIGNAL D'UN  =                     
   9 : C     OSCILLATEUR AVEC CONDITIONS INITIALES EN VITESSE    =                     
  10 : C     ET EN DEPLACEMENT.                                  =                     
  11 : C                                                         =                     
  12 : C     CREATION : 03/06/87                                 =                     
  13 : C     PROGRAMMEUR : MALAVAL                               =                     
  14 : C                                                         =                     
  15 : C     =====================================================                     
  16 : C                                                                               
  17 : -INC SMLREEL                                                                    
  18 : -INC CCREEL                                                                     
  19 :       LOGICAL PASCON                                                            
  20 :       MLREE1=IPT                                                                
  21 :       SEGACT MLREE1                                                             
  22 :       MLREE2=IPG                                                                
  23 :       SEGACT MLREE2                                                             
  24 :       NN=MLREE1.PROG(/1)                                                        
  25 :       JG=NN                                                                     
  26 :       SEGINI MLREE3                                                             
  27 :       IPYD=MLREE3                                                               
  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 :       MLREE3.PROG(1)=XDEP                                                       
  53 :       VITEP=XVIT                                                                
  54 : C                                                                               
  55 : C     CREATION DE LA BOUCLE                                                     
  56 : C                                                                               
  57 :       S=MLREE2.PROG(1)                                                          
  58 :       H1=MLREE1.PROG(1)                                                         
  59 :       DO 100 I=1,NN-1                                                           
  60 : C                                                                               
  61 : C     DIFFERENCE ENTRE 2 ACCELERATIONS SUCCESSIVES : G                          
  62 : C                                                                               
  63 :       T=MLREE2.PROG(I+1)                                                        
  64 :       G=T-S                                                                     
  65 :       IF (PASCON.AND.I.NE.1) GOTO 12                                            
  66 : C                                                                               
  67 : C     DIFFERENCE ENTRE 2 TEMPS SUCCESSIFS : H                                   
  68 : C                                                                               
  69 :       H2=MLREE1.PROG(I+1)                                                       
  70 :       H=H2-H1                                                                   
  71 :       P=EXP(-D*H)                                                               
  72 :       WH=A*H                                                                    
  73 :       Q=COS(WH)                                                                 
  74 :       R=SIN(WH)                                                                 
  75 : C                                                                               
  76 : C     CALCUL EXPLICITE DU DEPLACEMENT                                           
  77 : C                                                                               
  78 :       PSA=P/A                                                                   
  79 :       UNSW2=1/W2                                                                
  80 :       QPFR=Q+F*R                                                                
  81 : *                                                                               
  82 : 12    O=G/H                                                                     
  83 :       MLREE3.PROG(I+1)=PSA*((A*Q+D*R)*MLREE3.PROG(I)+R*VITEP)                   
  84 :      |+UNSW2*(P*(O*(B*Q+C*R)-S*QPFR)+T-B*O)                                     
  85 :       VITEP=PSA*((-W2)*R*MLREE3.PROG(I)+((-D)*R+A*Q)*                           
  86 :      |VITEP)+UNSW2*(P*((-O)*QPFR+S*E*R)+O)                                      
  87 :       S=T                                                                       
  88 :       H1=H2                                                                     
  89 : *                                                                               
  90 : 100   CONTINUE                                                                  
  91 :       SEGDES MLREE1                                                       
  92 :       SEGDES MLREE2                                                       
  93 :       SEGDES MLREE3                                                             
  94 :       RETURN                                                                    
  95 :       END                                                                       
  96 :  
  97 :  
  98 :  
  99 :  

© Cast3M 2003 - All rights reserved.
Disclaimer