C QULX SOURCE CB215821 20/11/25 13:38:10 10792 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 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