C QULX      SOURCE    CB215821  25/04/23    21:15:35     12247          
      SUBROUTINE QULX
C
C **  BUT : CHERCHER DANS UN CHPOINT TOUS LES MULTIPLICATEURS
C **        QUI SONT REFERENCE PAR UNE MATRICE
C **  UTILE POUR LES APPUIS UNILATERAUX
C
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMRIGID
-INC SMCOORD
-INC SMCHPOI
-INC SMELEME
      SEGMENT TRAV
        INTEGER IP(NIP)
        REAL*8 XP(NIP)
      ENDSEGMENT
      CALL LIROBJ ('RIGIDITE',MRIGID,1,IRETOU)
      IF(IERR.NE.0) RETURN
      CALL LIROBJ ('CHPOINT ',MCHPOI,1,IRETOU)
      IF(IERR.NE.0) RETURN
C
C  **  RECHERCHE DU SOUS CHAMPOINT CONTENANT LES MULTIPLICATEURS
C
      SEGACT MCHPOI
      DO 1 I = 1, IPCHP(/1)
      MSOUPO=IPCHP(I)
      II=I
      SEGACT MSOUPO
      IF(NOCOMP(1).EQ.'LX  ')  GO TO 2
      SEGDES MSOUPO
  1   CONTINUE
      CALL ERREUR (21)
      RETURN
  2   CONTINUE
      NOHA=NOHARM(1)
      IPT1=IGEOC
      MPOVAL=IPOVAL
      SEGACT IPT1,MPOVAL
      NIP=1000
      LIP=0
      SEGINI TRAV
      NNO=IPT1.NUM(/2)
C
C  *** RECHERCHE DES BLOQUAGES, ON REMPLIT AU FUR ET A MESURE IP
C  *** QUI CONTIENDRA LES NUMEROS DE NOEUDS ET XP LES VALEURS
C
      SEGACT MRIGID
      DO 3 I=1,IRIGEL(/2)
      MELEME=IRIGEL(1,I)
      SEGACT MELEME
      IF(ITYPEL.NE.22) GO TO 4
      DO 5 J=1,NUM(/2)
      DO 6 K=1,2
      NN= NUM(K,J)
      DO 7 L=1,NNO
      IF(IPT1.NUM(1,L).EQ.NN) THEN
          IF (NIP-LIP.LT.2) THEN
            NIP=NIP+1000
            SEGADJ TRAV
          ENDIF
          IP(LIP+1)=NN
          XP(LIP+1)=VPOCHA(L,1)
          LIP=LIP+1
      ENDIF
   7  CONTINUE
   6  CONTINUE
   5  CONTINUE
   4  CONTINUE
      SEGDES MELEME
   3  CONTINUE
      SEGDES MRIGID,MCHPOI,MSOUPO,IPT1,MPOVAL
C
C  *** CREATION DU CHPOINT
C
      IF(LIP.EQ.0) THEN
          SEGSUP TRAV
          NSOUPO=0
          NAT=1
          SEGINI MCHPOI
          JATTRI(1)=2
          CALL ECROBJ('CHPOINT ',MCHPOI)
          RETURN
      ENDIF
      NSOUPO=1
      NAT=1
      SEGINI MCHPOI
      JATTRI(1) = 2
      NC=1
      SEGINI MSOUPO
      IPCHP(1)=MSOUPO
      NOCOMP(1)='LX  '
      NOHARM(1)=NOHA
      NBELEM=LIP
      NBNN=1
      NBSOUS=0
      NBREF=0
      N=NBELEM
      SEGINI MELEME
      ITYPEL=1
      SEGINI MPOVAL
      IPOVAL=MPOVAL
      IGEOC=MELEME
      DO 8 I=1,NBELEM
      NUM(1,I)=IP(I)
      VPOCHA(I,1)=XP(I)
   8  CONTINUE
      SEGSUP TRAV
      SEGDES MPOVAL,MELEME,MSOUPO,MCHPOI
      CALL ECROBJ('CHPOINT ',MCHPOI)
      RETURN
      END