C     PROGRAM ELPK
C
C============   PROBLEM DEFINITION INTERFACE
C
      COMMON  / C1RVPR /  R1CUXX, R1CUXY, R1CUYY, R1CCUX, R1CCUY,
     A                    R1CCCU, R1CUZZ, R1CUXZ, R1CUYZ, R1CCUZ,
     B                    R1UNQX, R1UNQY, R1UNQZ, R1UNQU
      COMMON  / C1IVPR /  I1NBND
      COMMON  / C1LVPR /  L1ARCC, L1CLKW, L1CRST, L1CSTB, L1CSTC,
     A                    L1DRCH, L1HMBC, L1HMEQ, L1HOLE, L1LAPL,
     B                    L1MIXD, L1NEUM, L1NUNQ, L1POIS, L1RECT,
     C                    L1SELF, L1TWOD
      LOGICAL             L1ARCC, L1CLKW, L1CRST, L1CSTB, L1CSTC,
     A                    L1DRCH, L1HMBC, L1HMEQ, L1HOLE, L1LAPL,
     B                    L1MIXD, L1NEUM, L1NUNQ, L1POIS, L1RECT,
     C                    L1SELF, L1TWOD
      COMMON  / C1LVBC /  L1PRDC, L1PRDX, L1PRDY, L1PRDZ
      LOGICAL             L1PRDC, L1PRDX, L1PRDY, L1PRDZ
      COMMON  / C1BCST /  I1BCST(4,1)
      COMMON  / C1BCTY /  I1BCTY(1)
      COMMON  / C1CFST /  I1CFST(10)
      COMMON  / C1GRDX /  R1GRDX(1)
      COMMON  / C1GRDY /  R1GRDY(1)
      COMMON  / C1IVGR /  I1NGRX, I1NGRY, I1NGRZ, I1NBPT, I1MBPT,
     A                    I1PACK
      COMMON  / C1LVGR /  L1UNFG, L1UNFX, L1UNFY, L1UNFZ
      LOGICAL             L1UNFG, L1UNFX, L1UNFY, L1UNFZ
      COMMON  / C1RVGR /  R1AXGR, R1AYGR, R1AZGR, R1BXGR, R1BYGR,
     A                    R1BZGR, R1HXGR, R1HYGR, R1HZGR
      COMMON  / C1IVSO /  I1MUNK
      COMMON  / C1LVSO /  L1UINI
      LOGICAL             L1UINI
      COMMON  / C1UNKN /  R1UNKN(1)
C
C============   OTHER GLOBAL CONTROL VARIABLES
C
      COMMON  / C1IVCN /  I1LEVL, I1PAGE, I1INPT, I1OUTP, I1SCRA,
     A                    I1KWRK, I1KORD
      COMMON  / C1LVCN /  L1TIME, L1FATL, L1NEWD
      LOGICAL             L1TIME, L1FATL, L1NEWD
      COMMON  / C1RNRM /  R1NRM1, R1NRM2, R1NRMI
      COMMON              R1WORK(1)
      COMMON  / C1RVBS /  R1BSTP(1)
      COMMON  / C0IVCN /  I0GROT, I0MODN, I0TIME
      INTEGER             I0GROT(6)
      COMMON  / C0LVCN /  L0HVDI, L0HVAN
      LOGICAL             L0HVDI, L0HVAN
      COMMON  / C1RVGL /  R1EPSG, R1EPSM, PI
C
C
      I1INPT = I1MACH(1)
      I1OUTP = I1MACH(2)
      I1SCRA = 1
      I0TIME = 2
      PI     = 4.*ATAN(1.)
      R1EPSM = R1MACH(3)
      I1BCST(1,1) = 1
      R1AXGR = 0.0
      R1BXGR = 1.0
      R1AYGR = 0.0
      R1BYGR = 1.0
      CALL Q0BCTP( 1,2,1,1,
     A             3,4,1,1,
     B             0,0,0,0)
      CALL Q0INIT( .FALSE., .FALSE., .FALSE., .TRUE.,
     A             .TRUE., .TRUE., .TRUE., .FALSE., .FALSE.,
     B             .FALSE., .TRUE., .FALSE., .TRUE., .FALSE.,
     C             .TRUE., 1, .FALSE., 1,
     D             1, 1, 1, 1,
     E             1, 1, 0, .TRUE., .TRUE.,
     F             .TRUE., .TRUE. )
      CALL Q1PCOE(0.0, 0.0, R1CUXX)
C
C
      STOP
      END
      SUBROUTINE Q1PCOE(X, Y, R0CPDE)
C
C ======= DEFINE EQUATION COEFFICIENTS
C
      COMMON  / C1RVGL /  R1EPSG, R1EPSM, PI
      REAL            R0CPDE(6)
C
      R0CPDE( 1) = 0.0
      R0CPDE( 2) = 0.0
      R0CPDE( 3) = 0.0
      R0CPDE( 4) = 0.0
      R0CPDE( 5) = 0.0
      R0CPDE( 6) = 0.0
C
      RETURN
      END
      REAL FUNCTION R1PRHS(X, Y)
C
C ======= DEFINE THE RIGHT SIDE OF THE EQUATION
C
      COMMON  / C1RVGL /  R1EPSG, R1EPSM, PI
      R1PRHS = 0.0
C
      RETURN
      END
      SUBROUTINE Q1BCOE(I0SIDE, X, Y, R0CBC)
C
C ======= DEFINE THE BOUNDARY CONDITIONS
C
      COMMON  / C1RVGL /  R1EPSG, R1EPSM, PI
      REAL                R0CBC(3)
      COMMON  / C0IVCN /  I0GROT, I0MODN, I0TIME
      INTEGER             I0GROT(6)
C
      I0BCND = I0GROT(I0SIDE)
      GO TO (10001), I0BCND
10001 CONTINUE
      R0CBC(1) = 1.0
      R0CBC(2) = 0.0
      R0CBC(3) = 0.0
      GO TO 9999
C
C
 9999 CONTINUE
      RETURN
      END
      REAL FUNCTION R1BRHS(I0SIDE, X, Y)
C
C ======= DEFINE THE BOUNDARY CONDITIONS
C
      COMMON  / C1RVGL /  R1EPSG, R1EPSM, PI
      COMMON  / C0IVCN /  I0GROT, I0MODN, I0TIME
      INTEGER             I0GROT(6)
C
      I0BCND = I0GROT(I0SIDE)
      GO TO (10001), I0BCND
10001 CONTINUE
      R1BRHS = TRUE(X,Y)
      GO TO 9999
C
C
 9999 CONTINUE
      RETURN
      END
      REAL FUNCTION R0SOLV(IDERIV, X, Y)
C
C ======= RETURN THE SOLUTION AT THE SPECIFIED POINT
C
      COMMON  / C1UNKN /  R1UNKN(1)
      COMMON  / C1IVCN /  I1LEVL, I1PAGE, I1INPT, I1OUTP, I1SCRA,
     A                    I1KWRK, I1KORD
      COMMON  / C1LVCN /  L1TIME, L1FATL, L1NEWD
      LOGICAL             L1TIME, L1FATL, L1NEWD
      COMMON  / C0IVCN /  I0GROT, I0MODN, I0TIME
      INTEGER             I0GROT(6)
      COMMON  / C0LVCN /  L0HVDI, L0HVAN
      LOGICAL             L0HVDI, L0HVAN
C
      IF (.NOT. L0HVAN)  CALL Q0ERPP(3)
      GO TO (10001), I0MODN
10001 CONTINUE
      R1QD2I(X, Y, R1TABL, IDERIV)
 
      GO TO 9999
C
C
 9999 CONTINUE
      L1NEWD = .FALSE.
      RETURN
      END
