C SESBAS    SOURCE    CHAT      09/10/09    21:24:18     6519           
C     SUBROUTINE SESBAS ( IPLVEC, IPRIGI, IPMASS, IPLPMOX, IPLMOY )
************************************************************************        
*                                                                               
*                                SESBAS                                      
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     CONSTRUIT UNE BASE ORTHONORMEE APRES CHAQUE ITERATION. CELA EST
*     NECESSAIRE CAR LA RIGIDITE N'ETANT PAS SYMETRIQUE, LES VECTEURS PROPRES
*     NE SONT PLUS ORTHOGONAUX. 
*
* MODE D'APPEL:                                 
* -------------
*                                                                               
*     CALL SESBAS ( IPLVEC, IPRIGI, IPMASS )
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
* -----------                                                                   
*
*     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
*                            LE SOUS-ESPACE INITIAL.
*     IPLVEC  ENTIER    (S)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
*
*     IPRIGI  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' K
*     IPMASS  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' M
* 
*
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*   C. LE BIDEAU  09 / 2001  ( FORTRAN + ESOPE )                                       
*
***********************************************************************

      SUBROUTINE SESBAS( IPLVEC, IPRIGI, IPMASS, IPLMOX, IPLMOY)
                      
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC   CCOPTIO
-INC   SMLCHPO
-INC   SMLREEL
-INC   SMCHPOI
-INC   SMRIGID
-INC   CCHAMP

******
*     -- ARGUMENTS --
***
       POINTEUR IPLVEC.MLCHPO
       INTEGER  IPRIGI, IPMASS
            
******
*     -- VARIABLES LOCALES --
***
      POINTEUR IPLCH1.MLCHPO
      INTEGER ILDIM
      
      SEGACT ,IPLVEC*MOD
      ILDIM = IPLVEC.ICHPOI( /1 )
******
*     ON STOCKE LA LISTE EN ENTREE PUIS ON CALCULE
*     L'IMAGE DE LA BASE
***
      N1 = ILDIM
      SEGINI ,IPLCH1
      DO 95 IB95 = 1, ILDIM
         IPCHPO=IPLVEC.ICHPOI(IB95)
         CALL COPIE2(IPCHPO, IPCHP1)
         IPLCH1.ICHPOI(IB95)  = IPCHP1
 95   CONTINUE
******
*     ON ORTHONORMALISE LA BASE
***
      IPCHPO = IPLCH1.ICHPOI(1)
      CALL XTY1 (IPCHPO, IPCHPO,IPLMOX,IPLMOX, XNICHP1)
      XICHP1 = SQRT( ABS(XNICHP1) )
      CALL MUCHPO (IPCHPO, XICHP1, IRES, -1)
      CALL DTCHPO (IPCHPO)
      IPLCH1.ICHPOI(1) = IRES
     
      DO 100 IB100 = 2, ILDIM
      IPCHPO = IPLCH1.ICHPOI(IB100)
        DO 150 IB150 = 1, IB100-1
           IPCHP1 = IPLCH1.ICHPOI(IB150)
           CALL XTY1 (IPCHPO,IPCHP1,IPLMOX,IPLMOX,XNOR)
           CALL MUCHPO (IPCHP1, XNOR, IPRRES, 1)
           
           IF (IB150 .EQ. 1) THEN
              IPSOMM = IPRRES
           ELSE
              CALL ADCHPO (IPRRES, IPSOMM, IPSOM1, 1.D0, 1.D0)
              CALL DTCHPO (IPSOMM)
              IPSOMM = IPSOM1
           END IF
           
 150    CONTINUE
 
        CALL ADCHPO (IPCHPO, IPSOMM, IPSOM2, 1.D0,
     &       -1.D0)
        CALL XTY1 (IPSOM2, IPSOM2, IPLMOX, IPLMOX, XNIPS2)
        XIPS2 = SQRT( ABS(XNIPS2))
        CALL MUCHPO (IPSOM2, XIPS2, IPRES2, -1)
        CALL DTCHPO(IPCHPO)
        IPLCH1.ICHPOI(IB100) = IPRES2
 100  CONTINUE
 
******
*     ON STOCKE LE RESULTAT DANS IPLVEC
***
      DO 1000 IB1000 = 1, ILDIM
         IPCHP1=IPLCH1.ICHPOI(IB1000)
         CALL COPIE2(IPCHP1,IPCHPO)
         IPLVEC.ICHPOI(IB1000) = IPCHPO
 1000 CONTINUE
      SEGSUP IPLCH1
      END