C DEPGE1    SOURCE    CHAT      05/01/12    22:42:17     5004           
C                                                                               
      SUBROUTINE DEPGE1(IPB,IPX,QI,MOT,IBBX2,IPLMOX,IPLMOY)                     
C                                                                               
C********************************************************************           
C                                                                               
C      SBR APPELE PAR DEPGEN                                                    
C                                                                               
C      CALCUL DES DEPLACEMENTS GENERALISES                                      
C      """""""""""""""""""""""""""""""""""                                      
C         ECRIT PAR D. BROCHARD 15/5/86                                         
C                                                                               
C                                                                               
C      IPB POINTEUR MASSE                                                       
C      IPX POINTEUR MODE                                                        
C      PROPRE VECTEUR DES CARACTERISTIQUES MODALES)                             
C      MOT NOM DE LA COMPOSANTE                                                 
C      IBBX2 POINTEUR SUR CHPO M*X                                              
C      IPLIMO  POINTEUR SUR LIST MOTS  TABLEAU UX FX ... POUR APPEL A           
C              XTY1                                                             
C                                                                               
C      CE SBR CALCULE DTMU                                                      
C      TOUT D ABORD GENERATION  DU VECTEUR U AYANT DES COMPOSANTES              
C      DE VALEUR 1. SUR LES VARIABLES UX UY UZ  OU SUR UR UT DANS               
C      LEC CAS AXI OU FOURIER (1 OU -1 SELON L HARMONIQUE)                      
C                                                                               
C      SBR APPELANT  :  DEPGEN                                                  
C                                                                               
C      SBR APPELE  : YTMX,DTCHPO,PLACE                                          
C                                                                               
C      LE 15/05/86  : OPTION FOURIER N DIFF. 0 NON TESTEE                       
C                     NUMERO D HARMONIQUE NON ECRITE DANS CHAMP POINT           
C                                                                               
C                                                                               
C                                                                               
C      LE 08/07/86  : IFOPOI ET NOHARM CORRECTS SPR. TESTE DANS LE              
C                     CAS FOURIER AVEC UNE SEULE HARMONIQUE. RESTE              
C                     A TESTER LE CAS AXISYMETRIQUE.                            
C                                                                               
C********************************************************************           
C                                                                               
C                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC SMCHPOI                                                                    
-INC SMELEME                                                                    
-INC CCOPTIO                                                                    
      SEGMENT MTRA(NSOUP1)                                                      
C                                                                               
      REAL*8 QI                                                                 
      CHARACTER*4 MOREF(3),MOT,MOT1,MOT2(3),MOT3                                
      DATA MOT2/'UR  ','UT  ','UZ  '/,MOREF/'UX  ','UY  ','UZ  '/               
C                                                                               
C                                                                               
C     EXTRAIRE LA COMPOSANTE DE NOM MOT                                         
C                                                                               
C                                                                               
C                                                                               
      IHARM1=0                                                                  
      MCHPO1=IPX                                                                
      SEGACT MCHPO1                                                             
      IF(MCHPO1.IFOPOI.NE.1)  GOTO 1001                                         
      LMOREF=3                                                                  
      CALL PLACE(MOREF,LMOREF,IMOT,MOT)                                         
      GOTO (1,2,3),IMOT                                                         
1     CONTINUE                                                                  
C                                                                               
C     UX                                                                        
C                                                                               
      IHARM1=1                                                                  
      IDEB=1                                                                    
      IFIN=2                                                                    
      GOTO 1001                                                                 
2     CONTINUE                                                                  
C                                                                               
C     UY                                                                        
C                                                                               
      IHARM1=-1                                                                 
      IDEB=1                                                                    
      IFIN=2                                                                    
      GOTO 1001                                                                 
3     CONTINUE                                                                  
C                                                                               
C     UZ                                                                        
C                                                                               
      IDEB=3                                                                    
      IFIN=3                                                                    
C                                                                               
1001  CONTINUE                                                                  
      NSOUP1=MCHPO1.IPCHP(/1)                                                   
      SEGINI MTRA                                                               
      NSOUPO=0                                                                  
C                                                                               
C     BOUCLE SUR LES SOUS PAQUETS DE MCHPO1                                     
C                                                                               
      IF(MCHPO1.IFOPOI.EQ.1) GOTO 400                                           
      DO 100 IA=1,NSOUP1                                                        
      MSOUP1=MCHPO1.IPCHP(IA)                                                   
      SEGACT MSOUP1                                                             
      NC1=MSOUP1.NOCOMP(/2)                                                     
      DO 110 IB=1,NC1                                                           
      MOT1=MSOUP1.NOCOMP(IB)                                                    
      IF(MOT1.NE.MOT) GOTO 110                                                  
      NSOUPO=NSOUPO+1                                                           
      MTRA(NSOUPO)=MSOUP1                                                       
      GOTO 401                                                                  
  110 CONTINUE                                                                  
401   CONTINUE                                                                  
      SEGDES MSOUP1                                                             
100   CONTINUE                                                                  
      GOTO 500                                                                  
400   CONTINUE                                                                  
      DO 410 IA=1,NSOUP1                                                        
      MSOUP1=MCHPO1.IPCHP(IA)                                                   
      SEGACT MSOUP1                                                             
      NC1=MSOUP1.NOCOMP(/2)                                                     
      DO 112 I=IDEB,IFIN                                                        
      MOT3=MOT2(I)                                                              
      DO 111 IB=1,NC1                                                           
      MOT1=MSOUP1.NOCOMP(IB)                                                    
      IHARM=MSOUP1.NOHARM(IB)                                                   
      IF(MOT1.EQ.MOT3.AND.IHARM.EQ.IHARM1) GOTO 112                             
  111 CONTINUE                                                                  
      GOTO 405                                                                  
  112 CONTINUE                                                                  
      NSOUPO=NSOUPO+1                                                           
      MTRA(NSOUPO)=MSOUP1                                                       
  405 CONTINUE                                                                  
      SEGDES MSOUP1                                                             
  410 CONTINUE                                                                  
C                                                                               
500   CONTINUE                                                                  
C                                                                               
      IF(NSOUPO.EQ.0) GOTO  1000                                                
C                                                                               
      IF(IHARM1.EQ.0) GOTO 300                                                  
C                                                                               
C     CREATION DU CHAMP POINT AYANT SELON LES CAS 1 OU -1 SU UR ET UT           
C        
      NAT=1                                                                       
      SEGINI MCHPOI                                                             
      IFOPOI=MCHPO1.IFOPOI                                                      
      NC=2                                                                      
      DO 130 ISOUP=1,NSOUPO                                                     
      SEGINI MSOUPO                                                             
      IPCHP(ISOUP)=MSOUPO                                                       
      MSOUP1=MTRA(ISOUP)                                                        
      SEGACT MSOUP1                                                             
      IGEOC=MSOUP1.IGEOC                                                        
      NOCOMP(1)=MOT2(1)                                                         
      NOCOMP(2)=MOT2(2)                                                         
      NOHARM(1)=IHARM1                                                          
      NOHARM(2)=IHARM1                                                          
      MPOVA1=MSOUP1.IPOVAL                                                      
      SEGACT MPOVA1                                                             
      N=MPOVA1.VPOCHA(/1)                                                       
      SEGINI MPOVAL                                                             
      IPOVAL=MPOVAL                                                             
      DO 131 I=1,N                                                              
      VPOCHA(I,1)=1.0D0                                                         
      VPOCHA(I,2)=1.0D0                                                         
      IF(IHARM1.EQ.1) VPOCHA(I,2)=-1.0D0                                        
131   CONTINUE                                                                  
      SEGDES MPOVA1,MPOVAL,MSOUP1,MSOUPO                                        
130   CONTINUE                                                                  
      GOTO 310                                                                  
300   NAT=1
      SEGINI MCHPOI                                                             
      IFOPOI=MCHPO1.IFOPOI                                                      
C                                                                               
C     CREATION D UN CHAMP POINT DE VALEUR 1.0 SUR UX OU UY OU UZ                
C                                                                               
      NC=1                                                                      
      DO 120 ISOUP=1,NSOUPO                                                     
      SEGINI MSOUPO                                                             
      IPCHP(ISOUP)=MSOUPO                                                       
      MSOUP1=MTRA(ISOUP)                                                        
      SEGACT MSOUP1                                                             
      IGEOC=MSOUP1.IGEOC                                                        
      NOCOMP(1)=MOT                                                             
      NOHARM(1)=0                                                               
      MPOVA1=MSOUP1.IPOVAL                                                      
      SEGACT MPOVA1                                                             
      N     =MPOVA1.VPOCHA(/1)                                                  
      SEGINI MPOVAL                                                             
      IPOVAL=MPOVAL                                                             
      DO 121 I=1,N                                                              
      VPOCHA(I,1)= 1.D0                                                         
  121 CONTINUE                                                                  
      SEGDES MPOVA1,MPOVAL,MSOUP1,MSOUPO                                        
  120 CONTINUE                                                                  
 310  CONTINUE                                                                  
      IP2=MCHPOI                                                                
      SEGDES MCHPOI                                                             
*                                                                               
      IF(IBBX2.EQ.0) GOTO 2000                                                  
      CALL XTY1(IP2,IBBX2,IPLMOX,IPLMOY,QI)                                     
      GOTO 2001                                                                 
C                                                                               
2000  CALL YTMX(IPX,IP2,IPB,QI)                                                 
2001  CALL DTCHPO(IP2)                                                          
      GOTO  1100                                                                
1000  CONTINUE                                                                  
      QI=0.D0                                                                   
1100  CONTINUE                                                                  
      SEGSUP MTRA                                                               
      SEGDES MCHPO1                                                             
      RETURN                                                                    
      END