C SIMUL6    SOURCE    BP208322  10/11/03    21:15:21     6784           
      SUBROUTINE SIMUL6 (FREQPP,IPVECP,IPSOLU)                                  
************************************************************************        
*                                                                               
*                             S I M U L 6                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     CREATION OU COMPLETION DE L'OBJET "SOLUTION" REPRESENTANT LES             
*     MODES PROPRES CALCULES.                                                   
*     (VIBRATIONS - OPTION SIMULTANE)                                           
*                                                                               
* MODE D'APPEL:                                                                 
* -------------                                                                 
*                                                                               
*     CALL SIMUL6 (FREQPP,IPVECP,IPSOLU)                                        
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
* -----------                                                                   
*                                                                               
*     FREPP   REEL DP   (E)  FREQUENCE PROPRE DU DERNIER MODE CALCULE.          
*     IPVECP  ENTIER    (E)  POINTEUR DU DERNIER VECTEUR PROPRE CALCULE.        
*                       (S)  VECTEUR NORMALISE (PLUS GRANDE VALEUR MISE         
*                            A 1).                                              
*     IPSOLU  ENTIER    (E)  POINTEUR SUR L'OBJET "SOLUTION".                   
*                            = 0  SI CET OBJET N'EST PAS ENCORE CREE.           
*                       (S)  OBJET COMPLETE AVEC LE DERNIER MODE PROPRE         
*                            CALCULE.                                           
*                                                                               
* SOUS-PROGRAMMES APPELES:                                                      
* ------------------------                                                      
*                                                                               
*     DTCHPO, ECROBJ, ECSOLU, FUSOLU, LIROBJ, MANUMO, MOTS1, NORMA1.            
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*     PASCAL MANIGOT     03 JUIN 1985                                           
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*                                                                               
*     FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.                   
*                                                                               
************************************************************************        
*                                                                               
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC SMCHPOI
*                                                                               
      REAL*8 FREQPP                                                             
      CHARACTER*4 MOTCLE                                                        
*                                                                               
*     NORMALISATION                                                                          
*                                                                               
      CALL MOTS1 (IPLMOT,MOTCLE)                                                
      CALL NORMA1 (IPVECP,IPLMOT,MOTCLE,  IPVEC1)                               
      IF (IERR .NE. 0) RETURN                                                   
      CALL DTCHPO (IPVECP)                                                      
      IPVECP = IPVEC1                                                           
*                                                                               
*     ON ATTRIBUT UNE NATURE DIFFUSE A PRIORI                                                                       
* "les chpo contenus dans les objets de type solution sont diffus" [ENPAPF.eso]
*                                         
      MCHPOI=IPVECP
      segact,MCHPOI*mod
      JATTRI(1)=1
      segdes,MCHPOI
*                                                                               
*     LES VALEURS DE MASSES GEN. ET DEP.GEN. NUM. DE MODE                       
*     SERONT CALCULEES DANS SIMUL7                                              
*                                                                               
      CALL MANUSO('MODE    ',0,FREQPP,0.D0,0.D0,0.D0,0.D0,IPVECP,               
     &0,0,IPMODE)                                                               
*                                                                               
*                                                                               
*     AJOUT A L'ENSEMBLE DES MODES DEJA TROUVES:                                
      IF (IPSOLU .EQ. 0) THEN                                                   
         IPSOLU = IPMODE                                                        
      ELSE                                                                      
         CALL FUSOLU (IPSOLU,IPMODE,  IPSOL1)                                   
         CALL DESOLU (IPMODE)                                                   
         CALL DESOLU (IPSOLU)                                                   
         IPSOLU = IPSOL1                                                        
      END IF                                                                    
*                                                                               
      END