1 : C NLOCSB SOURCE FANDEUR 12/12/21 21:15:05 7629 2 : C_______________________________________________________________________ 3 : C 4 : C CALCUL DE LA MOYENNE NONLOCALE BASEE SUR L'ETAT DE CONTRAINTE 5 : C 6 : C 7 : C Entrees: 8 : C ________ 9 : C 10 : C IPCHI Pointeur sur un MCHAML de ss-type indifferent 11 : C IPLMOT Pointeur sur un LISTMOTS de noms de composante 12 : C 13 : C IPCHCO Pointeur sur un MCHAML de Connectivite 14 : C (ss-type CONNECTIVITE NON LOCAL) 15 : C 16 : C Sorties: 17 : C ________ 18 : C 19 : C IPCHO Pointeur sur un MCHAML de meme ss-type que IPCHI 20 : C avec les composantes IPLMOT moyennees 21 : C les composantes non reconnues dans iplmot sont 22 : C recopiees 23 : C 24 : C IRET 1 ou 0 suivant succes ou pas 25 : C 26 : C 27 : C Appele par: NLOCAL 28 : C ----------- 29 : C 30 : C Appel a: 31 : C -------- 32 : C 33 : C NLOVEP verification et preparation de la moyenne 34 : C TRTRVE point translate 35 : C TRSYPT point symetrique par rapport a un point 36 : C TRSYDR point symetrique par rapport a une droite 37 : C TRSYPL point symetrique par rapport a un plan 38 : C DOXE, JACOBI 39 : C 40 : C C.GIRY F.DUFOUR VERSION PRENANT EN COMPTE L'ETAT DE CONTRAINTE 41 : C SEPTEMBRE 2010 42 : C 43 : C NONLOCAL ORIGINAL 44 : C P.PEGON OCTOBRE 92 D'APRES C. LA BORDERIE AVRIL 1992 D'APRES P. PEGON 45 : C_______________________________________________________________________ 46 : C 47 : SUBROUTINE NLOCSB(IPCHI,IPLMOT,IPCHCO, IPCHO, IRET) 48 : 49 : IMPLICIT INTEGER(I-N) 50 : IMPLICIT REAL*8(A-H,O-Z) 51 : C 52 : -INC CCOPTIO 53 : C 54 : -INC SMMODEL 55 : -INC SMELEME 56 : -INC SMCOORD 57 : -INC SMCHAML 58 : -INC SMLENTI 59 : -INC SMLREEL 60 : -INC SMLMOTS 61 : -INC SMINTE 62 : 63 : SEGMENT,WRK1 64 : REAL*8 XE(3,NBNN) 65 : ENDSEGMENT 66 : * 67 : SEGMENT NLOC1 68 : INTEGER ILOC2 (NZONEF) 69 : END SEGMENT 70 : * 71 : SEGMENT NLOC2 72 : INTEGER MPCHAM (NDOUBL) 73 : INTEGER ILOC4 (NDOUBL) 74 : INTEGER MODLAC,MAILEF,MINTEF 75 : INTEGER MAILAC (NSZACC) 76 : INTEGER MINTAC (NSZACC) 77 : INTEGER ILOC3 (NSZACC) 78 : INTEGER ILOC3I,ILOC3O 79 : INTEGER MELCAR 80 : END SEGMENT 81 : * 82 : SEGMENT NLOC3 83 : INTEGER MELVAC (NCOMP) 84 : END SEGMENT 85 : * 86 : SEGMENT NLOC4 87 : INTEGER JCLE 88 : REAL*8 PT1(3),PT2(3),DISP 89 : INTEGER MELPNI,MELPLI 90 : END SEGMENT 91 : * 92 : SEGMENT,WRK2 93 : REAL*8 XEJ(3,NBNJ),SHP(6,NBNJ) 94 : ENDSEGMENT 95 : * 96 : SEGMENT WRK3 97 : REAL*8 SOMCOM(NCOMP,NBPGAU) 98 : REAL*8 SOMJAC( NBPGAU) 99 : END SEGMENT 100 : * 101 : POINTEUR MLCOMP.MLENTI 102 : POINTEUR MLNIMO.MLENTI 103 : C 104 : DIMENSION XXX(3),XXXJ(3),XXXV1(3),XXXV2(3),XXXV3(3),PTO(3) 105 : C 106 : DATA XMULTL/1.5/ 107 : C 108 : REAL*8 N2VEC2,NVEC2 109 : REAL*8 N2VECPO2,NVECPO2 110 : C 111 : NHRM=NIFOUR 112 : IRET=1 113 : C 114 : C ON VERIFIE/PREPARE LES DONNEES 115 : C 115 : CALL NLOVEP(IPCHCO,IPCHI,IPLMOT, IPCHO,NLOC1, IRET) 116 : IF (IRET.EQ.0) RETURN 117 : C 118 : C ON TRAITE L'INFORMATION 119 : C 120 : C BOUCLE SUR LES ZONES EFFECTIVES 121 : C 122 : NZONEF=ILOC2(/1) 123 : C 124 : DO ISOUCF=1,NZONEF 125 : C 126 : C write(IOIMP,*)'ZONE EFFECTIVE',ISOUCF 127 : NLOC2=ILOC2(ISOUCF) 128 : MINTE1=MINTEF 129 : IPT1=MAILEF 130 : NDOUBL=ILOC4(/1) 131 : NLOC3=ILOC3I 132 : NCOMP=MELVAC(/1) 133 : C 134 : C NOMBRE DE POINTS DE GAUSS PAR ELEMENTS POUR LA SS ZONE A MOYENNER 135 : C 136 : NBPGAU=MINTE1.POIGAU(/1) 137 : C 138 : C NOMBRE D'ELEMENTS ET DE NOEUDS POUR LA SS ZONE A MOYENNER 139 : C 140 : NBELEM=IPT1.NUM(/2) 141 : NBNN =IPT1.NUM(/1) 142 : SEGINI WRK1 143 : SEGINI WRK3 144 : C 145 : C DEBUT DE LA BOUCLE SUR LES ELEMENTS 146 : C 147 : DO IB=1,NBELEM 148 : C write(IOIMP,*)' ELEMENT NUMERO',IB 149 : C 150 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 151 : C 151 : CALL DOXE(XCOOR,IDIM,NBNN,IPT1.NUM,IB,XE) 152 : C 153 : C INITIALISATION DES DIVERSES INTEGRATIONS 154 : C 155 : DO IGAU=1,NBPGAU 156 : SOMJAC(IGAU)=0.D0 157 : DO IE1=1,NCOMP 158 : SOMCOM(IE1,IGAU)=0.D0 159 : END DO 160 : END DO 161 : C 162 : C ON BOUCLE SUR LES DOUBLONS 163 : C 164 : DO IDOUBL=1,NDOUBL 165 : NLOC4=ILOC4(IDOUBL) 166 : ICLE=JCLE 167 : C 168 : C ON RECUPERE LE NUMERO D'ORDRE DES SOUS ZONES ACCESSIBLES 169 : C 170 : MELVAL=MELPNI 171 : MLNIMO=IELCHE(1,IB) 172 : C write(IOIMP,*)' DOUBLON ICLE MLNIMO ',IDOUBL,ICLE,MLNIMO 173 : C 174 : C CET ELEMENT EST IL EN CONNECTIVITE ? 175 : C 176 : IF (MLNIMO.NE.0)THEN 177 : SEGACT,MLNIMO 178 : C 179 : C ON RECUPERE LA LISTE DES ELEMENTS ACCESSIBLES DANS 180 : C LE CHAMELEM DE CONNECTIVITE 181 : C 182 : MELVAL=MELPLI 183 : MLENTI=IELCHE(1,IB) 184 : SEGACT,MLENTI 185 : C 186 : C ON CREE UN MLENT1 QUI PERMETTRA DE TROUVER LE DEBUT DE L'INFORMATION 187 : C CONCERNANT CHAQUE SS ZONE 188 : C 189 : JG=1 190 : SEGINI MLENT1 191 : MLENT1.LECT(1)=1 192 : NSOUSA=MLNIMO.LECT(/1) 193 : IF (NSOUSA.GT.1)THEN 194 : DO IISOUJ=2,NSOUSA 195 : JG=MLENT1.LECT(/1)+1 196 : SEGADJ MLENT1 197 : MLENT1.LECT(JG)=MLENT1.LECT(JG-1)+ 198 : 1 LECT(MLENT1.LECT(JG-1))+1 199 : END DO 200 : ENDIF 201 : C 202 : C DEBUT DE LA BOUCLE SUR LES PTS D'INTEGRATION 203 : C 204 : DO IGAU=1,NBPGAU 205 : C 206 : C ON RECUPERE LA LONGUEUR CARACTERISTIQUE 207 : C 208 : MELVAL=MELCAR 209 : XLONG=VELCHE(MIN(IGAU,VELCHE(/1)),MIN(IB,VELCHE(/2))) 210 : C write(IOIMP,*)' GAUSS-P,XLONG ',IGAU,XLONG 211 : C 212 : C ON CHERCHE LA POSITION ABSOLUE DU POINT D"INTEGRATION 213 : C 214 : DO IE1=1,3 215 : r_z = 0.D0 216 : DO IE2=1,NBNN 217 : r_z=r_z+XE(IE1,IE2)*MINTE1.SHPTOT(1,IE2,IGAU) 218 : END DO 219 : XXX(IE1)=r_z 220 : END DO 221 : C write(IOIMP,*)' XXX ',XXX 222 : C 223 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES ACCESSIBLES 224 : C 225 : DO IISOUJ=1,NSOUSA 226 : IISOUS=MLNIMO.LECT(IISOUJ) 227 : NLOC3=ILOC3(IISOUS) 228 : IPT2=MAILAC(IISOUS) 229 : MINTE2=MINTAC(IISOUS) 230 : C 231 : NBPGAJ=MINTE2.POIGAU(/1) 232 : NBNJ =IPT2.NUM(/1) 233 : C 234 : IG1=MLENT1.LECT(IISOUJ) 235 : NBELEJ=LECT(IG1) 236 : C write(IOIMP,*)' ZONES-AC,IISOUS ',IISOUJ,IISOUS 237 : C 238 : C DEBUT DE LA BOUCLE SUR LES ELEMENTS ACCESSIBLES 239 : C 240 : SEGINI,WRK2 241 : DO IIBJ=1,NBELEJ 242 : IG1=IG1+1 243 : IBJ=LECT(IG1) 244 : C write(IOIMP,*)' ELEMENT_AC ',IBJ 245 : C 246 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IIBJ 247 : C 247 : CALL DOXE(XCOOR,IDIM,NBNJ,IPT2.NUM,IBJ,XEJ) 248 : C 249 : C DEBUT DE LA BOUCLE SUR LES PTS D'INTEGRATION 250 : C 251 : DO IGAUJ=1,NBPGAJ 252 : C 253 : C ON CHERCHE LA POSITION ABSOLUE DU POINT D"INTEGRATION 254 : C 255 : DO IE1=1,3 256 : r_z = 0.D0 257 : DO IE2=1,NBNJ 258 : r_z = r_z + XEJ(IE1,IE2) * 259 : & MINTE2.SHPTOT(1,IE2,IGAUJ) 260 : END DO 261 : XXXJ(IE1)=r_z 262 : END DO 263 : C write(IOIMP,*)' GAUSS-AC ',IGAUJ 264 : C write(IOIMP,*)' XXXJ-AS ',XXXJ 265 : C 266 : C ON TRANSFORME CES COORDONNEES EN FONCTION DES SYMETRIE OU DE LA 267 : C TRANSLATION 268 : C 269 : C+CG 270 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 271 : C 272 : C MODIFICATIONS POUR LA SYMMETRIE 273 : C 274 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 275 : DO IE1=1,3 276 : PTO(IE1)=0.D0 277 : PTO(IE1)=0.D0 278 : PTO(IE1)=0.D0 279 : END DO 280 : DZERO=0.D0 280 : IF(ICLE.EQ.2)CALL TRTRVE(XXXJ,1,PT1 ) 280 : IF(ICLE.EQ.3)CALL TRSYPT(XXXJ,1,PT1 ) 280 : IF(ICLE.EQ.4)CALL TRSYDR(XXXJ,1,PT1,PT2 ) 280 : IF(ICLE.EQ.5)CALL TRSYPL(XXXJ,1,PT1,DISP) 281 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 282 : C write(IOIMP,*)' XXXJ-PS ',XXXJ 283 : C 284 : C ON REMPLIT LES SHP 285 : C 286 : DO IE1=1,6 287 : DO IE2=1,NBNJ 288 : SHP(IE1,IE2)=MINTE2.SHPTOT(IE1,IE2,IGAUJ) 289 : END DO 290 : END DO 291 : C 292 : C ON CALCULE LE JACOBIEN 293 : C 293 : CALL JACOBI(XEJ,SHP,IDIM,NBNJ,DJAC) 294 : C 295 : C ON CALCULE LA VALEUR DE LA GAUSSIENNE 296 : C 297 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 298 : C 299 : C NONLOCAL BASE SUR L'ETAT DE CONTRAINTE 300 : C CG FD 301 : C 302 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 303 : C CHAMP PIC TRACTION FT 304 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 305 : MELVAL=MELVAC(14) 306 : IBMN=MIN(IBJ ,VELCHE(/2)) 307 : IGMN=MIN(IGAUJ,VELCHE(/1)) 308 : FT1 = VELCHE(IGMN,IBMN) 309 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 310 : C CHAMP TAILLE MINIMALE ELEMENT 311 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 312 : MELVAL=MELVAC(15) 313 : IBMN=MIN(IBJ ,VELCHE(/2)) 314 : IGMN=MIN(IGAUJ,VELCHE(/1)) 315 : TAL1 = VELCHE(IGMN,IBMN) 316 : TAI1 = TAL1 317 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 318 : C CONTRAINTE PRINCIPALE I 319 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 320 : MELVAL=MELVAC(2) 321 : IBMN=MIN(IBJ ,VELCHE(/2)) 322 : IGMN=MIN(IGAUJ,VELCHE(/1)) 323 : COEFI=VELCHE(IGMN,IBMN) 324 : COEFIB=FT1*TAI1/XLONG 325 : IF(ABS(COEFI).LE.COEFIB) THEN 326 : COEFI=COEFIB 327 : ENDIF 328 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 329 : C VECTEUR PRINCIPAL I 330 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 331 : MELVAL=MELVAC(5) 332 : IBMN=MIN(IBJ ,VELCHE(/2)) 333 : IGMN=MIN(IGAUJ,VELCHE(/1)) 334 : COX1=VELCHE(IGMN,IBMN) 335 : MELVAL=MELVAC(6) 336 : IBMN=MIN(IBJ ,VELCHE(/2)) 337 : IGMN=MIN(IGAUJ,VELCHE(/1)) 338 : COY1=VELCHE(IGMN,IBMN) 339 : MELVAL=MELVAC(7) 340 : IBMN=MIN(IBJ ,VELCHE(/2)) 341 : IGMN=MIN(IGAUJ,VELCHE(/1)) 342 : COZ1=VELCHE(IGMN,IBMN) 343 : IF(ICLE.EQ.4) THEN 344 : XXXV1(1)=COX1 345 : XXXV1(2)=COY1 346 : XXXV1(3)=COZ1 346 : CALL TRSYDR(XXXV1,1,PTO,PT2) 347 : COX1=XXXV1(1) 348 : COY1=XXXV1(2) 349 : COZ1=XXXV1(3) 350 : ENDIF 351 : IF(ICLE.EQ.5) THEN 352 : XXXV1(1)=COX1 353 : XXXV1(2)=COY1 354 : XXXV1(3)=COZ1 354 : CALL TRSYPL(XXXV1,1,PT1,DZERO) 355 : COX1=XXXV1(1) 356 : COY1=XXXV1(2) 357 : COZ1=XXXV1(3) 358 : ENDIF 359 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 360 : C CONTRAINTE PRINCIPALE II 361 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 362 : MELVAL=MELVAC(3) 363 : IBMN=MIN(IBJ ,VELCHE(/2)) 364 : IGMN=MIN(IGAUJ,VELCHE(/1)) 365 : COEFJ=VELCHE(IGMN,IBMN) 366 : COEFJB=FT1*TAI1/XLONG 367 : IF(ABS(COEFJ).LE.COEFJB) THEN 368 : COEFJ=COEFJB 369 : ENDIF 370 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 371 : C VECTEUR PRINCIPAL II 372 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 373 : MELVAL=MELVAC(8) 374 : IBMN=MIN(IBJ ,VELCHE(/2)) 375 : IGMN=MIN(IGAUJ,VELCHE(/1)) 376 : COX2=VELCHE(IGMN,IBMN) 377 : MELVAL=MELVAC(9) 378 : IBMN=MIN(IBJ ,VELCHE(/2)) 379 : IGMN=MIN(IGAUJ,VELCHE(/1)) 380 : COY2=VELCHE(IGMN,IBMN) 381 : MELVAL=MELVAC(10) 382 : IBMN=MIN(IBJ ,VELCHE(/2)) 383 : IGMN=MIN(IGAUJ,VELCHE(/1)) 384 : COZ2=VELCHE(IGMN,IBMN) 385 : IF(ICLE.EQ.4) THEN 386 : XXXV2(1)=COX2 387 : XXXV2(2)=COY2 388 : XXXV2(3)=COZ2 388 : CALL TRSYDR(XXXV2,1,PTO,PT2) 389 : COX2=XXXV2(1) 390 : COY2=XXXV2(2) 391 : COZ2=XXXV2(3) 392 : ENDIF 393 : IF(ICLE.EQ.5) THEN 394 : XXXV2(1)=COX2 395 : XXXV2(2)=COY2 396 : XXXV2(3)=COZ2 396 : CALL TRSYPL(XXXV2,1,PT1,DZERO) 397 : COX2=XXXV2(1) 398 : COY2=XXXV2(2) 399 : COZ2=XXXV2(3) 400 : ENDIF 401 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 402 : C CONTRAINTE PRINCIPALE III 403 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 404 : MELVAL=MELVAC(4) 405 : IBMN=MIN(IBJ ,VELCHE(/2)) 406 : IGMN=MIN(IGAUJ,VELCHE(/1)) 407 : COEFK=VELCHE(IGMN,IBMN) 408 : COEFKB=FT1*TAI1/XLONG 409 : IF(ABS(COEFK).LE.COEFKB) THEN 410 : COEFK=COEFKB 411 : ENDIF 412 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 413 : C VECTEUR PRINCIPAL III 414 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 415 : MELVAL=MELVAC(11) 416 : IBMN=MIN(IBJ ,VELCHE(/2)) 417 : IGMN=MIN(IGAUJ,VELCHE(/1)) 418 : COX3=VELCHE(IGMN,IBMN) 419 : MELVAL=MELVAC(12) 420 : IBMN=MIN(IBJ ,VELCHE(/2)) 421 : IGMN=MIN(IGAUJ,VELCHE(/1)) 422 : COY3=VELCHE(IGMN,IBMN) 423 : MELVAL=MELVAC(13) 424 : IBMN=MIN(IBJ ,VELCHE(/2)) 425 : IGMN=MIN(IGAUJ,VELCHE(/1)) 426 : COZ3=VELCHE(IGMN,IBMN) 427 : IF(ICLE.EQ.4) THEN 428 : XXXV3(1)=COX3 429 : XXXV3(2)=COY3 430 : XXXV3(3)=COZ3 430 : CALL TRSYDR(XXXV3,1,PTO,PT2) 431 : COX3=XXXV3(1) 432 : COY3=XXXV3(2) 433 : COZ3=XXXV3(3) 434 : ENDIF 435 : IF(ICLE.EQ.5) THEN 436 : XXXV3(1)=COX3 437 : XXXV3(2)=COY3 438 : XXXV3(3)=COZ3 438 : CALL TRSYPL(XXXV3,1,PT1,DZERO) 439 : COX3=XXXV3(1) 440 : COY3=XXXV3(2) 441 : COZ3=XXXV3(3) 442 : ENDIF 443 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 444 : C CALCUL DE L'ANGLE ENTRE U1 ET (X-S)u1u2 445 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 446 : VEC11=((XXX(2)-XXXJ(2))*COZ3)- 447 : 1 ((XXX(3)-XXXJ(3))*COY3) 448 : VEC12=((XXX(3)-XXXJ(3))*COX3)- 449 : 1 ((XXX(1)-XXXJ(1))*COZ3) 450 : VEC13=((XXX(1)-XXXJ(1))*COY3)- 451 : 1 ((XXX(2)-XXXJ(2))*COX3) 452 : VEC21=(COY3*VEC13)- (COZ3*VEC12) 453 : VEC22=(COZ3*VEC11)- (COX3*VEC13) 454 : VEC23=(COX3*VEC12)- (COY3*VEC11) 455 : N2VEC2=(VEC21**2)+(VEC22**2)+(VEC23**2) 456 : NVEC2=SQRT(N2VEC2) 457 : CTETA=((COX1*VEC21)+(COY1*VEC22)+(COZ1*VEC23)) 458 : 1 /(NVEC2 +10.E-10) 459 : STETA=((COX2*VEC21)+(COY2*VEC22)+(COZ2*VEC23)) 460 : 1 /(NVEC2 +10.E-10) 461 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 462 : C CALCUL DE L'ANGLE ENTRE U3 ET (X-S) 463 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 464 : VECPO1=(XXX(1)-XXXJ(1)) 465 : VECPO2=(XXX(2)-XXXJ(2)) 466 : VECPO3=(XXX(3)-XXXJ(3)) 467 : N2VECPO2=(VECPO1**2)+(VECPO2**2)+(VECPO3**2) 468 : NVECPO2=SQRT(N2VECPO2) 469 : CPHI=((COX3*VECPO1)+(COY3*VECPO2)+(COZ3*VECPO3)) 470 : 1 /(NVECPO2 +10.E-10) 471 : SPHI=((VECPO1*VEC21)+(VECPO2*VEC22)+ 472 : 1 (VECPO3*VEC23))/((NVEC2*NVECPO2) +10.E-10) 473 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 474 : C CORRECTION POUR PRENDRE EN COMPTE LE CAS OU SEUL SIGMA1 EST NON 475 : C NUL 476 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 477 : XXLONG1=XLONG*COEFI/FT1 478 : XXLONG2=XLONG*COEFJ/FT1 479 : XXLONG3=XLONG*COEFK/FT1 480 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 481 : C CALCUL DU RAYON D'INTERACTION 482 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 483 : COEF1=((SPHI**2)*(CTETA**2))/(XXLONG1**2) 484 : COEF2=((SPHI**2)*(STETA**2))/(XXLONG2**2) 485 : COEF3=(CPHI**2)/(XXLONG3**2) 486 : PHOLC=(1)/(COEF1+COEF2+COEF3) 487 : IF(PHOLC.GE.XLONG)THEN 488 : PHOLC=XLONG 489 : ENDIF 490 : C write(IOIMP,*)' XXLONG,DJAC ',XXLONG,DJAC 491 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 492 : C SELECTION D'UNE ZONE AUTOUR DU POINT DE GAUSS 493 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 494 : IF(NVECPO2.LE.XMULTL*XLONG)THEN 495 : GDEX=EXP(-(2*NVECPO2)**2/PHOLC ) 496 : DJAC=MINTE2.POIGAU(IGAUJ)*GDEX*ABS(DJAC) 497 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 498 : C modif NCOMP 499 : DO IE1=1,1 500 : MELVAL=MELVAC(IE1) 501 : C 502 : C ON DOIT RETROUVER LE NUMERO D'ELEMENT ATTACHE AU CHAMELEM 503 : C CORRESPONDANT A CELUI DU MELEME 504 : C 505 : IBMN=MIN(IBJ ,VELCHE(/2)) 506 : IGMN=MIN(IGAUJ,VELCHE(/1)) 507 : SOMCOM(IE1,IGAU)=SOMCOM(IE1,IGAU) 508 : 1 +VELCHE(IGMN,IBMN)*DJAC 509 : C write(IOIMP,*)' VELCHE,DJAC ',VELCHE(IGMN,IBMN),DJAC 510 : END DO 511 : SOMJAC(IGAU)=SOMJAC(IGAU)+DJAC 512 : ENDIF 513 : C 514 : C FIN DE LA BOUCLE SUR LES PTS D'INTEGRATION 515 : C 516 : END DO 517 : C 518 : C FIN DE LA BOUCLE SUR LES ELEMENTS ACCESSIBLES 519 : C 520 : END DO 521 : C 522 : SEGSUP,WRK2 523 : C 524 : C FIN DE LA BOUCLE SUR LES DIFFERENTES ZONES ACCESSIBLES 525 : C 526 : END DO 527 : C 528 : C FIN DE LA BOUCLE SUR LES PTS D'INTEGRATION 529 : C 530 : END DO 531 : SEGDES MLENTI 532 : SEGDES MLNIMO 533 : SEGSUP MLENT1 534 : C 535 : C FIN DU TEST D'EXISTENCE DE CONNECTIVITE SUR L'ELEMENT 536 : C 537 : ENDIF 538 : C 539 : C FIN DE LA BOUCLE SUR LES DOUBLONS 540 : C 541 : END DO 542 : C 543 : NLOC3=ILOC3O 544 : DO IE1=1,1 545 : MELVAL=MELVAC(IE1) 546 : SEGACT MELVAL*MOD 547 : DO IGAU=1,NBPGAU 548 : VELCHE(IGAU,IB)=SOMCOM(IE1,IGAU)/SOMJAC(IGAU) 549 : END DO 550 : END DO 551 : C 552 : C FIN DE LA BOUCLE SUR LES ELEMENTS 553 : C 554 : END DO 555 : C 556 : SEGSUP WRK1,WRK3 557 : C 558 : C FIN DE LA BOUCLE SUR LES SOUS ZONES EFFECTIVES 559 : C 560 : END DO 561 : C 562 : C DESACTIVATIONS/SUPRESSION 563 : C WARNING SUR LES DOUBLONS DE MODEL! 564 : C 565 : DO IZONEF=1,NZONEF 566 : NLOC2=ILOC2(IZONEF) 567 : NDOUBL=ILOC4(/1) 568 : DO IDOUBL=1,NDOUBL 569 : NLOC4=ILOC4(IDOUBL) 570 : MELVAL=MELPNI 571 : SEGDES,MELVAL 572 : MELVAL=MELPLI 573 : SEGDES,MELVAL 574 : SEGSUP,NLOC4 575 : ENDDO 576 : NSZACC=ILOC3(/1) 577 : DO ISZACC=1,NSZACC 578 : NLOC3=ILOC3(ISZACC) 579 : SEGSUP,NLOC3 580 : ENDDO 581 : NLOC3=ILOC3I 582 : NCOMP=MELVAC(/1) 583 : DO ICOMP=1,NCOMP 584 : MELVAL=MELVAC(ICOMP) 585 : SEGDES,MELVAL 586 : ENDDO 587 : SEGSUP,NLOC3 588 : NLOC3=ILOC3O 589 : NCOMP=MELVAC(/1) 590 : DO ICOMP=1,NCOMP 591 : MELVAL=MELVAC(ICOMP) 592 : SEGDES,MELVAL 593 : ENDDO 594 : SEGSUP,NLOC3 595 : MMODEL=MODLAC 596 : DO ISZACC=1,NSZACC 597 : MINTE=MINTAC(ISZACC) 598 : SEGDES,MINTE 599 : IMODEL=KMODEL(ISZACC) 600 : SEGDES,IMODEL 601 : ENDDO 602 : MELEME=MAILEF 603 : SEGDES,MELEME 604 : ENDDO 605 : DO IZONEF=1,NZONEF 606 : NLOC2=ILOC2(IZONEF) 607 : MMODEL=MODLAC 608 : SEGDES,MMODEL 609 : SEGSUP,NLOC2 610 : ENDDO 611 : SEGSUP,NLOC1 612 : C 613 : C BYE BYE 614 : C 615 : RETURN 616 : END 617 : 618 :
© Cast3M 2003 - All rights reserved.
Disclaimer