Télécharger la plaquette Cast3M


fr en

Télécharger proob1.eso

Retour à la liste

Numérotation des lignes : 

proob1

  1. C PROOB1    SOURCE    SP204843  24/08/05    21:15:02     11978          
  2. C CE PROGRAMME PERMET LA PROJECTION D'UN MAILLAGE 3D SUR UNE SUFACE
  3. C CARACTERISEE PAR UN AUTRE MAILLAGE 3D.
  4.  
  5. C ENTREES  MAI2  : UN MAILLAGE DE TYPE MELEME A PROJETER.
  6. C          MAI1  : UN MAILLAGE REPRESENTANT LA SURFACE SUR LAQUELLE MAI2
  7. C                  EST PROJETE.
  8. C          IPOIN : UN POINT S' IL S'AGIT D'UN POINT A PROJETER.
  9. C          IP1   : UN VECTEUR DEFINISSANT LA DIRECTION DE PROJECTION.
  10.  
  11. C DATE: AOUT 1996.
  12.  
  13. C   **********************************************************************
  14.         Subroutine proob1(mai2,mai1,ip1)
  15.       IMPLICIT INTEGER(I-N)
  16.         IMPLICIT REAL*8(A-H,O-Z)
  17.  
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMELEME
  22. -INC SMCOORD
  23. -INC CCREEL
  24.         SEGMENT ISEG1
  25.         REAL*8 XLIM(2,NBEL),YLIM(2,NBEL),ZLIM(2,NBEL)
  26.         ENDSEGMENT
  27.  
  28.         SEGMENT ISEG3
  29.         INTEGER NIZO(NZO+1)
  30.         ENDSEGMENT
  31.  
  32.         SEGMENT ISEG4
  33.         INTEGER NUMZO(NZO)
  34.         ENDSEGMENT
  35.  
  36.         SEGMENT ISEG5
  37.         INTEGER NNMEL(ILON),IDEJ(NZO)
  38.         ENDSEGMENT
  39.  
  40.         SEGMENT ISEG6
  41.         REAL*8 AM(4,4),AL(4),A(4),B(4),C(4)
  42.         REAL*8 XPU(2),P(3)
  43.         ENDSEGMENT
  44.  
  45.         SEGMENT MCOORA
  46.         REAL*8  XCOORA(XCOOR(/1))
  47.         ENDSEGMENT
  48. C LA DERNIERE COORDONNEE D'UN POINT N'EST PAS UTILISEE.
  49.  
  50.         SEGMENT MCOOR2
  51.         REAL*8  XCOOR2(XCOOR(/1))
  52.         ENDSEGMENT
  53. C LA DERNIERE COORDONNEE D'UN POINT N'EST PAS UTILISEE.
  54.  
  55.         SEGMENT MCOR
  56.         INTEGER ICOR(IONMAX+1)
  57.         ENDSEGMENT
  58.  
  59.         SEGMENT MCORRE
  60.         INTEGER ICORRE((nbpts))
  61.         ENDSEGMENT
  62.  
  63.         SEGMENT ICP1
  64.         INTEGER ICPR1(nbpts)
  65.         ENDSEGMENT
  66.  
  67.         SEGMENT ICP2
  68.         INTEGER  ICPR2(nbpts)
  69.         ENDSEGMENT
  70.  
  71.         SEGMENT MATRIC
  72.         REAL*8 TABMAT(3,3),invma(3,3)
  73.         ENDSEGMENT
  74.  
  75. C PASSAGE DU MAILLAGE MAI1 EN TRI3
  76.         call change(mai1,4)
  77.         if (ierr.ne.0) return
  78. C CREATION DE LA MATRICE DE CHANGEMENT DE BASE
  79.         segini matric
  80.         v1=xcoor((ip1-1)*(idim+1)+1)
  81.         v2=xcoor((ip1-1)*(idim+1)+2)
  82.         v3=xcoor((ip1-1)*(idim+1)+3)
  83.         r1=sqrt(v1*v1+v2*v2+v3*v3)
  84.         if( r1 . EQ. 0. ) then
  85.           call erreur ( 21 )
  86.         endif
  87.         v1 = V1 / r1
  88.         v2 = v2 / r1
  89.         v3 = v3 / r1
  90.         r2=sqrt(v1*v1+v2*v2)
  91.         if ( r2 . gt. 1.e-5) then
  92.         tabmat(1,1)=-v2/r2
  93.         tabmat(1,2)=v1/r2
  94.         tabmat(1,3)=0.
  95.         else
  96.         tabmat(1,1)=1.
  97.         tabmat(1,2)=0.
  98.         tabmat(1,3)=0.
  99.         endif
  100.         tabmat(2,1)=-v3*tabmat(1,2)
  101.         tabmat(2,2)=v3*tabmat(1,1)
  102.         tabmat(2,3)=v1*tabmat(1,2)-v2*tabmat(1,1)
  103.         tabmat(3,1)=v1
  104.         tabmat(3,2)=v2
  105.         tabmat(3,3)=v3
  106. * pas besoin de diviser par le determinant car egal à 1.
  107.         INVMA(1,1)= TABMAT(2,2)*TABMAT(3,3)-TABMAT(3,2)*TABMAT(2,3)
  108.         INVMA(1,2)=-TABMAT(1,2)*TABMAT(3,3)+TABMAT(3,2)*TABMAT(1,3)
  109.         INVMA(1,3)= TABMAT(1,2)*TABMAT(2,3)-TABMAT(2,2)*TABMAT(1,3)
  110.         INVMA(2,1)=-TABMAT(2,1)*TABMAT(3,3)+TABMAT(3,1)*TABMAT(2,3)
  111.         INVMA(2,2)= TABMAT(1,1)*TABMAT(3,3)-TABMAT(3,1)*TABMAT(1,3)
  112.         INVMA(2,3)=-TABMAT(1,1)*TABMAT(2,3)+TABMAT(2,1)*TABMAT(1,3)
  113.         INVMA(3,1)= TABMAT(2,1)*TABMAT(3,2)-TABMAT(2,2)*TABMAT(3,1)
  114.         INVMA(3,2)=-TABMAT(1,1)*TABMAT(3,2)+TABMAT(3,1)*TABMAT(1,2)
  115.         INVMA(3,3)= TABMAT(1,1)*TABMAT(2,2)-TABMAT(2,1)*TABMAT(1,2)
  116.  
  117. C LISTAGE DES POINTS APPARTENANT A MAI1
  118.         segini icp1
  119.         meleme=mai1
  120.         segact meleme
  121.         nbelem=num(/2)
  122.         nbnn = num(/1)
  123.         Do 10 i=1,nbelem
  124.            Do 20 j=1,nbnn
  125.               ia=num(j,i)
  126.               icpr1(ia)=1
  127. 20          continue
  128. 10      continue
  129.  
  130. C LISTAGE DES POINTS APPARTENANT A MAI2
  131.         ipt1=mai2
  132.         segact ipt1
  133.         segini icp2
  134.         nbelem= ipt1.num(/2)
  135.         nbnn = ipt1.num(/1)
  136.         Do 30 i=1,nbelem
  137.            Do 40 j=1,nbnn
  138.               ia=ipt1.num(j,i)
  139.               If (icpr1(ia).eq.1) then
  140.               icpr2(ia)=2
  141.               else
  142.               icpr2(ia)=1
  143.               Endif
  144. 40          continue
  145. 30      continue
  146.  
  147. C CALCUL DES COORDONNEES DANS LE NOUVEAU REPERE
  148.         segini mcoora
  149.         Do 31 ia=1,nbpts
  150.               If (icpr1(ia).eq.1) then
  151.                  xia1=xcoor((ia-1)*(idim+1)+1)
  152.                  xia2=xcoor((ia-1)*(idim+1)+2)
  153.                  xia3=xcoor((ia-1)*(idim+1)+3)
  154.                  Do 32 j=1,3
  155.                     xcoora((ia-1)*(idim+1)+j)=(xia1*tabmat(j,1))+
  156.      $(xia2*tabmat(j,2))+(xia3*tabmat(j,3))
  157. 32               continue
  158.               Endif
  159. 31      continue
  160.  
  161.         segini mcoor2
  162.         Do 33 ia=1,nbpts
  163.               If (icpr2(ia).eq.1)  then
  164.                  xia1=xcoor((ia-1)*(idim+1)+1)
  165.                  xia2=xcoor((ia-1)*(idim+1)+2)
  166.                  xia3=xcoor((ia-1)*(idim+1)+3)
  167.                  Do 34 j=1,3
  168.                     xcoor2((ia-1)*(idim+1)+j)=(xia1*tabmat(j,1))+
  169.      $(xia2*tabmat(j,2))+(xia3*tabmat(j,3))
  170. 34               continue
  171.               Endif
  172.               If (icpr2(ia).eq.2)  then
  173.                  xia1=xcoor((ia-1)*(idim+1)+1)
  174.                  xia2=xcoor((ia-1)*(idim+1)+2)
  175.                  xia3=xcoor((ia-1)*(idim+1)+3)
  176.                  Do 35 j=1,3
  177.                     xcoor2((ia-1)*(idim+1)+j)=(xia1*tabmat(j,1))+
  178.      $(xia2*tabmat(j,2))+(xia3*tabmat(j,3))
  179. 35               continue
  180.               Endif
  181. 33      continue
  182.  
  183. C******************** DEBUT DU ZONAGE DE MAI1 **********************
  184.  
  185. C ON CALCULE LA TAILLE MAXI D'UN ELEMENT DANS TOUTES LES DIRECTIONS
  186. C AFIN DE CREER UN ZONAGE DE L'ESPACE. EN MEME TEMPS ON CALCULE
  187. C LA DIMENSION HORS TOUT DU MAILLAGE
  188. C
  189.       IDIM1=4
  190.       NBEL = NUM(/2)
  191.       NBNN=NUM(/1)
  192.       SEGINI ISEG1
  193.       ILOC=0
  194.       XZO=0.D0
  195.       YZO=0.D0
  196.       ZZO=0.D0
  197.       XZA=XGRAND
  198.       YZA=XGRAND
  199.       ZZA=XGRAND
  200.       XTOMI=XGRAND
  201.       XTOMA=-XGRAND
  202.       YTOMI=XGRAND
  203.       YTOMA=-XGRAND
  204.       ZTOMI=XGRAND
  205.       ZTOMA=-XGRAND
  206.       DO 1 I1=1,NBEL
  207.          XMI=XGRAND
  208.          YMI=XGRAND
  209.          ZMI=XGRAND
  210.          YMA=-XGRAND
  211.          XMA=-XGRAND
  212.          ZMA=-XGRAND
  213.          DO 2 I2 = 1,NBNN
  214.             IB=NUM(I2,I1)
  215.             IA=(IB-1)*IDIM1
  216.             IF(XCOORA(IA+1).LT.XMI) XMI=XCOORA(IA+1)
  217.             IF(XCOORA(IA+1).GT.XMA) XMA=XCOORA(IA+1)
  218.             IF(XCOORA(IA+2).LT.YMI) YMI=XCOORA(IA+2)
  219.             IF(XCOORA(IA+2).GT.YMA) YMA=XCOORA(IA+2)
  220.     2    CONTINUE
  221.          XLIM(1,I1)=XMI
  222.          XLIM(2,I1)=XMA
  223.          YLIM(1,I1)=YMI
  224.          YLIM(2,I1)=YMA
  225.          XZO=MAX (XZO,XMA-XMI)
  226.          YZO=MAX (YZO,YMA-YMI)
  227.          XZA=MIN(XZA,XMA-XMI)
  228.          YZA=MIN(YZA,YMA-YMI)
  229.          IF(XMI.LT.XTOMI) XTOMI=XMI
  230.          IF(XMA.GT.XTOMA) XTOMA=XMA
  231.          IF(YMI.LT.YTOMI) YTOMI=YMI
  232.          IF(YMA.GT.YTOMA) YTOMA=YMA
  233.  
  234.     1 CONTINUE
  235.       XPR=MIN(XZO*1.D-2,(XTOMA-XTOMI)/2.D+4)
  236.       YPR=MIN(YZO*1.D-2,(YTOMA-YTOMI)/2.D+4)
  237.       XZA=XZA*0.97
  238.       YZA=YZA*0.97
  239.       XTOMI= XTOMI - (XTOMA-XTOMI)/1.D+4
  240.       XTOMA= XTOMA + (XTOMA-XTOMI)/1.D+4
  241.       YTOMI= YTOMI - (YTOMA-YTOMI)/1.D+4
  242.       YTOMA= YTOMA + (YTOMA-YTOMI)/1.D+4
  243.       XZA=MIN ( XZA, XTOMA-XTOMI)
  244.       YZA=MIN ( YZA, YTOMA-YTOMI)
  245.       XZA = max ( xza , (XTOMA-XTOMI) / 50)
  246.       YZA = max ( yza , (YTOMA-YTOMI) / 50)
  247.       NXZO=1
  248.       if (abs(XZA).GT.((XMI+XMA)*XZPREC)) NXZO=int((XTOMA-XTOMI)/XZA)+1
  249.       if (abs(YZA).GT.((YMI+YMA)*XZPREC)) NYZO=int((YTOMA-YTOMI)/YZA)+1
  250.       XZO=XZA
  251.       YZO=YZA
  252.       NZZO=1
  253.        NXDEP=MIN(NXZO,10)
  254.        NYDEP=MIN(NYZO,10)
  255.          IF(FLOAT(NXZO)*FLOAT(NYZO).GT.10000.) THEN
  256.           XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/90
  257.           NXZO=MAX(INT(NXZO/XY),NXDEP)
  258.           NYZO=MAX(INT(NYZO/XY),NYDEP)
  259.           IF(FLOAT(NXZO)*FLOAT(NYZO).GT.10000.) THEN
  260.             XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/60
  261.             NXZO=MAX(INT(NXZO/XY),NXDEP)
  262.             NYZO=MAX(INT(NYZO/XY),NYDEP)
  263.           ENDIF
  264.           XZO=(XTOMA-XTOMI)/NXZO
  265.           YZO=(YTOMA-YTOMI)/NYZO
  266.           NXZO=int((XTOMA-XTOMI)/XZO) +1
  267.           NYZO=int((YTOMA-YTOMI)/YZO) +1
  268.          ENDIF
  269.  
  270. C
  271. C  ON VEUT CONSTRUIRE LA LISTE DES ELEMENTS TOUCHANT UNE ZONE
  272. C  POUR CELA ON COMMENCE PAR COMPTER COMBIEN D'ELEMENT TOUCHENT
  273. C  CHAQUE ZONE ET EN MEME TEMPS ON STOCKE LES ZONES TOUCHEES
  274. C  PAR CHAQUE ELEMENT ET LEUR NOMBRE
  275. C
  276.  
  277.       NZO=NXZO*NYZO
  278.       IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NZO NXZO NYZO NZZO  ''
  279.      $,4I7) ') NZO,NXZO,NYZO,NZZO
  280.       NXYZO=NXZO*NYZO
  281.       if (nzo.lt.0) then
  282.         call erreur(21)
  283.         return
  284.       endif
  285.       SEGINI ISEG3
  286.       SEGINI ISEG4
  287.       DO 3 I1=1,NBEL
  288.           NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) +1
  289.           NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) +1
  290.           NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) +1
  291.           NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) +1
  292.                DO 201 L1=NIZ1Y,NIZ2Y
  293.                DO 2011 L2=NIZ1X,NIZ2X
  294.                    NIZA = L2 + ( L1-1) * NXZO
  295.                    NUMZO(NIZA) = NUMZO(NIZA) +1
  296.  2011          CONTINUE
  297.   201          CONTINUE
  298.     3 CONTINUE
  299. C
  300. C  CONSTRUCTION DU TABLEAU D'ADRESSAGE DU TABLEAU DONNANT LES
  301. C  ELEMENTS CONCERNEES PAR UNE ZONE
  302. C
  303.       ILON=0
  304.       NIZO(1)=1
  305.       DO 202 L1=1,NZO
  306.       NIZO(L1+1)=NIZO(L1)+NUMZO(L1)
  307.       ILON=ILON+ NUMZO(L1)
  308.  202  CONTINUE
  309.  110  FORMAT(16I5)
  310.       SEGINI ISEG5
  311.       DO 5 I1=1,NBEL
  312.           NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) + 1
  313.           NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) + 1
  314.           NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) + 1
  315.           NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) + 1
  316.                DO 203 L1=NIZ1Y,NIZ2Y
  317.                DO 2031 L2=NIZ1X,NIZ2X
  318.                    NIZA = L2 + ( L1-1) * NXZO
  319.                    IAD=NIZO(NIZA)+IDEJ(NIZA)
  320.                    NNMEL(IAD)=I1
  321.                    IDEJ(NIZA)=IDEJ(NIZA)+1
  322.  2031          CONTINUE
  323.   203          CONTINUE
  324.     5  CONTINUE
  325. C *********************** FIN DU ZONAGE DE MAI1 **************************
  326.         prec = 1.E-5
  327.         prec2 = -prec
  328.         prec3 = -2.E-3
  329. C ******RECHERCHE DU NOMBRE D'ELEMENT MAX CONTENU DANS UNE ZONE***********
  330.         la=0
  331.         ls=0
  332.         Do 420 i=1,nzo
  333.           ls=ls+numzo(i)
  334.           If (numzo(i).gt.la) then
  335.           la=numzo(i)
  336.           Endif
  337. 420     continue
  338.         ionmax=la
  339.  
  340. C ****************** TRAITEMENT SUR LES POINTS DE MAI2 *******************
  341.         nbelem=num(/2)
  342.         nbnn=num(/1)
  343.         nbpts2=nbpts
  344.         segini mcor,mcorre,iseg6
  345.         Do 405 ia=1,nbpts2
  346.            If (icpr2(ia).eq.2) then
  347.            icorre(ia)=ia
  348.            Endif
  349.            If (icpr2(ia).eq.1) then
  350.            xpu(1)=xcoor2((ia-1)*(idim+1)+1)
  351.            xpu(2)=xcoor2((ia-1)*(idim+1)+2)
  352.          if (((xpu(1)-xtomi).lt.prec.) .or.
  353.      $ ((xpu(2)-ytomi).lt.prec.) .or.
  354.      $ ((xpu(1)-xtoma).gt.prec2.) .or.
  355.      $ ((xpu(2)-ytoma).gt.prec2.)) then
  356.             call erreur(21)
  357.             return
  358.          endif
  359. C    RECHERCHE DU NUMERO DE LA ZONE CORRESPONDANTE
  360.          k2=int(((xcoor2((ia-1)*(idim+1)+1))-xtomi-xpr)/xzo)+1
  361.          k1=int(((xcoor2((ia-1)*(idim+1)+2))-ytomi-ypr)/yzo)+1
  362.            niza=k2+(k1-1)*nxzo
  363. C    INVENTAIRE DES ELEMENTS CONCERNES PAR LE POINT IA
  364.            iad=nizo(niza)
  365.            Do 406 i=1,numzo(niza)
  366.              i1=nnmel(iad)
  367. C    CALCUL DES COORDONNEES BARYCENTRIQUES DE IA DANS L'ELEMENT I1
  368.              j1=num(1,i1)
  369.              j2=num(2,i1)
  370.              j3=num(3,i1)
  371.              j1idim=(j1-1)*(idim+1)
  372.              j2idim=(j2-1)*(idim+1)
  373.              j3idim=(j3-1)*(idim+1)
  374.              Do 408 l=1,2
  375.                 p(l+1)=xpu(l)
  376.                 am(l+1,1)=xcoora(j1idim+l)
  377.                 am(l+1,2)=xcoora(j2idim+l)
  378.                 am(l+1,3)=xcoora(j3idim+l)
  379. 408          continue
  380.                x1=am(2,1)
  381.                x2=am(2,2)
  382.                x3=am(2,3)
  383.                y1=am(3,1)
  384.                y2=am(3,2)
  385.                y3=am(3,3)
  386.                x=p(2)
  387.                y=p(3)
  388.                detam=x1*y2+x2*y3+x3*y1-y1*x2-y2*x3-y3*x1
  389.                a(1)=x2*y3-y2*x3
  390.                a(2)=x3*y1-x1*y3
  391.                a(3)=x1*y2-x2*y1
  392.                b(1)=y2-y3
  393.                b(2)=y3-y1
  394.                b(3)=y1-y2
  395.                c(1)=x3-x2
  396.                c(2)=x1-x3
  397.                c(3)=x2-x1
  398.                Do 409 k=1,nbnn
  399.                   al(k)=(a(k)+b(k)*x+c(k)*y)/detam
  400. 409            continue
  401. C    TEST DE POSITION SUR LES COORDONNEES BARYCENTRIQUES
  402.              If (al(1).gt.prec3 . and. al(2).gt.prec3 . and.
  403.      $al(3).gt.prec3) then
  404. C    LE POINT EST A L'INTERIEUR DE L'ELEMENT I1
  405.                     icor(1)=icor(1)+1
  406.                     icor(icor(1)+1)=i1
  407.              Endif
  408.                    iad=iad+1
  409.  
  410. 406        continue
  411.          If (icor(1).eq.0) then
  412.            interr(1) = ia
  413.            call erreur(782)
  414.             return
  415.          Endif
  416.          Endif
  417. C    FIN DE L'INVENTAIRE
  418. C    CALCUL DES PROJETES DE MAI2 SUR MAI1
  419.          If  (icpr2(ia).eq.1) then
  420. C    SI IA SE PROJETTE SUR PLUSIEURS ELEMENTS
  421.               dmin=1.e30
  422.               nbpts=nbpts+1
  423.               segadj mcoord
  424.               Do 500 m=1,icor(1)
  425.                 m1=num(1,icor(m+1))
  426.                 m2=num(2,icor(m+1))
  427.                 m3=num(3,icor(m+1))
  428. C               Calcul des coordonnees du projete
  429.                 xm1=xcoora((m1-1)*(idim+1)+1)
  430.                 ym1=xcoora((m1-1)*(idim+1)+2)
  431.                 zm1=xcoora((m1-1)*(idim+1)+3)
  432.                 xm2=xcoora((m2-1)*(idim+1)+1)
  433.                 ym2=xcoora((m2-1)*(idim+1)+2)
  434.                 zm2=xcoora((m2-1)*(idim+1)+3)
  435.                 xm3=xcoora((m3-1)*(idim+1)+1)
  436.                 ym3=xcoora((m3-1)*(idim+1)+2)
  437.                 zm3=xcoora((m3-1)*(idim+1)+3)
  438.                 xnew=xcoor2((ia-1)*(idim+1)+1)
  439.                 ynew=xcoor2((ia-1)*(idim+1)+2)
  440. C               Calcul du zib
  441.                 o1=(ym1-ym2)*(zm1-zm3)-(ym1-ym3)*(zm1-zm2)
  442.                 o2=(zm1-zm2)*(xm1-xm3)-(zm1-zm3)*(xm1-xm2)
  443.                 o3=(xm1-xm2)*(ym1-ym3)-(xm1-xm3)*(ym1-ym2)
  444.                 o4=-(o1*xm1+o2*ym1+o3*zm1)
  445.                 znew=-(o1*xnew+o2*ynew+o4)/o3
  446.                 zpoint = xcoor2((ia-1)*(idim+1)+3)
  447. *               If ((znew-zpoint).gt.0.) then
  448.                   If ((znew-zpoint).lt.dmin) then
  449.                        icorre(ia) = nbpts
  450.                        dmin=znew-zpoint
  451.                        xcoor((nbpts-1)*(idim+1)+1)=xnew
  452.                        xcoor((nbpts-1)*(idim+1)+2)=ynew
  453.                        xcoor((nbpts-1)*(idim+1)+3)=znew
  454.                   Endif
  455. *                Endif
  456. 500           continue
  457.  
  458. C *********************RETOUR A L'ANCIENNE BASE*********************
  459.         ib=nbpts
  460.         xa1=xcoor((ib-1)*(idim+1)+1)
  461.         xa2=xcoor((ib-1)*(idim+1)+2)
  462.         xa3=xcoor((ib-1)*(idim+1)+3)
  463.                  Do 3200 j=1,3
  464.                     xcoor((ib-1)*(idim+1)+j)=(xa1*invma(j,1))+
  465.      $(xa2*invma(j,2))+(xa3*invma(j,3))
  466. 3200               continue
  467.          Endif
  468.         icor(1)=0
  469. 405     continue
  470.  
  471.         segsup iseg1,iseg3,iseg4,iseg5,iseg6,mcoora,mcoor2
  472.         segsup icp1,icp2
  473. C   CREATION DU MAILLAGE PROJETE MAI3
  474.         segini,ipt3=ipt1
  475.         ipt4 = IPT3
  476.         do 2456 IU = 1, max( 1,IPT3.LISOUS(/1))
  477.         If( IPT3.LISOUS(/1).NE.0) THEN
  478.           IPT5=IPT3.LISOUS(IU)
  479.           SEGINI,IPT4=IPT5
  480.           NBREF = 0
  481.           NBSOUS=0
  482.           SEGADJ IPT4
  483.         ENDIF
  484.         nbel1=ipt4.num(/2)
  485.         nbnn1=ipt4.num(/1)
  486.         Do 600 i=1,nbel1
  487.             Do 601 j=1,nbnn1
  488.             ia=ipt4.num(j,i)
  489.             ib=icorre(ia)
  490.             ipt4.num(j,i)=ib
  491. 601         continue
  492. 600     continue
  493. 2456    continue
  494.         do 2457 IU = 1, max( 0,IPT3.LISREF(/1))
  495.         If( IPT3.LISREF(/1).NE.0) THEN
  496.          IPT5 = IPT3.LISREF(IU)
  497.          SEGINI,IPT4=IPT5
  498.         ENDIF
  499.         nbel1=ipt4.num(/2)
  500.         nbnn1=ipt4.num(/1)
  501.         Do 602 i=1,nbel1
  502.             Do 603 j=1,nbnn1
  503.             ia=ipt4.num(j,i)
  504.             ib=icorre(ia)
  505.             ipt4.num(j,i)=ib
  506. 603         continue
  507. 602     continue
  508.         SEGDES IPT4
  509. 2457    continue
  510.         call ecrobj('MAILLAGE',ipt3)
  511.         segdes ipt3,ipt1,meleme
  512.         segsup mcor,mcorre,matric
  513.         Return
  514.         End
  515.  
  516.  
  517.  
  518.  
  519.  
  520.  
  521.  
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  

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