Esope source files

   1 : C DEPGEN    SOURCE    CHAT      05/01/12    22:42:26     5004           
   2 : C                                                                               
   3 :       SUBROUTINE DEPGEN(IPB,IPX,PROPRE,IBBX2,IPLMOX,IPLMOY)                     
   4 : C                                                                               
   5 : C********************************************************************           
   6 : C                                                                               
   7 : C      SBR APPELE PAR ITINV                                                     
   8 : C                                                                               
   9 : C      CALCUL DES DEPLACEMENTS GENERALISES                                      
  10 : C      """""""""""""""""""""""""""""""""""                                      
  11 : C         ECRIT PAR D. BROCHARD   15/06/86                                      
  12 : C                                                                               
  13 : C                                                                               
  14 : C      IPB POINTEUR MASSE                                                       
  15 : C      IPX POINTEUR MODE                                                        
  16 : C      PROPRE VECTEUR DES CARACTERISTIQUES MODALES VOIR ITINV                   
  17 : C      IBBX2 POINTEUR SUR CHAMPONT  M*X                                         
  18 : C      IPLIMO POINTEUR SUR LISTMOTS CONTENANT LES COUPLES UX FX ETC             
  19 : C             POUR APPEL DE XTY1                                                
  20 : C                                                                               
  21 : C      CAS PLAN QX,QY  (QZ=0)                                                   
  22 : C      CAS AXISYMETRIQUE  QX=QY=0  QZ NON NUL)  QZ=QZ                      
  23 : C      FOURIER:                                                                 
  24 : C         N=0  QZ NON NUL QX=QY=0 QZ+QZ                                    
  25 : C         N=1 (HARM.SYM.) QY=QZ=0 QX NON NUL  QX=(QR-QT)                     
  26 : C         N=-1 (HARM.ANTIS.) QX=QZ=0 QY NON NUL QY=(QR+QT)                   
  27 : C                                                                               
  28 : C                                                                               
  29 : C                                                                               
  30 : C      15/05/86                                                                 
  31 : C      ________                                                                 
  32 : C                                                                               
  33 : C      LES CAS N DIFFERENT DE 0 N ONT PU ETRE TESTES CAR LES NUMEROS            
  34 : C      D HARMONIQUE NE SONT PAS STOCKES DANS LES CHAMPS-POINT                   
  35 : C                                                                               
  36 : C      SOUS PROGRAMME APPELANT : ITINV                                          
  37 : C                                                                               
  38 : C      SOUS PROGRAMME APPELE:                                                   
  39 : C         DEPGE1 : CALCUL  DTMU EN TESTANT SI ON EST EN SERIE DE                
  40 : C                  FOURIER OU NON                                               
  41 : C                                                                               
  42 : C********************************************************************           
  43 : C                                                                               
  44 : C                                                                               
  45 :       IMPLICIT INTEGER(I-N)
  46 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  47 :       REAL*8 PROPRE(*)                                                          
  48 : -INC SMCHPOI                                                                    
  49 : -INC SMELEME                                                                    
  50 : -INC CCOPTIO                                                                    
  51 : C                                                                               
  52 :       CHARACTER*4 MOT(3)                                                        
  53 : *                                                                               
  54 : *     ON PREND LE NUMERO D'OPTION DANS LE MCHPOI ,VARIABLE IFOPOI               
  55 : *                                                                               
  56 :       MCHPOI=IPX                                                                
  57 :       SEGACT MCHPOI                                                             
  58 :       IFOU1=IFOPOI                                                              
  59 :       SEGDES MCHPOI                                                       
  60 :       JFOUR=IFOU1+4                                                             
  61 : *                                                                               
  62 : *     IMPRESSIONS                                                               
  63 : *                                                                               
  64 :       IF(IIMPI.EQ.322) WRITE(IOIMP,1000) JFOUR                                  
  65 : 1000  FORMAT(/10X,'SBR DEPGEN  JFOUR',I5)                                       
  66 : *                                                                               
  67 : *     ANCIENNE VERSION     JFOUR=IFOUR+4                                        
  68 : *                                                                               
  69 :       GOTO(200,200,200,210,220,230),JFOUR                                       
  70 : 200   CONTINUE                                                                  
  71 : C                                                                               
  72 : C     CAS PLAN  QX QY    (QZ= 0)                                                
  73 : C                                                                               
  74 :       PROPRE(5)=0.D0                                                            
  75 :       MOT(1)='UX'                                                               
  76 :       MOT(2)='UY'                                                               
  77 :       LMOT=2                                                                    
  78 : 520   DO 500 IMOT=1,LMOT                                                        
  78 :       CALL DEPGE1(IPB,IPX,PROPRE(IMOT+2),MOT(IMOT),IBBX2,IPLMOX,                
  79 :      C IPLMOY)                                                                  
  80 : 500   CONTINUE                                                                  
  81 :       GOTO 999                                                                  
  82 : 210   CONTINUE                                                                  
  83 : C                                                                               
  84 : C     CAS AXISYMETRIQUE  QX=QY=0    QZ                                          
  85 : C                                                                               
  86 :       PROPRE(3)=0.D0                                                            
  87 :       PROPRE(4)=0.D0                                                            
  88 :       MOT(1)='UZ'                                                               
  88 :       CALL DEPGE1(IPB,IPX,PROPRE(5),MOT(1),IBBX2,IPLMOX,IPLMOY)                 
  89 :       PROPRE(5)=PROPRE(5)                                               
  90 :       GOTO 999                                                                  
  91 : 220   CONTINUE                                                                  
  92 : C                                                                               
  93 : C     SERIE DE FOURIER                                                          
  94 : C        N DIFF. 1 ET 0 QX=QY=QZ=0                                              
  95 : C        N =1 QY=QZ=0  QX=QR-QT HARM. SYM.                                      
  96 : C             QX=QZ=0  QY=QR+QT HARM.ANTYS.                                     
  97 : C        N=0  QX=QY=0  QZ NON NUL                                               
  98 : C                                                                               
  99 :       MOT(1)='UX'                                                               
 100 :       MOT(2)='UY'                                                               
 101 :       MOT(3)='UZ'                                                               
 102 :       LMOT=3                                                                    
 103 :       DO 510 IMOT=1,LMOT                                                        
 103 :       CALL DEPGE1(IPB,IPX,PROPRE(2+IMOT),MOT(IMOT),IBBX2,IPLMOX,                
 104 :      C IPLMOY)                                                                  
 105 : 510   CONTINUE                                                                  
 106 :       PROPRE(3)=PROPRE(3)                                                 
 107 :       PROPRE(4)=PROPRE(4)                                                   
 108 :       PROPRE(5)=PROPRE(5)                                                 
 109 :       GOTO 999                                                                  
 110 : 230   CONTINUE                                                                  
 111 : C                                                                               
 112 : C     CAS TRIDIM                                                                
 113 : C                                                                               
 114 :       MOT(1)='UX'                                                               
 115 :       MOT(2)='UY'                                                               
 116 :       MOT(3)='UZ'                                                               
 117 :       LMOT=3                                                                    
 118 :       GOTO 520                                                                  
 119 : 999   CONTINUE                                                                  
 120 :       RETURN                                                                    
 121 :       END                                                                       
 122 :  
 123 :