C....*...1.........2.........3.........4.........5.........6.........7.*.......8
C     ELAST2       1/19/85
C
C     PURPOSE
C     COMPUTE SUBSTITUTION, PRICE, AND INCOME ELASTICITIES AND THEIR
C     STANDARD ERRORS FROM ESTIMATED COEFFICIENTS OF THE FOURIER
C     INDIRECT UTILITY FUNCTION.
C
C     USAGE
C     CALL FFFCGH(N,KC,IS,KA,IAA,JJA,M,DL,X,CGH,LT,IW)
C     CALL ELAST2(M,LT,CGH,THEAT,VAR,SUB,SESUB,PRIH,SEPRIH,
C    &PRIM,SEPRIM,EINC,SEEINC,WORK)
C
C     SUBROUTINES CALLED
C     DGMPRD
C
C     ARGUMENTS
C     M     - AS FOR FFFCGH, INPUT.  SET EQUAL TO THE TOTAL NUMBER OF
C             GOODS.
C     LT    - AS FOR FFFCGH, INPUT.
C     CGH   - AS FOR FFFCGH, INPUT.  NOTE THAT FFFCGH IS CALLED WITH M
C             EQUAL TO THE NUMBER OF GOODS NOT THE NUMBER OF GOODS LESS
C             ONE.
C     THETA - ESTIMATED COEFFICIENTS OF THE FOURIER COST FUNCTION,
C             INPUT VECTOR OF LENGTH LT.
C             REAL*8
C     VAR   - EXTIMATED VARIANCE-COVARIANCE MATRIX OF THETA, INPUT.
C             MATRIX OF ORDER LT BY LT STORED COLUMNWISE (STORAGE MODE
C             0).
C             REAL* 8
C     SUB   - ESTIMATED ELASTICITIES OF SUBSTITUTION, OUTPUT.  MATRIX OF
C             ORDER M BY M STORED COLUMNWISE (STORAGE MODE 0).
C             REAL*8
C     SESUB - ESTIMATED STANDARD ERRORS OF SUB, OUTPUT.  STORED THE SAME
C             AS SUB.
C             REAL*8
C     PRIH  - ESTIMATED COMPENSATED PRICE ELASTICITIES, OUTPUT.
C             MATRIX OF ORDER M BY M STORED COLUMNWISE (STORAGE MODE 0).
C             ROWS INDEX QUANTITIES AND COLUMNS INDEX PRICES.
C             REAL*8
C     SEPRIH- ESTIMATED STANDARD ERRORS OF PRIH, OUTPUT.  STORED THE SAM
C             AS SUB.
C             REAL*8
C     PRIM  - ESTIMATED UNCOMPENSATED PRICE ELASTICITIES, OUTPUT.
C             MATRIX OF ORDER M BY M STORED COLUMNWISE (STORAGE MODE 0).
C             ROWS INDEX QUANTITIES AND COLUMNS INDEX PRICES.
C             REAL*8
C     SEPRIM- ESTIMATED STANDARD ERRORS OF PRIM, OUTPUT.  STORED THE SAM
C             AS SUB.
C             REAL* 8
C     EINC  - ESTIMATED INCOME ELASTICITIES, OUTPUT.  A VECTOR OF LENGTH
C             ROWS INDEX QUANTITIES.
C             REAL*8
C     SEEINC- ESTIMATED STANDARD ERRORS OF EINC, OUTPUT.  STORED THE SAM
C             AS EINC.
C             REAL*8
C     WORK  - A WORK VECTOR OF LENGTH 4*LT+1.
C             REAL*8
C
C
      SUBROUTINE ELAST2(M,LT,X,CGH,THETA,VAR,SUB,SESUB,PRIH,SEPRIH,
     &PRIM,SEPRIM,EINC,SEEINC,WORK)
      IMPLICIT INTEGER*4 (A-Z)
      save
      REAL*8 THETA(1),VAR(1)
      REAL*8 CGH(1),X(1)
      REAL*8 SUB(1),SESUB(1),PRIM(1),SEPRIM(1),PRIH(1),SEPRIH(1)
      REAL*8 EINC(1),SEEINC(1)
      REAL*8 WORK(1)
      XG=1
      HIJ=XG+LT
      GI=HIJ+LT
      GJ=GI+LT
      XHJ=GJ+LT
      XHI=XHJ+LT
      XHX=XHI+LT
      DEL=XHX+LT
      DELINC=DEL+LT
      CALL Z1ELAST2(M,LT,X,CGH,THETA,VAR,SUB,SESUB,PRIH,SEPRIH,
     &PRIM,SEPRIM,EINC,SEEINC,WORK(XG),WORK(HIJ),WORK(GI),
     &WORK(GJ),WORK(XHJ),WORK(XHI),WORK(XHX),WORK(DEL),WORK(DELINC))
      RETURN
      END
      SUBROUTINE Z1ELAST2(NF,LT,X,CGH,THETA,VAR,SUB,SESUB,PRIH,SEPRIH,
     &PRIM,SEPRIM,EINC,SEEINC,XG,HIJ,GI,
     &GJ,XHJ,XHI,XHX,DEL,DELINC)
      IMPLICIT REAL*8 (A-H,O-Z)
      save
      REAL*8 THETA(1),VAR(1)
      REAL*8 CGH(1),X(1)
      REAL*8 XG(1),HIJ(1),GI(1),GJ(1),XHJ(1),XHI(1),XHX(1),DEL(1)
      REAL*8 SUB(1),SESUB(1),PRIM(1),SEPRIM(1),PRIH(1),SEPRIH(1)
      REAL*8 EINC(1),SEEINC(1),DELINC(1)
      INTEGER*4 C0,G0,H0,GI0,GJ0,HIJ0
      C0=0
      G0=C0+1
      H0=G0+NF
      LCGH=1+NF+NF*NF
      DO 5 I=1,NF
      EINC(I)=0.D0
      SEEINC(I)=0.D0
      DO 5 J=1,NF
      PRIM(NF*(J-1)+I)=0.D0
      SEPRIM(NF*(J-1)+I)=0.D0
      PRIH(NF*(J-1)+I)=0.D0
      SEPRIH(NF*(J-1)+I)=0.D0
      SUB(NF*(J-1)+I)=0.D0
5     SESUB(NF*(J-1)+I)=0.D0
      DO 100 I=1,NF
      DO 100 J=1,NF
      DO 10 K=1,LT
      XG(K)=0.D0
      XHJ(K)=0.D0
      XHI(K)=0.D0
10    XHX(K)=0.D0
      DO 30 K=1,LT
      DO 20 L=1,NF
      XG(K)=XG(K)+X(L)*CGH(G0+L+LCGH*(K-1))
      XHJ(K)=XHJ(K)+X(L)*CGH(H0+NF*(J-1)+L+LCGH*(K-1))
      XHI(K)=XHI(K)+X(L)*CGH(H0+NF*(L-1)+I+LCGH*(K-1))
      DO 20 M=1,NF
20    XHX(K)=XHX(K)+X(L)*X(M)*CGH(H0+NF*(L-1)+M+LCGH*(K-1))
30    CONTINUE
      DO 40  K=1,LT
      GI(K)=CGH(G0+I+LCGH*(K-1))
      GJ(K)=CGH(G0+J+LCGH*(K-1))
      HIJ(K)=CGH(H0+NF*(J-1)+I+LCGH*(K-1))
40    CONTINUE
      XGT=0.D0
      HIJT=0.D0
      GIT=0.D0
      GJT=0.D0
      XHJT=0.D0
      XHIT=0.D0
      XHXT=0.D0
      DO 50 K=1,LT
      XGT=XGT+XG(K)*THETA(K)
      HIJT=HIJT+HIJ(K)*THETA(K)
      GIT=GIT+GI(K)*THETA(K)
      GJT=GJT+GJ(K)*THETA(K)
      XHJT=XHJT+XHJ(K)*THETA(K)
      XHIT=XHIT+XHI(K)*THETA(K)
50    XHXT=XHXT+XHX(K)*THETA(K)
      SUB(NF*(J-1)+I)=XGT*HIJT/(GIT*GJT)
     &               -XHJT/GJT
     &               -XHIT/GIT
     &               +XHXT/XGT
      DO 60 K=1,LT
      DEL(K)=XG(K)*HIJT/(GIT*GJT)
     &       +XGT*HIJ(K)/(GIT*GJT)
     &       -XGT*HIJT*GI(K)/(GIT*GIT*GJT)
     &       -XGT*HIJT*GJ(K)/(GIT*GJT*GJT)
     &       -XHJ(K)/GJT
     &       +XHJT*GJ(K)/(GJT*GJT)
     &       -XHI(K)/GIT
     &       +XHIT*GI(K)/(GIT*GIT)
     &       +XHX(K)/XGT
     &       -XHXT*XG(K)/(XGT*XGT)
60    CONTINUE
      CALL DGMABA(DEL,VAR,SESUB(NF*(J-1)+I),LT,1)
      SESUB((NF*(J-1)+I))=DSQRT(SESUB(NF*(J-1)+I))
      PRIM(NF*(J-1)+I)=X(J)*HIJT/GIT
     &                -X(J)*XHJT/XGT
     &                -X(J)*GJT/XGT
      DO 70 K=1,LT
      DEL(K)=X(J)*HIJ(K)/GIT
     &      -X(J)*HIJT*GI(K)/(GIT*GIT)
     &      -X(J)*XHJ(K)/XGT
     &      +X(J)*XHJT*XG(K)/(XGT*XGT)
     &      -X(J)*GJ(K)/XGT
     &      +X(J)*GJT*XG(K)/(XGT*XGT)
70    CONTINUE
      CALL DGMABA(DEL,VAR,SEPRIM(NF*(J-1)+I),LT,1)
      SEPRIM(NF*(J-1)+I) = DSQRT(SEPRIM(NF*(J-1)+I))
      EINCI=-XHIT/GIT
     &      +XHXT/XGT+1.D0
      DO 80 K=1,LT
80    DELINC(K)=-XHI(K)/GIT
     &          +XHIT*GI(K)/(GIT*GIT)
     &          +XHX(K)/XGT
     &          -XHXT*XG(K)/(XGT*XGT)
      IF(J.EQ.1) EINC(I)=EINCI
      IF(J.EQ.1) CALL DGMABA(DELINC,VAR,SEEINC(I),LT,1)
      SEEINC(I) = DSQRT(SEEINC(I))
      PRIH(NF*(J-1)+I)=PRIM(NF*(J-1)+I)+EINCI*X(J)*GJT/XGT
      DO 90 K=1,LT
90    DEL(K)=DEL(K)+DELINC(K)*X(J)*GJT/XGT
     &             +EINCI*X(J)*GJ(K)/XGT
     &             -EINCI*X(J)*GJT*XG(K)/(XGT*XGT)
      CALL DGMABA(DEL,VAR,SEPRIH(NF*(J-1)+I),LT,1)
      SEPRIH(NF*(J-1)+I) = DSQRT(SEPRIH(NF*(J-1)+I))
100   CONTINUE
      RETURN
      END