C DIAGN1    SOURCE    PV        13/02/15    21:15:01     7699           
      SUBROUTINE DIAGN1 (IPRIGI,INFER0)                                         
************************************************************************        
*                                                                               
*                             D I A G N 1                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     EXECUTER LA FONCTION ATTRIBUEE A L'OPERATEUR "DIAGNEG".                   
*                                                                               
* MODE D'APPEL:                                                                 
* -------------                                                                 
*                                                                               
*     CALL DIAGN1 (IPRIGI,INFER0)                                               
*                                                                               
* PARAMETRES:  (E)=ENTREE   (S)=SORTIE                                          
* -----------                                                                   
*                                                                               
*     IPRIGI  ENTIER    (E)  POINTEUR D'UNE 'RIGIDITE'.                         
*     INFER0  ENTIER    (S)  NOMBRE DE TERMES DIAGONAUX NEGATIFS DE LA          
*                            MATRICE DIAGONALE "D" DE LA 'RIGIDITE'             
*                            DECOMPOSEE EN "L.D.LT"                             
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*     PASCAL MANIGOT     8 OCTOBRE 1984                                         
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*                                                                               
*     ESOPE + FORTRAN77                                                         
*                                                                               
************************************************************************        
*                                                                               
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC SMMATRI                                                                    
-INC SMRIGID                                                                    
-INC SMTABLE
* 
      integer insym
      isupt = 0
      insym = 0
      MRIGID = IPRIGI                                                           
      SEGACT,MRIGID 
      isupt = isupeq
*     write (6,*) ' isupeq 1 ',isupeq
      ipoiri = jrcond
      if (ipoiri.ne.0) then
       mrigid = ipoiri
       segact mrigid
       if (isupt.eq.0) isupt = isupeq
*     write (6,*) ' isupoq 2 ',isupeq
      endif
      NRG = IRIGEL(/1)
      NBR = IRIGEL(/2)
      if (nbr.eq.0) then
       infer0 = 0
       segdes mrigid
       return
      endif
      IPMATR = ICHOLE
      IF(NORINC.GT.0  .AND. NORIND.GT.0) THEN
         INSYM = 1
      ENDIF
      IF (NRG.GE.7) THEN
         DO  9 IN = 1,NBR
            IANTI=IRIGEL(7,IN)
            IF(IANTI.GT.0) THEN
               INSYM = 1
            ENDIF
  9      CONTINUE
      ENDIF                                                           
      SEGDES,MRIGID                                                       
*                                                                               
      if (isupt.eq.0) then
      IF (IPMATR .EQ. 0) THEN
        IF (INSYM .EQ. 0) THEN
         CALL TRIANG (mrigid,1D-18)
        ELSE
         CALL ldmt1(mrigid,1d-18)
        ENDIF
         IF (IERR .NE. 0) RETURN                                                
         MRIGID = IPRIGI                                                        
         SEGACT,MRIGID                                                          
         IPMATR = ICHOLE                                                        
         SEGDES,MRIGID                                                    
      END IF                                                                    
*                                                                               
      MMATRI = IPMATR                                                           
      SEGACT,MMATRI                                                             
      INFER0 = INEG                                                             
      SEGDES,MMATRI                                                       
      else
       mtable = isupt
       segact mtable
         CALL ACCTAB(mtable,'ENTIER',13,0.d0,' ',.true.,IP0,
     &                   'ENTIER',infer0,X1,CHARRE,.true.,ITMOD)
**     write (6,*) ' unilateral nbneg ',infer0
       segdes mtable
      endif
*                                                                               
      END