inclu4
C INCLU4 SOURCE PV 20/03/30 21:19:57 10567 IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCREEL -INC PPARAM -INC CCOPTIO -INC SMELEME -INC SMCOORD * * IL EST SUPPOSER QUE LE IPT2 ne contiennent quer des TET4 et que ipt1 * soit des poi1, * * IPEX(I)=1 veut dire que le noeud I est interne à un element de ipt2 * * POUR DECIDER SI UN POINT EST A L'INTERIEUR D'UN ELEMENT ON CALCULE * LES COORDONNEES BARYCENTRIQUES DU POINT ET IL FAUT QU'ELLES SOIENT * TOUTES POSITIVES OU QUE CELLES QUI SOIENT NEGATIVES SOIENT D'UN * ORDRE DE GRANDEUR TRES INFERIEUR AUX AUTRES ( 0.0001 FOIS ). * SEGMENT ISEG1 ENDSEGMENT SEGMENT ISEG3 INTEGER NIZO(NZO+1) ENDSEGMENT SEGMENT ISEG4 INTEGER NUMZO(NZO) ENDSEGMENT SEGMENT ISEG5 INTEGER NNMEL(ILON),IDEJ(NZO) ENDSEGMENT SEGMENT ISEG6 REAL*8 AM(4,4),P(4),AL(4),A(4),B(4),C(4),D(4) REAL*8 XA(3,4),XPU(3) ENDSEGMENT SEGMENT IPEX(nbpts) * * ON CALCULE LA TAILLE MAXI D'UN ELEMENT DANS TOUTES LES DIRECTIONS * AFIN DE CREER UN ZONAGE DE L'ESPACE. EN MEME TEMPS ON CALCULE * LA DIMENSION HORS TOUT DU MAILLAGE ET ON COMMENCE A CREER * UNE NUMEROTATION LOCALE DES POINTS DU MAILLAGE IPT * IDIM1=IDIM+1 XPREC=-XCRIT MELEME= IPT2 SEGACT MELEME IF(ITYPEL.NE.23) THEN RETURN ENDIF NBNN=NUM(/1) * WRITE(6,FMT='('' NBEL NBNN '',2I6)') NBEL,NBNN SEGINI ISEG1 ILOC=0 XZO=0.D0 YZO=0.D0 ZZO=0.D0 XZA=XGRAND YZA=XGRAND ZZA=XGRAND XTOMI=XGRAND XTOMA=-XGRAND YTOMI=XGRAND YTOMA=-XGRAND ZTOMI=XGRAND ZTOMA=-XGRAND XMI=XGRAND YMI=XGRAND ZMI=XGRAND YMA=-XGRAND XMA=-XGRAND ZMA=-XGRAND IA=(IB-1)*IDIM1 IF(XCOOR(IA+1).LT.XMI) XMI=XCOOR(IA+1) IF(XCOOR(IA+1).GT.XMA) XMA=XCOOR(IA+1) IF(XCOOR(IA+2).LT.YMI) YMI=XCOOR(IA+2) IF(XCOOR(IA+2).GT.YMA) YMA=XCOOR(IA+2) * IF( IDIM.EQ.3 ) THEN IF(XCOOR(IA+3).LT.ZMI) ZMI=XCOOR(IA+3) IF(XCOOR(IA+3).GT.ZMA) ZMA=XCOOR(IA+3) * ENDIF 2 CONTINUE XLIM(1,I1)=XMI XLIM(2,I1)=XMA YLIM(1,I1)=YMI YLIM(2,I1)=YMA XZO=MAX (XZO,XMA-XMI) YZO=MAX (YZO,YMA-YMI) XZA=MIN(XZA,XMA-XMI) YZA=MIN(YZA,YMA-YMI) IF(XMI.LT.XTOMI) XTOMI=XMI IF(XMA.GT.XTOMA) XTOMA=XMA IF(YMI.LT.YTOMI) YTOMI=YMI IF(YMA.GT.YTOMA) YTOMA=YMA * IF(IDIM.EQ.3) THEN ZLIM(1,I1)=ZMI ZLIM(2,I1)=ZMA ZZO=MAX(ZZO,ZMA-ZMI) ZZA=MIN(ZZA,ZMA-ZMI) IF(ZMI.LT.ZTOMI) ZTOMI=ZMI IF(ZMA.GT.ZTOMA) ZTOMA=ZMA * ENDIF 1 CONTINUE * WRITE(6,FMT='(''XZO YZO '',4E12.5)') XZO,YZO * WRITE(6,FMT='(''XZA YZA '',4E12.5)') XZA,YZA * WRITE(6,FMT='(''XTOMI XTOMA '',4E12.5)') XTOMI,XTOMA * WRITE(6,FMT='(''YTOMI YTOMA '',4E12.5)') YTOMI,YTOMA XPR=MIN(XZO*1.D-2,(XTOMA-XTOMI)/2.D+4) YPR=MIN(YZO*1.D-2,(YTOMA-YTOMI)/2.D+4) C XZO=XZO*1.1 C YZO=YZO*1.1 XZA=XZA*0.97 YZA=YZA*0.97 XTOMI= XTOMI - (XTOMA-XTOMI)/1.D+4 XTOMA= XTOMA + (XTOMA-XTOMI)/1.D+4 YTOMI= YTOMI - (YTOMA-YTOMI)/1.D+4 YTOMA= YTOMA + (YTOMA-YTOMI)/1.D+4 C XZO=MIN ( XZO, XTOMA-XTOMI) C YZO=MIN ( YZO, YTOMA-YTOMI) XZA=MIN ( XZA, XTOMA-XTOMI) YZA=MIN ( YZA, YTOMA-YTOMI) NXZO=INT((XTOMA-XTOMI)/XZA) + 1 NYZO=INT((YTOMA-YTOMI)/YZA) + 1 XZO=XZA YZO=YZA NZZO=1 * WRITE(6,FMT='('' NXZO NYZO'',2I7)') NXZO,NYZO * IF(IDIM.EQ.3) THEN ZPR=MIN(ZZO*1.D-2,(ZTOMA-ZTOMI)/2.D+4) C ZZO=ZZO*1.1 ZZA=ZZA*0.97 ZTOMI= ZTOMI - (ZTOMA-ZTOMI)/1.D+4 ZTOMA= ZTOMA + (ZTOMA-ZTOMI)/1.D+4 C ZZO=MIN ( ZZO, ZTOMA-ZTOMI) ZZA=MIN ( ZZA, ZTOMA-ZTOMI) NZZO=INT((ZTOMA-ZTOMI)/ZZA)+ 1 ZZO=ZZA * WRITE(6,FMT='('' zz0,zzA,ztomi,ztoma'',4e12.5)') * $ xzo,xza,ztomi,ztoma * ENDIF * WRITE(6,FMT='('' XTOMI XTOMA YTOMI YTOMA '',4E12.5 )') * $ XTOMI, XTOMA, YTOMI ,YTOMA NXDEP=MIN(NXZO,10) NYDEP=MIN(NYZO,10) * IF(IDIM.EQ.2) THEN * IF(FLOAT(NXZO)*FLOAT(NYZO).GT.10000.) THEN * XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/90 * NXZO=MAX(INT(NXZO/XY),NXDEP) * NYZO=MAX(INT(NYZO/XY),NYDEP) * IF(FLOAT(NXZO)*FLOAT(NYZO).GT.10000.) THEN * XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/60 * NXZO=MAX(INT(NXZO/XY),NXDEP) * NYZO=MAX(INT(NYZO/XY),NYDEP) * ENDIF * XZO=(XTOMA-XTOMI)/NXZO * YZO=(YTOMA-YTOMI)/NYZO * NXZO=(XTOMA-XTOMI)/XZO +1 * NYZO=(YTOMA-YTOMI)/YZO +1 * ENDIF C WRITE(6,FMT='('' XZO NXZO YZO NYZO '' , E12.5,I5,E12.5,I5)') C $ XZO ,NXZO, YZO, NYZO * ELSE NZDEP=MIN(NZZO,10) * WRITE(6,FMT='('' XZO NXZO YZO NYZO ZZO NZZO'' , E12.5,I7,/, * $ E12.5,I7,E12.5,I7)') C $ XZO ,NXZO, YZO, NYZO,ZZO,NZZO IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NXZO NYZO NZZO '' $,4I7) ') NXZO,NYZO,NZZO IF(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO).GT.25000.) THEN XYZ =(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO))**0.3333/25. NXZO=MAX(INT(FLOAT(NXZO)/XYZ),NXDEP) NYZO=MAX(INT(FLOAT(NYZO)/XYZ),NYDEP) NZZO=MAX(INT(FLOAT(NZZO)/XYZ),NZDEP) IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NXZO NYZO NZZO '' $,4I7) ') NXZO,NYZO,NZZO IF(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO).GT.20000.) THEN XYZ =(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO))**0.3333/25. NXZO=MAX(INT(FLOAT(NXZO)/XYZ),NXDEP) NYZO=MAX(INT(FLOAT(NYZO)/XYZ),NYDEP) NZZO=MAX(INT(FLOAT(NZZO)/XYZ),NZDEP) IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NXZO NYZO NZZO '' $,4I7) ') NXZO,NYZO,NZZO IF(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO).GT.20000.) THEN XYZ =(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO))**0.3333/25. NXZO=MAX(INT(FLOAT(NXZO)/XYZ),NXDEP) NYZO=MAX(INT(FLOAT(NYZO)/XYZ),NYDEP) NZZO=MAX(INT(FLOAT(NZZO)/XYZ),NZDEP) ENDIF ENDIF XZO=(XTOMA-XTOMI)/FLOAT(NXZO) YZO=(YTOMA-YTOMI)/FLOAT(NYZO) ZZO=(ZTOMA-ZTOMI)/FLOAT(NZZO) NXZO=INT((XTOMA-XTOMI)/XZO)+1 NYZO=INT((YTOMA-YTOMI)/YZO)+1 NZZO=INT((ZTOMA-ZTOMI)/ZZO)+1 ENDIF * ENDIF * * ON VEUT CONSTRUIRE LA LISTE DES ELEMENTS TOUCHANT UNE ZONE * POUR CELA ON COMMENCE PAR COMPTER COMBIEN D'ELEMENT TOUCHENT * CHAQUE ZONE ET EN MEME TEMPS ON STOCKE LES ZONES TOUCHEES * PAR CHAQUE ELEMENT ET LEUR NOMBRE * NZO=NXZO*NYZO*NZZO IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NZO NXZO NYZO NZZO '' $,4I7) ') NZO,NXZO,NYZO,NZZO NXYZO=NXZO*NYZO * IDI=4 * IF(IDIM.EQ.3) THEN * IDI=8 * ENDIF SEGINI ISEG3 SEGINI ISEG4 NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) +1 NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) +1 NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) +1 NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) +1 * IF(IDIM.EQ.3) THEN NIZ1Z=INT((ZLIM(1,I1)-ZTOMI-ZPR)/ZZO) +1 NIZ2Z=INT((ZLIM(2,I1)-ZTOMI+ZPR)/ZZO) +1 DO 200 L3=NIZ1Z,NIZ2Z DO 200 L1=NIZ1Y,NIZ2Y DO 200 L2=NIZ1X,NIZ2X NIZA = L2 + ( L1-1) * NXZO + ( L3-1)*NXYZO NUMZO(NIZA) = NUMZO(NIZA) +1 200 CONTINUE * ELSE * DO 201 L1=NIZ1Y,NIZ2Y * DO 201 L2=NIZ1X,NIZ2X * NIZA = L2 + ( L1-1) * NXZO * NUMZO(NIZA) = NUMZO(NIZA) +1 * 201 CONTINUE * ENDIF 3 CONTINUE * * CONSTRUCTION DU TABLEAU D'ADRESSAGE DU TABLEAU DONNANT LES * ELEMENTS CONCERNEES PAR UNE ZONE * ILON=0 NIZO(1)=1 DO 202 L1=1,NZO NIZO(L1+1)=NIZO(L1)+NUMZO(L1) ILON=ILON+ NUMZO(L1) 202 CONTINUE * WRITE(6,FMT='('' ILON '',I5)') ILON * WRITE(6,109) (KKK,NUMZO(KKK),(NELZO(KI,KKK),KI=1,4),KKK=1,NBEL) * 109 FORMAT(I6,I5,4I5) * WRITE(6,110)( NIZO(KI),KI=1,NZO+1) 110 FORMAT(16I5) SEGINI ISEG5 NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) +1 NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) +1 NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) +1 NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) +1 * IF(IDIM.EQ.3) THEN NIZ1Z=INT((ZLIM(1,I1)-ZTOMI-ZPR)/ZZO) +1 NIZ2Z=INT((ZLIM(2,I1)-ZTOMI+ZPR)/ZZO) +1 DO 205 L3=NIZ1Z,NIZ2Z DO 205 L1=NIZ1Y,NIZ2Y DO 205 L2=NIZ1X,NIZ2X NIZA = L2 + ( L1-1) * NXZO + ( L3-1)*NXYZO IAD=NIZO(NIZA)+IDEJ(NIZA) NNMEL(IAD)=I1 IDEJ(NIZA)=IDEJ(NIZA)+1 205 CONTINUE * ELSE * DO 203 L1=NIZ1Y,NIZ2Y * DO 203 L2=NIZ1X,NIZ2X * NIZA = L2 + ( L1-1) * NXZO * IAD=NIZO(NIZA)+IDEJ(NIZA) * NNMEL(IAD)=I1 * IDEJ(NIZA)=IDEJ(NIZA)+1 * 203 CONTINUE * ENDIF 5 CONTINUE * * IL NE RESTE PLUS QU'A FAIRE LE TRAVAIL PROPREMENT DIT POUR CHAQUE * POINT DE L'OBJETR MAILLAGE IPT1, ON COMMENCE PAR LE METTRE SOUS * FORME D'ELEMENTS DE TYPE POI1 * SEGSUP ISEG1,ISEG4 SEGACT IPT1 IF(IPT1.ITYPEL.NE.1) THEN ENDIF SEGINI IPEX SEGINI ISEG6 C WRITE(6,FMT='('' AVANT BOUCLE 10'')') DO 10 I=1,IPT1.NUM(/2) IP=IPT1.NUM(1,I) XPU(1)=XCOOR((IP-1)*IDIM1+1) XPU(2)=XCOOR((IP-1)*IDIM1+2) XPU(3)=XCOOR((IP-1)*IDIM1+3) * write(6,fmt='('' point x y '',i5,2e12.5)') iP,XPU(1),xpu(2) IF(XPU(1).LT.XTOMI.OR.XPU(1).GT.XTOMA) GO TO 10 IF(XPU(2).LT.YTOMI.OR.XPU(2).GT.YTOMA) GO TO 10 * IF(IDIM.EQ.3) THEN IF(XPU(3).LT.ZTOMI.OR.XPU(3).GT.ZTOMA) GO TO 10 * ENDIF INDZO=INT((XPU(1)-XTOMI)/XZO)+ 1 +INT((XPU(2)-YTOMI)/YZO)*NXZO # +INT((XPU(3)-ZTOMI)/ZZO)*NXZO*NYZO * IF(IDIM.EQ.3) INDZO=INDZO+INT((XPU(3)-ZTOMI)/ZZO)*NXZO*NYZO IDEB=NIZO(INDZO) IFIN=NIZO(INDZO+1)-1 * write(6,fmt='('' ideb ifin'',2i5)') ideb,ifin IF(IDEB.GT.IFIN) GO TO 10 IEL=0 DO 11 KK=IDEB,IFIN * * ON CALCULE LES COORDONNEES BARYCENTRIQUES ( AU PLUS 4 ) * K=NNMEL(KK) * write(6,fmt='('' k '',i5)') k J1=NUM(1,K) J3=NUM(3,K) J1IDIM=(J1-1)*IDIM1 J2IDIM=(J2-1)*IDIM1 J3IDIM=(J3-1)*IDIM1 * IF(IDIM.EQ.3) THEN J4=NUM(4,K) J4IDIM=(J4-1)*IDIM1 * ENDIF P(1)=1.D0 DO 12 K1=1,NBNN AM(1,K1)=1.D0 12 CONTINUE DO 13 K1=1,IDIM P(K1+1)=XPU(K1) AM(K1+1,1)=XCOOR(J1IDIM+K1) AM(K1+1,2)=XCOOR(J2IDIM+K1) AM(K1+1,3)=XCOOR(J3IDIM+K1) * IF(IDIM.EQ.3) THEN AM(K1+1,4)=XCOOR(J4IDIM+K1) * ENDIF 13 CONTINUE * IF(IDIM.EQ.2) THEN * X1=AM(2,1) * X2=AM(2,2) * X3=AM(2,3) * Y1=AM(3,1) * Y2=AM(3,2) * Y3=AM(3,3) * X=P(2) * Y=P(3) * DETAM=X1*Y2+X2*Y3+X3*Y1-Y1*X2-Y2*X3-Y3*X1 * A(1)=X2*Y3-X3*Y2 * A(2)=X3*Y1-X1*Y3 * A(3)=X1*Y2-X2*Y1 * B(1)=Y2-Y3 * B(2)=Y3-Y1 * B(3)=Y1-Y2 * C(1)=X3-X2 * C(2)=X1-X3 * C(3)=X2-X1 * DO 14 IK=1,NBNN * AL(IK)=(A(IK)+B(IK)*X+C(IK)*Y)/DETAM * 14 CONTINUE * AL(4)=1.D0 * ELSE X1=AM(2,1) X2=AM(2,2) X3=AM(2,3) X4=AM(2,4) Y1=AM(3,1) Y2=AM(3,2) Y3=AM(3,3) Y4=AM(3,4) Z1=AM(4,1) Z2=AM(4,2) Z3=AM(4,3) Z4=AM(4,4) X=P(2) Y=P(3) Z=P(4) DETAM=X2*Y3*Z4+X3*Y4*Z2+X4*Y2*Z3-X4*Y3*Z2-X2*Y4*Z3-X3*Y2*Z4-X1*Y3* 1Z4-X3*Y4*Z1-X4*Y1*Z3+X4*Y3*Z1+X3*Y1*Z4+X1*Y4*Z3+X1*Y2*Z4+X4*Y1*Z2+ 2X2*Y4*Z1-X4*Y2*Z1-X2*Y1*Z4-X1*Y4*Z2-X1*Y2*Z3-X3*Y1*Z2-X2*Y3*Z1+X3* 3Y2*Z1+X2*Y1*Z3+X1*Y3*Z2 A(1)=X2*Y3*Z4+X3*Y4*Z2+X4*Y2*Z3-X4*Y3*Z2-X2*Y4*Z3-X3*Y2*Z4 A(2)=X4*Y3*Z1+X3*Y1*Z4+X1*Y4*Z3-X1*Y3*Z4-X3*Y4*Z1-X4*Y1*Z3 A(3)=X1*Y2*Z4+X4*Y1*Z2+X2*Y4*Z1-X4*Y2*Z1-X2*Y1*Z4-X1*Y4*Z2 A(4)=X3*Y2*Z1+X2*Y1*Z3+X1*Y3*Z2-X1*Y2*Z3-X3*Y1*Z2-X2*Y3*Z1 B(1)=Y4*Z3-Y3*Z4+Y2*Z4-Y4*Z2+Y3*Z2-Y2*Z3 B(2)=Y3*Z4-Y4*Z3+Y4*Z1-Y1*Z4+Y1*Z3-Y3*Z1 B(3)=Y4*Z2-Y2*Z4+Y1*Z4-Y4*Z1+Y2*Z1-Y1*Z2 B(4)=Y2*Z3-Y3*Z2+Y3*Z1-Y1*Z3+Y1*Z2-Y2*Z1 C(1)=X3*Z4-X4*Z3+X4*Z2-X2*Z4+X2*Z3-X3*Z2 C(2)=X4*Z3-X3*Z4+X1*Z4-X4*Z1+X3*Z1-X1*Z3 C(3)=X2*Z4-X4*Z2+X4*Z1-X1*Z4+X1*Z2-X2*Z1 C(4)=X3*Z2-X2*Z3+X1*Z3-X3*Z1+X2*Z1-X1*Z2 D(1)=X4*Y3-X3*Y4+X2*Y4-X4*Y2+X3*Y2-X2*Y3 D(2)=X3*Y4-X4*Y3+X4*Y1-X1*Y4+X1*Y3-X3*Y1 D(3)=X4*Y2-X2*Y4+X1*Y4-X4*Y1+X2*Y1-X1*Y2 D(4)=X2*Y3-X3*Y2+X3*Y1-X1*Y3+X1*Y2-X2*Y1 DO 15 II=1,NBNN AL(II)=(A(II)+B(II)*X+C(II)*Y+D(II)*Z)/DETAM 15 CONTINUE * ENDIF * write(6,fmt='(''K al '',I5,4e12.3)')K, * $ al(1),al(2),al(3),al(4) IF( AL(1).GT.XPREC.AND.AL(2).GT.XPREC.AND.AL(3).GT.XPREC. $ AND.AL(4).GT.XPREC) THEN * * LE POINT EST INTERNE A L'ELEMENT * * IEL=IEL+1 IPEX(IP)=1 * WRITE(6,*) IP GO TO 10 ENDIF 11 CONTINUE 10 CONTINUE SEGSUP ISEG5,ISEG6,ISEG3 SEGDES IPT1,MELEME RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales