C SESPC4    SOURCE    CHAT      09/10/09    21:24:22     6519           
C SESPA4    SOURCE    CHAT      05/01/13    03:14:42     5004           
C SESPA4    SOURCE    WP        94/12/07                
C     SUBROUTINE SESPA4 ( IPLVEC, IPMPHI )
************************************************************************        
*                                                                               
*                                SESPC4 inspiré de SESPA4                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*      CALCUL D'UNE APPROXIMATION DES VECTEURS PROPRES, A PARTIR
*      DE LEUR PROJECTION IPMPHI SUR LE SOUS-ESPACE IPLVEC.
*
* MODE D'APPEL:                                 
*                                                                               
*     CALL SESPA4 ( IPLVEC, IPMPHI )
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
* -----------                                                                   
*                                                                               
*     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
*                       (S)  LA SUITE DE 'CHPOINT' X(i)
*
*     IPMPHI  ENTIER    (E)  POINTEUR SUR L'OBJET 'MATRIX'   PHI
*
*
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*   A.M. JOLIVALT,  W. PASILLAS  29 / 07 / 94.    ( ESOPE )                                       
*                                                                               
************************************************************

      SUBROUTINE SESPC4 ( IPLVEC, IPMPHI, ILAMBI )

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC  CCOPTIO
-INC  SMLCHPO

*      SEGMENT ,MATRIX
*        REAL*8 A(N,N)
*      ENDSEGMENT
-INC  SMRIGID
          
******
*     -- ARGUMENTS --
***
      POINTEUR IPLVEC.MLCHPO
*      POINTEUR IPMPHI.MATRIX
      POINTEUR IPMPHI.XMATRI
      POINTEUR ILAMBI.XMATRI


******
*     -- VARIABLES LOCALES --
***
      POINTEUR IPLVE1.MLCHPO
      INTEGER  ILDIM, IPCHP1, IPCHPO, IPCHP2
      REAL*8   ALPHA,XVALPI
      CHARACTER*4 MOTCLE
      LOGICAL  MODC


******
*     -- CHAQUE VECTEUR DE IPLVE1 EST UNE COMBINAISON
*     LINEAIRE DES VECTEURS DE IPLVEC, PONDEREE PAR
*     LES COEFFICIENTS DE IPMPHI --
***
      MODC = .false.
      CALL MOTS1( IPLMOT, MOTCLE )
      N1 = 0
      SEGINI ,IPLVE1

      SEGACT ,IPLVEC ,IPMPHI
      SEGACT ,ILAMBI

      ILDIM = IPLVEC.ICHPOI(/1)
      
***** on construit le IB100^ieme mode ********************************
      DO 100 IB100 = 1, ILDIM
      
         ALPHA  = IPMPHI.RE( 1, IB100,1 )
         IPCHP1 = IPLVEC.ICHPOI( 1 )
         CALL MUCHPO ( IPCHP1, ALPHA, IPCHPO, 1 )
         IF ( IERR .NE. 0 ) RETURN 
         IPLVE1.ICHPOI(**) = IPCHPO  
               
*------  on somme les contributions des vecteurs ib200=1,ildim
         DO 200 IB200 = 2, ILDIM
            ALPHA  = IPMPHI.RE( IB200, IB100,1 )
            IPCHP1 = IPLVE1.ICHPOI( IB100 )
            IPCHP2 = IPLVEC.ICHPOI( IB200 )
            CALL COMBI2 ( IPCHP1, 1.D0, IPCHP2, ALPHA, IPCHPO )
            IF ( IERR .NE. 0 ) RETURN 
            IPLVE1.ICHPOI( IB100 ) = IPCHPO
            CALL DTCHPO ( IPCHP1 )
            IF ( IERR .NE. 0 ) RETURN 
            
 200     CONTINUE

*------- Normalisation
*        on a deja construit les parties Reelles et Imaginaires du vecteur 
         if(MODC) goto 90
         
         XVALPI = ILAMBI.RE(1, IB100,1)
         
         if(XVALPI .eq. 0.D0) then
*        il s agit d un mode Réel'
            MODC = .false.
            call NORMA1( IPCHPO, IPLMOT, MOTCLE, IPCHP1 )
            IPLVE1.ICHPOI( IB100 ) = IPCHP1
            CALL DTCHPO ( IPCHPO )
            
*        il s'agit d'un mode Complexe => on stocke le vecteur Reel, 
*        on calule le vecteur imaginaire, puis on normalise ce vecteur Complexe
*        enfin on les ecrit, avant de passer au(x) suivant(s)
         else
*        il s agit d un mode Complexe'
             MODC = .true. 
             ICHP1R = IPCHPO
         endif
         
         goto 100
         
 90      CONTINUE
         call NORM1C(ICHP1R,IPCHPO,IPLMOT,MOTCLE,ICHP2R,ICHP2I)
         IPLVE1.ICHPOI( IB100 - 1 ) = ICHP2R
         IPLVE1.ICHPOI( IB100     ) = ICHP2I
         MODC = .false.
 
 100  CONTINUE
***** fin de boucle sur les modes ************************************


******
*     -- ON DETRUIT IPLVEC --
***
      DO 300 IB300 = 1, ILDIM
         IPCHPO = IPLVEC.ICHPOI( IB300 )
         CALL DTCHPO( IPCHPO )
         IF ( IERR .NE. 0 ) RETURN 
 300  CONTINUE
      CALL DTLCHP ( IPLVEC )
      IF ( IERR .NE. 0 ) RETURN 
      
******
*     -- ON RETOURNE IPLVEC --
***
      IPLVEC = IPLVE1
      SEGDES ,IPLVEC, IPMPHI
      SEGSUP ,IPMPHI

      RETURN
      END