1 : C RICABL SOURCE CHAT 09/10/09 21:23:08 6519 2 : SUBROUTINE RICABL 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : -INC CCOPTIO 6 : -INC SMELEME 7 : -INC SMRIGID 8 : -INC SMCOORD 9 : SEGMENT ITRA 10 : REAL*8 COR(6),XK(6,6),C(3),D(3),E(3) 11 : ENDSEGMENT 12 : CHARACTER*4 MOTU(3),MOTF(3) 13 : DATA MOTU/'UX ','UY ','UZ '/,MOTF/'FX ','FY ','FZ '/ 13 : CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU) 14 : IF(IERR.NE.0) RETURN 14 : CALL LIRREE(XVAL,1,IRETOU) 15 : IF(IERR.NE.0) RETURN 16 : FE=XVAL 16 : CALL LIRREE(XVAL,1,IRETOU) 17 : IF(IERR.NE.0) RETURN 18 : EPS=XVAL 18 : IF(XVAL.LE.0.) CALL ERREUR(368) 19 : IF(IERR.NE.0) RETURN 20 : SEGACT MELEME 20 : IF(LISOUS(/1).NE.0) CALL ERREUR (369) 21 : IF(IERR.NE.0) RETURN 21 : IF(ITYPEL.NE.2)CALL ERREUR (369) 22 : IF(IERR.NE.0) RETURN 23 : NRIGE=8 24 : NRIGEL=idim +1 25 : SEGINI MRIGID 26 : C 27 : C *** CREATION D'UN NOUVEAU MELEME A 2 POINTS POUR Y APPUYER LA 28 : C *** RIGIDITE PROPRE AU CABLE.ON CALCULE LA RIGIDITE AU FUR ET A 29 : C *** MESURE .ON CREE UN NOUVEAU NOEUD A LA MEME 30 : C *** PLACE QUE LE DEUXIEME ET ON METTRA EN RELATION UNILATERALES 31 : C *** CES DEUX NOEUDS CONFONDUS 32 : C 33 : IFORIG=IFOMOD 34 : IRIGEL(5,1)=NIFOUR 35 : IRIGEL(5,2)=NIFOUR 36 : MTYMAT='RIGIDITE' 37 : COERIG(1)=1.D0 38 : COERIG(2)=1.D0 39 : COERIG(3)=1.D0 40 : if(idim.eq.3)COERIG(4)=1.D0 41 : NBNN=2 42 : NBELEM=NUM(/2) 43 : NLIGRP = IDIM*2 44 : NLIGRD = IDIM*2 45 : SEGINI DESCR 46 : NELRIG=NBELEM 47 : SEGINI xMATRI 48 : NBSOUS=0 49 : NBREF=0 50 : SEGINI IPT1 51 : IRIGEL(1,1)=IPT1 52 : IRIGEL(4,1)=xMATRI 53 : LVAL=10+ ( IDIM-2)* 11 54 : IRIGEL(3,1)=DESCR 55 : LISINC(1)=MOTU(1) 56 : NOELEP(1)=1 57 : NOELED(1)=1 58 : LISDUA(1)=MOTF(1) 59 : LISINC(2)=MOTU(2) 60 : NOELEP(2)=1 61 : NOELED(2)=1 62 : LISDUA(2)=MOTF(2) 63 : IA=2 64 : IF( IDIM.EQ.3) THEN 65 : IA=3 66 : LISINC(3)=MOTU(3) 67 : LISDUA(3)=MOTF(3) 68 : NOELEP(3)=1 69 : NOELED(3)=1 70 : ENDIF 71 : LISINC(IA+1)=MOTU(1) 72 : NOELEP(IA+1)=2 73 : NOELED(IA+1)=2 74 : LISDUA(IA+1)=MOTF(1) 75 : LISINC(IA+2)=MOTU(2) 76 : NOELEP(IA+2)=2 77 : NOELED(IA+2)=2 78 : LISDUA(IA+2)=MOTF(2) 79 : IF( IDIM.EQ.3) THEN 80 : LISINC(6)=MOTU(3) 81 : LISDUA(6)=MOTF(3) 82 : NOELEP(6)=2 83 : NOELED(6)=2 84 : ENDIF 85 : SEGDES DESCR 86 : IPT1.ITYPEL=2 87 : SEGINI ITRA 88 : segact mcoord*mod 89 : C 90 : C *** BOUCLE 1 SUR LES ELEMENTS ON CREE LE MELEME ET ON FAIT LA 91 : C *** RIGIDITE DU CABLE EN TRACTION COMPRESSION 92 : C *** LES CONDITIONS UNILATERALES SERONT FAITES PLUS TARD 93 : 94 : DO 1 I=1,NBELEM 95 : IP=NUM(1,I) 96 : IPT1.NUM(1,I)=IP 97 : IPDE=(IP-1)*( IDIM+1) 98 : COR(1)=XCOOR(IPDE+1) 99 : COR(2)=XCOOR(IPDE+2) 100 : COR(3)=0 101 : IF( IDIM.EQ.3)COR(3)=XCOOR(IPDE+3) 102 : NP=(NUM(2,I)-1)*(IDIM+1) 103 : IPT1.NUM(2,I)=XCOOR(/1)/(IDIM+1) +1 104 : XCOOR(**)= XCOOR(NP+1) 105 : XCOOR(**)=XCOOR(NP+2) 106 : IF(IDIM.EQ.3) XCOOR(**)=XCOOR(NP+3) 107 : COR(4)= XCOOR(NP+1) 108 : COR(5)=XCOOR(NP+2) 109 : COR(6)=0 110 : IF(IDIM.EQ.3)COR(6)=XCOOR(NP+3) 111 : XCOOR(**)=XCOOR(NP+1+IDIM) 112 : X21=COR(4)-COR(1) 113 : Y21=COR(5)-COR(2) 114 : Z21=COR(6)-COR(3) 115 : XL=SQRT(X21*X21+Y21*Y21+Z21*Z21) 116 : C(1)=X21/XL 117 : C(2)=Y21/XL 118 : C(3)=Z21/XL 119 : R=FE/(EPS*XL) 120 : DO 2 K=1,idim 121 : K1=K+idim 122 : DO 2 J=1,idim 123 : J1=J+idim 124 : XK(K,J)=C(K)*R*C(J) 125 : XK(K1,J1)=XK(K,J) 126 : XK(K ,J1)=-XK(K,J) 127 : XK(K1,J )=-XK(K,J) 128 : 2 CONTINUE 129 : KJ=1 130 : * SEGINI XMATRI 131 : * DO 3 K=1,2*IDIM 132 : * KJ=KJ+K-1 133 : * K1=K 134 : * IF(IDIM.EQ.2.AND.K.GT.IDIM) K1=K1+1 135 : * DO 3 J=1,K 136 : * IK=J-1 137 : * J1=J 138 : * IF(IDIM.EQ.2.AND.J.GT.IDIM) J1=J1+1 139 : * RE(KJ+IK)=XK(K1,J1) 140 : * 3 CONTINUE 141 : DO 3 K=1,IDIM*2 142 : DO 3 J=1,IDIM*2 143 : RE(J,K,i)=XK(J,K) 144 : 3 CONTINUE 145 : * SEGDES XMATRI 146 : * IMATTT(I)=XMATRI 147 : 1 CONTINUE 148 : SEGDES xMATRI 149 : C 150 : C **** ON REPREND TOUS LES ELEMENTS POUR CREER LES CONDITIONS 151 : C **** UNILATERALES 152 : C 153 : NLIGRP=IDIM*2 + 2 154 : NLIGRD=IDIM*2 + 2 155 : NBNN=4 156 : SEGINI DESCR 157 : LISINC(1)='LX ' 158 : LISDUA(1)='FLX' 159 : NOELEP(1)=1 160 : NOELED(1)=1 161 : LISINC(2)='LX ' 162 : LISDUA(2)='FLX' 163 : NOELEP(2)=2 164 : NOELED(2)=2 165 : LISINC(3)=MOTU(1) 166 : LISDUA(3)=MOTF(1) 167 : NOELEP(3)=3 168 : NOELED(3)=3 169 : LISINC(4)=MOTU(2) 170 : LISDUA(4)=MOTF(2) 171 : NOELEP(4)=3 172 : NOELED(4)=3 173 : IA=2 174 : IF(IDIM.EQ.3) THEN 175 : LISINC(5)=MOTU(3) 176 : LISDUA(5)=MOTF(3) 177 : NOELEP(5)=3 178 : NOELED(5)=3 179 : IA=3 180 : ENDIF 181 : LISINC(IA+3)=MOTU(1) 182 : LISDUA(IA+3)=MOTF(1) 183 : NOELEP(IA+3)=4 184 : NOELED(IA+3)=4 185 : LISINC(IA+4)=MOTU(2) 186 : LISDUA(IA+4)=MOTF(2) 187 : NOELEP(IA+4)=4 188 : NOELED(IA+4)=4 189 : IF(IDIM.EQ.3) THEN 190 : LISINC(8)=MOTU(3) 191 : LISDUA(8)=MOTF(3) 192 : NOELEP(8)=4 193 : NOELED(8)=4 194 : ENDIF 195 : SEGDES DESCR 196 : IRIGEL(3,2)=DESCR 197 : IRIGEL(3,3)=DESCR 198 : if(idim.eq.3)IRIGEL(3,4)=DESCR 199 : SEGINI xMATRI 200 : IRIGEL(4,2)=xMATRI 201 : SEGINI IPT2 202 : IPT2.ITYPEL=22 203 : IRIGEL(1,2)=IPT2 204 : IRIGEL(5,2)=NIFOUR 205 : IRIGEL(5,3)=NIFOUR 206 : if (idim.eq.3)IRIGEL(5,4)=NIFOUR 207 : IRIGEL(6,2)=1 208 : IRIGEL(6,3)=0 209 : if( idim.eq.3) IRIGEL(6,4)=0 210 : * LVAL=(NLIGRE*NLIGRE+NLIGRE)/2 211 : C 212 : C **** BOUCLE SUR LES ELEMENTS ON CREES IPT2 ET LES RIGIDITES 213 : C 214 : DO 500 JOP=1,idim 215 : IF(JOP.GE.2) THEN 216 : SEGDES xMATRI,IPT2 217 : SEGINI xMATRI,IPT2 218 : IPT2.ITYPEL=22 219 : IRIGEL(1,JOP+1)=IPT2 220 : IRIGEL(4,JOP+1)=xMATRI 221 : ENDIF 222 : DO 50 I=1,NBELEM 223 : I1=NUM(2,I) 224 : I2=IPT1.NUM(2,I) 225 : IL1=XCOOR(/1)/(IDIM+1)+1 226 : IL2=IL1+1 227 : IN1=(I1-1)*(IDIM+1) 228 : IN2=(I2-1)*(IDIM+1) 229 : XCOOR(**)=XCOOR(IN1+1) 230 : XCOOR(**)=XCOOR(IN1+2) 231 : IF(IDIM.EQ.3)XCOOR(**)=XCOOR(IN1+3) 232 : XCOOR(**)=XCOOR(IN1+IDIM+1) 233 : XCOOR(**)=XCOOR(IN2+1) 234 : XCOOR(**)=XCOOR(IN2+2) 235 : IF(IDIM.EQ.3)XCOOR(**)=XCOOR(IN2+3) 236 : XCOOR(**)=XCOOR(IN1+IDIM+1) 237 : IPT2.NUM(1,I)=IL1 238 : IPT2.NUM(2,I)=IL2 239 : IPT2.NUM(3,I)=I1 240 : IPT2.NUM(4,I)=I2 241 : * SEGINI XMATRI 242 : RE(1,1,i)=-1.D0 243 : RE(2,1,i)=1.D0 244 : RE(1,2,i)=1.D0 245 : RE(2,2,i)=-1.D0 246 : IP1=NUM(1,I) 247 : INP1=(IP1-1)*(IDIM+1) 248 : C(1)=XCOOR(IN1+1)-XCOOR(INP1+1) 249 : C(2)=XCOOR(IN1+2)-XCOOR(INP1+2) 250 : C(3)=0.D0 251 : IF(IDIM.EQ.3) C(3)=XCOOR(IN1+3)-XCOOR(INP1+3) 252 : XL= SQRT( C(1)*C(1)+C(2)*C(2)+C(3)*C(3)) 253 : C(1)=C(1)/XL 254 : C(2)=C(2)/XL 255 : C(3)=C(3)/XL 256 : IF(JOP.EQ.2) THEN 257 : D(1)=-C(2) 258 : D(2)=C(1) 259 : D(3)=0.D0 260 : XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3)) 261 : IF(XL.LT.1.D-3) THEN 262 : D(1)=-C(3) 263 : D(2)=0D0 264 : D(3)=C(1) 265 : XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3)) 266 : ENDIF 267 : C(1)=D(1)/XL 268 : C(2)=D(2)/XL 269 : C(3)=D(3)/XL 270 : ENDIF 271 : IF(JOP.EQ.3) THEN 272 : D(1)=-C(2) 273 : D(2)=C(1) 274 : D(3)=0. 275 : XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3)) 276 : IF(XL.LT.1.D-3) THEN 277 : D(1)=-C(3) 278 : D(2)=0. 279 : D(3)=C(1) 280 : XL=SQRT(D(1)*D(1)+D(2)*D(2)+D(3)*D(3)) 281 : ENDIF 282 : D(1)=D(1)/XL 283 : D(2)=D(2)/XL 284 : D(3)=D(3)/XL 285 : E(1)=C(2)*D(3)-C(3)*D(2) 286 : E(2)=C(3)*D(1)-C(1)*D(3) 287 : E(3)=C(1)*D(2)-C(2)*D(1) 288 : C(1)=E(1) 289 : C(2)=E(2) 290 : C(3)=E(3) 291 : ENDIF 292 : RE(3,1,i)=C(1) 293 : RE(3,2,i)=C(1) 294 : RE(1,3,i)=C(1) 295 : RE(2,3,i)=C(1) 296 : RE(4,1,i)=C(2) 297 : RE(4,2,i)=C(2) 298 : RE(1,4,i)=C(2) 299 : RE(2,4,i)=C(2) 300 : IA=4 301 : * IB=15 302 : IF(IDIM.EQ.3) THEN 303 : RE(5,1,i)=C(3) 304 : RE(5,2,i)=C(3) 305 : RE(1,5,i)=C(3) 306 : RE(2,5,i)=C(3) 307 : IA=5 308 : * IB=21 309 : ENDIF 310 : RE(IA+1,1,i)=-C(1) 311 : RE(IA+1,2,i)=-C(1) 312 : RE(1,IA+1,i)=-C(1) 313 : RE(2,IA+1,i)=-C(1) 314 : RE(IA+2,1,i)=-C(2) 315 : RE(IA+2,2,i)=-C(2) 316 : RE(1,IA+2,i)=-C(2) 317 : RE(2,IA+2,i)=-C(2) 318 : IF(IDIM.EQ.3) THEN 319 : RE(IA+3,1,i)=-C(3) 320 : RE(IA+3,2,i)=-C(3) 321 : RE(1,IA+3,i)=-C(3) 322 : RE(2,IA+3,i)=-C(3) 323 : ENDIF 324 : * SEGDES XMATRI 325 : * IMATTT(I)=XMATRI 326 : 50 CONTINUE 327 : 500 CONTINUE 328 : SEGDES MELEME,IPT1,IPT2,xMATRI 329 : SEGDES MRIGID 330 : SEGSUP ITRA 330 : CALL ECROBJ('RIGIDITE',MRIGID) 331 : RETURN 332 : END 333 : 334 :
© Cast3M 2003 - All rights reserved.
Disclaimer