1 : C REACT1 SOURCE PV 13/04/16 21:15:23 7765 2 : SUBROUTINE REACT1(MRIGID,MCHPOI,MCHPO1) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : -INC SMRIGID 6 : -INC SMELEME 7 : -INC SMCHPOI 8 : -INC CCOPTIO 9 : CHARACTER*72 CTEXT 10 : SEGMENT IGARD(NNOL) 11 : C 12 : C ** ON VERIFIE QUE LE CHPOINT CONTIENT DES MULTIPLICATEURS 13 : C ** EN LEUR ABSENCE ON CREE UN CHPOINT VIDE 14 : C 15 : SEGACT MCHPOI 16 : CTEXT = MOCHDE 17 : ITRUC = IFOPOI 18 : DO 500 K=1,IPCHP(/1) 19 : MSOUPO=IPCHP(K) 20 : SEGACT MSOUPO 21 : DO 501 J=1,NOCOMP(/2) 22 : IF(NOCOMP(J).EQ.'LX ') GO TO 502 23 : 501 CONTINUE 24 : SEGDES MSOUPO 25 : 500 CONTINUE 26 : SEGDES MCHPOI 27 : GO TO 288 28 : * 29 : 502 CONTINUE 30 : C DANS UN CHPOINT IL NE PEUT Y AVOIR Q'UNE SEULE PARTIE QUI CONTIENT 31 : C DES MULTIPLICATEURS , ON CREE UN CHPOIN LE CONTENANT 32 : SEGDES MSOUPO 33 : SEGDES MCHPOI 34 : NSOUPO=1 35 : NAT=1 36 : SEGINI MCHPOI 37 : JATTRI(1)=2 38 : IPCHP(1)=MSOUPO 39 : SEGDES MCHPOI 40 : C 41 : C ** TERMINE POUR LE CHPOINT ON PASSE A LA RIGIDITE . ON VEUT 42 : C ** MAINTENANT FABRIQUER UN OBJET RIGIDITE CONTENANT UNIQUEMENT 43 : C ** LES MATRICES DE BLOQUAGE. 44 : C 45 : NRIGEL=0 46 : SEGACT MRIGID 47 : NNR=IRIGEL(/2) 48 : C 49 : C ** BOUCLE 1 SUR LES SOUS OBJETS RIGIDITES POUR COMPTER COMBIEN 50 : C ** DE MATRICES DE BLOQUAGES 51 : C 52 : DO 1 I=1,NNR 53 : DESCR= IRIGEL(3,I) 54 : SEGACT DESCR 55 : NINC=LISINC(/2) 56 : DO 2 J = 1,NINC 57 : IF(LISINC(J).EQ.'LX ') GO TO 3 58 : 2 CONTINUE 59 : SEGDES DESCR 60 : GO TO 1 61 : 3 CONTINUE 62 : NRIGEL=NRIGEL+1 63 : SEGDES DESCR 64 : 1 CONTINUE 65 : C 66 : C ** INITIALISATION DE L'OBJET RIGIDITE 67 : C 68 : IF(NRIGEL.NE.0) GO TO 4 69 : C 70 : C SI RIGIDITE VIDE , ON CREE UN CHPOINT VIDE 71 : C 72 : SEGSUP MCHPOI 73 : SEGDES MRIGID 74 : 288 NSOUPO=0 75 : NAT=1 76 : SEGINI MCHPO1 77 : MCHPO1.JATTRI(1)=2 78 : MCHPO1.IFOPOI=ITRUC 79 : MCHPO1.MOCHDE=CTEXT 80 : MCHPO1.MTYPOI=' ' 81 : SEGDES MCHPO1 82 : RETURN 83 : C 84 : 4 CONTINUE 85 : IA=1 86 : NRIGE= IRIGEL(/1) 87 : SEGINI RI1 88 : DO 10 I=1,NNR 89 : DESCR= IRIGEL(3,I) 90 : SEGACT DESCR 91 : NINC=LISINC(/2) 92 : DO 20 J = 1,NINC 93 : IF(LISINC(J).EQ.'LX ') GO TO 30 94 : 20 CONTINUE 95 : SEGDES DESCR 96 : GO TO 10 97 : 30 CONTINUE 98 : DO 31 L=1,NRIGE 99 : RI1.IRIGEL(L,IA)=IRIGEL(L,I) 100 : 31 CONTINUE 101 : RI1.COERIG(IA)=-COERIG(I) 102 : IA=IA+1 103 : SEGDES DESCR 104 : 10 CONTINUE 105 : SEGDES MRIGID,RI1 105 : CALL MUCPRI(MCHPOI,RI1,IRET) 106 : C 107 : C ** IL FAUT ENLEVER DU CHPOINT LA PARTIE CONCERNANT FLX 108 : C 109 : C ** ON VERIFIE AU PREALABLE QU'IL N'Y A PAS DE MULTIPLICATEURS 110 : C ** DE MULTIPLICATEUR 111 : C 112 : SEGACT RI1 113 : INON=1 114 : DO 40 I=1,RI1.IRIGEL(/2) 115 : DESCR=RI1.IRIGEL(3,I) 116 : SEGACT DESCR 117 : DO 41 J=3,LISINC(/2) 118 : IF( LISINC(J).EQ.'LX ') THEN 119 : INON=0 120 : SEGDES DESCR 121 : GO TO 45 122 : ENDIF 123 : 41 CONTINUE 124 : SEGDES DESCR 125 : 40 CONTINUE 126 : 45 CONTINUE 127 : MCHPOI=IRET 128 : SEGACT MCHPOI 129 : NSOUPO=IPCHP(/1) -INON 130 : NAT=1 131 : SEGINI MCHPO1 132 : MCHPO1.IFOPOI=ITRUC 133 : MCHPO1.MOCHDE=CTEXT 134 : MCHPO1.MTYPOI=' ' 135 : MCHPO1.JATTRI(1)=2 136 : IA=1 137 : DO 60 I=1,NSOUPO+INON 138 : MSOUPO=IPCHP(I) 139 : SEGACT MSOUPO 140 : IF(NOCOMP(1).EQ.'FLX ') THEN 141 : IF(INON.EQ.0) THEN 142 : MELEME=IGEOC 143 : SEGACT MELEME 144 : NNOL=NUM(/2) 145 : SEGINI IGARD 146 : DO 61 J=1,RI1.IRIGEL(/2) 147 : DESCR= RI1.IRIGEL(3,J) 148 : SEGACT DESCR 149 : DO 62 K=3,LISINC(/2) 150 : IF(LISINC(K).EQ.'LX ') THEN 151 : IPT1=RI1.IRIGEL(1,J) 152 : SEGACT IPT1 153 : DO 63 L=1,IPT1.NUM(/2) 154 : IP=IPT1.NUM(NOELEP(K),L) 155 : DO 64 M=1,NNOL 156 : IF( NUM(1,M).EQ.IP) THEN 157 : IGARD(M)=1 158 : GO TO 63 159 : ENDIF 160 : 64 CONTINUE 161 : 63 CONTINUE 162 : SEGDES IPT1 163 : ENDIF 164 : 62 CONTINUE 165 : SEGDES DESCR 166 : 61 CONTINUE 167 : NBELEM=0 168 : DO 65 J=1,NNOL 169 : NBELEM=NBELEM+IGARD(J) 170 : 65 CONTINUE 171 : NBNN=1 172 : NBSOUS=0 173 : NBREF=0 174 : SEGINI IPT2 175 : IGEOC=IPT2 176 : IB=1 177 : N=NBELEM 178 : NC=1 179 : SEGINI MPOVA1 180 : MPOVAL=IPOVAL 181 : SEGACT MPOVAL 182 : DO 66 J=1,NNOL 183 : IF(IGARD(J).EQ.0) GO TO 66 184 : IPT2.NUM(1,IB)=NUM(1,J) 185 : MPOVA1.VPOCHA(IB,1)=VPOCHA(J,1) 186 : IB=IB+1 187 : 66 CONTINUE 188 : SEGSUP MPOVAL 189 : IPOVAL=MPOVA1 189 : call crech1(ipt2,1) 190 : SEGDES MSOUPO,IPT2,MPOVA1 191 : MCHPO1.IPCHP(IA)=MSOUPO 192 : IA=IA+1 193 : SEGSUP IGARD 194 : ELSE 195 : MELEME=IGEOC 196 : MPOVAL=IPOVAL 197 : SEGSUP MPOVAL,MSOUPO 198 : ENDIF 199 : ELSE 200 : SEGDES MSOUPO 201 : MCHPO1.IPCHP(IA)=MSOUPO 202 : IA=IA+1 203 : ENDIF 204 : 60 CONTINUE 205 : NSOUPO=IA-1 206 : SEGADJ MCHPO1 207 : SEGDES MCHPO1 208 : SEGSUP MCHPOI,RI1 209 : RETURN 210 : END 211 : 212 : 213 : 214 : 215 : 216 : 217 : 218 : 219 :
© Cast3M 2003 - All rights reserved.
Disclaimer