Télécharger la plaquette Cast3M


fr en

Télécharger inclu4.eso

Retour à la liste

Numérotation des lignes : 

inclu4

  1. C INCLU4    SOURCE    CB215821  26/08/24    21:16:52     12622          
  2.       SUBROUTINE INCLU4(IPT1,IPT2,IPEX,XCRIT)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. -INC CCREEL
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC SMELEME
  10. -INC SMCOORD
  11. *
  12. * IL EST SUPPOSER QUE LE IPT2 ne contiennent quer des TET4 et que ipt1
  13. * soit des poi1,
  14. *
  15. * IPEX(I)=1 veut dire que le noeud I est interne à un element de ipt2
  16. *
  17. * POUR DECIDER SI UN POINT EST A L'INTERIEUR D'UN ELEMENT ON CALCULE
  18. * LES COORDONNEES BARYCENTRIQUES DU POINT ET IL FAUT QU'ELLES SOIENT
  19. * TOUTES POSITIVES OU QUE CELLES QUI SOIENT NEGATIVES SOIENT D'UN
  20. * ORDRE DE GRANDEUR TRES INFERIEUR AUX AUTRES ( 0.0001 FOIS ).
  21. *
  22.       SEGMENT ISEG1
  23.          REAL*8 XLIM(2,NBEL),YLIM(2,NBEL),ZLIM(2,NBEL)
  24.       ENDSEGMENT
  25.       SEGMENT ISEG3
  26.          INTEGER NIZO(NZO+1)
  27.       ENDSEGMENT
  28.       SEGMENT ISEG4
  29.          INTEGER NUMZO(NZO)
  30.       ENDSEGMENT
  31.       SEGMENT ISEG5
  32.         INTEGER NNMEL(ILON),IDEJ(NZO)
  33.       ENDSEGMENT
  34.       SEGMENT ISEG6
  35.       REAL*8 AM(4,4),P(4),AL(4),A(4),B(4),C(4),D(4)
  36.       REAL*8 XA(3,4),XPU(3)
  37.       ENDSEGMENT
  38.       SEGMENT IPEX(nbpts)
  39. *
  40. *  ON CALCULE LA TAILLE MAXI D'UN ELEMENT DANS TOUTES LES DIRECTIONS
  41. * AFIN DE CREER UN ZONAGE DE L'ESPACE. EN MEME TEMPS ON CALCULE
  42. * LA DIMENSION HORS TOUT DU MAILLAGE ET ON COMMENCE A CREER
  43. * UNE NUMEROTATION LOCALE DES POINTS DU MAILLAGE IPT
  44. *
  45.       IDIM1=IDIM+1
  46.       XPREC=-XCRIT
  47.       MELEME= IPT2
  48.       SEGACT MELEME
  49.       IF(ITYPEL.NE.23) THEN
  50.          CALL ERREUR(16)
  51.          RETURN
  52.       ENDIF
  53.       NBEL = NUM(/2)
  54.       NBNN=NUM(/1)
  55. *      WRITE(6,FMT='(''  NBEL NBNN '',2I6)') NBEL,NBNN
  56.       SEGINI ISEG1
  57.       ILOC=0
  58.       XZO=0.D0
  59.       YZO=0.D0
  60.       ZZO=0.D0
  61.       XZA=XGRAND
  62.       YZA=XGRAND
  63.       ZZA=XGRAND
  64.       XTOMI=XGRAND
  65.       XTOMA=-XGRAND
  66.       YTOMI=XGRAND
  67.       YTOMA=-XGRAND
  68.       ZTOMI=XGRAND
  69.       ZTOMA=-XGRAND
  70.       DO 1 I1=1,NBEL
  71.          XMI=XGRAND
  72.          YMI=XGRAND
  73.          ZMI=XGRAND
  74.          YMA=-XGRAND
  75.          XMA=-XGRAND
  76.          ZMA=-XGRAND
  77.          DO 2 I2 = 1,NBNN
  78.             IB=NUM(I2,I1)
  79.             IA=(IB-1)*IDIM1
  80.             IF(XCOOR(IA+1).LT.XMI) XMI=XCOOR(IA+1)
  81.             IF(XCOOR(IA+1).GT.XMA) XMA=XCOOR(IA+1)
  82.             IF(XCOOR(IA+2).LT.YMI) YMI=XCOOR(IA+2)
  83.             IF(XCOOR(IA+2).GT.YMA) YMA=XCOOR(IA+2)
  84. *            IF( IDIM.EQ.3 ) THEN
  85.                IF(XCOOR(IA+3).LT.ZMI) ZMI=XCOOR(IA+3)
  86.                IF(XCOOR(IA+3).GT.ZMA) ZMA=XCOOR(IA+3)
  87. *            ENDIF
  88.     2    CONTINUE
  89.          XLIM(1,I1)=XMI
  90.          XLIM(2,I1)=XMA
  91.          YLIM(1,I1)=YMI
  92.          YLIM(2,I1)=YMA
  93.          XZO=MAX (XZO,XMA-XMI)
  94.          YZO=MAX (YZO,YMA-YMI)
  95.          XZA=MIN(XZA,XMA-XMI)
  96.          YZA=MIN(YZA,YMA-YMI)
  97.          IF(XMI.LT.XTOMI) XTOMI=XMI
  98.          IF(XMA.GT.XTOMA) XTOMA=XMA
  99.          IF(YMI.LT.YTOMI) YTOMI=YMI
  100.          IF(YMA.GT.YTOMA) YTOMA=YMA
  101. *         IF(IDIM.EQ.3) THEN
  102.              ZLIM(1,I1)=ZMI
  103.              ZLIM(2,I1)=ZMA
  104.              ZZO=MAX(ZZO,ZMA-ZMI)
  105.              ZZA=MIN(ZZA,ZMA-ZMI)
  106.              IF(ZMI.LT.ZTOMI) ZTOMI=ZMI
  107.              IF(ZMA.GT.ZTOMA) ZTOMA=ZMA
  108. *         ENDIF
  109.     1 CONTINUE
  110. *      WRITE(6,FMT='(''XZO YZO  '',4E12.5)') XZO,YZO
  111. *      WRITE(6,FMT='(''XZA YZA  '',4E12.5)') XZA,YZA
  112. *      WRITE(6,FMT='(''XTOMI XTOMA  '',4E12.5)') XTOMI,XTOMA
  113. *      WRITE(6,FMT='(''YTOMI YTOMA  '',4E12.5)') YTOMI,YTOMA
  114.       XPR=MIN(XZO*1.D-2,(XTOMA-XTOMI)/2.D+4)
  115.       YPR=MIN(YZO*1.D-2,(YTOMA-YTOMI)/2.D+4)
  116. C      XZO=XZO*1.1
  117. C      YZO=YZO*1.1
  118.       XZA=XZA*0.97
  119.       YZA=YZA*0.97
  120.       XTOMI= XTOMI - (XTOMA-XTOMI)/1.D+4
  121.       XTOMA= XTOMA + (XTOMA-XTOMI)/1.D+4
  122.       YTOMI= YTOMI - (YTOMA-YTOMI)/1.D+4
  123.       YTOMA= YTOMA + (YTOMA-YTOMI)/1.D+4
  124. C      XZO=MIN ( XZO, XTOMA-XTOMI)
  125. C      YZO=MIN ( YZO, YTOMA-YTOMI)
  126.       XZA=MIN ( XZA, XTOMA-XTOMI)
  127.       YZA=MIN ( YZA, YTOMA-YTOMI)
  128.       NXZO=INT((XTOMA-XTOMI)/XZA) + 1
  129.       NYZO=INT((YTOMA-YTOMI)/YZA) + 1
  130.       XZO=XZA
  131.       YZO=YZA
  132.       NZZO=1
  133. *      WRITE(6,FMT='('' NXZO NYZO'',2I7)') NXZO,NYZO
  134. *      IF(IDIM.EQ.3) THEN
  135.          ZPR=MIN(ZZO*1.D-2,(ZTOMA-ZTOMI)/2.D+4)
  136. C         ZZO=ZZO*1.1
  137.          ZZA=ZZA*0.97
  138.          ZTOMI= ZTOMI - (ZTOMA-ZTOMI)/1.D+4
  139.          ZTOMA= ZTOMA + (ZTOMA-ZTOMI)/1.D+4
  140. C         ZZO=MIN ( ZZO, ZTOMA-ZTOMI)
  141.          ZZA=MIN ( ZZA, ZTOMA-ZTOMI)
  142.          NZZO=INT((ZTOMA-ZTOMI)/ZZA)+ 1
  143.          ZZO=ZZA
  144. *      WRITE(6,FMT='('' zz0,zzA,ztomi,ztoma'',4e12.5)')
  145. *     $ xzo,xza,ztomi,ztoma
  146. *      ENDIF
  147. *      WRITE(6,FMT='('' XTOMI XTOMA YTOMI YTOMA '',4E12.5 )')
  148. *     $ XTOMI, XTOMA, YTOMI ,YTOMA
  149.        NXDEP=MIN(NXZO,10)
  150.        NYDEP=MIN(NYZO,10)
  151. *      IF(IDIM.EQ.2) THEN
  152. *         IF(FLOAT(NXZO)*FLOAT(NYZO).GT.10000.) THEN
  153. *          XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/90
  154. *          NXZO=MAX(INT(NXZO/XY),NXDEP)
  155. *          NYZO=MAX(INT(NYZO/XY),NYDEP)
  156. *          IF(FLOAT(NXZO)*FLOAT(NYZO).GT.10000.) THEN
  157. *            XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/60
  158. *            NXZO=MAX(INT(NXZO/XY),NXDEP)
  159. *            NYZO=MAX(INT(NYZO/XY),NYDEP)
  160. *          ENDIF
  161. *          XZO=(XTOMA-XTOMI)/NXZO
  162. *          YZO=(YTOMA-YTOMI)/NYZO
  163. *          NXZO=(XTOMA-XTOMI)/XZO +1
  164. *          NYZO=(YTOMA-YTOMI)/YZO +1
  165. *         ENDIF
  166. C        WRITE(6,FMT='(''  XZO NXZO YZO NYZO '' , E12.5,I5,E12.5,I5)')
  167. C     $  XZO ,NXZO, YZO, NYZO
  168. *      ELSE
  169.        NZDEP=MIN(NZZO,10)
  170. *        WRITE(6,FMT='(''  XZO NXZO YZO NYZO ZZO NZZO'' , E12.5,I7,/,
  171. *     $   E12.5,I7,E12.5,I7)')
  172. C     $  XZO ,NXZO, YZO, NYZO,ZZO,NZZO
  173.       IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NXZO NYZO NZZO  ''
  174.      $,4I7) ') NXZO,NYZO,NZZO
  175.          IF(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO).GT.25000.) THEN
  176.             XYZ =(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO))**0.3333/25.
  177.             NXZO=MAX(INT(FLOAT(NXZO)/XYZ),NXDEP)
  178.             NYZO=MAX(INT(FLOAT(NYZO)/XYZ),NYDEP)
  179.             NZZO=MAX(INT(FLOAT(NZZO)/XYZ),NZDEP)
  180.       IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NXZO NYZO NZZO  ''
  181.      $,4I7) ') NXZO,NYZO,NZZO
  182.          IF(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO).GT.20000.) THEN
  183.             XYZ =(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO))**0.3333/25.
  184.                NXZO=MAX(INT(FLOAT(NXZO)/XYZ),NXDEP)
  185.                NYZO=MAX(INT(FLOAT(NYZO)/XYZ),NYDEP)
  186.                NZZO=MAX(INT(FLOAT(NZZO)/XYZ),NZDEP)
  187.       IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NXZO NYZO NZZO  ''
  188.      $,4I7) ') NXZO,NYZO,NZZO
  189.          IF(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO).GT.20000.) THEN
  190.             XYZ =(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO))**0.3333/25.
  191.                   NXZO=MAX(INT(FLOAT(NXZO)/XYZ),NXDEP)
  192.                   NYZO=MAX(INT(FLOAT(NYZO)/XYZ),NYDEP)
  193.                   NZZO=MAX(INT(FLOAT(NZZO)/XYZ),NZDEP)
  194.                ENDIF
  195.             ENDIF
  196.             XZO=(XTOMA-XTOMI)/FLOAT(NXZO)
  197.             YZO=(YTOMA-YTOMI)/FLOAT(NYZO)
  198.             ZZO=(ZTOMA-ZTOMI)/FLOAT(NZZO)
  199.             NXZO=INT((XTOMA-XTOMI)/XZO)+1
  200.             NYZO=INT((YTOMA-YTOMI)/YZO)+1
  201.             NZZO=INT((ZTOMA-ZTOMI)/ZZO)+1
  202.          ENDIF
  203. *      ENDIF
  204. *
  205. *  ON VEUT CONSTRUIRE LA LISTE DES ELEMENTS TOUCHANT UNE ZONE
  206. *  POUR CELA ON COMMENCE PAR COMPTER COMBIEN D'ELEMENT TOUCHENT
  207. *  CHAQUE ZONE ET EN MEME TEMPS ON STOCKE LES ZONES TOUCHEES
  208. *  PAR CHAQUE ELEMENT ET LEUR NOMBRE
  209. *
  210.  
  211.       NZO=NXZO*NYZO*NZZO
  212.       IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NZO NXZO NYZO NZZO  ''
  213.      $,4I7) ') NZO,NXZO,NYZO,NZZO
  214.       NXYZO=NXZO*NYZO
  215. *      IDI=4
  216. *      IF(IDIM.EQ.3) THEN
  217. *        IDI=8
  218. *      ENDIF
  219.       SEGINI ISEG3
  220.       SEGINI ISEG4
  221.       DO 3 I1=1,NBEL
  222.           NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) +1
  223.           NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) +1
  224.           NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) +1
  225.           NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) +1
  226. *          IF(IDIM.EQ.3) THEN
  227.                NIZ1Z=INT((ZLIM(1,I1)-ZTOMI-ZPR)/ZZO) +1
  228.                NIZ2Z=INT((ZLIM(2,I1)-ZTOMI+ZPR)/ZZO) +1
  229.                DO 207 L3=NIZ1Z,NIZ2Z
  230.                DO 206 L1=NIZ1Y,NIZ2Y
  231.                DO 200 L2=NIZ1X,NIZ2X
  232.                    NIZA = L2 + ( L1-1) * NXZO + ( L3-1)*NXYZO
  233.                    NUMZO(NIZA) = NUMZO(NIZA) +1
  234.   200          CONTINUE
  235.   206          CONTINUE
  236.   207          CONTINUE
  237. *           ELSE
  238. *               DO 201 L1=NIZ1Y,NIZ2Y
  239. *               DO 201 L2=NIZ1X,NIZ2X
  240. *                   NIZA = L2 + ( L1-1) * NXZO
  241. *                   NUMZO(NIZA) = NUMZO(NIZA) +1
  242. *  201          CONTINUE
  243. *           ENDIF
  244.     3 CONTINUE
  245. *
  246. *  CONSTRUCTION DU TABLEAU D'ADRESSAGE DU TABLEAU DONNANT LES
  247. *  ELEMENTS CONCERNEES PAR UNE ZONE
  248. *
  249.       ILON=0
  250.       NIZO(1)=1
  251.       DO 202 L1=1,NZO
  252.       NIZO(L1+1)=NIZO(L1)+NUMZO(L1)
  253.       ILON=ILON+ NUMZO(L1)
  254.  202  CONTINUE
  255. *      WRITE(6,FMT='(''  ILON '',I5)') ILON
  256. *      WRITE(6,109) (KKK,NUMZO(KKK),(NELZO(KI,KKK),KI=1,4),KKK=1,NBEL)
  257. *  109 FORMAT(I6,I5,4I5)
  258. *      WRITE(6,110)( NIZO(KI),KI=1,NZO+1)
  259.  110  FORMAT(16I5)
  260.       SEGINI ISEG5
  261.       DO 5 I1=1,NBEL
  262.           NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) +1
  263.           NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) +1
  264.           NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) +1
  265.           NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) +1
  266. *          IF(IDIM.EQ.3) THEN
  267.                NIZ1Z=INT((ZLIM(1,I1)-ZTOMI-ZPR)/ZZO) +1
  268.                NIZ2Z=INT((ZLIM(2,I1)-ZTOMI+ZPR)/ZZO) +1
  269.                DO 209 L3=NIZ1Z,NIZ2Z
  270.                DO 208 L1=NIZ1Y,NIZ2Y
  271.                DO 205 L2=NIZ1X,NIZ2X
  272.                    NIZA = L2 + ( L1-1) * NXZO + ( L3-1)*NXYZO
  273.                    IAD=NIZO(NIZA)+IDEJ(NIZA)
  274.                    NNMEL(IAD)=I1
  275.                    IDEJ(NIZA)=IDEJ(NIZA)+1
  276.   205          CONTINUE
  277.   208          CONTINUE
  278.   209          CONTINUE
  279. *           ELSE
  280. *               DO 203 L1=NIZ1Y,NIZ2Y
  281. *               DO 203 L2=NIZ1X,NIZ2X
  282. *                   NIZA = L2 + ( L1-1) * NXZO
  283. *                   IAD=NIZO(NIZA)+IDEJ(NIZA)
  284. *                   NNMEL(IAD)=I1
  285. *                   IDEJ(NIZA)=IDEJ(NIZA)+1
  286. *  203          CONTINUE
  287. *           ENDIF
  288.     5  CONTINUE
  289. *
  290. *  IL NE RESTE PLUS QU'A FAIRE LE TRAVAIL PROPREMENT DIT POUR CHAQUE
  291. * POINT DE L'OBJETR MAILLAGE IPT1, ON COMMENCE PAR LE METTRE SOUS
  292. * FORME D'ELEMENTS DE TYPE POI1
  293. *
  294.       SEGSUP ISEG1,ISEG4
  295.       SEGACT IPT1
  296.       IF(IPT1.ITYPEL.NE.1) THEN
  297.       CALL CHANGE(IPT1,1)
  298.       ENDIF
  299.       SEGINI IPEX
  300.       SEGINI ISEG6
  301. C      WRITE(6,FMT='(''  AVANT BOUCLE 10'')')
  302.       DO 10 I=1,IPT1.NUM(/2)
  303.         IP=IPT1.NUM(1,I)
  304.         XPU(1)=XCOOR((IP-1)*IDIM1+1)
  305.         XPU(2)=XCOOR((IP-1)*IDIM1+2)
  306.         XPU(3)=XCOOR((IP-1)*IDIM1+3)
  307. *        write(6,fmt='('' point x y '',i5,2e12.5)') iP,XPU(1),xpu(2)
  308.         IF(XPU(1).LT.XTOMI.OR.XPU(1).GT.XTOMA) GO TO 10
  309.         IF(XPU(2).LT.YTOMI.OR.XPU(2).GT.YTOMA) GO TO 10
  310. *        IF(IDIM.EQ.3) THEN
  311.           IF(XPU(3).LT.ZTOMI.OR.XPU(3).GT.ZTOMA) GO TO 10
  312. *        ENDIF
  313.         INDZO=INT((XPU(1)-XTOMI)/XZO)+ 1 +INT((XPU(2)-YTOMI)/YZO)*NXZO
  314.      #        +INT((XPU(3)-ZTOMI)/ZZO)*NXZO*NYZO
  315. *        IF(IDIM.EQ.3) INDZO=INDZO+INT((XPU(3)-ZTOMI)/ZZO)*NXZO*NYZO
  316.         IDEB=NIZO(INDZO)
  317.         IFIN=NIZO(INDZO+1)-1
  318. *        write(6,fmt='('' ideb ifin'',2i5)') ideb,ifin
  319.         IF(IDEB.GT.IFIN) GO TO 10
  320.         IEL=0
  321.         DO 11 KK=IDEB,IFIN
  322. *
  323. *  ON CALCULE LES COORDONNEES BARYCENTRIQUES ( AU PLUS 4 )
  324. *
  325.           K=NNMEL(KK)
  326. *          write(6,fmt='('' k '',i5)') k
  327.           J1=NUM(1,K)
  328.           J2=NUM(2,K)
  329.           J3=NUM(3,K)
  330.           J1IDIM=(J1-1)*IDIM1
  331.           J2IDIM=(J2-1)*IDIM1
  332.           J3IDIM=(J3-1)*IDIM1
  333. *          IF(IDIM.EQ.3) THEN
  334.              J4=NUM(4,K)
  335.              J4IDIM=(J4-1)*IDIM1
  336. *          ENDIF
  337.           P(1)=1.D0
  338.           DO 12 K1=1,NBNN
  339.             AM(1,K1)=1.D0
  340.    12     CONTINUE
  341.           DO 13 K1=1,IDIM
  342.             P(K1+1)=XPU(K1)
  343.             AM(K1+1,1)=XCOOR(J1IDIM+K1)
  344.             AM(K1+1,2)=XCOOR(J2IDIM+K1)
  345.             AM(K1+1,3)=XCOOR(J3IDIM+K1)
  346. *            IF(IDIM.EQ.3) THEN
  347.             AM(K1+1,4)=XCOOR(J4IDIM+K1)
  348. *            ENDIF
  349.    13     CONTINUE
  350. *          IF(IDIM.EQ.2) THEN
  351. *             X1=AM(2,1)
  352. *             X2=AM(2,2)
  353. *             X3=AM(2,3)
  354. *             Y1=AM(3,1)
  355. *             Y2=AM(3,2)
  356. *             Y3=AM(3,3)
  357. *             X=P(2)
  358. *             Y=P(3)
  359. *             DETAM=X1*Y2+X2*Y3+X3*Y1-Y1*X2-Y2*X3-Y3*X1
  360. *             A(1)=X2*Y3-X3*Y2
  361. *             A(2)=X3*Y1-X1*Y3
  362. *             A(3)=X1*Y2-X2*Y1
  363. *             B(1)=Y2-Y3
  364. *             B(2)=Y3-Y1
  365. *             B(3)=Y1-Y2
  366. *             C(1)=X3-X2
  367. *             C(2)=X1-X3
  368. *             C(3)=X2-X1
  369. *             DO 14 IK=1,NBNN
  370. *               AL(IK)=(A(IK)+B(IK)*X+C(IK)*Y)/DETAM
  371. *   14        CONTINUE
  372. *             AL(4)=1.D0
  373. *          ELSE
  374.              X1=AM(2,1)
  375.              X2=AM(2,2)
  376.              X3=AM(2,3)
  377.              X4=AM(2,4)
  378.              Y1=AM(3,1)
  379.              Y2=AM(3,2)
  380.              Y3=AM(3,3)
  381.              Y4=AM(3,4)
  382.              Z1=AM(4,1)
  383.              Z2=AM(4,2)
  384.              Z3=AM(4,3)
  385.              Z4=AM(4,4)
  386.              X=P(2)
  387.              Y=P(3)
  388.              Z=P(4)
  389.       DETAM=X2*Y3*Z4+X3*Y4*Z2+X4*Y2*Z3-X4*Y3*Z2-X2*Y4*Z3-X3*Y2*Z4-X1*Y3*
  390.      1Z4-X3*Y4*Z1-X4*Y1*Z3+X4*Y3*Z1+X3*Y1*Z4+X1*Y4*Z3+X1*Y2*Z4+X4*Y1*Z2+
  391.      2X2*Y4*Z1-X4*Y2*Z1-X2*Y1*Z4-X1*Y4*Z2-X1*Y2*Z3-X3*Y1*Z2-X2*Y3*Z1+X3*
  392.      3Y2*Z1+X2*Y1*Z3+X1*Y3*Z2
  393.              A(1)=X2*Y3*Z4+X3*Y4*Z2+X4*Y2*Z3-X4*Y3*Z2-X2*Y4*Z3-X3*Y2*Z4
  394.              A(2)=X4*Y3*Z1+X3*Y1*Z4+X1*Y4*Z3-X1*Y3*Z4-X3*Y4*Z1-X4*Y1*Z3
  395.              A(3)=X1*Y2*Z4+X4*Y1*Z2+X2*Y4*Z1-X4*Y2*Z1-X2*Y1*Z4-X1*Y4*Z2
  396.              A(4)=X3*Y2*Z1+X2*Y1*Z3+X1*Y3*Z2-X1*Y2*Z3-X3*Y1*Z2-X2*Y3*Z1
  397.              B(1)=Y4*Z3-Y3*Z4+Y2*Z4-Y4*Z2+Y3*Z2-Y2*Z3
  398.              B(2)=Y3*Z4-Y4*Z3+Y4*Z1-Y1*Z4+Y1*Z3-Y3*Z1
  399.              B(3)=Y4*Z2-Y2*Z4+Y1*Z4-Y4*Z1+Y2*Z1-Y1*Z2
  400.              B(4)=Y2*Z3-Y3*Z2+Y3*Z1-Y1*Z3+Y1*Z2-Y2*Z1
  401.              C(1)=X3*Z4-X4*Z3+X4*Z2-X2*Z4+X2*Z3-X3*Z2
  402.              C(2)=X4*Z3-X3*Z4+X1*Z4-X4*Z1+X3*Z1-X1*Z3
  403.              C(3)=X2*Z4-X4*Z2+X4*Z1-X1*Z4+X1*Z2-X2*Z1
  404.              C(4)=X3*Z2-X2*Z3+X1*Z3-X3*Z1+X2*Z1-X1*Z2
  405.              D(1)=X4*Y3-X3*Y4+X2*Y4-X4*Y2+X3*Y2-X2*Y3
  406.              D(2)=X3*Y4-X4*Y3+X4*Y1-X1*Y4+X1*Y3-X3*Y1
  407.              D(3)=X4*Y2-X2*Y4+X1*Y4-X4*Y1+X2*Y1-X1*Y2
  408.              D(4)=X2*Y3-X3*Y2+X3*Y1-X1*Y3+X1*Y2-X2*Y1
  409.              DO 15 II=1,NBNN
  410.               AL(II)=(A(II)+B(II)*X+C(II)*Y+D(II)*Z)/DETAM
  411.    15        CONTINUE
  412. *          ENDIF
  413. *         write(6,fmt='(''K  al '',I5,4e12.3)')K,
  414. *     $  al(1),al(2),al(3),al(4)
  415.           IF( AL(1).GT.XPREC.AND.AL(2).GT.XPREC.AND.AL(3).GT.XPREC.
  416.      $    AND.AL(4).GT.XPREC) THEN
  417. *
  418. *  LE POINT EST INTERNE A L'ELEMENT
  419. *
  420. *             IEL=IEL+1
  421.              IPEX(IP)=1
  422. *             WRITE(6,*) IP
  423.              GO TO 10
  424.           ENDIF
  425.    11   CONTINUE
  426.    10 CONTINUE
  427.       SEGSUP ISEG5,ISEG6,ISEG3
  428.       SEGDES IPT1,MELEME
  429.       RETURN
  430.       END
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  
  437.  
  438.  
  439.  
  440.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales