1 : C QULX SOURCE CHAT 09/10/09 21:22:07 6519 2 : SUBROUTINE QULX 3 : C 4 : C ** BUT : CHERCHER DANS UN CHPOINT TOUS LES MULTIPLICATEURS 5 : C ** QUI SONT REFERENCE PAR UNE MATRICE 6 : C ** UTILE POUR LES APPUIS UNILATERAUX 7 : C 8 : IMPLICIT INTEGER(I-N) 9 : -INC CCOPTIO 10 : -INC SMRIGID 11 : -INC SMCHPOI 12 : -INC SMELEME 13 : SEGMENT TRAV 14 : INTEGER IP(NIP) 15 : REAL*8 XP(NIP) 16 : ENDSEGMENT 16 : CALL LIROBJ ('RIGIDITE',MRIGID,1,IRETOU) 17 : IF(IERR.NE.0) RETURN 17 : CALL LIROBJ ('CHPOINT ',MCHPOI,1,IRETOU) 18 : IF(IERR.NE.0) RETURN 19 : C 20 : C ** RECHERCHE DU SOUS CHAMPOINT CONTENANT LES MULTIPLICATEURS 21 : C 22 : SEGACT MCHPOI 23 : DO 1 I = 1, IPCHP(/1) 24 : MSOUPO=IPCHP(I) 25 : II=I 26 : SEGACT MSOUPO 27 : IF(NOCOMP(1).EQ.'LX ') GO TO 2 28 : SEGDES MSOUPO 29 : 1 CONTINUE 29 : CALL ERREUR (21) 30 : RETURN 31 : 2 CONTINUE 32 : NOHA=NOHARM(1) 33 : IPT1=IGEOC 34 : MPOVAL=IPOVAL 35 : SEGACT IPT1,MPOVAL 36 : NIP=1000 37 : LIP=0 38 : SEGINI TRAV 39 : NNO=IPT1.NUM(/2) 40 : C 41 : C *** RECHERCHE DES BLOQUAGES, ON REMPLIT AU FUR ET A MESURE IP 42 : C *** QUI CONTIENDRA LES NUMEROS DE NOEUDS ET XP LES VALEURS 43 : C 44 : SEGACT MRIGID 45 : DO 3 I=1,IRIGEL(/2) 46 : MELEME=IRIGEL(1,I) 47 : SEGACT MELEME 48 : IF(ITYPEL.NE.22) GO TO 4 49 : DO 5 J=1,NUM(/2) 50 : DO 6 K=1,2 51 : NN= NUM(K,J) 52 : DO 7 L=1,NNO 53 : IF(IPT1.NUM(1,L).EQ.NN) THEN 54 : IF (NIP-LIP.LT.2) THEN 55 : NIP=NIP+1000 56 : SEGADJ TRAV 57 : ENDIF 58 : IP(LIP+1)=NN 59 : XP(LIP+1)=VPOCHA(L,1) 60 : LIP=LIP+1 61 : ENDIF 62 : 7 CONTINUE 63 : 6 CONTINUE 64 : 5 CONTINUE 65 : 4 CONTINUE 66 : SEGDES MELEME 67 : 3 CONTINUE 68 : SEGDES MRIGID,MCHPOI,MSOUPO,IPT1,MPOVAL 69 : C 70 : C *** CREATION DU CHPOINT 71 : C 72 : IF(LIP.EQ.0) THEN 73 : SEGSUP TRAV 74 : NSOUPO=0 75 : NAT=1 76 : SEGINI MCHPOI 77 : JATTRI(1)=2 77 : CALL ECROBJ('CHPOINT ',MCHPOI) 78 : RETURN 79 : ENDIF 80 : NSOUPO=1 81 : NAT=1 82 : SEGINI MCHPOI 83 : JATTRI(1) = 2 84 : NC=1 85 : SEGINI MSOUPO 86 : IPCHP(1)=MSOUPO 87 : NOCOMP(1)='LX ' 88 : NOHARM(1)=NOHA 89 : NBELEM=LIP 90 : NBNN=1 91 : NBSOUS=0 92 : NBREF=0 93 : N=NBELEM 94 : SEGINI MELEME 95 : ITYPEL=1 96 : SEGINI MPOVAL 97 : IPOVAL=MPOVAL 98 : IGEOC=MELEME 99 : DO 8 I=1,NBELEM 100 : NUM(1,I)=IP(I) 101 : VPOCHA(I,1)=XP(I) 102 : 8 CONTINUE 103 : SEGSUP TRAV 104 : SEGDES MPOVAL,MELEME,MSOUPO,MCHPOI 104 : CALL ECROBJ('CHPOINT ',MCHPOI) 105 : RETURN 106 : END 107 : 108 : 109 : 110 : 111 : 112 : 113 : 114 :
© Cast3M 2003 - All rights reserved.
Disclaimer