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

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