C DEVPSM    SOURCE    CHAT      05/01/12    22:47:13     5004           
      SUBROUTINE DEVPSM(ITCHAR,ITBAS,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS)           
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*--------------------------------------------------------------------*          
*                                                                    *          
*     Opérateur DYNE : algorithme de Fu - de Vogelaere               *          
*     ________________________________________________               *          
*                                                                    *          
*     Traitement des pseudo-modes.                                   *          
*                                                                    *          
*     Paramètres:                                                    *          
*                                                                    *          
* e   ITCHAR  Table représentant les chargements                     *          
* e   ITBAS   Table représentant la base modale                      *          
* e   KTLIAB  Segment contenant les liaisons sur base B              *          
* e   KTNUM   Segment contenant les paramètres numériques            *          
* e   KTPHI   Segment des déformées modales                          *          
* es  KTFEX   Segment contenant les chargements libres               *          
* e   REPRIS  Logique indiquant si le calcul est en reprise          *          
*                                                                    *          
*     Auteur, date de création:                                      *          
*                                                                    *          
*     Lionel VIVAN, le 10 avril 1990                                 *          
*                                                                    *          
*--------------------------------------------------------------------*          
*                                                                               
-INC CCOPTIO                                                                    
*                                                                               
      SEGMENT,MTPHI                                                             
         INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) 
         INTEGER IAROTA(NSB)                 
         REAL*8  XPHILB(NSB,NPLSB,NA2,IDIMB)                                    
      ENDSEGMENT                                                                
*                                                                               
      LOGICAL L0,L1,REPRIS                                                      
      CHARACTER*8  TYPRET,CHARRE                                                       
      CHARACTER*40 MOTSOU                                                       
*                                                                               
      MTPHI  = KTPHI                                                            
      NPLB   = IBASB(/1)                                                        
      IF (NPLB.EQ.0) RETURN                                                     
*                                                                               
*     On extrait les chargements de la table                                    
*                                                                               
      TYPRET = ' '                                                              
      CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0,                           
     &            TYPRET,I1,X1,CHARRE,L1,ICHAR1)                                   
      IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN                          
         CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,                       
     &                     'MOT',I1,X1,MOTSOU,L1,IP1)                           
         IF (MOTSOU(1:17).EQ.'ENSEMBLE_DE_BASES') THEN                          
            IBA = 0                                                             
 10         CONTINUE                                                            
            IBA = IBA + 1                                                       
            TYPRET = ' '                                                        
            CALL ACCTAB(ITBAS,'ENTIER',IBA,X0,' ',L0,IP0,                       
     &                          TYPRET,I1,X1,CHARRE,L1,IBBB)                       
            IF (IBBB.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN                      
               TYPRET = ' '                                                     
               CALL ACCTAB(IBBB,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,              
     &                         TYPRET,I1,X1,CHARRE,L1,ITPS)                        
               IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN                   
                  CALL ACCTAB(IBBB,'MOT',I0,X0,'MODES',L0,IP0,                  
     &                           'TABLE',I1,X1,' ',L1,IBAS)                     
                  CALL DEVPS2(ICHAR1,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS,           
     &                        ITPS,IBAS,IBA)                                    
                  IF (IERR.NE.0) RETURN                                         
               ENDIF                                                            
               GOTO 10                                                          
            ENDIF                                                               
         ELSE IF (MOTSOU(1:11).EQ.'BASE_MODALE') THEN                           
            TYPRET = ' '                                                        
            CALL ACCTAB(ITBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,                
     &                       TYPRET,I1,X1,CHARRE,L1,ITPS)                          
            IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN                      
               CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0,                    
     &                         'TABLE',I1,X1,' ',L1,IBAS)                       
               CALL DEVPS2(ICHAR1,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS,              
     &                     ITPS,IBAS,1)                                         
               IF (IERR.NE.0) RETURN                                            
            ENDIF                                                               
         ENDIF                                                                  
      ENDIF                                                                     
*                                                                               
      END