C PJLIBR    SOURCE    PV        11/03/07    21:17:48     6885           
      SUBROUTINE PJLIBR(IP1,IP2,IP4,IRET )                                      
      IMPLICIT INTEGER(I-N)
      CHARACTER*4 MOT1,MOT2,MOT3,MOT4                                           
      CHARACTER*4 LDUATR(3),LDUARO(3)                                           
      DIMENSION IPLACF(3),IPLACM(3)                                             
C***********************************************************************        
C  CALCUL DES FORCES GENERALISEES DANS LE CAS D'UNE BASE TOURNANTE     *        
C  ET D'UN CHARGEMENT NON LIE A LA BASE ( OPTION LIBR DE PJBA )        *        
C  APPELE PAR PJBA                                                     *        
C***********************************************************************        
C ARGUMENTS                                                            *        
C     ENTREES :                                                        *        
C   -----------                                                        *        
C    IP1 = CHAMPOINT ASSOCIE AU CHARGEMENT(OBJET 'CHPOINT')            *        
C    IP2 = BASE MODALE (OBJET 'BASEMODA')                              *        
C    IP4 = NUMERO DE LA BASE ELEMENTAIRE AFFECTEE (ENTIER)             *        
C     SORTIES :                                                        *        
C   -----------                                                        *        
C    IRET = LISTE DES CHAMPOINTS DE DECOMPOSITION DES FORCES           *        
C           GENERALISEES ( OBJET 'LISTCHPO' )                          *        
C                                                                      *        
C PROGAMMEUR : CHARVET QUEMIN                                          *        
C***********************************************************************        
-INC CCOPTIO                                                                    
-INC SMCHPOI                                                                    
-INC SMLCHPO                                                                    
-INC SMLREEL                                                                    
      SEGMENT ICARA                                                             
      CHARACTER*4 LCARA(NCARA)                                                  
      ENDSEGMENT                                                                
      SEGMENT ILIST                                                             
      INTEGER     LIST(NLIST)                                                   
      ENDSEGMENT                                                                
C                                                                               
      DATA LDUATR/'FX  ','FY  ','FZ  '/                                         
      DATA LDUARO/'MX  ','MY  ','MZ  '/                                         
C                                                                               
      IF(IFOMOD.EQ.0) GOTO 5000                                                 
      DO 1 I=1,3                                                                
      IPLACF(I) = 0                                                             
      IPLACM(I) = 0                                                             
1     CONTINUE                                                                  
C                                                                               
C DESCRIPTION DES COMPOSANTES DU CHAMPOINT IP1                                  
      NBMO = 0                                                                  
      MCHPOI = IP1                                                              
      SEGACT MCHPOI                                                             
      MSOUPO = IPCHP(1)                                                         
      SEGACT MSOUPO                                                             
      SEGDES MCHPOI                                                       
      NDDL = NOCOMP(/2)                                                         
      NCARA = NDDL                                                              
      SEGINI ICARA                                                              
      MOTDDL = ICARA                                                            
      DO 2 I = 1,NDDL                                                           
      MOT1 = NOCOMP(I)                                                          
      LCARA(I) = MOT1                                                           
      DO 3 J = 1,IDIM                                                           
      IF( MOT1.EQ.LDUARO(J) ) THEN                                              
      IPLACM(J) = I                                                             
      NBMO = NBMO + 1                                                           
      GOTO 2                                                                    
      ENDIF                                                                     
      IF( MOT1.EQ.LDUATR(J) ) THEN                                              
      IPLACF(J) = I                                                             
      GOTO 2                                                                    
      ENDIF                                                                     
3     CONTINUE                                                                  
2     CONTINUE                                                                  
      IF( NBMO.NE.0. AND .IDIM.EQ.2 ) GOTO 6000                                 
C                                                                               
C CREATION D'UN CHAMPOINT NUL                                                   
      IPOE = IGEOC                                                              
      SEGDES MSOUPO                                                       
      JG = 1                                                                    
      SEGINI MLREEL                                                             
      PROG(1) = 0.D0                                                            
      IL0 = MLREEL                                                              
      NLIST = NDDL                                                              
      SEGINI ILIST                                                              
      DO 4 I =1,NDDL                                                            
      LIST(I) = IL0                                                             
4     CONTINUE                                                                  
      LIST0 = ILIST                                                             
      CALL MANUC1(IPOE,MOTDDL,LIST0,ICH0)                                       
      ILIST = LIST0                                                             
      SEGSUP ILIST                                                              
      MLREEL= IL0                                                               
      SEGSUP MLREEL                                                             
      ICARA = MOTDDL                                                            
      SEGSUP ICARA                                                              
C                                                                               
      N1 = IDIM * IDIM                                                          
      SEGINI MLCHPO                                                             
C                                                                               
C CALCUL DES CHAMPOINTS DE DECOMPOSITION                                        
      DO 5 I = 1,IDIM                                                           
      MOT2 = LDUATR(I)                                                          
      IF ( NBMO.NE.0. AND .IDIM.EQ.3 ) MOT4 = LDUARO(I)                         
C                                                                               
      DO 6 J = 1,IDIM                                                           
      K = (J-1) * IDIM + I                                                      
      IF(IPLACF(J).EQ.0) THEN                                                   
           CALL COPIE2(ICH0,ICH)                                                
      ELSE                                                                      
           MOT1 = LDUATR(J)                                                     
           CALL EXCOPP (IP1,MOT1,ICH,MOT2,0 )                                   
      ENDIF                                                                     
      IF( IPLACM(J).NE.0) THEN                                                  
           IF ( NBMO.NE.0. AND .IDIM.EQ.3 ) MOT3 = LDUARO(J)                    
           CALL EXCOPP (IP1,MOT3,ICHR,MOT4,0 )                                  
           CALL ADCHPO (ICHR,ICH,ICH2,1D0,-1D0)
           CALL DTCHPO (ICHR)                                                   
           CALL DTCHPO (ICH)                                                    
           CALL COPIE2(ICH2,ICH)                                                
           CALL DTCHPO(ICH2)                                                    
      ENDIF                                                                     
      CALL PROJBA( ICH,IP2,IP4,IRET1 )                                          
      IF ( IRET1 .EQ. 0 ) THEN                                                  
           DO 7 L = 1,N1                                                        
           IRET2 = ICHPOI(L)                                                    
           IF(IRET2.NE.0) CALL DTCHPO(IRET2)                                    
7          CONTINUE                                                             
           SEGSUP MLCHPO                                                        
           CALL DTCHPO (ICH0)                                                   
           RETURN                                                               
      ENDIF                                                                     
      ICHPOI(K) = IRET1                                                         
      CALL DTCHPO(ICH)                                                          
6     CONTINUE                                                                  
5     CONTINUE                                                                  
      IRET = MLCHPO                                                             
      SEGDES MLCHPO                                                             
      CALL DTCHPO(ICH0)                                                         
      RETURN                                                                    
C                                                                               
5000  CONTINUE                                                                  
      WRITE(IOIMP,5001)                                                         
5001  FORMAT(' LE CAS AXISYMETRIQUE N EXISTE PAS ENCORE POUR L OPTION           
     *LIBR DE PJBA ')                                                           
      RETURN                                                                    
6000  CONTINUE                                                                  
      WRITE(IOIMP,6001)                                                         
6001  FORMAT(' LA FORMULATION COQUE PLANE N EXISTE PAS ENCORE POUR L OPT        
     *ION LIBR DE PJBA ')                                                       
      RETURN                                                                    
      END