C SESRED    SOURCE    CHAT      05/01/13    03:14:57     5004           
C     SUBROUTINE SESRED ( IPLVEC, IPRIGI, IPMASS, MATRED, IPLMOX )
************************************************************************        
*                                                                               
*                                SESRED                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     CONSTRUIT LA MATRICE REDUITE MATRED DE L'OPERATEUR (K**-1)M SUR LA BASE IPLVEC
*
* MODE D'APPEL:                                 
* -------------
*                                                                               
*     CALL SESRED ( IPLVEC, IPRIGI, IPMASS, MATRED )
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
* -----------                                                                   
*
*     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
*                            LA BASE DE REDUCTION ET D'ITERATIONS
*     IPRIGI  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' K
*     IPMASS  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' M
*     MATRED  ENTIER    (S)  POINTEUR SUR LA MATRICE REDUITE SUR IPLVEC.
*                            ELLE VA SERVIR AUX ITERATIONS
* 
*
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*   C. LE BIDEAU  09 / 2001  ( FORTRAN + ESOPE )                                       
*
***********************************************************************

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

-INC  CCOPTIO
-INC  SMLCHPO
-INC  SMLREEL
                                                 

******
*     -- ARGUMENTS --
***
      POINTEUR IPLVEC.MLCHPO
      INTEGER  IPRIGI, IPMASS

******
*     -- VARIABLES LOCALES --
***
      SEGMENT MATRED
         REAL*8 MATVEC (N, N),MATVE1(N,N), XMAT(N, N)
      END SEGMENT
      POINTEUR IPLCH1.MLCHPO
      INTEGER ILDIM, N       

******
*     INITIALISATIONS                    
***    

      SEGACT ,IPLVEC
      ILDIM = IPLVEC.ICHPOI( /1 )
      N1 = ILDIM
      SEGINI ,IPLCH1
      DO 95 IB95 = 1, ILDIM
         IPCHPO = IPLVEC.ICHPOI(IB95) 
         CALL COPIE2 ( IPCHPO, IPCHP1 )
         IF ( IERR .NE. 0 ) RETURN
         IPLCH1.ICHPOI(IB95)  = IPCHP1
 95   CONTINUE
      SEGDES ,IPLVEC
      SEGACT  MATRED*MOD
      
******
*     CALCUL DES FACTEURS DE LA MATRICE      
***
      DO 100 IB100 = 1, ILDIM
         IPCHPO = IPLCH1.ICHPOI(IB100)
         CALL MTREDU ( IPCHPO, IPRIGI, IPMASS, IPRES)
         
         DO 150 IB150 = 1, ILDIM
            IPCHP1 = IPLCH1.ICHPOI(IB150)
            CALL XTY1 (IPCHP1, IPRES, IPLMOX,
     &           IPLMOX, XRES )
            IF (IERR .NE. 0) RETURN
            
            XMAT(IB150, IB100) = XRES
*            write(6,*)'matrice reduite', xres
 150     CONTINUE
         CALL DTCHPO(IPRES)
 100  CONTINUE     
 
*     ON VIDE LA MEMOIRE
      SEGSUP IPLCH1
      
      END