C SESPC2    SOURCE    FANDEUR   12/11/15    21:15:04     7571           
C SESPA2    SOURCE    CHAT      05/01/13    03:14:36     5004           
C SESPA2    SOURCE    WP        20/08/94
C     SUBROUTINE SESPA2 ( IPLVEC, IPRIGI, IPRIG1 )
************************************************************************
*
*                                SESPC2 inspiré de sespa2
*                             -----------
*
* FONCTION:
* ---------
*
*     CALCULER LA RESTRICTION DE IPRIGI AU LE SOUS-ESPACE IPLVEC.
*
*
* MODE D'APPEL:
*
*     CALL SESPA2 ( IPLVEC, IPRIGI, IPRIG1 )
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
*                            LA SUITE DE 'CHPOINT' X(i)
*
*     IPRIGI  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' K
*     IPRIG1  ENTIER    (E)  POINTEUR SUR L'OBJET 'MATRIX'   K=Xt K X
*
*
*   A.M. JOLIVALT,  W. PASILLAS     12 / 07 / 94.  ( ESOPE )
*
************************************************************

      SUBROUTINE SESPC2 ( IPLVEC, IPRIGI, IPRIG1 )

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

-INC  CCOPTIO
-INC  SMLCHPO
-INC  SMLMOTS
-INC  SMCHPOI

*      SEGMENT ,MATRIX
*        REAL*8 A(N,N)
*      ENDSEGMENT
-INC  SMRIGID

******
*     -- ARGUMENTS --
***
      POINTEUR IPLVEC.MLCHPO
*      POINTEUR IPRIG1.MATRIX
      POINTEUR IPRIG1.XMATRI
      INTEGER  IPRIGI

******
*     -- VARIABLES LOCALES --
***
      INTEGER ILDIM, IB100, IPCHP1, IPCHP2
      REAL*8  XITMXJ


******
*     -- K' = Xt K X --
***
      SEGACT ,IPLVEC
      ILDIM = IPLVEC.ICHPOI(/1)
*      N = ILDIM
      nelrig=1
      NLIGRD = ILDIM
      NLIGRP = ILDIM
      SEGINI ,IPRIG1

      DO 100 IB100 = 1, ILDIM
         IPCHP1 = IPLVEC.ICHPOI( IB100 )
         CALL MUCPRI(IPCHP1,IPRIGI,IPCHP3)
         DO 200 IB200 = 1, ILDIM
            IPCHP2 = IPLVEC.ICHPOI( IB200 )
            IF(IB200.EQ.1.AND.IB100.EQ.1)
     >          CALL CORRSP(iprigi,IPCHP2,IPCHP3,MLMOT1,MLMOT2)
            CALL XTY1 (IPCHP2,IPCHP3,MLMOT1,MLMOT2,  XITMXJ)
            IF ( IERR .NE. 0 ) RETURN
*            IPRIG1.A(IB100,IB200) = XITMXJ
            IPRIG1.RE(IB200,IB100) = XITMXJ
 200     CONTINUE
        CALL DTCHPO(IPCHP3)
 100  CONTINUE
      SEGSUP MLMOT1,MLMOT2
      SEGDES ,IPLVEC
c*      SEGDES,IPRIG1

      RETURN
      END