C MODI      SOURCE    CHAT      07/10/29    21:24:45     5940           
C   MODIFICATION INTERACTIVE DE MAILLAGE
C
      SUBROUTINE MODI
      IMPLICIT INTEGER(I-N)
-INC CCREEL
-INC CCOPTIO
-INC CCGEOME
-INC SMELEME
-INC SMCOORD
      SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
      SEGMENT IVU(ITE)
      SEGMENT NTSEG(LTSEGS)
      SEGMENT /KON1/(KON(NBCON,NMAX)),KON2.KON1
      SEGMENT XPROJ(3,ITE)
      SEGMENT IDCP(ITE)
      SEGMENT IMILL(ITE)
      SEGMENT IBOUJ(ITE)
      COMMON /CMODI/LIGMAX,XPREC,YPREC
      DIMENSION XTR(40),YTR(40),ZTR(40)
      CHARACTER*4 JPROJ,CMOT
      CHARACTER*9 ZONE,ZONE1,ZONE2,ZONE3,ZONE4,ZONF1,ZONF2,ZONF3,ZONF4
      CHARACTER*3 CREP
      LOGICAL VALEUR,FENET
      CHARACTER*4 ITOPT(5)
      CHARACTER*6 LEGEND(7)
      LOGICAL LBLANC
C#      real*8 ddec
      real ddec
      DATA JPROJ/'PROJ'/,ITOPT/'PLAN','SPHE','CYLI','CONI','TORI'/
      DATA LBLANC/.FALSE./
      do i=1,40
        ztr(i)=0
      enddo
      LPROJ=0
      IBOUJ=0
      IPREM=0
      INITIA=0
      JOEIL=0
      DIOCA2=DIOCAD
      LIGMAX=32
      IMILL=0
      KON1=0
      KON2=0
      ICPR=0
      IDCP=0
      IVU=0
      NTSEG=0
      SEGACT MCOORD*MOD
      NBPTS=XCOOR(/1)/(IDIM+1)
      FENET=.TRUE.
      VALEUR=.FALSE.
      ICACHE=0
      IF (IDIM.EQ.3) ICACHE=1
      CALL LIROBJ('MAILLAGE',MELEME,1,IRET)
      IF (IDIM.EQ.3) CALL LIROBJ('POINT ',JOEIL,1,IRETOU)
      IF (IERR.NE.0) RETURN
      SEGINI ICPR
      ITE=0
      SEGACT MELEME
      IPT1=MELEME
      DO 40 I=1,MAX(1,LISOUS(/1))
         IF (LISOUS(/1).NE.0) IPT1=LISOUS(I)
         SEGACT IPT1
         DO 30 J=1,IPT1.NUM(/1)
            DO 30 K=1,IPT1.NUM(/2)
               IPOIT=IPT1.NUM(J,K)
               IF (ICPR(IPOIT).NE.0) GOTO 30
               ITE=ITE+1
               ICPR(IPOIT)=ITE
  30     CONTINUE
  40  CONTINUE
      SEGINI XPROJ
      SEGINI IBOUJ
      CALL PROMOD(ICPR,XPROJ,JOEIL,1,IBOUJ)
      IVPR=ICPR(/1)
      SEGINI IDCP
      DO 60 I=1,NBPTS
         IP=ICPR(I)
         IF (IP.EQ.0) GOTO 60
         IDCP(IP)=I
  60  CONTINUE
*  SI REAFFICHAGE IL SE FAIT A PARTIR D'ICI
 1000 CONTINUE
      IF (IMILL.NE.0) SEGSUP IMILL
      SEGINI IMILL
      IPT1=MELEME
      NBCON=9
      NBCONR=NBCON-1
      NMAX=(12*ITE)/NBCON+200
      IF (KON1.NE.0) SEGSUP KON1
      SEGINI KON1
*   KON EST INITIALISE A ZERO
*   REMPLISSAGE DU TABLEAU DES CONNECTIONS
      ICHAIN=ITE
      DO 285 IO=1,MAX(1,LISOUS(/1))
         IF (LISOUS(/1).NE.0) IPT1=LISOUS(IO)
         SEGACT IPT1
         K=IPT1.ITYPEL
*
         IDEP=LPT(K)
         IFIN1=IDEP+2*LPL(K)-2
         IFIN2=IFIN1
         IF (LPL(K).EQ.0) THEN
           IF (LPT(K).EQ.0)THEN
             GOTO 270
            ELSE
C             Polygone
              IFIN1=IDEP+2*IPT1.NUM(/1)-2
              IFIN2=IFIN1 -2
            ENDIF
         ENDIF
         DO 260 I=1,IPT1.NUM(/2)
            IS=1
            DO 250 J=IDEP,IFIN1,2
               IF (J.LE.IFIN2) THEN
                 N1=ICPR(IPT1.NUM(KSEGM(J),I))
                 N2=ICPR(IPT1.NUM(KSEGM(J+1),I))
               ELSE
C                Polygone
                 N1=ICPR(IPT1.NUM(KSEGM(IFIN2+1),I))
                 N2=ICPR(IPT1.NUM(KSEGM(1),I))
               ENDIF
               NI=N1
               NJ=N2
               IF (N1*N2.EQ.0) GOTO 290
               IPO=0
 110           CONTINUE
               NII=NI
 120           DO 170 K=1,NBCONR
                  IF (KON(K,NI).GE.NJ) GOTO 130
                  KSAUV1=NJ
                  GOTO 200
 130              IF (KON(K,NI).NE.NJ) GOTO 170
                  JJ=0
 140              DO 150 II=1,NBCONR
                     IF (KON(II,NJ).EQ.NII) THEN
                        GOTO 160
                     ENDIF
 150              CONTINUE
                  IF (KON(NBCON,NJ).NE.0) THEN
                     NJ=KON(NBCON,NJ)
                     GOTO 140
                  ENDIF
 160             CONTINUE
                 GOTO 250
 170          CONTINUE
              IF (KON(NBCON,NI).EQ.0) GOTO 180
              NI=KON(NBCON,NI)
              GOTO 120
 180          KSAUV1=NJ
 190          ICHAIN=ICHAIN+1
              IF (ICHAIN.EQ.NMAX) GOTO 290
              KON(NBCON,NI)=ICHAIN
              K=1
              NI=ICHAIN
 200          KSAUV=KON(K,NI)
              KON(K,NI)=KSAUV1
              KSAUV1=KSAUV
              IF (KSAUV.EQ.0) GOTO 240
              KDEP=K+1
              IF (KDEP.EQ.NBCON) GOTO 230
 210          DO 220 KHE=KDEP,NBCONR
                 KSAUV=KON(KHE,NI)
                 KON(KHE,NI)=KSAUV1
                 IF (KSAUV.EQ.0) GOTO 240
                 KSAUV1=KSAUV
 220          CONTINUE
 230          IF (KON(NBCON,NI).EQ.0) GOTO 190
              NI=KON(NBCON,NI)
              KDEP=1
              GOTO 210
 240          IF (NJ.NE.N2.OR.IPO.EQ.1) GOTO 250
              NI=N2
              NJ=N1
              IPO=1
              GOTO 110
 250       CONTINUE
 260     CONTINUE
 270     CONTINUE
 285  CONTINUE
      GOTO 300
 290  CALL ERREUR(23)
      RETURN
 300  CONTINUE
*
C#      XMIN=xgrand
      XMIN=xsgran
      XMAX=-XMIN
      YMIN=XMIN
      TMIN=XMIN
      YMAX=XMAX
      TMAX=XMAX
      DO 400 I=1,ITE
         XMIN=MIN(XMIN,XPROJ(1,I))
         XMAX=MAX(XMAX,XPROJ(1,I))
         YMIN=MIN(YMIN,XPROJ(2,I))
         YMAX=MAX(YMAX,XPROJ(2,I))
         TMIN=MIN(TMIN,XPROJ(3,I))
         TMAX=MAX(TMAX,XPROJ(3,I))
 400  CONTINUE
      XDEC=XMAX-XMIN
      YDEC=YMAX-YMIN
      DDEC=MAX(XDEC,YDEC)*0.01
C#      DDEC=MAX(DDEC,xpetit)
      DDEC=MAX(DDEC,xspeti)
      XMAX=XMAX+DDEC
      XMIN=XMIN-DDEC
      YMIN=YMIN-DDEC
      YMAX=YMAX+DDEC
      IF (INITIA.EQ.0) THEN
         INITIA=1
         XMI=XMIN
         XMA=XMAX
         YMI=YMIN
         YMA=YMAX
      ENDIF
*
      IF (IPREM.EQ.0.AND.IDIM.EQ.3) THEN
         CALL TRINIT(25,DIOCA2,DIOCA2,TITREE,0.15,VALEUR,NCOUMA)
         CALL DFENET(0.,80.,0.,25.,-1.,1.,X1,X2,Y1,Y2,.TRUE.)
         CALL MOIN(LPROJ,LPPR1,LPPR2,LPPR3,LPPR4)
         IPREM=1
      ENDIF
 405  CONTINUE
      CALL TRINIT(25,DIOCA2,DIOCA2,TITREE,0.15,VALEUR,NCOUMA)
      CALL DFENET(0.,80.,0.,25.,-1.,1.,X1,X2,Y1,Y2,.TRUE.)
      CALL CHCOUL(0)
*      OBTENIR LES BONNES VALEURS DU CADRE
      CALL TRLABL(0.,16.,0.,'Cadre actuel ci dessous',23,1.)
      CALL TRLABL(0.,2.,0.,'   Xmin',7,1.)
      CALL TRLABL(0.,4.,0.,'   Xmax',7,1.)
      CALL TRLABL(0.,6.,0.,'   Ymin',7,1.)
      CALL TRLABL(0.,8.,0.,'   Ymax',7,1.)
      WRITE (ZONE1,FMT='(G9.2)') XMI
      CALL TRLABL(40.,2.,0.,ZONE1,9,1.)
      WRITE (ZONE2,FMT='(G9.2)') XMA
      CALL TRLABL(40.,4.,0.,ZONE2,9,1.)
      WRITE (ZONE3,FMT='(G9.2)') YMI
      CALL TRLABL(40.,6.,0.,ZONE3,9,1.)
      WRITE (ZONE4,FMT='(G9.2)') YMA
      CALL TRLABL(40.,8.,0.,ZONE4,9,1.)
      GOTO 404
 403  CONTINUE
      CALL TRMESS('Valeur incorrecte recommencez')
 404  CONTINUE
      LEGEND(1)=' '
      LEGEND(2)='Xmin ?'
      LEGEND(3)='Xmax ?'
      LEGEND(4)='Ymin ?'
      LEGEND(5)='Ymax ?'
      LEGEND(6)='Auto'
      LEGEND(7)='Cont'
      CALL MENU(LEGEND,7,6)
      CALL TRAFF(ICLE)
      IF (ICLE.EQ.5) THEN
      INCLE=0
        XMI=XMIN
        XMA=XMAX
        YMI=YMIN
        YMA=YMAX
      ELSEIF (ICLE.EQ.6) THEN
      INCLE=0
      ELSEIF (ICLE.EQ.1) THEN
      CALL TRGET('NOUVELLE VALEUR DE XMIN :',ZONF1)
      INCLE=1
      IF (ZONF1.NE.ZONE1) READ  (ZONF1,FMT='(G9.2)',ERR=403) XMI
      ELSEIF (ICLE.EQ.2) THEN
      CALL TRGET('NOUVELLE VALEUR DE XMAX :',ZONF2)
      INCLE=1
      IF (ZONF2.NE.ZONE2) READ  (ZONF2,FMT='(G9.2)',ERR=403) XMA
      ELSEIF (ICLE.EQ.3) THEN
      CALL TRGET('NOUVELLE VALEUR DE YMIN :',ZONF3)
      INCLE=1
      IF (ZONF3.NE.ZONE3) READ  (ZONF3,FMT='(G9.2)',ERR=403) YMI
      ELSEIF (ICLE.EQ.4) THEN
      CALL TRGET('NOUVELLE VALEUR DE YMAX :',ZONF4)
      INCLE=1
      IF (ZONF4.NE.ZONE4) READ  (ZONF4,FMT='(G9.2)',ERR=403) YMA
      ENDIF
      IF (INCLE.EQ.1) GOTO 405
      CALL TRINIT(25,DIOCA2,DIOCA2,TITREE,0.15,VALEUR,NCOUMA)
      CALL DFENET(XMI,XMA,YMI,YMA,-1.,1.,X1,X2,Y1,Y2,FENET)
*  POUR TRAVAILLER EN NON SEGMENTE
      XPREC=(XMA-XMI)/100
      YPREC=(YMA-YMI)/100
      XPREC=MAX(XPREC,YPREC)
      YPREC=MAX(XPREC,YPREC)
*   INITIALISATION DE IVU
*   IVU=1  PT VU
*   IVU<>1 PT PAS VU
      IF (IVU.NE.0) SEGSUP IVU
      SEGINI IVU
      DO 410 I=1,ITE
         IVU(I)=1
 410  CONTINUE
      IF (ICACHE.NE.0) THEN
         MCOUP=0
         CALL TIRET3(XPROJ,MELEME,ICPR,XMIN,XMAX,YMIN,YMAX,IVU,NELEM,
     #    TMIN,TMAX,MCOUP)
         SEGACT ICPR
      ENDIF
      IF (NTSEG.NE.0) SEGSUP NTSEG
      IF (ICACHE.EQ.1) THEN
            LTSEGS=1000
            SEGINI NTSEG
            LTSEG=0
      ENDIF
      CALL CHCOUL(2)
      IF (KON2.NE.0) SEGSUP KON2
      SEGINI,KON2=KON1
      SEGACT KON1*MOD
      ITR=1
      KAUX=1
 500  K=KAUX
      IF (IVU(KAUX).NE.1) GOTO 530
      KAUXR=KAUX
 510  DO 520 KL=1,NBCONR
      ITRA=KON(KL,K)
      IF (ITRA.LT.0) GOTO 520
      IF (ITRA.EQ.0) GOTO 530
      IF (IVU(ITRA).EQ.1) GOTO 540
 520  CONTINUE
      K=KON(NBCON,K)
      IF (K.NE.0) GOTO 510
 530  KAUX=KAUX+1
      IF (KAUX.EQ.ITE+1) GOTO 630
      GOTO 500
 540  CONTINUE
      IF (ITR.GT.1) THEN
       CALL POLRL(ITR,XTR,YTR,ZTR)
      ENDIF
      ITR=1
      XTR(1)=XPROJ(1,KAUXR)
      YTR(1)=XPROJ(2,KAUXR)
      KPRESS=KAUXR
      GOTO 560
 550  KL=1
 560  DO 570 L=KL,NBCONR
      M=KON(L,K)
      IF (M.EQ.0) GOTO 500
      IF (M.LT.0) GOTO 570
      IF (IVU(M).NE.1) GOTO 570
      GOTO 580
 570  CONTINUE
      K=KON(NBCON,K)
      IF (K.EQ.0) GOTO 500
      GOTO 550
 580  CONTINUE
      ITR=ITR+1
      XTR(ITR)=XPROJ(1,M)
      YTR(ITR)=XPROJ(2,M)
      IF (ITR.EQ.40) THEN
       CALL POLRL(ITR,XTR,YTR,ZTR)
       XTR(1)=XTR(ITR)
       YTR(1)=YTR(ITR)
       ITR=1
      ENDIF
      KON(L,K)=-KON(L,K)
      M1=M
 590  DO 600 L=1,NBCONR
      IF (KON(L,M1).EQ.0) GOTO 620
      IF (KON(L,M1).EQ.KPRESS) GOTO 610
 600  CONTINUE
      M1=KON(NBCON,M1)
      IF (M1.EQ.0) GOTO 620
      GOTO 590
 610  KON(L,M1)=-KON(L,M1)
 620  KPRESS=M
      K=KPRESS
      GOTO 550
 630  CONTINUE
      IF (ITR.GT.1) CALL POLRL(ITR,XTR,YTR,ZTR)
      ITR=1
      IF (ICACHE.EQ.0) GOTO 670
C  ON REMPLIT ISEGM AVEC LES SEGMENTS EN PARTIE VU
      DO 660 K=1,ITE
      IF (IVU(K).NE.1) GOTO 660
      KK=K
 640  DO 650 KL=1,NBCONR
      ITRA=KON(KL,KK)
      IF (ITRA.LT.0) GOTO 650
      IF (ITRA.EQ.0) GOTO 660
      IF (LTSEGS-LTSEG.LT.10) THEN
              LTSEGS=LTSEGS+1000
              SEGADJ NTSEG
      ENDIF
      NTSEG(LTSEG+1)=K
      NTSEG(LTSEG+2)=ITRA
      NTSEG(LTSEG+3)=2
      LTSEG=LTSEG+3
 650  CONTINUE
      KK=KON(NBCON,KK)
      IF (KK.NE.0) GOTO 640
 660  CONTINUE
 670  CONTINUE
      SEGDES KON1
      IF (ICACHE.NE.0) THEN
      CALL DICHO3(XPROJ,MELEME,ICPR,XMIN,XMAX,
     #  YMIN,YMAX,IVU,NTSEG,NELEM,IDCOUL,IDCOUL,LBLANC,LTSEG)
      SEGACT MELEME
      DO 671 IO=1,LISOUS(/1)
      IPT1=LISOUS(IO)
      SEGACT IPT1
 671  CONTINUE
      ENDIF
 1010 CONTINUE
      CALL MENUU
      CALL TRAFF(ICLE)
*  DEMANDE DE REAFFICHAGE
      IF (ICLE.EQ.11) GOTO 1000
*  DEPLACEMENT DE NOEUD
      IF (ICLE.EQ.1) THEN
      CALL MODP(XPROJ,IVU,KON2,ICPR,IDCP,IBOUJ)
      GOTO 1010
      ENDIF
*  NOMMER UN NOEUD
      IF (ICLE.EQ.2) THEN
          CALL MONO(XPROJ,IVU,IDCP)
          GOTO 1010
      ENDIF
*  SUPPRIMER UN ELEMENT
      IF (ICLE.EQ.3) THEN
          CALL MOSU(XPROJ,IVU,ICPR,MELEME)
          GOTO 1010
      ENDIF
*  CREATION D'UN ELEMENT
      IF (ICLE.EQ.4) THEN
          CALL MOCR(XPROJ,IVU,IDCP,MELEME,ICPR,ITE,IMILL,TMIN,IBOUJ)
          GOTO 1010
       ENDIF
*  NOMMER UN ENSEMBLE D'ELEMENT
      IF (ICLE.EQ.5) THEN
          CALL MONL(XPROJ,IVU,ICPR,MELEME)
          GOTO 1010
       ENDIF
*  ECRITURE COORDONNEES
      IF (ICLE.EQ.6) THEN
          CALL MOCO(XPROJ,IVU,KON2,IDCP,ICPR,IBOUJ)
          GOTO 1010
      ENDIF
*  AFFICHAGE NOMS DES POINTS
      IF (ICLE.EQ.7) THEN
          CALL MOPO(XPROJ,ICPR,IVU)
          GOTO 1010
      ENDIF
*  AFFICHAGE CONTOUR
      IF (ICLE.EQ.8) THEN
          CALL MOCT(XPROJ,ICPR,IVU,MELEME)
          GOTO 1010
      ENDIF
*  DEMANDE DE ZOOM
      IF (ICLE.EQ.9) THEN
        CALL TRMESS('Entrez le premier point pour le zoom')
          CALL TRDIG(X1,Y1,INCLE)
        CALL TRMESS('Entrez le second point pour le zoom')
          CALL TRDIG(X2,Y2,INCLE)
          XMI=MIN(X1,X2)
          XMA=MAX(X1,X2)
          YMI=MIN(Y1,Y2)
          YMA=MAX(Y1,Y2)
          GOTO 1000
      ENDIF
*  RECENTRAGE DES NOEUDS MILIEUX
      IF (ICLE.EQ.10) THEN
          CALL MOCE(MELEME,XPROJ,ICPR,IBOUJ)
          GOTO 1000
      ENDIF
      IF (ICLE.LT.0) GOTO 1010
      CALL PROMOD(ICPR,XPROJ,JOEIL,2,IBOUJ)
      IF (LPROJ.EQ.0) GOTO 2100
      NBELEM=0
      DO 2000 I=1,ITE
       IF (IBOUJ(I).EQ.0) GOTO 2000
       NBELEM=NBELEM+1
 2000 CONTINUE
      IF (NBELEM.EQ.0) GOTO 2100
      NBNN=1
      NBREF=0
      NBSOUS=0
      SEGINI MELEME
      ITYPEL=1
      ICC=0
      DO 2010 I=1,ITE
       IF (IBOUJ(I).EQ.0) GOTO 2010
       ICC=ICC+1
       NUM(1,ICC)=IDCP(I)
 2010 CONTINUE
*  TORE
      IF (LPROJ.EQ.5) THEN
       CALL ECROBJ('POINT ',LPPR4)
       CALL ECROBJ('POINT ',LPPR3)
       CALL ECROBJ('POINT ',LPPR2)
       CALL ECROBJ('POINT ',LPPR1)
*  CONE
      ELSEIF (LPROJ.EQ.4) THEN
       CALL ECROBJ('POINT ',LPPR3)
       CALL ECROBJ('POINT ',LPPR2)
       CALL ECROBJ('POINT ',LPPR1)
*  CYLINDRE
      ELSEIF (LPROJ.EQ.3) THEN
       CALL ECROBJ('POINT ',LPPR3)
       CALL ECROBJ('POINT ',LPPR2)
       CALL ECROBJ('POINT ',LPPR1)
*  SPHERE
      ELSEIF (LPROJ.EQ.2) THEN
       CALL ECROBJ('POINT ',LPPR2)
       CALL ECROBJ('POINT ',LPPR1)
*  PLAN
      ELSEIF (LPROJ.EQ.1) THEN
       CALL ECROBJ('POINT ',LPPR3)
       CALL ECROBJ('POINT ',LPPR2)
       CALL ECROBJ('POINT ',LPPR1)
      ENDIF
      CALL ECRCHA(ITOPT(LPROJ))
      CALL ECROBJ('POINT ',IVPR)
      CALL ECRCHA(JPROJ)
      CALL ECROBJ('MAILLAGE',MELEME)
      CALL DEPLAC
      SEGSUP MELEME
 2100 CONTINUE
      SEGSUP XPROJ,ICPR,IVU
      IF (NTSEG.NE.0) SEGSUP NTSEG
      IF (KON1.NE.0) SEGSUP KON1
      IF (KON2.NE.0) SEGSUP KON2
      IF (IDCP.NE.0) SEGSUP IDCP
      IF (IMILL.NE.0) SEGSUP IMILL
      IF (IBOUJ.NE.0) SEGSUP IBOUJ
* LB
      CALL TRMFIN
      RETURN
*LB
      END