$NOFLOATCALLS
C**********************************************************************
C
      SUBROUTINE ELAS
C
C**********************************************************************
C             --  THE NUMERICAL ELASTICITY PROGRAM  --
C
C   THIS  SUBROUTINE CALCULATES A PRICE ELASTICITY MATRIX FOR MARKET
C   SUPPLIES AND DEMANDS.
C
C        VERSION:  A.31.07.84
C
C        REAL INPUTS:   PIM, EDIL, EDIMKT, ESIL, ESIMKT
C        REAL OUTPUTS:  UIJ, VIJ
C
C        SUBROUTINES CALLED:   1) PPPP   2) SSSS   3) PSPS   4)DDDD
C
C        CODED BY:
C        JAE EDMONDS                        LATEST REVISION:
C        1 JANUARY 1982                     31 JULY 1984
C                                           BY:  JAE EDMONDS
C                                           *PI CHANGED TO PIM
C
C***********************************************************************
C
C  MAKE ALL REAL VARIABLES DOUBLE PRECISION
C
      IMPLICIT   REAL*8 (A-H,O-Z),   INTEGER (I-N)
C
C COMMON BLOCKS
$INCLUDE:'COMMON.FOR'
C
C                    --  LOCAL VARIABLES  --
C
      REAL*8   DELTA, PIHOLD, U, V
      INTEGER  F(6)
C
C
      F(1)='    '
      F(2)=' OIL'
      F(3)='    '
      F(4)=' GAS'
      F(5)='    '
      F(6)='COAL'
C
C
C             +---------------------------------------+
C             |   CALCULATE DERIVATIVES NUMERICALLY   |
C             +---------------------------------------+
      DELTA=0.0010D0
      DO 100 I=1,NF
C
C                     --  PERTERB PRICES  --
C
         PIHOLD=PIM(I,M)
         PIM(I,M) =PIM(I,M)+DELTA
C
C                      --  RUN THE MODEL  --
C
         CALL PPPP
         CALL PSPS
         CALL SSSS
         NUB=0
         CALL DDDD
C
C          --  COMPUTE NEW MARKET SUPPLIES AND DEMANDS  --
C
         DO 60 II=1,NF
            U=1.D0
            V=1.D0
            DO 30 L=1,NL
               U=U+EDRIL(II,L)
               V=V+ESRILM(II,L,M)
   30       CONTINUE
C
C         --  CALCULATE NUMERICAL ELASTICITIES FOR FUEL I  --
C
            UIJ(II,I)=(U-EDIMKT(II))/EDIMKT(II)/(DELTA/PIHOLD)
            VIJ(II,I)=(V-ESIMKT(II))/ESIMKT(II)/(DELTA/PIHOLD)
   60    CONTINUE
C
C              --  RETURN PRICE TO ORIGINAL VALUE  --
C
         PIM(I,M)=PIHOLD
  100 CONTINUE
C
C -- OUTPUT OPTION CONTROL
C
      IF(NOPT(4)-1) 110,210,110
C
  110 CONTINUE
C           +---------------------------------+
C           |   INTERMEDIATE OUTPUT SECTION   |
C           +---------------------------------+
C
      WRITE(JUNIT,1000)   M
 1000 FORMAT(1H1,'PERIOD',I2,' GLOBAL PRICE ELASTICITIES')
      WRITE(JUNIT,1010)  (F(II),II=1,6)
 1010 FORMAT(1X,'DEMAND ',3(2A4,2X),4X,'SUPPLY ',3(2A4,2X))
      DO 200 I=1,NMKT
         IJ=1+2*(I-1)
         IK=IJ+1
         WRITE(JUNIT,2000)  (F(II),II=IJ,IK), (UIJ(I,J),J=1,NMKT),
     $                   (F(II),II=IJ,IK), (VIJ(I,J),J=1,NMKT)
C
 2000    FORMAT(1X,2(2A4,2X,3F10.4,1X))
C
  200 CONTINUE
C
  210 CONTINUE
C
      RETURN
      END