Télécharger la plaquette Cast3M


fr en

Télécharger modi.eso

Retour à la liste

Numérotation des lignes : 

modi

  1. C MODI      SOURCE    PV        20/08/20    21:15:04     10699          
  2. C   MODIFICATION INTERACTIVE DE MAILLAGE
  3. C
  4.       SUBROUTINE MODI
  5.       IMPLICIT INTEGER(I-N)
  6. -INC CCREEL
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC CCGEOME
  11. -INC SMELEME
  12. -INC SMCOORD
  13.       SEGMENT ICPR(nbpts)
  14.       SEGMENT IVU(ITE)
  15.       SEGMENT NTSEG(LTSEGS)
  16.       SEGMENT /KON1/(KON(NBCON,NMAX)),KON2.KON1
  17.       SEGMENT XPROJ(3,ITE)
  18.       SEGMENT IDCP(ITE)
  19.       SEGMENT IMILL(ITE)
  20.       SEGMENT IBOUJ(ITE)
  21.       COMMON /CMODI/LIGMAX,XPREC,YPREC
  22.       DIMENSION XTR(40),YTR(40),ZTR(40)
  23.       CHARACTER*4 JPROJ,CMOT
  24.       CHARACTER*9 ZONE,ZONE1,ZONE2,ZONE3,ZONE4,ZONF1,ZONF2,ZONF3,ZONF4
  25.       CHARACTER*3 CREP
  26.       LOGICAL VALEUR,FENET
  27.       CHARACTER*4 ITOPT(5)
  28.       CHARACTER*6 LEGEND(7)
  29.       LOGICAL LBLANC
  30. C#      real*8 ddec
  31.       real ddec
  32.       DATA JPROJ/'PROJ'/,ITOPT/'PLAN','SPHE','CYLI','CONI','TORI'/
  33.       DATA LBLANC/.FALSE./
  34.       do i=1,40
  35.         ztr(i)=0
  36.       enddo
  37.       LPROJ=0
  38.       IBOUJ=0
  39.       IPREM=0
  40.       INITIA=0
  41.       JOEIL=0
  42.       DIOCA2=DIOCAD
  43.       LIGMAX=32
  44.       IMILL=0
  45.       KON1=0
  46.       KON2=0
  47.       ICPR=0
  48.       IDCP=0
  49.       IVU=0
  50.       NTSEG=0
  51.       SEGACT MCOORD*MOD
  52.       FENET=.TRUE.
  53.       VALEUR=.FALSE.
  54.       ICACHE=0
  55.       IF (IDIM.EQ.3) ICACHE=1
  56.       CALL LIROBJ('MAILLAGE',MELEME,1,IRET)
  57.       IF (IDIM.EQ.3) CALL LIROBJ('POINT ',JOEIL,1,IRETOU)
  58.       IF (IERR.NE.0) RETURN
  59.       SEGINI ICPR
  60.       ITE=0
  61.       SEGACT MELEME
  62.       IPT1=MELEME
  63.       DO 40 I=1,MAX(1,LISOUS(/1))
  64.          IF (LISOUS(/1).NE.0) IPT1=LISOUS(I)
  65.          SEGACT IPT1
  66.          DO  J=1,IPT1.NUM(/1)
  67.             DO  K=1,IPT1.NUM(/2)
  68.                IPOIT=IPT1.NUM(J,K)
  69.                IF (ICPR(IPOIT).EQ.0) THEN
  70.                  ITE=ITE+1
  71.                  ICPR(IPOIT)=ITE
  72.                ENDIF
  73.             ENDDO
  74.          ENDDO
  75.   40  CONTINUE
  76.       SEGINI XPROJ
  77.       SEGINI IBOUJ
  78.       CALL PROMOD(ICPR,XPROJ,JOEIL,1,IBOUJ)
  79.       IVPR=ICPR(/1)
  80.       SEGINI IDCP
  81.       DO 60 I=1,NBPTS
  82.          IP=ICPR(I)
  83.          IF (IP.EQ.0) GOTO 60
  84.          IDCP(IP)=I
  85.   60  CONTINUE
  86. *  SI REAFFICHAGE IL SE FAIT A PARTIR D'ICI
  87.  1000 CONTINUE
  88.       IF (IMILL.NE.0) SEGSUP IMILL
  89.       SEGINI IMILL
  90.       IPT1=MELEME
  91.       NBCON=9
  92.       NBCONR=NBCON-1
  93.       NMAX=(12*ITE)/NBCON+200
  94.       IF (KON1.NE.0) SEGSUP KON1
  95.       SEGINI KON1
  96. *   KON EST INITIALISE A ZERO
  97. *   REMPLISSAGE DU TABLEAU DES CONNECTIONS
  98.       ICHAIN=ITE
  99.       DO 285 IO=1,MAX(1,LISOUS(/1))
  100.          IF (LISOUS(/1).NE.0) IPT1=LISOUS(IO)
  101.          SEGACT IPT1
  102.          K=IPT1.ITYPEL
  103. *
  104.          IDEP=LPT(K)
  105.          IFIN1=IDEP+2*LPL(K)-2
  106.          IFIN2=IFIN1
  107.          IF (LPL(K).EQ.0) THEN
  108.            IF (LPT(K).EQ.0)THEN
  109.              GOTO 270
  110.             ELSE
  111. C             Polygone
  112.               IFIN1=IDEP+2*IPT1.NUM(/1)-2
  113.               IFIN2=IFIN1 -2
  114.             ENDIF
  115.          ENDIF
  116.          DO 260 I=1,IPT1.NUM(/2)
  117.             IS=1
  118.             DO 250 J=IDEP,IFIN1,2
  119.                IF (J.LE.IFIN2) THEN
  120.                  N1=ICPR(IPT1.NUM(KSEGM(J),I))
  121.                  N2=ICPR(IPT1.NUM(KSEGM(J+1),I))
  122.                ELSE
  123. C                Polygone
  124.                  N1=ICPR(IPT1.NUM(KSEGM(IFIN2+1),I))
  125.                  N2=ICPR(IPT1.NUM(KSEGM(1),I))
  126.                ENDIF
  127.                NI=N1
  128.                NJ=N2
  129.                IF (N1*N2.EQ.0) GOTO 290
  130.                IPO=0
  131.  110           CONTINUE
  132.                NII=NI
  133.  120           DO 170 K=1,NBCONR
  134.                   IF (KON(K,NI).GE.NJ) GOTO 130
  135.                   KSAUV1=NJ
  136.                   GOTO 200
  137.  130              IF (KON(K,NI).NE.NJ) GOTO 170
  138.                   JJ=0
  139.  140              DO 150 II=1,NBCONR
  140.                      IF (KON(II,NJ).EQ.NII) THEN
  141.                         GOTO 160
  142.                      ENDIF
  143.  150              CONTINUE
  144.                   IF (KON(NBCON,NJ).NE.0) THEN
  145.                      NJ=KON(NBCON,NJ)
  146.                      GOTO 140
  147.                   ENDIF
  148.  160             CONTINUE
  149.                  GOTO 250
  150.  170          CONTINUE
  151.               IF (KON(NBCON,NI).EQ.0) GOTO 180
  152.               NI=KON(NBCON,NI)
  153.               GOTO 120
  154.  180          KSAUV1=NJ
  155.  190          ICHAIN=ICHAIN+1
  156.               IF (ICHAIN.EQ.NMAX) GOTO 290
  157.               KON(NBCON,NI)=ICHAIN
  158.               K=1
  159.               NI=ICHAIN
  160.  200          KSAUV=KON(K,NI)
  161.               KON(K,NI)=KSAUV1
  162.               KSAUV1=KSAUV
  163.               IF (KSAUV.EQ.0) GOTO 240
  164.               KDEP=K+1
  165.               IF (KDEP.EQ.NBCON) GOTO 230
  166.  210          DO 220 KHE=KDEP,NBCONR
  167.                  KSAUV=KON(KHE,NI)
  168.                  KON(KHE,NI)=KSAUV1
  169.                  IF (KSAUV.EQ.0) GOTO 240
  170.                  KSAUV1=KSAUV
  171.  220          CONTINUE
  172.  230          IF (KON(NBCON,NI).EQ.0) GOTO 190
  173.               NI=KON(NBCON,NI)
  174.               KDEP=1
  175.               GOTO 210
  176.  240          IF (NJ.NE.N2.OR.IPO.EQ.1) GOTO 250
  177.               NI=N2
  178.               NJ=N1
  179.               IPO=1
  180.               GOTO 110
  181.  250       CONTINUE
  182.  260     CONTINUE
  183.  270     CONTINUE
  184.  285  CONTINUE
  185.       GOTO 300
  186.  290  CALL ERREUR(23)
  187.       RETURN
  188.  300  CONTINUE
  189. *
  190. C#      XMIN=xgrand
  191.       XMIN=xsgran
  192.       XMAX=-XMIN
  193.       YMIN=XMIN
  194.       TMIN=XMIN
  195.       YMAX=XMAX
  196.       TMAX=XMAX
  197.       DO 400 I=1,ITE
  198.          XMIN=MIN(XMIN,XPROJ(1,I))
  199.          XMAX=MAX(XMAX,XPROJ(1,I))
  200.          YMIN=MIN(YMIN,XPROJ(2,I))
  201.          YMAX=MAX(YMAX,XPROJ(2,I))
  202.          TMIN=MIN(TMIN,XPROJ(3,I))
  203.          TMAX=MAX(TMAX,XPROJ(3,I))
  204.  400  CONTINUE
  205.       XDEC=XMAX-XMIN
  206.       YDEC=YMAX-YMIN
  207.       DDEC=MAX(XDEC,YDEC)*0.01
  208. C#      DDEC=MAX(DDEC,xpetit)
  209.       DDEC=MAX(DDEC,xspeti)
  210.       XMAX=XMAX+DDEC
  211.       XMIN=XMIN-DDEC
  212.       YMIN=YMIN-DDEC
  213.       YMAX=YMAX+DDEC
  214.       IF (INITIA.EQ.0) THEN
  215.          INITIA=1
  216.          XMI=XMIN
  217.          XMA=XMAX
  218.          YMI=YMIN
  219.          YMA=YMAX
  220.       ENDIF
  221. *
  222.       IF (IPREM.EQ.0.AND.IDIM.EQ.3) THEN
  223.          CALL TRINIT(25,DIOCA2,DIOCA2,TITREE,0.15,VALEUR,NCOUMA)
  224.          CALL DFENET(0.,80.,0.,25.,-1.,1.,X1,X2,Y1,Y2,.TRUE.)
  225.          CALL MOIN(LPROJ,LPPR1,LPPR2,LPPR3,LPPR4)
  226.          IPREM=1
  227.       ENDIF
  228.  405  CONTINUE
  229.       CALL TRINIT(25,DIOCA2,DIOCA2,TITREE,0.15,VALEUR,NCOUMA)
  230.       CALL DFENET(0.,80.,0.,25.,-1.,1.,X1,X2,Y1,Y2,.TRUE.)
  231.       CALL CHCOUL(0)
  232. *      OBTENIR LES BONNES VALEURS DU CADRE
  233.       CALL TRLABL(0.,16.,0.,'Cadre actuel ci dessous',23,1.)
  234.       CALL TRLABL(0.,2.,0.,'   Xmin',7,1.)
  235.       CALL TRLABL(0.,4.,0.,'   Xmax',7,1.)
  236.       CALL TRLABL(0.,6.,0.,'   Ymin',7,1.)
  237.       CALL TRLABL(0.,8.,0.,'   Ymax',7,1.)
  238.       WRITE (ZONE1,FMT='(G9.2)') XMI
  239.       CALL TRLABL(40.,2.,0.,ZONE1,9,1.)
  240.       WRITE (ZONE2,FMT='(G9.2)') XMA
  241.       CALL TRLABL(40.,4.,0.,ZONE2,9,1.)
  242.       WRITE (ZONE3,FMT='(G9.2)') YMI
  243.       CALL TRLABL(40.,6.,0.,ZONE3,9,1.)
  244.       WRITE (ZONE4,FMT='(G9.2)') YMA
  245.       CALL TRLABL(40.,8.,0.,ZONE4,9,1.)
  246.       GOTO 404
  247.  403  CONTINUE
  248.       CALL TRMESS('Valeur incorrecte recommencez')
  249.  404  CONTINUE
  250.       LEGEND(1)=' '
  251.       LEGEND(2)='Xmin ?'
  252.       LEGEND(3)='Xmax ?'
  253.       LEGEND(4)='Ymin ?'
  254.       LEGEND(5)='Ymax ?'
  255.       LEGEND(6)='Auto'
  256.       LEGEND(7)='Cont'
  257.       CALL MENU(LEGEND,7,6)
  258.       CALL TRAFF(ICLE)
  259.       IF (ICLE.EQ.5) THEN
  260.       INCLE=0
  261.         XMI=XMIN
  262.         XMA=XMAX
  263.         YMI=YMIN
  264.         YMA=YMAX
  265.       ELSEIF (ICLE.EQ.6) THEN
  266.       INCLE=0
  267.       ELSEIF (ICLE.EQ.1) THEN
  268.       CALL TRGET('NOUVELLE VALEUR DE XMIN :',ZONF1)
  269.       INCLE=1
  270.       IF (ZONF1.NE.ZONE1) READ  (ZONF1,FMT='(G9.2)',ERR=403) XMI
  271.       ELSEIF (ICLE.EQ.2) THEN
  272.       CALL TRGET('NOUVELLE VALEUR DE XMAX :',ZONF2)
  273.       INCLE=1
  274.       IF (ZONF2.NE.ZONE2) READ  (ZONF2,FMT='(G9.2)',ERR=403) XMA
  275.       ELSEIF (ICLE.EQ.3) THEN
  276.       CALL TRGET('NOUVELLE VALEUR DE YMIN :',ZONF3)
  277.       INCLE=1
  278.       IF (ZONF3.NE.ZONE3) READ  (ZONF3,FMT='(G9.2)',ERR=403) YMI
  279.       ELSEIF (ICLE.EQ.4) THEN
  280.       CALL TRGET('NOUVELLE VALEUR DE YMAX :',ZONF4)
  281.       INCLE=1
  282.       IF (ZONF4.NE.ZONE4) READ  (ZONF4,FMT='(G9.2)',ERR=403) YMA
  283.       ENDIF
  284.       IF (INCLE.EQ.1) GOTO 405
  285.       CALL TRINIT(25,DIOCA2,DIOCA2,TITREE,0.15,VALEUR,NCOUMA)
  286.       CALL DFENET(XMI,XMA,YMI,YMA,-1.,1.,X1,X2,Y1,Y2,FENET)
  287. *  POUR TRAVAILLER EN NON SEGMENTE
  288.       XPREC=(XMA-XMI)/100
  289.       YPREC=(YMA-YMI)/100
  290.       XPREC=MAX(XPREC,YPREC)
  291.       YPREC=MAX(XPREC,YPREC)
  292. *   INITIALISATION DE IVU
  293. *   IVU=1  PT VU
  294. *   IVU<>1 PT PAS VU
  295.       IF (IVU.NE.0) SEGSUP IVU
  296.       SEGINI IVU
  297.       DO 410 I=1,ITE
  298.          IVU(I)=1
  299.  410  CONTINUE
  300.       IF (ICACHE.NE.0) THEN
  301.          MCOUP=0
  302.          CALL TIRET3(XPROJ,MELEME,ICPR,XMIN,XMAX,YMIN,YMAX,IVU,NELEM,
  303.      #    TMIN,TMAX,MCOUP)
  304.          SEGACT ICPR
  305.       ENDIF
  306.       IF (NTSEG.NE.0) SEGSUP NTSEG
  307.       IF (ICACHE.EQ.1) THEN
  308.             LTSEGS=1000
  309.             SEGINI NTSEG
  310.             LTSEG=0
  311.       ENDIF
  312.       CALL CHCOUL(2)
  313.       IF (KON2.NE.0) SEGSUP KON2
  314.       SEGINI,KON2=KON1
  315.       SEGACT KON1*MOD
  316.       ITR=1
  317.       KAUX=1
  318.  500  K=KAUX
  319.       IF (IVU(KAUX).NE.1) GOTO 530
  320.       KAUXR=KAUX
  321.  510  DO 520 KL=1,NBCONR
  322.       ITRA=KON(KL,K)
  323.       IF (ITRA.LT.0) GOTO 520
  324.       IF (ITRA.EQ.0) GOTO 530
  325.       IF (IVU(ITRA).EQ.1) GOTO 540
  326.  520  CONTINUE
  327.       K=KON(NBCON,K)
  328.       IF (K.NE.0) GOTO 510
  329.  530  KAUX=KAUX+1
  330.       IF (KAUX.EQ.ITE+1) GOTO 630
  331.       GOTO 500
  332.  540  CONTINUE
  333.       IF (ITR.GT.1) THEN
  334.        CALL POLRL(ITR,XTR,YTR,ZTR)
  335.       ENDIF
  336.       ITR=1
  337.       XTR(1)=XPROJ(1,KAUXR)
  338.       YTR(1)=XPROJ(2,KAUXR)
  339.       KPRESS=KAUXR
  340.       GOTO 560
  341.  550  KL=1
  342.  560  DO 570 L=KL,NBCONR
  343.       M=KON(L,K)
  344.       IF (M.EQ.0) GOTO 500
  345.       IF (M.LT.0) GOTO 570
  346.       IF (IVU(M).NE.1) GOTO 570
  347.       GOTO 580
  348.  570  CONTINUE
  349.       K=KON(NBCON,K)
  350.       IF (K.EQ.0) GOTO 500
  351.       GOTO 550
  352.  580  CONTINUE
  353.       ITR=ITR+1
  354.       XTR(ITR)=XPROJ(1,M)
  355.       YTR(ITR)=XPROJ(2,M)
  356.       IF (ITR.EQ.40) THEN
  357.        CALL POLRL(ITR,XTR,YTR,ZTR)
  358.        XTR(1)=XTR(ITR)
  359.        YTR(1)=YTR(ITR)
  360.        ITR=1
  361.       ENDIF
  362.       KON(L,K)=-KON(L,K)
  363.       M1=M
  364.  590  DO 600 L=1,NBCONR
  365.       IF (KON(L,M1).EQ.0) GOTO 620
  366.       IF (KON(L,M1).EQ.KPRESS) GOTO 610
  367.  600  CONTINUE
  368.       M1=KON(NBCON,M1)
  369.       IF (M1.EQ.0) GOTO 620
  370.       GOTO 590
  371.  610  KON(L,M1)=-KON(L,M1)
  372.  620  KPRESS=M
  374.       GOTO 550
  375.  630  CONTINUE
  376.       IF (ITR.GT.1) CALL POLRL(ITR,XTR,YTR,ZTR)
  377.       ITR=1
  378.       IF (ICACHE.EQ.0) GOTO 670
  379. C  ON REMPLIT ISEGM AVEC LES SEGMENTS EN PARTIE VU
  380.       DO 660 K=1,ITE
  381.       IF (IVU(K).NE.1) GOTO 660
  382.       KK=K
  383.  640  DO 650 KL=1,NBCONR
  384.       ITRA=KON(KL,KK)
  385.       IF (ITRA.LT.0) GOTO 650
  386.       IF (ITRA.EQ.0) GOTO 660
  387.       IF (LTSEGS-LTSEG.LT.10) THEN
  388.               LTSEGS=LTSEGS+1000
  389.               SEGADJ NTSEG
  390.       ENDIF
  391.       NTSEG(LTSEG+1)=K
  392.       NTSEG(LTSEG+2)=ITRA
  393.       NTSEG(LTSEG+3)=2
  394.       LTSEG=LTSEG+3
  395.  650  CONTINUE
  396.       KK=KON(NBCON,KK)
  397.       IF (KK.NE.0) GOTO 640
  398.  660  CONTINUE
  399.  670  CONTINUE
  400.       SEGDES KON1
  401.       IF (ICACHE.NE.0) THEN
  402.       CALL DICHO3(XPROJ,MELEME,ICPR,XMIN,XMAX,
  403.      #  YMIN,YMAX,IVU,NTSEG,NELEM,IDCOUL,IDCOUL,LBLANC,LTSEG)
  404.       SEGACT MELEME
  405.       DO 671 IO=1,LISOUS(/1)
  406.       IPT1=LISOUS(IO)
  407.       SEGACT IPT1
  408.  671  CONTINUE
  409.       ENDIF
  410.  1010 CONTINUE
  411.       CALL MENUU
  412.       CALL TRAFF(ICLE)
  413. *  DEMANDE DE REAFFICHAGE
  414.       IF (ICLE.EQ.11) GOTO 1000
  415. *  DEPLACEMENT DE NOEUD
  416.       IF (ICLE.EQ.1) THEN
  417.       CALL MODP(XPROJ,IVU,KON2,ICPR,IDCP,IBOUJ)
  418.       GOTO 1010
  419.       ENDIF
  420. *  NOMMER UN NOEUD
  421.       IF (ICLE.EQ.2) THEN
  422.           CALL MONO(XPROJ,IVU,IDCP)
  423.           GOTO 1010
  424.       ENDIF
  425. *  SUPPRIMER UN ELEMENT
  426.       IF (ICLE.EQ.3) THEN
  427.           CALL MOSU(XPROJ,IVU,ICPR,MELEME)
  428.           GOTO 1010
  429.       ENDIF
  430. *  CREATION D'UN ELEMENT
  431.       IF (ICLE.EQ.4) THEN
  432.           CALL MOCR(XPROJ,IVU,IDCP,MELEME,ICPR,ITE,IMILL,TMIN,IBOUJ)
  433.           GOTO 1010
  434.        ENDIF
  435. *  NOMMER UN ENSEMBLE D'ELEMENT
  436.       IF (ICLE.EQ.5) THEN
  437.           CALL MONL(XPROJ,IVU,ICPR,MELEME)
  438.           GOTO 1010
  439.        ENDIF
  440. *  ECRITURE COORDONNEES
  441.       IF (ICLE.EQ.6) THEN
  442.           CALL MOCO(XPROJ,IVU,KON2,IDCP,ICPR,IBOUJ)
  443.           GOTO 1010
  444.       ENDIF
  445. *  AFFICHAGE NOMS DES POINTS
  446.       IF (ICLE.EQ.7) THEN
  447.           CALL MOPO(XPROJ,ICPR,IVU)
  448.           GOTO 1010
  449.       ENDIF
  450. *  AFFICHAGE CONTOUR
  451.       IF (ICLE.EQ.8) THEN
  452.           CALL MOCT(XPROJ,ICPR,IVU,MELEME)
  453.           GOTO 1010
  454.       ENDIF
  455. *  DEMANDE DE ZOOM
  456.       IF (ICLE.EQ.9) THEN
  457.         CALL TRMESS('Entrez le premier point pour le zoom')
  458.           CALL TRDIG(X1,Y1,INCLE)
  459.         CALL TRMESS('Entrez le second point pour le zoom')
  460.           CALL TRDIG(X2,Y2,INCLE)
  461.           XMI=MIN(X1,X2)
  462.           XMA=MAX(X1,X2)
  463.           YMI=MIN(Y1,Y2)
  464.           YMA=MAX(Y1,Y2)
  465.           GOTO 1000
  466.       ENDIF
  467. *  RECENTRAGE DES NOEUDS MILIEUX
  468.       IF (ICLE.EQ.10) THEN
  469.           CALL MOCE(MELEME,XPROJ,ICPR,IBOUJ)
  470.           GOTO 1000
  471.       ENDIF
  472.       IF (ICLE.LT.0) GOTO 1010
  473.       CALL PROMOD(ICPR,XPROJ,JOEIL,2,IBOUJ)
  474.       IF (LPROJ.EQ.0) GOTO 2100
  475.       NBELEM=0
  476.       DO 2000 I=1,ITE
  477.        IF (IBOUJ(I).EQ.0) GOTO 2000
  478.        NBELEM=NBELEM+1
  479.  2000 CONTINUE
  480.       IF (NBELEM.EQ.0) GOTO 2100
  481.       NBNN=1
  482.       NBREF=0
  483.       NBSOUS=0
  484.       SEGINI MELEME
  485.       ITYPEL=1
  486.       ICC=0
  487.       DO 2010 I=1,ITE
  488.        IF (IBOUJ(I).EQ.0) GOTO 2010
  489.        ICC=ICC+1
  490.        NUM(1,ICC)=IDCP(I)
  491.  2010 CONTINUE
  492. *  TORE
  493.       IF (LPROJ.EQ.5) THEN
  494.        CALL ECROBJ('POINT ',LPPR4)
  495.        CALL ECROBJ('POINT ',LPPR3)
  496.        CALL ECROBJ('POINT ',LPPR2)
  497.        CALL ECROBJ('POINT ',LPPR1)
  498. *  CONE
  499.       ELSEIF (LPROJ.EQ.4) THEN
  500.        CALL ECROBJ('POINT ',LPPR3)
  501.        CALL ECROBJ('POINT ',LPPR2)
  502.        CALL ECROBJ('POINT ',LPPR1)
  503. *  CYLINDRE
  504.       ELSEIF (LPROJ.EQ.3) THEN
  505.        CALL ECROBJ('POINT ',LPPR3)
  506.        CALL ECROBJ('POINT ',LPPR2)
  507.        CALL ECROBJ('POINT ',LPPR1)
  508. *  SPHERE
  509.       ELSEIF (LPROJ.EQ.2) THEN
  510.        CALL ECROBJ('POINT ',LPPR2)
  511.        CALL ECROBJ('POINT ',LPPR1)
  512. *  PLAN
  513.       ELSEIF (LPROJ.EQ.1) THEN
  514.        CALL ECROBJ('POINT ',LPPR3)
  515.        CALL ECROBJ('POINT ',LPPR2)
  516.        CALL ECROBJ('POINT ',LPPR1)
  517.       ENDIF
  518.       CALL ECRCHA(ITOPT(LPROJ))
  519.       CALL ECROBJ('POINT ',IVPR)
  520.       CALL ECRCHA(JPROJ)
  521.       CALL ECROBJ('MAILLAGE',MELEME)
  522.       CALL DEPLAC
  523.       SEGSUP MELEME
  524.  2100 CONTINUE
  525.       SEGSUP XPROJ,ICPR,IVU
  526.       IF (NTSEG.NE.0) SEGSUP NTSEG
  527.       IF (KON1.NE.0) SEGSUP KON1
  528.       IF (KON2.NE.0) SEGSUP KON2
  529.       IF (IDCP.NE.0) SEGSUP IDCP
  530.       IF (IMILL.NE.0) SEGSUP IMILL
  531.       IF (IBOUJ.NE.0) SEGSUP IBOUJ
  532. * LB
  533.       CALL TRMFIN
  534.       RETURN
  535. *LB
  536.       END
  537.  
  538.  
  539.  
  540.  
  541.  
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548.  
  549.  

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