*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE UEAREA(XP,YP,ZP,VLVM,AX,AY,NP,NI,NG)

      INTEGER  NP(2),NI(2)
      REAL     XP(4),YP(4),ZP(4),VLVM(2),AX(*),AY(*)

      INTEGER  NNM(2),MM(2)
      REAL     XCM(4,2),YCM(4,2)
      LOGICAL  LPM(4,2),LCM(4,2),LBM(4,2),LCRNR,LSTRP

      SAVE


*     / FIND MIN. & MAX. VALUES AND CHECK STATUS OF EACH CORNER /

      ZPMAX=-REALMX
      ZPMIN=+REALMX
      DO 20 N=1,4
        IF (ZP(N).GT.ZPMAX) ZPMAX=ZP(N)
        IF (ZP(N).LT.ZPMIN) ZPMIN=ZP(N)
        LPM(N,1)=ZP(N).GE.VLVM(1)
        LPM(N,2)=ZP(N).LE.VLVM(2)
   20 CONTINUE

      DO 60 M=1,2

*       / CALCULATE CROSSING POINTS /

        NNM(M)=0
        DO 30 N=1,4
          N1=N
          N2=MOD(N,4)+1
          IF (LPM(N1,M).NEQV.LPM(N2,M)) THEN
            LCM(N,M)=.TRUE.
            NNM(M)=NNM(M)+1
            FC=(VLVM(M)-ZP(N1))/(ZP(N2)-ZP(N1))
            XCM(N,M)=XP(N1)+(XP(N2)-XP(N1))*FC
            YCM(N,M)=YP(N1)+(YP(N2)-YP(N1))*FC
          ELSE
            LCM(N,M)=.FALSE.
          END IF
   30   CONTINUE

*       / CHECK STATUS OF EACH LINE /

        DO 40 N=1,4
          N1=N
          N2=MOD(N+2,4)+1
          LBM(N,M)=.NOT.(LCM(N1,M).AND.LCM(N2,M))
   40   CONTINUE

*       / TREAT THE CONDITION WITH 4 LINES /

        IF (NNM(M).EQ.4) THEN
          NX=0
          RTMIN=+REALMX
          DO 50 N=1,4
            N1=N
            N2=MOD(N,4)+1
            RTX=SQRT((XCM(N2,M)-XCM(N1,M))**2+(YCM(N2,M)-YCM(N1,M))**2)
            IF (RTX.LT.RTMIN) THEN
              RTMIN=RTX
              NX=N
            END IF
   50     CONTINUE
          NL=MOD(NX-1,2)+1
          LBM(NL  ,M)=.TRUE.
          LBM(NL+2,M)=.TRUE.
        END IF

   60 CONTINUE

*     / SET CROSSING POINTS /

      NQ=0
      IF (NNM(1).EQ.0 .AND. NNM(2).EQ.0) THEN
        IF (VLVM(1).LE.ZPMIN .AND. ZPMAX.LE.VLVM(2)) THEN
          CALL VRSET0(XP,AX,4,1,1)
          CALL VRSET0(YP,AY,4,1,1)
          NQ=4
        END IF
      ELSE
        DO 80 N=1,4
          IF (LPM(N,1).AND.LPM(N,2)) THEN
            NQ=NQ+1
            AX(NQ)=XP(N)
            AY(NQ)=YP(N)
          END IF
          MMP=0
          IF (LCM(N,1).AND.LCM(N,2)) THEN
            MMP=2
            IF (LPM(N,1)) THEN
              MM(1)=2
              MM(2)=1
            ELSE
              MM(1)=1
              MM(2)=2
            END IF
          ELSE IF (LCM(N,1)) THEN
            MMP=1
            MM(1)=1
          ELSE IF (LCM(N,2)) THEN
            MMP=1
            MM(1)=2
          END IF
          DO 70 MP=1,MMP
            NQ=NQ+1
            AX(NQ)=XCM(N,MM(MP))
            AY(NQ)=YCM(N,MM(MP))
   70     CONTINUE
   80   CONTINUE
      END IF

*     / FIND THE NUMBER OF AREAS AND DO SOME TREATMENT /

      NG=0
      IF (NNM(1).EQ.4 .OR. NNM(2).EQ.4) THEN
        IF (LBM(2,1).AND.LBM(4,1).AND.LBM(2,2).AND.LBM(4,2)) THEN
          LCRNR=LPM(1,1).AND.LPM(1,2)
          LSTRP=(LPM(1,1).NEQV.LPM(1,2)) .AND. (LCM(1,1).AND.LCM(1,2))
          IF (LCRNR .OR. LSTRP) THEN
            IF (LCRNR) THEN
              NPT=3
            ELSE IF (LSTRP) THEN
              NPT=4
            END IF
            NG=2
            NP(1)=NQ-NPT
            NP(2)=NPT
            NI(1)=3
            NI(2)=NI(1)+NP(1)
            AX(NQ+1)=AX(1)
            AX(NQ+2)=AX(2)
            AY(NQ+1)=AY(1)
            AY(NQ+2)=AY(2)
          END IF
        ELSE IF (LBM(1,1).AND.LBM(3,1).AND.LBM(1,2).AND.LBM(3,2)) THEN
          LCRNR=LPM(2,1).AND.LPM(2,2)
          LSTRP=(LPM(2,1).NEQV.LPM(2,2)) .AND. (LCM(1,1).AND.LCM(1,2))
          IF (LCRNR .OR. LSTRP) THEN
            IF (LCRNR) THEN
              NPT=3
            ELSE
              NPT=4
            END IF
            NG=2
            NP(1)=NPT
            NP(2)=NQ-NPT
            NI(1)=1
            NI(2)=NI(1)+NP(1)
          END IF
        END IF
      END IF

      IF (NG.EQ.0 .AND. NQ.NE.0) THEN
        NG=1
        NP(1)=NQ
        NI(1)=1
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY UEAINT

      CALL GLRGET('REALMAX ',REALMX)

      RETURN
      END
