1 : C CALP1 SOURCE KK2000 13/11/08 21:15:08 7860 2 : SUBROUTINE CALP1(IPTR1,IPTR2,IPMODL,LOC,IPTR4) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C 6 : C APPELE PAR CALP 7 : C 8 : C AUTEUR : J.BRUN (AVRIL 90) 9 : C 10 : C PARTIE CALCUL EN PEAU DES CONTRAINTES 11 : C 12 : C----------------------------------------------------------- 13 : C PARAMETRES : 14 : C IPTR1 : POINTEUR SUR UN MCHAML DE TYPE CONTRAINTE 15 : C IPTR2 : POINTEUR SUR UN MCHAML DE TYPE CARACTERISTIQUE 16 : C IPMODL : POINTEUR SUR UN SEGMENT MMODEL 17 : C LOC : MOT CLE SUR 4 CARACTERES 18 : C SUPE PEAU SUP 19 : C MOYE PLAN MOYEN 20 : C INFE PEAU INF 21 : C IPTR4 : POINTEUR SUR UN MCHMAL DU MEME TYPE QUE CELUI D'IPTR1 22 : C (SORTIE) 23 : C 24 : -INC SMMODEL 25 : -INC SMCHAML 26 : -INC SMELEME 27 : -INC CCOPTIO 28 : C -INC CCREEL 29 : -INC CCHAMP 30 : -INC CCGEOME 31 : -INC SMCOORD 32 : -INC SMINTE 33 : C 34 : SEGMENT MPTVAL 35 : INTEGER IPOS(NS) ,NSOF(NS) 36 : INTEGER IVAL(NCOSOU) 37 : CHARACTER*16 TYVAL(NCOSOU) 38 : ENDSEGMENT 39 : C 40 : SEGMENT NOTYPE 41 : CHARACTER*16 TYPE(NBTYPE) 42 : ENDSEGMENT 43 : C 44 : PARAMETER ( NINF=3 ) 45 : INTEGER INFOS(NINF) 46 : CHARACTER*4 LOC 47 : CHARACTER*(NCONCH) CONM 48 : LOGICAL lsupco 49 : 50 : IPTR4 = 0 51 : IF (LOC.EQ.'SUPE') THEN 52 : I_LOC = 1 53 : ELSE IF (LOC.EQ.'MOYE') THEN 54 : I_LOC = 2 55 : ELSE IF (LOC.EQ.'INFE') THEN 56 : I_LOC = 3 57 : ELSE 57 : CALL ERREUR(5) 58 : RETURN 59 : ENDIF 60 : C 61 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES 62 : C 62 : CALL QUESUP(IPMODL,IPTR1,5,0,ISUP1,IRET) 63 : IF (ISUP1.GT.1) RETURN 64 : C 65 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES 66 : C 66 : CALL QUESUP(IPMODL,IPTR2,5,0,ISUP2,IRET1) 67 : IF (ISUP2.GT.1) RETURN 68 : 69 : NHRM=NIFOUR 70 : C 71 : C ACTIVATION DU MODELE 72 : C 73 : MMODEL=IPMODL 74 : SEGACT MMODEL 75 : NSOUS=KMODEL(/1) 76 : C 77 : C CREATION DU MCHELM 78 : C 79 : N1=NSOUS 80 : L1=11 81 : N3=6 82 : SEGINI MCHELM 83 : TITCHE='CONTRAINTES' 84 : IFOCHE=IFOUR 85 : IPTR4=MCHELM 86 : C---------------------------------------------------------- 87 : C TRAITEMENT POUR CHAQUE SOUS ZONE DU MODELE ORIGINE 88 : C 89 : DO 1 NS=1,KMODEL(/1) 90 : C INITIALISATION 91 : IPMING=0 92 : IVASTR=0 93 : IVACAR=0 94 : NSTR=0 95 : NCARA=0 96 : NCARF=0 97 : MOSTRS=0 98 : MOCARA=0 99 : lsupco=.false. 100 : 101 : IMODEL=KMODEL(NS) 102 : SEGACT IMODEL 103 : MELE=NEFMOD 103 : C CALL ELQUOI(MELE,0,5,INFO,IMODEL) 104 : MFR=INFELE(13) 105 : NBPGAU=INFELE(4) 106 : C MINTE=INFELE(11) 107 : MINTE=infmod(7) 108 : NBNN= NBNNE( NUMGEO(MELE)) 109 : IPPORE=0 110 : IF(MFR.EQ.33) IPPORE=NBNN 111 : C SEGSUP INFO 112 : 113 : MELEME=IMAMOD 114 : SEGACT MELEME 115 : NBELEM=NUM(/2) 116 : SEGDES MELEME 117 : IPMAIL=IMAMOD 118 : CONM =CONMOD 119 : IMACHE(NS)=IPMAIL 120 : CONCHE(NS)=CONMOD 121 : C 122 : C COQUE INTEGREE OU PAS ? 123 : C 124 : IF(INFMOD(/1).NE.0)THEN 125 : NPINT=INFMOD(1) 126 : ELSE 127 : NPINT=0 128 : ENDIF 129 : IF (NPINT.NE.0)THEN 130 : MCHEL1=IPTR1 131 : IF (I_LOC.EQ.2) THEN 132 : INF=INFMOD(1) 133 : IF (MOD(INF,2).EQ.0) THEN 133 : CALL ERREUR(722) 134 : RETURN 135 : ENDIF 136 : IENT1=(INFMOD(1)+1)/2 137 : IERR1=0 137 : CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM,IENT1,IERR1) 138 : IF (IERR1.NE.0) GO TO 9990 139 : GO TO 1 140 : ELSE IF (I_LOC.EQ.1) THEN 141 : IENT1=INFMOD(1) 142 : IERR1=0 142 : CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM,IENT1,IERR1) 143 : IF (IERR1.NE.0) GO TO 9990 144 : GO TO 1 145 : ELSE IF (I_LOC.EQ.3) THEN 146 : IERR1=0 146 : CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM, 1,IERR1) 147 : IF (IERR1.NE.0) GO TO 9990 148 : GO TO 1 149 : ENDIF 150 : ENDIF 151 : C 152 : C CREATION DU TABLEAU INFOS 153 : C 153 : CALL IDENT(IPMAIL,CONM,IPTR1,IPTR2,INFOS,IRTD) 154 : IF (IRTD.EQ.0) GOTO 9990 155 : C 156 : INFCHE(NS,1)=1 157 : INFCHE(NS,2)=0 158 : INFCHE(NS,3)=NHRM 159 : INFCHE(NS,4)=MINTE 160 : INFCHE(NS,5)=1 161 : INFCHE(NS,6)=5 162 : C____________________________________________________________________ 163 : C 164 : C RECHERCHE DES NOMS DE COMPOSANTES 165 : C____________________________________________________________________ 166 : C 167 : if(lnomid(4).ne.0) then 168 : nomid=lnomid(4) 169 : segact nomid 170 : mostrs=nomid 171 : nstr=lesobl(/2) 172 : nfac=lesfac(/2) 173 : else 174 : lsupco=.true. 174 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) 175 : endif 176 : C 177 : C VERIFICATION DE LEUR PRESENCE 178 : C____________________________________________________________________ 179 : C 180 : NBTYPE=1 181 : SEGINI NOTYPE 182 : MOTYPE=NOTYPE 183 : TYPE(1)='REAL*8' 183 : CALL KOMCHA(IPTR1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR) 184 : SEGSUP NOTYPE 185 : IF (IERR.NE.0) GOTO 9990 186 : 187 : IPMING=MINTE 188 : SEGACT,MINTE 189 : IF (ISUP1.EQ.1) THEN 189 : CALL VALCHE(IVASTR,NSTR,IPMING,IPPORE) 190 : ENDIF 191 : C 192 : C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER 193 : C 194 : N1PTEL=0 195 : N1EL=0 196 : MPTVAL=IVASTR 197 : DO 110 IO=1,NSTR 198 : MELVAL=IVAL(IO) 199 : N1PTEL=MAX(N1PTEL,VELCHE(/1)) 200 : N1EL =MAX(N1EL ,VELCHE(/2)) 201 : 110 CONTINUE 202 : C NBGSTR=N1PTEL 203 : IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN 204 : N1PTEL=1 205 : ELSE 206 : N1PTEL=NBPGAU 207 : ENDIF 208 : NBPTEL=N1PTEL 209 : NEL=N1EL 210 : C____________________________________________________________________ 211 : C 212 : C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES * 213 : C____________________________________________________________________ 214 : C 215 : NBROBL=0 216 : NBRFAC=0 217 : NOMID =0 218 : NOTYPE=0 219 : C IVECT=0 220 : C 221 : C EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES 222 : C 223 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 224 : NBROBL=1 225 : NBRFAC=1 226 : SEGINI NOMID 227 : LESOBL(1)='EPAI' 228 : LESFAC(1)='EXCE' 229 : 230 : NBTYPE=1 231 : SEGINI NOTYPE 232 : TYPE(1)='REAL*8' 233 : C 234 : C CARACTERISTIQUES POUR LES POUTRES 235 : C 236 : ELSE IF (MFR.EQ.7 ) THEN 237 : NBROBL=5 238 : NBRFAC=1 239 : SEGINI NOMID 240 : LESOBL(1)='INRY' 241 : LESOBL(2)='INRZ' 242 : LESOBL(3)='SECT' 243 : LESOBL(4)='DY ' 244 : LESOBL(5)='DZ ' 245 : LESFAC(1)='TORS' 246 : C 247 : NBTYPE=1 248 : SEGINI NOTYPE 249 : TYPE(1)='REAL*8' 250 : C 251 : C CARACTERISTIQUES POUR LES TUYAUX 252 : C 253 : ELSE IF (MFR.EQ.13) THEN 254 : NBROBL=2 255 : NBRFAC=2 256 : SEGINI NOMID 257 : LESOBL(1)='EPAI' 258 : LESOBL(2)='RAYO' 259 : LESFAC(1)='RACO' 260 : LESFAC(2)='PRES' 261 : 262 : NBTYPE=1 263 : SEGINI NOTYPE 264 : TYPE(1)='REAL*8' 265 : ENDIF 266 : 267 : MOCARA=NOMID 268 : MOTYPE=NOTYPE 269 : NCARA=NBROBL 270 : NCARF=NBRFAC 271 : NCARR=NCARA+NCARF 272 : 272 : CALL KOMCHA(IPTR2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3, 273 : $ IVACAR) 274 : SEGSUP NOTYPE 275 : IF (IERR.NE.0) GOTO 9990 276 : 277 : IF (ISUP2.EQ.1) THEN 277 : CALL VALCHE(IVACAR,NCARR,IPMING,IPPORE) 278 : ENDIF 279 : N2=6 280 : SEGINI MCHAML 281 : ICHAML(NS)=MCHAML 282 : NOMCHE(1)='SMXX' 283 : TYPCHE(1)='REAL*8' 284 : NOMCHE(2)='SMYY' 285 : TYPCHE(2)='REAL*8' 286 : NOMCHE(3)='SMZZ' 287 : TYPCHE(3)='REAL*8' 288 : NOMCHE(4)='SMXY' 289 : TYPCHE(4)='REAL*8' 290 : NOMCHE(5)='SMYZ' 291 : TYPCHE(5)='REAL*8' 292 : NOMCHE(6)='SMXZ' 293 : TYPCHE(6)='REAL*8' 294 : N2PTEL=0 295 : N2EL=0 296 : 297 : C----------------------------------------------------------- 298 : C CHAQUE MELVAL = COMPOSANTE SELON SIGMA 299 : C 300 : SEGINI MELVA1,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6 301 : IELVAL(1)=MELVA1 302 : IELVAL(2)=MELVA2 303 : IELVAL(3)=MELVA3 304 : IELVAL(4)=MELVA4 305 : IELVAL(5)=MELVA5 306 : IELVAL(6)=MELVA6 307 : 308 : C----------------------------------------------------------- 309 : C BRANCHEMENT SELON ELEMENT FINI 310 : C----------------------------------------------------------- 311 : C COQ3,COQ2,DKT 312 : IF ((MELE.EQ.27).OR.(MELE.EQ.28).OR.(MELE.EQ.44)) GOTO 3000 313 : C POUTRE 314 : IF (MELE.EQ.29) GOTO 2000 315 : C TUYAU 316 : C IF (MELE.EQ.42) GOTO 4000 317 : C COQ4 ,DST 318 : IF (MELE.EQ.49.OR.MELE.EQ.93) GOTO 5000 319 : C----------------------------------------------------------- 320 : C AUCUNE CREATION CAR NE SAIT PAS FAIRE POUR L'ELEMENT 321 : C----------------------------------------------------------- 322 : MOTERR(1:4) =NOMTP(MELE) 323 : MOTERR(5:12)='CALP ' 323 : CALL ERREUR(86) 324 : SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML 325 : GOTO 9990 326 : C----------------------------------------------------------- 327 : C POUTRES + CONTRAINTES 328 : C----------------------------------------------------------- 329 : 2000 CONTINUE 330 : DO 2010 N2=1,NEL 331 : DO 2011 N1=1,NBPTEL 332 : MPTVAL=IVASTR 333 : MELVAL=IVAL(1) 334 : EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 335 : 336 : MELVAL=IVAL(2) 337 : EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 338 : 339 : MELVAL=IVAL(3) 340 : EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 341 : 342 : MELVAL=IVAL(5) 343 : FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 344 : 345 : MELVAL=IVAL(6) 346 : FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 347 : 348 : MPTVAL=IVACAR 349 : 350 : MELVAL=IVAL(3) 351 : SECT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 352 : 353 : MELVAL=IVAL(1) 354 : FINRY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 355 : 356 : MELVAL=IVAL(2) 357 : FINRZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 358 : 359 : MELVAL=IVAL(4) 360 : PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 361 : MELVAL=IVAL(5) 362 : PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 363 : AIRY=SECT 364 : 365 : AIRZ=SECT 366 : 367 : C CALCUL DES CONTRAINTES REELLES 368 : MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ/FINRY) 369 : . -(FLEXZ*PY/FINRZ) 370 : MELVA2.VELCHE(N1,N2)=0. 371 : MELVA3.VELCHE(N1,N2)=0. 372 : MELVA4.VELCHE(N1,N2)=(EFFY/AIRY) 373 : MELVA5.VELCHE(N1,N2)=0. 374 : MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ) 375 : 2011 CONTINUE 376 : 2010 CONTINUE 377 : 378 : SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML 379 : 380 : GOTO 510 381 : 382 : C----------------------------------------------------------- 383 : C COQ2,COQ3,DKT + CONTRAINTES 384 : C----------------------------------------------------------- 385 : 3000 CONTINUE 386 : IF (IFOUR.EQ.2.OR.IFOUR.EQ.1) THEN 387 : DO 3010 N2=1,NEL 388 : DO 3011 N1=1,NBPTEL 389 : 390 : MPTVAL=IVASTR 391 : 392 : MELVAL=IVAL(1) 393 : AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 394 : 395 : MELVAL=IVAL(2) 396 : AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 397 : 398 : MELVAL=IVAL(3) 399 : AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 400 : 401 : MELVAL=IVAL(4) 402 : AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 403 : 404 : MELVAL=IVAL(5) 405 : AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 406 : 407 : MELVAL=IVAL(6) 408 : AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 409 : 410 : MPTVAL=IVACAR 411 : 412 : MELVAL=IVAL(1) 413 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 414 : 415 : IF (I_LOC.EQ.3) THEN 416 : r_z = EPAI*EPAI 417 : MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) 418 : MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z) 419 : MELVA3.VELCHE(N1,N2)=0. 420 : MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z) 421 : MELVA5.VELCHE(N1,N2)=0. 422 : MELVA6.VELCHE(N1,N2)=0. 423 : ELSE IF (I_LOC.EQ.1) THEN 424 : r_z = EPAI*EPAI 425 : MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) 426 : MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z) 427 : MELVA3.VELCHE(N1,N2)=0. 428 : MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z) 429 : MELVA5.VELCHE(N1,N2)=0. 430 : MELVA6.VELCHE(N1,N2)=0. 431 : ELSE IF (I_LOC.EQ.2) THEN 432 : MELVA1.VELCHE(N1,N2)=AN11/EPAI 433 : MELVA2.VELCHE(N1,N2)=AN22/EPAI 434 : MELVA3.VELCHE(N1,N2)=0. 435 : MELVA4.VELCHE(N1,N2)=AN12/EPAI 436 : MELVA5.VELCHE(N1,N2)=0. 437 : MELVA6.VELCHE(N1,N2)=0. 438 : ENDIF 439 : 3011 CONTINUE 440 : 3010 CONTINUE 441 : ENDIF 442 : 443 : IF (IFOUR.EQ.0) THEN 444 : DO 3012 N2=1,NEL 445 : DO 3013 N1=1,NBPTEL 446 : 447 : MPTVAL=IVASTR 448 : 449 : MELVAL=IVAL(1) 450 : AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 451 : 452 : MELVAL=IVAL(2) 453 : AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 454 : 455 : MELVAL=IVAL(3) 456 : AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 457 : 458 : MELVAL=IVAL(4) 459 : AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 460 : 461 : MPTVAL=IVACAR 462 : 463 : MELVAL=IVAL(1) 464 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 465 : 466 : IF (I_LOC.EQ.3) THEN 467 : r_z = EPAI*EPAI 468 : MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) 469 : MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z) 470 : MELVA3.VELCHE(N1,N2)=0. 471 : MELVA4.VELCHE(N1,N2)=0. 472 : MELVA5.VELCHE(N1,N2)=0. 473 : MELVA6.VELCHE(N1,N2)=0. 474 : ELSE IF (I_LOC.EQ.1) THEN 475 : r_z = EPAI*EPAI 476 : MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) 477 : MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z) 478 : MELVA3.VELCHE(N1,N2)=0. 479 : MELVA4.VELCHE(N1,N2)=0. 480 : MELVA5.VELCHE(N1,N2)=0. 481 : MELVA6.VELCHE(N1,N2)=0. 482 : ELSE IF (I_LOC.EQ.2) THEN 483 : MELVA1.VELCHE(N1,N2)=AN11/EPAI 484 : MELVA2.VELCHE(N1,N2)=AN22/EPAI 485 : MELVA3.VELCHE(N1,N2)=0. 486 : MELVA4.VELCHE(N1,N2)=0. 487 : MELVA5.VELCHE(N1,N2)=0. 488 : MELVA6.VELCHE(N1,N2)=0. 489 : ENDIF 490 : 3013 CONTINUE 491 : 3012 CONTINUE 492 : ENDIF 493 : 494 : IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN 495 : DO 3014 N2=1,NEL 496 : DO 3015 N1=1,NBPTEL 497 : 498 : MPTVAL=IVASTR 499 : 500 : MELVAL=IVAL(1) 501 : AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 502 : 503 : MELVAL=IVAL(2) 504 : ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 505 : 506 : MELVAL=IVAL(3) 507 : AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 508 : 509 : MELVAL=IVAL(4) 510 : AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 511 : 512 : MPTVAL=IVACAR 513 : 514 : MELVAL=IVAL(1) 515 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 516 : 517 : IF (I_LOC.EQ.3) THEN 518 : r_z = EPAI*EPAI 519 : MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) 520 : MELVA2.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z) 521 : MELVA3.VELCHE(N1,N2)=0. 522 : MELVA4.VELCHE(N1,N2)=0. 523 : MELVA5.VELCHE(N1,N2)=0. 524 : MELVA6.VELCHE(N1,N2)=0. 525 : ELSE IF (I_LOC.EQ.1) THEN 526 : r_z = EPAI*EPAI 527 : MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) 528 : MELVA2.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z) 529 : MELVA3.VELCHE(N1,N2)=0. 530 : MELVA4.VELCHE(N1,N2)=0. 531 : MELVA5.VELCHE(N1,N2)=0. 532 : MELVA6.VELCHE(N1,N2)=0. 533 : ELSE IF (I_LOC.EQ.2) THEN 534 : MELVA1.VELCHE(N1,N2)=AN11/EPAI 535 : MELVA2.VELCHE(N1,N2)=ANZZ/EPAI 536 : MELVA3.VELCHE(N1,N2)=0. 537 : MELVA4.VELCHE(N1,N2)=0. 538 : MELVA5.VELCHE(N1,N2)=0. 539 : MELVA6.VELCHE(N1,N2)=0. 540 : ENDIF 541 : 3015 CONTINUE 542 : 3014 CONTINUE 543 : ENDIF 544 : IF (IFOUR.EQ.-3) THEN 545 : DO 3016 N2=1,NEL 546 : DO 3017 N1=1,NBPTEL 547 : 548 : MPTVAL=IVASTR 549 : 550 : MELVAL=IVAL(1) 551 : AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 552 : 553 : MELVAL=IVAL(2) 554 : ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 555 : 556 : MELVAL=IVAL(3) 557 : AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 558 : 559 : MELVAL=IVAL(4) 560 : AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 561 : 562 : MPTVAL=IVACAR 563 : 564 : MELVAL=IVAL(1) 565 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 566 : 567 : IF (I_LOC.EQ.3) THEN 568 : r_z = EPAI*EPAI 569 : MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) 570 : MELVA2.VELCHE(N1,N2)=0. 571 : MELVA3.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z) 572 : MELVA4.VELCHE(N1,N2)=0. 573 : MELVA5.VELCHE(N1,N2)=0. 574 : MELVA6.VELCHE(N1,N2)=0. 575 : ELSE IF (I_LOC.EQ.1) THEN 576 : r_z = EPAI*EPAI 577 : MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) 578 : MELVA2.VELCHE(N1,N2)=0. 579 : MELVA3.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z) 580 : MELVA4.VELCHE(N1,N2)=0. 581 : MELVA5.VELCHE(N1,N2)=0. 582 : MELVA6.VELCHE(N1,N2)=0. 583 : ELSE IF (I_LOC.EQ.2) THEN 584 : MELVA1.VELCHE(N1,N2)=AN11/EPAI 585 : MELVA2.VELCHE(N1,N2)=0. 586 : MELVA3.VELCHE(N1,N2)=ANZZ/EPAI 587 : MELVA4.VELCHE(N1,N2)=0. 588 : MELVA5.VELCHE(N1,N2)=0. 589 : MELVA6.VELCHE(N1,N2)=0. 590 : ENDIF 591 : 3017 CONTINUE 592 : 3016 CONTINUE 593 : ENDIF 594 : SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML 595 : 596 : GOTO 510 597 : C----------------------------------------------------------- 598 : C TUYAU+CONTRAINTE 599 : C----------------------------------------------------------- 600 : C 4000 CONTINUE 601 : C DO 4010 N2=1,NEL 602 : C DO 4011 N1=1,NBPTEL 603 : C 604 : C MPTVAL=IVASTR 605 : C 606 : C MELVAL=IVAL(1) 607 : C EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 608 : C 609 : C MELVAL=IVAL(2) 610 : C EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 611 : C 612 : C MELVAL=IVAL(3) 613 : C EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 614 : C 615 : C MELVAL=IVAL(4) 616 : C FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 617 : C 618 : C MELVAL=IVAL(5) 619 : C FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 620 : C 621 : C MELVAL=IVAL(6) 622 : C 623 : C FLEXX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 624 : C 625 : C MPTVAL=IVACAR 626 : C 627 : C MELVAL=IVAL(1) 628 : C EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 629 : C 630 : C MELVAL=IVAL(2) 631 : C RAYO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 632 : C 633 : C IF(IVECT.EQ.2)THEN 634 : C MELVAL=IVAL(6) 635 : C PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 636 : C MELVAL=IVAL(7) 637 : C PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 638 : C ELSE 639 : C MELVAL=IVAL(5) 640 : C IPO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 640 : C CALL EXCOO1(IPO,PX,PY,PZ,D) 641 : C ENDIF 642 : C RINT=(RAYO-EPAI) 643 : C D1=SQRT((PY**2)+(PZ**2)) 644 : C 645 : C CALCUL DES CONTRAINTES REELLES 646 : C 647 : C FINRY=((RAYO**4)-(RINT**4))*XPI/4 648 : C SECT=XPI*((RAYO**2)-(RINT**2)) 649 : C IF ((D1.GE.RINT).AND.(D1.LE.RAYO)) THEN 650 : C MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ 651 : C . /FINRY)-(FLEXZ*PY/FINRY) 652 : C MELVA2.VELCHE(N1,N2)=0. 653 : C MELVA3.VELCHE(N1,N2)=0. 654 : C MELVA4.VELCHE(N1,N2)=(EFFY/AIRY) 655 : C MELVA5.VELCHE(N1,N2)=(FLEXX/2*XPI*RAYO**2*EPAI) 656 : C MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ) 657 : C ELSE 657 : C CALL ERREUR(505) 658 : C SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML 659 : C GOTO 9990 660 : C ENDIF 661 : C 4011 CONTINUE 662 : C 4010 CONTINUE 663 : C 664 : C SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML 665 : C GOTO 510 666 : C----------------------------------------------------------- 667 : C COQ4 +CONTRAINTE 668 : C----------------------------------------------------------- 669 : 5000 CONTINUE 670 : DO 5010 N2=1,NEL 671 : DO 5011 N1=1,NBPTEL 672 : 673 : MPTVAL=IVASTR 674 : 675 : MELVAL=IVAL(1) 676 : AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 677 : 678 : MELVAL=IVAL(2) 679 : AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 680 : 681 : MELVAL=IVAL(3) 682 : AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 683 : 684 : MELVAL=IVAL(4) 685 : AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 686 : 687 : MELVAL=IVAL(5) 688 : AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 689 : 690 : MELVAL=IVAL(6) 691 : AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 692 : 693 : MELVAL=IVAL(7) 694 : V1=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 695 : 696 : MELVAL=IVAL(8) 697 : V2=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 698 : 699 : MPTVAL=IVACAR 700 : 701 : MELVAL=IVAL(1) 702 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2))) 703 : 704 : IF (I_LOC.EQ.3) THEN 705 : r_z = EPAI*EPAI 706 : MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z) 707 : MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z) 708 : MELVA3.VELCHE(N1,N2)=0. 709 : MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z) 710 : MELVA5.VELCHE(N1,N2)=V1/EPAI 711 : MELVA6.VELCHE(N1,N2)=V2/EPAI 712 : ELSE IF (I_LOC.EQ.1) THEN 713 : r_z = EPAI*EPAI 714 : MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z) 715 : MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z) 716 : MELVA3.VELCHE(N1,N2)=0. 717 : MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z) 718 : MELVA5.VELCHE(N1,N2)=V1/EPAI 719 : MELVA6.VELCHE(N1,N2)=V2/EPAI 720 : ELSE IF (I_LOC.EQ.2) THEN 721 : r_z = EPAI*EPAI 722 : MELVA1.VELCHE(N1,N2)=AN11/EPAI 723 : MELVA2.VELCHE(N1,N2)=AN22/EPAI 724 : MELVA3.VELCHE(N1,N2)=0. 725 : MELVA4.VELCHE(N1,N2)=AN12/EPAI 726 : MELVA5.VELCHE(N1,N2)=V1/EPAI 727 : MELVA6.VELCHE(N1,N2)=V2/EPAI 728 : ENDIF 729 : 5011 CONTINUE 730 : 5010 CONTINUE 731 : 732 : SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML 733 : 734 : 735 : C----------------------------------------------------------- 736 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE NS 737 : C----------------------------------------------------------- 738 : 510 CONTINUE 739 : 740 : SEGDES IMODEL 741 : SEGDES,MINTE 742 : 743 : IF (ISUP1.EQ.1) THEN 743 : CALL DTMVAL(IVASTR,3) 744 : ELSE 744 : CALL DTMVAL(IVASTR,1) 745 : ENDIF 746 : 747 : IF (ISUP2.EQ.1) THEN 747 : CALL DTMVAL(IVACAR,3) 748 : ELSE 748 : CALL DTMVAL(IVACAR,1) 749 : ENDIF 750 : 751 : NOMID=MOSTRS 752 : IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID 753 : NOMID=MOCARA 754 : IF (MOCARA.NE.0) SEGSUP NOMID 755 : 1 CONTINUE 756 : 757 : SEGDES MCHELM,MMODEL 758 : RETURN 759 : C----------------------------------------------------------- 760 : C DESACTIVATION ET RETOUR DANS LE CAS D'ERREUR 761 : C----------------------------------------------------------- 762 : 9990 CONTINUE 763 : 764 : SEGDES,MINTE 765 : IF (ISUP1.EQ.1) THEN 765 : CALL DTMVAL(IVASTR,3) 766 : ELSE 766 : CALL DTMVAL(IVASTR,1) 767 : ENDIF 768 : 769 : IF (ISUP2.EQ.1) THEN 769 : CALL DTMVAL(IVACAR,3) 770 : ELSE 770 : CALL DTMVAL(IVACAR,1) 771 : ENDIF 772 : 773 : NOMID=MOCARA 774 : IF (MOCARA.NE.0) SEGSUP NOMID 775 : NOMID=MOSTRS 776 : IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID 777 : SEGDES MMODEL,IMODEL 778 : SEGSUP MCHELM 779 : 780 : RETURN 781 : END 782 : 783 : 784 : 785 :
© Cast3M 2003 - All rights reserved.
Disclaimer