      SUBROUTINE FINDFA(XCUCU,YCUCU,NBON,IORDRE,NN,NDS,XX,YY,VAL
     &                 ,ISO,NPROJE,VALF,IOPT)
C
      DIMENSION XX(4,*),YY(4,*),VALF(5,*)
      INTEGER   IORDRE(*),NPROJE(*)
      REAL*8    S,T
C
      IF (IOPT.EQ.0) CALL GSQCUR(WIN,XCUCU,YCUCU)
      NN = 0
      IF (NDS.EQ.3) THEN
        DO I=NBON,1,-1
          N = IORDRE(I)
          CALL TROUVEST3(XX(1,N),YY(1,N),XCUCU,YCUCU,S,T,ITROUVE)
          IF (ITROUVE.NE.0) THEN
            NN = N
            NE = NPROJE(N)
            IF (ISO.NE.3) THEN
              VAL = S*VALF(1,NE) + T*VALF(2,NE) + (1.D0-S-T)*VALF(3,NE)
            ELSE
              VAL = VALF(5,NE)
            ENDIF
            RETURN
          ENDIF
        ENDDO
      ELSE
        DO I=NBON,1,-1
          N = IORDRE(I)
          CALL TROUVEST4(XX(1,N),YY(1,N),XCUCU,YCUCU,S,T,ITROUVE)
          IF (ITROUVE.NE.0) THEN
            NN = N
            IF (ISO.NE.3) THEN
              CALL INTER4(S,T,VALF(1,NPROJE(N)),VAL)
            ELSE
              VAL = VALF(5,NPROJE(N))
            ENDIF
            RETURN
          ENDIF
        ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE ECRVAL(XCUCU,YCUCU,VAVA)
      INCLUDE 'com_options.f'
C
      CHARACTER*13 VVG
C
      DX = XLARG*.01
      CALL GSLW(-1)
      CALL GSCOL(7)
      CALL GSMOVE(XCUCU-DX,YCUCU)
      CALL GSLINE(XCUCU+DX,YCUCU)
      CALL GSMOVE(XCUCU,YCUCU-DX)
      CALL GSLINE(XCUCU,YCUCU+DX)
      VVG = '             '
      WRITE(VVG,'(G13.4)') VAVA
      CALL BLANC(VVG,NNG)
      CALL GSLSS(IFONT0)
      XCU = XCUCU - DX*.75*REAL(NNG)
      YCU = YCUCU + DX*2.
      CALL GSCHAR(XCU,YCU,NNG,VVG)
      CALL GSLW(0)
      END
C=======================================================================
      SUBROUTINE TROUVEST3(XX,YY,XCOUR,YCOUR,S,T,ITROUVE)
      DIMENSION XX(3),YY(3)
      REAL*8 XXX,YYY,X1,X2,Y1,Y2,DE,S,T
C
      ITROUVE = 0
      X1 = XX(1)-XX(3)
      X2 = XX(2)-XX(3)
      Y1 = YY(1)-YY(3)
      Y2 = YY(2)-YY(3)
      DE = X1*Y2 - X2*Y1
      IF (DE.NE.0.D0) THEN
        XXX = XCOUR-XX(3)
        YYY = YCOUR-YY(3)
        S = (XXX*Y2 - YYY*X2)/DE
        T = (YYY*X1 - XXX*Y1)/DE
        IF (S.GE.0.D0.AND.T.GE.0.D0.AND.(S+T).LE.1.D0) THEN
          ITROUVE = 1
          RETURN
        ENDIF
      ENDIF
      END
C=======================================================================
      SUBROUTINE TROUVEST4(XX,YY,XCOUR,YCOUR,S,T,ITROUVE)
      DIMENSION XX(4),YY(4)
      REAL*8 XXX,YYY,X1,X2,X3,X4,Y1,Y2,Y3,Y4,A,B,C,D,SD,DE,S,T,EPS
      DATA EPS / 1.D-08 /
C
      XXX = 4.D0*XCOUR
      YYY = 4.D0*YCOUR
      ITROUVE = 0
      TOTO = (XX(2)-XX(1))*(YY(3)-YY(2))
     &     - (XX(3)-XX(2))*(YY(2)-YY(1))
      IF (TOTO.GE.0.D0) THEN
        X1 = XX(1)+XX(2)+XX(3)+XX(4)
        X2 =-XX(1)+XX(2)+XX(3)-XX(4)
        X3 =-XX(1)-XX(2)+XX(3)+XX(4)
        X4 = XX(1)-XX(2)+XX(3)-XX(4)
        Y1 = YY(1)+YY(2)+YY(3)+YY(4)
        Y2 =-YY(1)+YY(2)+YY(3)-YY(4)
        Y3 =-YY(1)-YY(2)+YY(3)+YY(4)
        Y4 = YY(1)-YY(2)+YY(3)-YY(4)
      ELSE
        X1 = XX(1)+XX(4)+XX(3)+XX(2)
        X2 =-XX(1)+XX(4)+XX(3)-XX(2)
        X3 =-XX(1)-XX(4)+XX(3)+XX(2)
        X4 = XX(1)-XX(4)+XX(3)-XX(2)
        Y1 = YY(1)+YY(4)+YY(3)+YY(2)
        Y2 =-YY(1)+YY(4)+YY(3)-YY(2)
        Y3 =-YY(1)-YY(4)+YY(3)+YY(2)
        Y4 = YY(1)-YY(4)+YY(3)-YY(2)
      ENDIF
      A = X4*Y3 - X3*Y4
      B = X4*Y1 - X1*Y4 + X2*Y3 - X3*Y2 + XXX*Y4 - X4*YYY
      C = X2*Y1 - X1*Y2 + XXX*Y2 - X2*YYY
      S = 2.D0
      T = 2.D0
      IF (B.NE.0.D0) THEN
        IF (ABS(A/B).GT.EPS) THEN
          D = B**2 - 4.D0*A*C
          IF (D.GE.0.D0) THEN
            SD = SQRT(D)
            T = (-B+SD)/(2.D0*A)
            IF (ABS(T).LE.1.D0) THEN
              DE = X2+T*X4
              IF (ABS(DE).GT.EPS) THEN
                S = (XXX - X1 - T*X3)/DE
              ELSE
                DE = Y2+T*Y4
                IF (ABS(DE).GT.EPS) S = (YYY - Y1 - T*Y3)/DE
              ENDIF
              IF (ABS(S).LE.1.D0) THEN
                ITROUVE = 1
                RETURN
              ENDIF
            ENDIF
            IF (ITROUVE.EQ.0) THEN
              T = (-B-SD)/(2.D0*A)
              IF (ABS(T).LE.1.D0) THEN
                DE = X2+T*X4
                IF (ABS(DE).GT.EPS) THEN
                  S = (XXX - X1 - T*X3)/DE
                ELSE
                  DE = Y2+T*Y4
                  IF (ABS(DE).GT.EPS) S = (YYY - Y1 - T*Y3)/DE
                ENDIF
                IF (ABS(S).LE.1.D0) THEN
                  ITROUVE = 1
                  RETURN
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ELSE
          T = -C/B
          IF (ABS(T).LE.1.D0) THEN
            DE = X2+T*X4
            IF (ABS(DE).GT.EPS) THEN
              S = (XXX - X1 - T*X3)/DE
            ELSE
              DE = Y2+T*Y4
              IF (ABS(DE).GT.EPS) S = (YYY - Y1 - T*Y3)/DE
            ENDIF
            IF (ABS(S).LE.1.D0) THEN
              ITROUVE = 1
              RETURN
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      END
C=======================================================================
      SUBROUTINE INTER4(S,T,V,VAL)
      DIMENSION V(4)
      REAl*8 S,T,SM,TM,SP,TP
C
      SM = 1.D0-S
      SP = 1.D0+S
      TM = 1.D0-T
      TP = 1.D0+T
      VAL = .25D0*( SM*TM*DBLE(V(1)) + SP*TM*DBLE(V(2)) 
     &            + SP*TP*DBLE(V(3)) + SM*TP*DBLE(V(4)) )
      END
C=======================================================================
      SUBROUTINE BLANC(CHAINE,LONG)
      CHARACTER*13 CHAINE,BID
      BID = CHAINE
      IDEB = 0
 10   IDEB = IDEB+1
      IF (BID(IDEB:IDEB).EQ.' ') GOTO 10
C
      IFIN = 14
  20  IFIN = IFIN-1
      IF (BID(IFIN:IFIN).EQ.' ') GOTO 20
      LONG = IFIN+1-IDEB
      CHAINE(1:LONG) = BID(IDEB:IFIN)
      END
