C ISOINT    SOURCE    PV        22/09/20    21:15:04     11460          
C  VISUALISATION INTERACTIVE D'ISOVALEUR
C
      SUBROUTINE ISOINT(VCPCHA,MELEME,ICPR,XPROJ,IVU,PAS,XMI,YMI,X1,Y1,
     >                  mcham)
      IMPLICIT INTEGER(I-N)
-INC SMELEME

-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMCHAML
       SEGMENT XPROJ(3,0)
       SEGMENT VCPCHA(0)
       SEGMENT IVU(0)
       SEGMENT ICPR(0)
       CHARACTER*19 TEXT2
       save text2
       SEGACT VCPCHA,IVU,ICPR,XPROJ
 400   CONTINUE
       CALL TRMESS('POINTEZ LE LIEU OU OBTENIR LA VALEUR DU CHAMP')
       CALL TRDIG(XP,YP,INCLE)
      XP=(XP-X1)/PAS+XMI
      YP=(YP-Y1)/PAS+YMI
      IPT1=MELEME
      SEGACT IPT1
      DO 220 IO=1,MAX(1,LISOUS(/1))
      IF (LISOUS(/1).NE.0) THEN

       IPT1=LISOUS(IO)
       if (mcham.ne.0) then
         melval=lisref(io)
         segact melval
         lval=velche(/1)
         leml=velche(/2)
       endif
       SEGACT IPT1
      ENDIF
      NBNN=IPT1.NUM(/1)
      IF (KSURF(IPT1.ITYPEL).NE.0) GOTO 30
*  C'EST UNE LIGNE
      DO 20 IEL=1,IPT1.NUM(/2)
      do 21 iafa=1,nbnn-1
       ibfa=iafa+1
      IPA=IPT1.NUM(iafa,iel)
      IA=ICPR(IPA)
      IPB=IPT1.NUM(ibfa,iel)
      IB=ICPR(IPB)
      IF (IVU(IA).LE.0) GOTO 20
      IF (IVU(IB).LE.0) GOTO 20
      XA=XPROJ(1,IA)
      YA=XPROJ(2,IA)
      XB=XPROJ(1,IB)
      YB=XPROJ(2,IB)
      SCA=(XP-XA)*(XP-XB)+(YP-YA)*(YP-YB)
      xlong=(xb-xa)**2+(yb-ya)**2
      IF (SCA.LE.-0.9*xlong) GOTO 95
  21  CONTINUE
  20  CONTINUE
      GOTO 70
  30  CONTINUE
*  C'EST UNE SURFACE OU UN VOLUME
      NBELEM=IPT1.NUM(/2)
      NBNN=IPT1.NUM(/1)
      NBFAC=LTEL(1,IPT1.ITYPEL)
      IAD=LTEL(2,IPT1.ITYPEL)-1
      IF (NBFAC.EQ.0) GOTO 70
      DO 65 IFAC=1,NBFAC
        ITYP=LDEL(1,IAD+IFAC)
        NPFAC=KDFAC(1,ITYP)
        IF (NPFAC.NE.0) THEN
          JAD=LDEL(2,IAD+IFAC)-1
          IDEP=KDFAC(2,ITYP)
          IFEP=IDEP+3*(KDFAC(3,ITYP)-1)
          DO 60 ITRIAN=IDEP,IFEP,3
            IAFA=LFAC(JAD+KFAC(ITRIAN))
            IBFA=LFAC(JAD+KFAC(ITRIAN+1))
            ICFA=LFAC(JAD+KFAC(ITRIAN+2))
            DO 40  IEL=1,NBELEM
              IPA=IPT1.NUM(IAFA,IEL)
              IPB=IPT1.NUM(IBFA,IEL)
              IPC=IPT1.NUM(ICFA,IEL)
              IA=ICPR(IPA)
              IB=ICPR(IPB)
              IC=ICPR(IPC)
              IF (IVU(IA).LT.1.OR.IVU(IB).LT.1.OR.IVU(IC).LT.1)
     #          GOTO 40
              XA=XPROJ(1,IA)
              XB=XPROJ(1,IB)
              XC=XPROJ(1,IC)
              YA=XPROJ(2,IA)
              YB=XPROJ(2,IB)
              YC=XPROJ(2,IC)
              VAX=XP-XA
              VBX=XP-XB
              VCX=XP-XC
              VAY=YP-YA
              VBY=YP-YB
              VCY=YP-YC
              DC=VAX*VBY-VAY*VBX
              DA=VBX*VCY-VBY*VCX
              IF (DA*DC.LT.0.) GOTO 40
              DB=VCX*VAY-VCY*VAX
              IF (DA*DB.LT.0.) GOTO 40
              IF (DB*DC.LT.0.) GOTO 40
              if (mcham.eq.0) then
                VC = VCPCHA(IPC)
              else
                VC = velche(min(lval,ICFA),min(leml,IEL))
              endif
              GOTO 90
  40        CONTINUE
  60      CONTINUE
        ELSE
*
*         POLYGONE
*
          DO 45, IEL = 1, NBELEM
*
*           Recherche des coordonnees du centre du polygone
*
            XXM = 0.
            YYM = 0.
            VVM = 0.
            IVUE = 1
            DO  67 ICT = 1, NBNN
*
              NUPT = IPT1.NUM(ICT, IEL)
              IDPT = ICPR(NUPT)
              XXM = XPROJ(1,IDPT) + XXM
              YYM = XPROJ(2,IDPT) + YYM

              if (mcham.eq.0) then
                VVM = VCPCHA(NUPT)
              else
                VVM = velche(min(lval,IAFA),min(leml,IEL))
              endif
              IF (IVU(IDPT).NE.1)  IVUE = 0
*
   67       CONTINUE
*
            IF (IVUE.EQ.1) THEN
*
              XC=XXM/NBNN
              YC=YYM/NBNN
              VC=VVM/NBNN
*
              IAFA = NBNN
              IPA = IPT1.NUM(IAFA, IEL)
              ID2 = ICPR(IPA)
              XA=XPROJ(1,ID2)
              YA=XPROJ(2,ID2)
*
*             Boucle sur tous les triangles
*
              DO 670, ICT = 1, NBNN
*
                IBFA = ICT
                IPB = IPT1.NUM(IBFA, IEL)
                ID1 = ICPR(IPB)
*
                XB=XPROJ(1,ID1)
                YB=XPROJ(2,ID1)

                VAX=XP-XA
                VBX=XP-XB
                VCX=XP-XC
                VAY=YP-YA
                VBY=YP-YB
                VCY=YP-YC
                DC=VAX*VBY-VAY*VBX
                DA=VBX*VCY-VBY*VCX
                IF (DA*DC.LT.0.) GOTO 675
                DB=VCX*VAY-VCY*VAX
                IF (DA*DB.LT.0.) GOTO 675
                IF (DB*DC.LT.0.) GOTO 675
                GOTO 90

  675           XA = XB
                YA = YB
                IPA = IPB
                IAFA = IBFA
*
  670         CONTINUE
*
            ENDIF
*
  45      CONTINUE
*
        ENDIF
  65  CONTINUE
  70  CONTINUE
      IF (LISOUS(/1).NE.0) SEGDES IPT1
 220  CONTINUE
      SEGDES MELEME
  80  CONTINUE
* ON N'A PAS TROUVE ON TERMINE
      GOTO 1000
* ON A TROUVE ON ECRIT CE QUE C'EST
  95  CONTINUE
      DA=((XP-XA)**2+(YP-YA)**2)**0.5
      DB=((XP-XB)**2+(YP-YB)**2)**0.5
      DS=DA+DB
      IF (DS.EQ.0.) GOTO 400
      if (mcham.eq.0) then
         BONVAL=(VCPCHA(IPA)*DA+VCPCHA(IPB)*DB)/DS
      else
         BONVAL=(velche(min(lval,IAFA),min(leml,IEL))*da+
     >           velche(min(lval,IBFA),min(leml,IEL))*db)/DS
      endif
      GOTO 97
  90  CONTINUE
      DS=DA+DB+DC
      IF (DS.EQ.0.) GOTO 400
      if (mcham.eq.0) then
        BONVAL=(VCPCHA(IPA)*DA+VCPCHA(IPB)*DB+VC*DC)/DS
      else
        BONVAL=(velche(min(lval,IAFA),min(leml,IEL))*da+
     >          velche(min(lval,IBFA),min(leml,IEL))*db+VC*dc)/DS
      endif
  97  CONTINUE
      TEXT2='VALEUR : '
      WRITE (TEXT2(10:19),FMT='(1PG10.3)') BONVAL
      CALL TRMESS(TEXT2)
      SEGDES IPT1,MELEME
 1000 CONTINUE
*     CALL TRTINI
      RETURN
      END