Télécharger la plaquette Cast3M


fr en

Télécharger volumg.eso

Retour à la liste

Numérotation des lignes : 

volumg

  1. C VOLUMG    SOURCE    CB215821  26/08/24    21:18:53     12622          
  2. C    FABRICATION DE CUBES ET PRISMES PAR TRANSLATION D'UNE SURFACE
  3. C    SELON UNE GENERATRICE    (NOVEMBRE 1985)
  4.       SUBROUTINE VOLUMG
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT real*8 (a-h,o-z)
  7. -INC SMELEME
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC SMCOORD
  12. -INC CCGEOME
  13.       logical ltelq
  14.       SEGMENT ICPR(NBNNEL,NBELEC)
  15.       IF (ILCOUR.LT.14.OR.ILCOUR.GT.17) CALL ERREUR(16)
  16.       IF (IERR.NE.0) RETURN
  17.       CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  18.       CALL LIROBJ('MAILLAGE',IPT9,1,IRETOU)
  19.        IF(IERR.NE.0) RETURN
  20. C  IPT9 EST LA GENERATRICE VERIFICATION DU TYPE
  21.       SEGACT IPT9
  22.       IF (IPT9.ITYPEL.NE.KDEGRE(ILCOUR)) THEN
  23.       CALL ERREUR(16)
  24.       SEGDES IPT9
  25.       RETURN
  26.       ENDIF
  27.       ISVOL1=0
  28.       SEGACT IPT1
  29. C  SI IPT1 VOLUME IL FAUT EN EXTRAIRE LA FACE 2
  30.  3100 IF (IPT1.LISOUS(/1).EQ.0) GOTO 1000
  31.       IF (IPT1.LISOUS(/1).NE.2) GOTO 3102
  32.       IDEUX=2
  33.       IPT3=IPT1.LISOUS(1)
  34.       IPT4=IPT1.LISOUS(2)
  35.       SEGACT IPT3,IPT4
  36.       IP=IPT3.ITYPEL*IPT4.ITYPEL
  37.       IF (IP.NE.32.AND.IP.NE.60) GOTO 3101
  38.       IS=IPT3.ITYPEL+IPT4.ITYPEL
  39.       IF (IS.NE.12.AND.IS.NE.16) GOTO 3101
  40.       INCR=1
  41.       IF (IS.EQ.16) INCR=2
  42.       NBNNEL=4*INCR
  43. C  EN FAIT ON CREE UN SEGMENT QUI CONTIENT LES CUBES ET LES TRIANGLES
  44. C  0 DANS LA DERNIERE POSITION DU TRIANGLE
  45.       NBSOUS=0
  46.       NBREF=0
  47.       NBNN=NBNNEL
  48.       NBELE3=IPT3.NUM(/2)
  49.       IF (IPT3.ITYPEL.LE.6) NBTRI=NBELE3
  50.       IF (IPT3.ITYPEL.GE.8) NBQUA=NBELE3
  51.       NBELE4=IPT4.NUM(/2)
  52.       IF (IPT4.ITYPEL.LE.6) NBTRI=NBELE4
  53.       IF (IPT4.ITYPEL.GE.8) NBQUA=NBELE4
  54.       NBELEM=NBELE3+NBELE4
  55.       SEGINI MELEME
  56.       DO 9001 I=1,NBNN
  57.       DO 1100 J=1,NBELEM
  58.       NUM(I,J)=0
  59.  1100 CONTINUE
  60.  9001 CONTINUE
  61.       DO 9002 J=1,NBELE3
  62.       ICOLOR(J)=IPT3.ICOLOR(J)
  63.       DO 1101 I=1,IPT3.NUM(/1)
  64.       NUM(I,J)=IPT3.NUM(I,J)
  65.  1101 CONTINUE
  66.  9002 CONTINUE
  67.       DO 9003 J=1,NBELE4
  68.       ICOLOR(J+NBELE3)=IPT4.ICOLOR(J)
  69.       DO 1102 I=1,IPT4.NUM(/1)
  70.       NUM(I,J+NBELE3)=IPT4.NUM(I,J)
  71.  1102 CONTINUE
  72.  9003 CONTINUE
  73.       SEGDES IPT3,IPT4
  74.       GOTO 1001
  75. C  RECHERCHE DE LA PREMIERE FACE DE IPT1
  76.  3101 SEGDES IPT3,IPT4
  77.  3102 IF (IPT1.LISREF(/1).LT.2) CALL ERREUR(16)
  78.       IF (IERR.NE.0) RETURN
  79.       ISVOL1=IPT1
  80.       IAUX=IPT1.LISREF(2)
  81.       SEGDES IPT1
  82.       IPT1=IAUX
  83.       SEGACT IPT1
  84.       GOTO 3100
  85.  1000 CONTINUE
  86.       IDEUX=1
  87.       NBNNEL=IPT1.NUM(/1)
  88.       NBELEM=IPT1.NUM(/2)
  89.       IF  (IPT1.ITYPEL.NE.8.AND.IPT1.ITYPEL.NE.10.AND.IPT1.ITYPEL.NE.4
  90.      #.AND.IPT1.ITYPEL.NE.6)  GOTO 3102
  91.       INCR=1
  92.       IF (KDEGRE(IPT1.ITYPEL).EQ.3) INCR=2
  93.       MELEME=IPT1
  94.  1001 SEGACT MCOORD*mod
  95.       IPT3=MELEME
  96.       NCOUCH=IPT9.NUM(/2)
  97.       NX=NCOUCH-1
  98.       IF (IIMPI.EQ.1) WRITE(IOIMP,9000) NCOUCH
  99.  9000 FORMAT(/,' COUCHES ',I6)
  100. C  ON FAIT TOUJOURS COMME SI IL N'Y AVAIT QU'UN TYPE D'ELEMENT
  101.       NBSOUS=0
  102. C  MODIF POUR CONSTRUIRE TOUJOURS LE POURTOUR
  103.       NBREF=3
  104.       IF (IPT1.LISREF(/1).NE.0) NBREF=3
  105.       NBNN=2*NBNNEL+(INCR-1)*(NBNNEL/2)
  106.       NBNNV=NBNN
  107.       NBASE=NBELEM
  108.       NBELEM=NBELEM*NCOUCH
  109.       SEGINI IPT7
  110.       IF (NBNNV.EQ.6 ) IPT7.ITYPEL=16
  111.       IF (NBNNV.EQ.15) IPT7.ITYPEL=17
  112.       IF (NBNNV.EQ.8 ) IPT7.ITYPEL=14
  113.       IF (NBNNV.EQ.20) IPT7.ITYPEL=15
  114.       IPT7.LISREF(1)=IPT1
  115.       DO 9004 I=1,NBNN
  116.       DO 1040 J=1,NBELEM
  117.       IPT7.NUM(I,J)=0
  118.  1040 CONTINUE
  119.  9004 CONTINUE
  120.       IOPTG=1
  121. C  CALCUL DU VECTEUR TRANSLATION TOTALE
  122.       IREFB=(IPT9.NUM(1,1)-1)*4
  123.       IREFH=(IPT9.NUM(IPT9.NUM(/1),NCOUCH)-1)*4
  124.       NBPTS=nbpts+1
  125.       SEGADJ MCOORD
  126.       XCOOR((NBPTS-1)*(IDIM+1)+1)=XCOOR(IREFH+1)-XCOOR(IREFB+1)
  127.       XCOOR((NBPTS-1)*(IDIM+1)+2)=XCOOR(IREFH+2)-XCOOR(IREFB+2)
  128.       XCOOR((NBPTS-1)*(IDIM+1)+3)=XCOOR(IREFH+3)-XCOOR(IREFB+3)
  129.       XCOOR(NBPTS*(IDIM+1))=XCOOR(IREFH+4)
  130.       IVEC=NBPTS
  131.       IDEB=IVEC+1
  132.       CALL ECROBJ('POINT ',IVEC)
  133.       CALL ECROBJ('MAILLAGE',IPT1)
  134.       CALL PROPER(IOPTG)
  135.       CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  136.       IF (IERR.NE.0) RETURN
  137. C  IPT3 ET IPT4 ONT ETE DESCENDU DANS L'OPERATION AINSI QUE MCOORD/REFPO
  138.   16  SEGACT IPT1,IPT2,MCOORD
  139.       IPT4=IPT2
  140.       IF (IDEUX.EQ.1) GOTO 15
  141.       IPT5=IPT2.LISOUS(1)
  142.       IPT6=IPT2.LISOUS(2)
  143.       SEGACT IPT5,IPT6
  144. C  ON FAIT COMME POUR LE BAS
  145.       NBSOUS=0
  146.       NBREF=0
  147.       NBNN=4*INCR
  148.       NBNNR=NBNN
  149.       NBELEM=NBELE3+NBELE4
  150.       SEGINI MELEME
  151.       DO 9005 J=1,NBELEM
  152.       DO 1110 I=1,NBNN
  153.       NUM(I,J)=0
  154.  1110 CONTINUE
  155.  9005 CONTINUE
  156.       DO 9006 J=1,NBELE3
  157.       ICOLOR(J)=IPT5.ICOLOR(J)
  158.       DO 1111 I=1,IPT5.NUM(/1)
  159.       NUM(I,J)=IPT5.NUM(I,J)
  160.  1111 CONTINUE
  161.  9006 CONTINUE
  162.       DO 9007 J=1,NBELE4
  163.       ICOLOR(J+NBELE3)=IPT6.ICOLOR(J)
  164.       DO 1112 I=1,IPT6.NUM(/1)
  165.       NUM(I,J+NBELE3)=IPT6.NUM(I,J)
  166.  1112 CONTINUE
  167.  9007 CONTINUE
  168.       SEGDES IPT5,IPT6,IPT2
  169.       IPT4=MELEME
  170.   15  IPT7.LISREF(2)=IPT2
  171. C  CONSTRUCTION DE LA TABLE DES POINTS EFFECTIFS
  172.       NBELEC=IPT3.NUM(/2)
  173.       SEGINI ICPR
  174.       DO 9008 I=1,NBNNEL
  175.       DO 12 J=1,NBELEC
  176.       ICPR(I,J)=0
  177.    12 CONTINUE
  178.  9008 CONTINUE
  179.       DO 9009 J=1,NBELEC
  180.       DO 13 I=1,NBNNEL
  181.       IR=IPT3.NUM(I,J)
  182.       IR2=IPT4.NUM(I,J)
  183.       IF (IR.EQ.0) GOTO 1120
  184.       IF (IR2.EQ.0) GOTO 8833
  185.       I1=IR
  186.       I1R2=IR2
  187.       IF (J.EQ.1) GOTO 13
  188.       JM1=J-1
  189.       DO 9010 JJ=1,JM1
  190.       DO 14 II=1,NBNNEL
  191.       IR=IPT3.NUM(II,JJ)
  192.       IR2=IPT4.NUM(II,JJ)
  193.       IF (IR.EQ.0) GOTO 14
  194.       IF (IR.NE.I1) GOTO 8834
  195.       IF (IR2.NE.I1R2) GOTO 8833
  196.       ICPR(I,J)=II+(JJ-1)*8
  197.       GOTO 13
  198.  8834 IF (IR2.EQ.I1R2) GOTO 8833
  199.   14  CONTINUE
  200.  9010 CONTINUE
  201.       GOTO 13
  202.  1120 ICPR(I,J)=-1
  203.       IF (IR2.NE.0) GOTO 8833
  204.   13  CONTINUE
  205.  9009 CONTINUE
  206.       GOTO 8835
  207.  8833 CONTINUE
  208. C  LES TOPOLOGIES SONT DIFFERENTES
  209.       SEGSUP ICPR
  210.       CALL ERREUR(21)
  211.       RETURN
  212.  8835 CONTINUE
  213. C  ON FABRIQUE POUR LE MOMENT DES CUBES A 8 OU 20 NOEUDS ET DES PRISMES
  214. C  A 6 OU 15 NOEUDS
  215. C  D'ABORD LES POINTS DU BAS
  216.       DO 9011 I=1,NBELEC
  217.        IPT7.ICOLOR(I)=IPT3.ICOLOR(I)
  218.       DO 20 J=1,NBNNEL
  219.       IR=IPT3.NUM(J,I)
  220.       IF (IR.EQ.0) GOTO 20
  221.       IPT7.NUM(J,I)=IR
  222.   20  CONTINUE
  223.  9011 CONTINUE
  224.       IBASE=nbpts
  225. C  ON FABRIQUE ENSUITE LES COUCHES
  226. C  ON AFFECTE SEULEMENT LES NUMEROS DE NOEUDS
  227.       IDIF=(INCR-1)*(NBNNEL/2)
  228.       NX=NCOUCH-1
  229.       DO 21 ICOUCH=1,NCOUCH
  230.       IF (ICOUCH.EQ.NCOUCH) GOTO 21
  231.       JBASE=(ICOUCH-1)*NBELEC
  232.       IF (INCR.EQ.1) GOTO 2000
  233. C  ON FABRIQUE D'ABORD LA COUCHE INTERMEDIAIRE
  234.       DO 9012 J=1,NBELEC
  235.       IPT7.ICOLOR(J+JBASE)=IPT7.ICOLOR(J)
  236.       DO 2001 IA=1,(NBNNEL/2)
  237.       I=2*IA-1
  238.       IF (ICPR(I,J).EQ.-1) GOTO 2001
  239.       IF (ICPR(I,J).NE.0) GOTO 2002
  240.       IBASE=IBASE+1
  241.       IPT7.NUM(IA+NBNNEL,J+JBASE)=IBASE
  242.       GOTO 2001
  243.  2002 IAUX=ICPR(I,J)
  244.       JJ=(IAUX-1)/8+1
  245.       II=IAUX-8*JJ+8
  246.       IIA=(II+1)/2
  247.       IPT7.NUM(IA+NBNNEL,J+JBASE)=IPT7.NUM(IIA+NBNNEL,JJ+JBASE)
  248.  2001 CONTINUE
  249.  9012 CONTINUE
  250.  2000 CONTINUE
  251.       DO 9013 J=1,NBELEC
  252.       IPT7.ICOLOR(J+JBASE)=IPT7.ICOLOR(J)
  253.       DO 22 I=1,NBNNEL
  254.       IF (ICPR(I,J).EQ.-1) GOTO 22
  255.       IF (ICPR(I,J).NE.0) GOTO 23
  256.       IBASE=IBASE+1
  257.       IPT7.NUM(I,J+JBASE+NBELEC)=IBASE
  258.       IPT7.NUM(I+NBNNEL+IDIF,J+JBASE)=IBASE
  259.       GOTO 22
  260.   23  IAUX=ICPR(I,J)
  261.       JJ=(IAUX-1)/8+1
  262.       II=IAUX-8*JJ+8
  263.       IPT7.NUM(I,J+JBASE+NBELEC)=IPT7.NUM(II,JJ+JBASE+NBELEC)
  264.       IPT7.NUM(I+NBNNEL+IDIF,J+JBASE)=IPT7.NUM(II+NBNNEL+IDIF,JJ+JBASE)
  265.   22  CONTINUE
  266.  9013 CONTINUE
  267.   21  CONTINUE
  268.   25  CONTINUE
  269. C  ON FAIT LES POINTS DU HAUT ET EVENTUELLEMENT LA COUCHE INTERMEDIAIRE
  270. C  PRECEDENTE
  271.       JBASE=NBELEC*NX
  272.       IF (INCR.EQ.1) GOTO 2003
  273.       DO 9014 J=1,NBELEC
  274.       IPT7.ICOLOR(J+JBASE)=IPT7.ICOLOR(J)
  275.       DO 2004 IA=1,(NBNNEL/2)
  276.       I=2*IA-1
  277.       IF (ICPR(I,J).EQ.-1) GOTO 2004
  278.       IF (ICPR(I,J).NE.0) GOTO 2005
  279.       IBASE=IBASE+1
  280.       IPT7.NUM(IA+NBNNEL,J+JBASE)=IBASE
  281.       GOTO 2004
  282.  2005 IAUX=ICPR(I,J)
  283.       JJ=(IAUX-1)/8+1
  284.       II=IAUX-8*JJ+8
  285.       IIA=(II+1)/2
  286.       IPT7.NUM(IA+NBNNEL,J+JBASE)=IPT7.NUM(IIA+NBNNEL,JJ+JBASE)
  287.  2004 CONTINUE
  288.  9014 CONTINUE
  289.  2003 CONTINUE
  290.       DO 9015 J=1,NBELEC
  291.       IPT7.ICOLOR(J+JBASE)=IPT7.ICOLOR(J)
  292.       DO 30 I=1,NBNNEL
  293.       IF (ICPR(I,J).EQ.-1) GOTO 30
  294.       IPT7.NUM(I+NBNNEL+IDIF,J+JBASE)=IPT4.NUM(I,J)
  295.   30  CONTINUE
  296.  9015 CONTINUE
  297. C  CREATION DES POINTS
  298.       IADR=nbpts
  299.       NBPTS=IADR+NCOUCH*INCR*NBELEC*NBNNEL
  300.       SEGADJ MCOORD
  301.       DO 61 ICOUCH=1,NCOUCH
  302.       DO 610 IC=1,INCR
  303.       IREFC=(IPT9.NUM(IC+1,ICOUCH)-1)*4
  304.       XPLUS=XCOOR(IREFC+1)-XCOOR(IREFB+1)
  305.       YPLUS=XCOOR(IREFC+2)-XCOOR(IREFB+2)
  306.       ZPLUS=XCOOR(IREFC+3)-XCOOR(IREFB+3)
  307.       TPLUS=XCOOR(IREFC+4)
  308.       IC1=INCR+1-IC
  309.       IF (ICOUCH.EQ.NCOUCH.AND.IC.EQ.INCR) GOTO 610
  310.       DO 620 J=1,NBELEC
  311.       DO 62 I=1,NBNNEL,IC1
  312.       IF (ICPR(I,J).NE.0) GOTO 62
  313.       IREF=4*IPT3.NUM(I,J)-4
  314.       XCOOR(IADR*(IDIM+1)+1)=XCOOR(IREF+1)+XPLUS
  315.       XCOOR(IADR*(IDIM+1)+2)=XCOOR(IREF+2)+YPLUS
  316.       XCOOR(IADR*(IDIM+1)+3)=XCOOR(IREF+3)+ZPLUS
  317.       XCOOR((IADR+1)*(IDIM+1))=TPLUS
  318.       IADR=IADR+1
  319.   62  CONTINUE
  320.  620  CONTINUE
  321.  610  CONTINUE
  322.   61  CONTINUE
  323.       NBPTS=IADR
  324.       SEGADJ MCOORD
  325. C  C'EST FINI
  326. C  IL RESTE DANS LE CAS OU ON A DES CUBES ET DES PRISMES A LES SEPARER
  327. C  ET A SUPPRIMER LES SEGMENTS SUPPLEMENTAIRES DE TRAVAIL
  328. C  D'ABORD FAIRE LE POURTOUR A PARTIR DU CONTOUR
  329.       IF (IPT7.LISREF(/1).EQ.2) GOTO 3000
  330.       CALL ECROBJ('MAILLAGE',IPT1)
  331.       CALL PRCONT
  332.       CALL LIROBJ('MAILLAGE',IPT5,1,IRETOU)
  333.       IF (IERR.NE.0) GOTO 3000
  334. C  IPT5 LE CONTOUR  IPT6 SERA LE POURTOUR
  335.       SEGACT IPT5
  336.       NBASE=IPT5.NUM(/2)
  337.       NBNN=INCR*4
  338.       NBELEM=NBASE*NCOUCH
  339.       NBSOUS=0
  340.       NBREF=0
  341.       SEGINI IPT6
  342.       IPT6.ITYPEL=6+2*INCR
  343.       SEGACT IPT3
  344.       DO 9016 IEL=1,NBASE
  345.       DO 3001 IP=1,INCR+1
  346.       INP=IPT5.NUM(IP,IEL)
  347.       DO 9017 IELS=1,NBELEC
  348.       DO 3003 IPS=1,NBNNEL
  349.       IPSP=IPT3.NUM(IPS,IELS)
  350.       IF (IPSP.EQ.0) GOTO 3003
  351.       IF (IPSP.EQ.INP) GOTO 3002
  352.  3003 CONTINUE
  353.  9017 CONTINUE
  354.       GOTO 3000
  355.  3002 CONTINUE
  356.       DO 3004 IC=1,NCOUCH
  357.       IBASE=(IC-1)*NBASE
  358.       JBASE=(IC-1)*NBELEC
  359. C  PTS DU BAS
  360.       IPT6.NUM(IP,IEL+IBASE)=IPT7.NUM(IPS,IELS+JBASE)
  361. C  PTS DU HAUT
  362.       IPT6.NUM(NBNN+2-INCR-IP,IEL+IBASE)=
  363.      #                 IPT7.NUM(IPS+NBNNEL+IDIF,IELS+JBASE)
  364. C  EVENTUELLEMENT PTS MILIEUX
  365.       IF (INCR.EQ.1.OR.IP.EQ.2) GOTO 3004
  366.       IPT6.NUM(10-2*IP,IEL+IBASE)=IPT7.NUM((IPS+1)/2+NBNNEL,IELS+JBASE)
  367.  3004 CONTINUE
  368.  3001 CONTINUE
  369.  9016 CONTINUE
  370.       DO 9018 I=1,NCOUCH
  371.        DO 3005 J=1,NBASE
  372.               IPT6.ICOLOR(J+(I-1)*NBASE)=IPT5.ICOLOR(J)
  373.  3005 CONTINUE
  374.  9018 CONTINUE
  375.       SEGDES IPT5,IPT6
  376.       IPT7.LISREF(3)=IPT6
  377.  3000 CONTINUE
  378.       IF (IDEUX.EQ.1) GOTO 1500
  379.       SEGSUP IPT3,IPT4
  380.       MELEME=IPT7
  381.       NBSOUS=2
  382.       NBREF=LISREF(/1)
  383.       NBNN=0
  384.       NBELEM=0
  385.       SEGINI IPT7
  386.       IPT7.LISREF(1)=LISREF(1)
  387.       IPT7.LISREF(2)=LISREF(2)
  388.       IF (NBREF.EQ.3) IPT7.LISREF(3)=LISREF(3)
  389.       NBSOUS=0
  390.       NBREF=0
  391.       NBNN=6
  392.       IF (INCR.EQ.2) NBNN=15
  393.       NBELEM=NBTRI*NCOUCH
  394.       SEGINI IPT3
  395.       IPT3.ITYPEL=16
  396.       IF (INCR.EQ.2) IPT3.ITYPEL=17
  397.       IPT7.LISOUS(1)=IPT3
  398.       NBNN=8
  399.       IF (INCR.EQ.2) NBNN=20
  400.       NBELEM=NBQUA*NCOUCH
  401.       SEGINI IPT4
  402.       IPT4.ITYPEL=14
  403.       IF (INCR.EQ.2) IPT4.ITYPEL=15
  404.       IPT7.LISOUS(2)=IPT4
  405.       IT=0
  406.       IQ=0
  407.       DO 1501 J=1,NUM(/2)
  408.       IF (NUM(NBNNV,J).EQ.0) GOTO 1502
  409. C  C'EST UN CUBE
  410.       IQ=IQ+1
  411.       IPT4.ICOLOR(IQ)=ICOLOR(J)
  412.       DO 1503 K=1,IPT4.NUM(/1)
  413.       IPT4.NUM(K,IQ)=NUM(K,J)
  414.  1503 CONTINUE
  415.       GOTO 1501
  416.  1502 IT=IT+1
  417.       IPT3.ICOLOR(IT)=ICOLOR(J)
  418. C  C'EST UN PRISME
  419.       IF (INCR.EQ.2) GOTO 2020
  420.       IPT3.NUM(1,IT)=NUM(1,J)
  421.       IPT3.NUM(2,IT)=NUM(2,J)
  422.       IPT3.NUM(3,IT)=NUM(3,J)
  423.       IPT3.NUM(4,IT)=NUM(NBNNEL+1,J)
  424.       IPT3.NUM(5,IT)=NUM(NBNNEL+2,J)
  425.       IPT3.NUM(6,IT)=NUM(NBNNEL+3,J)
  426.       GOTO 1501
  427.  2020 CONTINUE
  428.       DO 2021 L=1,6
  429.       IPT3.NUM(L,IT)=NUM(L,J)
  430.  2021 CONTINUE
  431.       IPT3.NUM(7,IT)=NUM(NBNNEL+1,J)
  432.       IPT3.NUM(8,IT)=NUM(NBNNEL+2,J)
  433.       IPT3.NUM(9,IT)=NUM(NBNNEL+3,J)
  434.       DO 2022 L=1,6
  435.       IPT3.NUM(L+9,IT)=NUM(NBNNEL+IDIF+L,J)
  436.  2022 CONTINUE
  437.  1501 CONTINUE
  438.       SEGDES IPT3,IPT4
  439.       SEGSUP MELEME
  440.  1500 SEGDES IPT1,IPT2
  441.       SEGSUP ICPR
  442.       IF (ISVOL1.EQ.0) GOTO 3200
  443.       IPT8=ISVOL1
  444.       SEGACT IPT8
  445.       ltelq=.false.
  446.       CALL FUSE(IPT8,IPT7,IRET,ltelq)
  447.       SEGDES IPT7,IPT8
  448.       IPT7=IRET
  449.  3200 CONTINUE
  450.       SEGDES IPT7,IPT9
  451.       CALL ECROBJ('MAILLAGE',IPT7)
  452.       RETURN
  453.       END
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463.  
  464.  
  465.  
  466.  
  467.  
  468.  

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