      COMMON/GETNXT/NEXT
      COMMON/GETNCW/NCHW
      COMMON/MEMORY/LENGTH,LEXICN,IBLOCK(8000)
      COMMON/CONTR/NV,NG,NI,NT,IFMT(180),NC
C
      DOUBLE PRECISION PROBLM,TITLE,THIS,FORMAT,TAPE,PNAME,LABELS,VARIAB
     1,GROUPS,INPUT,INDEX
      DATA PROBLM,TITLE,INPUT,FORMAT,TAPE,INDEX,VARIAB,GROUPS,LABELS/
     16HPROBL.,6HTITLE.,6HINPUT.,6HFORMA.,6HTAPE. ,6HINDEX.,6HVARIA.,
     26HGROUP.,6HLABEL./
      DATA COVI,XBARI,COV,XBAR,GUSE,VUSE,IUSE,GRN,X,SMALL,BIG,TEMP,VRBL,
     1GRPS                                                             /
     2 4HCOVI,4HXBRI ,3HCOV,4HXBAR,4HGUSE,4HVUSE,4HIUSE,3HGRN,1HX,
     3 4HSMAL ,3HBIG,4HTEMP,4HVRBL,4HGRPS                              /
      DATA IFM1,IFM2,IBLANK/'(12F','6.0)','    '/
C
 1000 FORMAT(//1H ,30A5)
 1001 FORMAT(///
     1 20H NUMBER OF VARIABLES, I6 / 20H NUMBER OF GROUPS   , I6 /
     2 20H GROUP INDICATOR VAR, I6 / 20H INPUT TAPE'S NUMBER, I6 )
 1012 FORMAT(7H FORMAT,30A5,/(' ',6X,30A5))
 1971 FORMAT(//  80H SUBSCRIPT OF GROUP INDICATES VARIABLE IS GREATER TH
     1AN NUMBER OF VARIABLES.                       )
 2000 FORMAT('1BMDX82 - ANALYSIS OF COVARIANCE - REVISED ',
     X'MAY 10, 1968'/
     1           50H HEALTH SCIENCES COMPUTING FACILITY,  U.C.L.A.     )
C
      NEXT=0
	CALL USAGEB('BMDX82')
    1 CALL SETUP
      IFMT(1)=IFM1
      IFMT(2)=IFM2
      DO 2 I2=3,180
 2    IFMT(I2) = IBLANK
      NT=5
      NI=0
      CALL GETME(PROBLM,TITLE,120,1,MANY,IBLOCK,IERROR)
      IF(IERROR.EQ.1) GO TO 999
      WRITE(6,2000)
      IF(MANY.GT.0) WRITE(6,1000)(IBLOCK(I),I=1,30)
      CALL GETME(INPUT,FORMAT,720,1,MANY,IFMT,IERROR)
      CALL GETME(INPUT,TAPE  ,1,1,MANY,NT,IERROR)
      CALL GETME(INPUT,INDEX ,1,1,MANY,NI,IERROR)
      CALL GETME(INPUT,VARIAB,1,1,MANY,NV,IERROR)
      CALL GETME(INPUT,GROUPS,1,1,MANY,NG,IERROR)
      WRITE(6,1001)NV,NG,NI,NT
      WRITE(6,1012)(IFMT(I),I=1,180)
      CALL RECORD(VRBL,LVNAME,NV)
      II=LVNAME
      DO 10 I=1,NV
      IBLOCK(II)=IBLANK
      IF(I.LE.9)
     *CALL PUTCHR(IBLOCK(II),NCHW,(MOD(I,100)+240)*2**24)
      IF(I.GT.9)
     1CALL PUTCHR(IBLOCK(II),NCHW,((MOD(I,100)-(MOD(I,100)/10)*10)+240)*
     22**24)
      IF(I.GT. 9) CALL PUTCHR(IBLOCK(II),NCHW-1,(MOD(I,100)/10+240)*2**
     1 24)
      IF(I.GT.99) CALL PUTCHR(IBLOCK(II),NCHW-2,(I/100+240)*2**24)
   10 II=II+1
      CALL GETME(LABELS,VARIAB,NCHW,NV,MANY,IBLOCK(LVNAME),IERROR)
      CALL RECORD(GRPS,LGNAME,NG)
      II=LGNAME
      DO 20 I=1,NG
      IBLOCK(II)=IBLANK
      CALL PUTCHR(IBLOCK(II),NCHW,(MOD(I,100)+240)*2**24)
      IF(I.GT. 9) CALL PUTCHR(IBLOCK(II),NCHW-1,(MOD(I,100)/10+240)*2**
     1 24)
      IF(I.GT.99) CALL PUTCHR(IBLOCK(II),NCHW-2,(I/100+240)*2**24)
   20 II=II+1
      CALL GETME(LABELS,GROUPS,NCHW,NG,MANY,IBLOCK(LGNAME),IERROR)
      IF(NI.GT.NV) GO TO 971
      CALL RESERV(COVI,LCOVI,NG*NV*(NV+1)/2)
      CALL RESERV(XBARI,LXBARI,NV*NG)
      CALL RESERV(COV,LCOV,NV*(NV+1)/2)
      CALL RESERV(XBAR,LXBAR,NV)
      CALL RESERV(GUSE,LGUSE,NG)
      CALL RESERV(VUSE,LVUSE,NV)
      CALL RESERV(IUSE,LIUSE,NV)
      CALL RESERV(GRN,LGRN,NG)
      NGG=MAX0(NV,NG)
      CALL RESERV(X,LX,NGG)
      NGG=MAX0(NG,3)
      CALL RESERV(SMALL,LSMALL,NV*NGG)
      NGG=MAX0(NG*(NG+1)/2,NG*NV)
      CALL RESERV(BIG,LBIG,NGG)
      NGG=MAX0(NV*(NV+1)/2,NG*(NG+1)/2)
      CALL RESERV(TEMP,LTEMP,NGG)
      NC=(LENGTH-LEXICN)/NG
      CALLCOVANA(IBLOCK(LCOVI),IBLOCK(LXBARI),IBLOCK(LCOV),IBLOCK(LXBAR)
     1          ,IBLOCK(LGUSE),IBLOCK(LVUSE),IBLOCK(LIUSE),IBLOCK(LGRN),
     2IBLOCK(LX),IBLOCK(LX),IBLOCK(LSMALL),IBLOCK(LBIG),IBLOCK(LVNAME)
     3          ,IBLOCK(LGNAME),IBLOCK(LTEMP),IBLOCK(LEXICN),NV,NG)
      GO TO 1
  971 WRITE(6,1971)
  999 STOP
      END
      SUBROUTINE GETSEQ(COEF,NCC,USEG,USEV,USEI,MORE)
      COMMON/GETNXT/NEXT
      COMMON/CONTR/NV,NG,NI,NT,FMT(180),NC
      DIMENSION USEG(1),USEV(1),USEI(1),USE(99),COEF(1)
      DOUBLE PRECISION SUBPRO,TITLE,INDEPE,DEPEND,CONTRA,GROUPS
      DATA SUBPRO,DEPEND,INDEPE,GROUPS,CONTRA,TITLE/
     1 6HSUBPR.,6HDEPEN.,6HINDEP.,6HGROUP.,6HCONTR.    ,6HTITLE. /
C
 1000 FORMAT(1H ,30A5)
 1001 FORMAT(1H1)
C
      WRITE(6,1001)
      NEXT=0
      MORE=1
      NCC=0
      DO 1 I=1,NV
      IF(USEI(I).NE.0.0) USEV(I)=0.0
    1 CONTINUE
      CALL GETME(SUBPRO,TITLE,120,1,MANY,USE,IERROR)
      IF(IERROR.NE.0) GO TO 77
      IF(MANY.GT.0)WRITE(6,1000)(USE(I),I=1,30)
      CALL GETME(SUBPRO,INDEPE,2,NV,MANY,USE,IERROR)
      IF(MANY.LE.0) GO TO 19
      DO 10 I=1,NV
   10 USEI(I)=0.0
      DO 15 I=1,MANY
      II=USE(I)+.00001
   15 USEI(II)=1.0
   19 CALL GETME(SUBPRO,DEPEND,2,NV,MANY,USE,IERROR)
      IF(MANY.LE.0) GO TO 29
      DO 20 I=1,NV
   20 USEV(I)=0.0
      DO 25 I=1,MANY
      II=USE(I)+.00001
   25 USEV(II)=1.0
   29 CALL GETME(SUBPRO,GROUPS,2,NG,NGG ,USE,IERROR)
      IF(NGG.GT.NG) NGG=NG
      IF(NGG .LE.0) GO TO 49
      DO 30 I=1,NG
   30 USEG(I)=0.0
      DO 35 I=1,NGG
      II=USE(I)+.00001
   35 USEG(II)=1.0
      CALL GETME(SUBPRO,CONTRA,2,NC*NG,MANY,COEF,IERROR)
      NCC=MANY/NGG
      IF(NCC .LE.0) GO TO 49
      IF(NGG.EQ.NG) GO TO 49
      MANY1=NCC*NGG+1
      LAST=NCC*NG
      DO 38 I=MANY1,LAST
   38 COEF(I)=0.0
      DO 40 J=1,NCC
      JJ=NCC+1-J
      DO 40 I=1,NGG
      MANY1=MANY1-1
      II=NGG+1-I
      II=USE(II)+.00001
      LOC=(JJ-1)*NG+II
      COEF(LOC)=COEF(MANY1)
      IF(LOC.NE.MANY1) COEF(MANY1)=0.0
   40 CONTINUE
   49 DO 50 I=1,NV
      IF(USEI(I).EQ.1.0) USEV(I)=1.0
   50 CONTINUE
      RETURN
   77 IF(IERROR.EQ.1) MORE=0
      RETURN
      END
      SUBROUTINE COVANA(COVI,XBARI,COV,XBAR,GUSE,VUSE,IUSE,GRN,X,IX,
     1                  SMALL,BIG,VNAME,GNAME,TEMP,WORK,N,NG)
      DOUBLE PRECISION GROUP,TOTAL,WITHIN,BETWEN,MEANS,STDS
      DIMENSION WORK(NG,1 ),TEMP(1),IX(1)
      DIMENSION COVI(1),XBARI(N,NG),COV(1),XBAR(N),GUSE(N),VUSE(NG),
     1  IUSE(1),GRN(NG),X(N),SMALL(N,NG),BIG(N,NG),VNAME(N),GNAME(NG)
      DATA GROUP,TOTAL,WITHIN,BETWEN/'GROUP ','TOTAL ','WITHIN',
     1'BETWEEN'/
C
      DATA ULINE/4H*   /
C
 1000 FORMAT(1X,A6,5X,12F9.4)
 1001 FORMAT(1H )
 1005 FORMAT( ///30H NUMBER OF CASES PER GROUPS    //(1X,A6,5X,F6.0 ))
 1010 FORMAT(10X,6HD.F.= ,F6.0)
 1040 FORMAT(/// 24H ANALYSIS OF VARIANCE    //20H SOURCE OF VARIANCE
     *  10X, 50H D.F.     SUM OF SQ.     MEAN SQ.       F-VALUE     )
 1041 FORMAT(    30H EQUALITY OF ADJ. CELL MEANS  ,I5,3F15.4)
 1042 FORMAT(    30H ZERO SLOPE                   ,I5,3F15.4)
 1043 FORMAT(    30H    ERROR                     ,I5,2F15.4 )
 1044 FORMAT(    30H EQUALITY OF SLOPES           ,I5,3F15.4)
 1050 FORMAT( ///30H OBSERVED MINIMUMS            //11X,12(3X,A6))
 1060 FORMAT( ///30H OBSERVED MAXIMUMS            //11X,12(3X,A6))
 1070 FORMAT( ///30H ESTIMATES OF MEANS           //11X,12(3X,A6))
 1078 FORMAT(1H1,23H SUBPROBLEM FOR GROUPS 12(2X,A6))
 1080 FORMAT( ///30H VARIANCE-COVARIANCE MATRIX   ,A8)
 1084 FORMAT(//  62H GROUP      N         GRP.MEAN       ADJ.GRP.MEAN   
     *STD.ERR.     )
 1085 FORMAT(//53H COVARIATE      REG.COEFF.     STD.ERR.       T-VALUE)
 1086 FORMAT(3X,A6,F6.0,3X,4F15.5)
 1087 FORMAT(3X,A6     ,3X,4F15.5)
 1088 FORMAT(/// 45H T-TEST MATRIX FOR ADJUSTED GROUP MEANS          )
 1090 FORMAT(/// 51H CORRELATION MATRIX FOR THE REGRESSION COEFFICIENTS)
 1091 FORMAT(/// 50H CORRELATION MATRIX FOR THE ADJUSTED GROUP MEANS   )
 1095 FORMAT( ///24H DEPENDENT VARIABLE IS    ,A6)
 1096 FORMAT(1X,120A1)
 1110 FORMAT( // 50H VARIANCE-COVARIANCE MATRIX TOTAL IS SINGULAR      )
 1120 FORMAT( // 50H VARIANCE-COVARIANCE MATRIX WITHIN IS SINGULAR     )
 1130 FORMAT(/   37H VARIANCE-COVARIANCE MATRIX OF GROUP ,A6,
     * 60H IS SINGULAR. F-TEST FOR EQUALITY OF SLOPES IS NOT COMPUTED.)
C
      NN=N*(N+1)/2
      DO 10 IG=1,NG
      GRN(IG)=0.0
      DO 10 I=1,N
      VUSE(I)=1.0
      SMALL(I,IG)= 10.0**10
   10 BIG(I,IG)=-SMALL(I,IG)
   20 CALL READIN(X,IX,IG)
      IF(IG.EQ.0) GO TO 50
      II=NN*(IG-1)+1
      CALL MACLOM(COVI(II),XBARI(1,IG),X,XBAR,GRN(IG),N)
      DO 30 I=1,N
      IF(SMALL(I,IG).GT.X(I)) SMALL(I,IG)=X(I)
      IF(BIG(I,IG).LT.X(I)) BIG(I,IG)=X(I)
   30 CONTINUE
      GO TO 20
   50 WRITE(6,1005)(GNAME(I),GRN(I),I=1,NG)
      NPRNT=0
   51 IPRNT=NPRNT+1
      NPRNT=MIN0(N,NPRNT+12)
      WRITE(6,1050)(VNAME(I),I=IPRNT,NPRNT)
      WRITE(6,1001)
      DO 52 IG=1,NG
   52 WRITE(6,1000)GNAME(IG),(SMALL(I,IG),I=IPRNT,NPRNT)
      IF(NPRNT.LT.N) GO TO 51
      NPRNT=0
   61 IPRNT=NPRNT+1
      NPRNT=MIN0(N,NPRNT+12)
   60 WRITE(6,1060)(VNAME(I),I=IPRNT,NPRNT)
      WRITE(6,1001)
      DO 62 IG=1,NG
   62 WRITE(6,1000)GNAME(IG),(BIG  (I,IG),I=IPRNT,NPRNT)
      IF(NPRNT.LT.N) GO TO 61
      NPRNT=0
   71 IPRNT=NPRNT+1
      NPRNT=MIN0(N,NPRNT+12)
   70 WRITE(6,1070)(VNAME(I),I=IPRNT,NPRNT)
      WRITE(6,1001)
      DO 72 IG=1,NG
   72 WRITE(6,1000)GNAME(IG),(XBARI(I,IG),I=IPRNT,NPRNT)
      IF(NPRNT.LT.N) GO TO 71
      DO 90 IG=1,NG
      II=NN*(IG-1)+1
      WRITE(6,1080)GROUP,GNAME(IG)
      GRN1=GRN(IG)-1.0
      WRITE(6,1010)GRN1
   90 CALL PRDLOM(COVI(II),N,GRN1   ,X,VNAME,VUSE)
   75 CALL GETSEQ(WORK,NCC,GUSE,VUSE,IUSE,MORE)
      IF(MORE.EQ.0) RETURN
      WRITE(6,1096)(ULINE,LINE=1,240)
      CALL BARTOT(XBARI,XBAR,GRN,NG,N,GUSE)
      NPRNT=0
   77 IPRNT=NPRNT+1
      NPRNT=MIN0(N,NPRNT+12)
      WRITE(6,1070)(VNAME(I),I=IPRNT,NPRNT)
      DO 78 IG=1,NG
      IF(GUSE(IG).NE.1.0) GO TO 78
      WRITE(6,1000)GNAME(IG),(XBARI(I,IG),I=IPRNT,NPRNT)
   78 CONTINUE
      WRITE(6,1000)TOTAL,(XBAR(I),I=IPRNT,NPRNT)
      IF(NPRNT.LT.N) GO TO 77
      WRITE(6,1080)TOTAL
      CALL TOTLOM(COVI,XBARI,COV,GRN,NG,N,GUSE,DFT)
      DFT1=DFT-1.0
      WRITE(6,1010)DFT1
      CALL PRDLOM(COV,N,DFT-1.0,X,VNAME,VUSE)
      CALL INVLOM(COV,IUSE,X,BIG,N)
      IF(X(1).EQ.1.0)WRITE(6,1110)
      IF(X(1).EQ.1.0) GO TO 75
      II=0
      L=0
      DO 80 I=1,N
      II=II+I
      IF(IUSE(I).EQ.0) GO TO 80
      L=L+1
   80 SMALL(I,1)=COV(II)
      WRITE(6,1080)BETWEN
      CALL BETLOM(XBARI,COV,GRN,NG,N,GUSE,DFB)
      DFB1=DFB-1.
      WRITE(6,1010)DFB1
      CALL PRDLOM(COV,N,DFB-1.0,X,VNAME,VUSE)
      WRITE(6,1080)WITHIN
      CALL WITLOM(COVI,COV,NG,N,GUSE,DFW,GRN)
      II=0
      DO 81 I=1,N
      II=II+I
   81 SMALL(I,2)=COV(II)
      WRITE(6,1010)DFW
      CALL PRDLOM(COV,N,DFW,X,VNAME,VUSE)
      WRITE(6,1090)
      CALL INVLOM(COV,IUSE,X,BIG,N)
      IF(X(1).EQ.1.0)WRITE(6,1120)
      IF(X(1).EQ.1.0) GO TO 75
      CALL PRDLOM(COV,N,0.0    ,X,VNAME,IUSE)
      WRITE(6,1091)
      CALL CAGLOM(COV,XBARI,XBAR,BIG  ,GRN,NG,N,GUSE,IUSE,-1.0)
      CALL PRDLOM(BIG  ,NG,0.0        ,X,GNAME,GUSE)
      DFL=DFW-FLOAT(L)
      II=0
      DO 85 I=1,N
      II=II+I
      IF((IUSE(I).NE.0).OR.(VUSE(I).NE.1.0)) GO TO 85
      WRITE(6,1095)VNAME(I)
      WRITE(6,1096)(ULINE,LINE=1,120)
      WRITE(6,1085)
      IJ=II-I
      DO 82 J=1,N
      IF(IUSE(J).EQ.0) GO TO 82
      IJJ=IJ+J
      IF(J.GT.I) IJJ=J*(J-1)/2+I
      JJ=J*(J+1)/2
      STD=SQRT(-COV(II)*COV(JJ)/DFL)
      T=COV(IJJ)/STD
      WRITE(6,1087)VNAME(J),COV(IJJ),STD,T
   82 CONTINUE
      WRITE(6,1001)
      WRITE(6,1084)
      IFL=DFL    +.001
      IFB1=DFB1  +.001
      SUME=0.0
      DFE=0.0
      ISIGN=0
      DO 86 IG=1,NG
      IF(GUSE(IG).EQ.0.0) GO TO 86
      ADJMN      =XBARI(I,IG)
      DO 87 J=1,N
      IF(IUSE(J).EQ.0) GO TO 87
      JJ=II-I+J
      IF(J.GT.I) JJ=J*(J-1)/2+I
      ADJMN=ADJMN-            (XBARI(J,IG)-XBAR(J))*COV(JJ)
   87 CONTINUE
      IGG=IG*(IG+1)/2
      STD=SQRT(BIG(IGG,1)/DFL*COV(II))
      WRITE(6,1086)GNAME(IG),GRN(IG),XBARI(I,IG),ADJMN,STD
      IF(GRN(IG)-FLOAT(L+1).LE.0.0) GO TO 86
      IJ=NN*(IG-1)
      DO 84 J=1,NN
      JJ=J+IJ
   84 TEMP(J)=COVI(JJ)
      CALL INVLOM(TEMP,IUSE,X,SMALL(1,3),N)
      IF(X(1).EQ.1.0)WRITE(6,1130)GNAME(IG)
      IF(X(1).EQ.1.0) ISIGN=1
      SUME=SUME+TEMP(II)
      DFE=DFE+GRN(IG)-FLOAT(L+1)
   86 CONTINUE
      WRITE(6,1040)
      WRITE(6,1001)
      SME=COV(II)/DFL
      SS=SMALL(I,1)-COV(II)
      SM=SS/DFB1
      FVAL=SM/SME
      WRITE(6,1041)IFB1,SS,SM,FVAL
      SS=SMALL(I,2)-COV(II)
      SM=SS/FLOAT(L)
      FVAL=SM/SME
      WRITE(6,1042)L,SS,SM,FVAL
      WRITE(6,1043)IFL,COV(II),SME
      WRITE(6,1001)
      IF(ISIGN.NE.0) GO TO 95
      SS=COV(II)-SUME
      IDFS=DFL-DFE+.001
      SM=SS/(DFL-DFE)
      SME=SUME/DFE
      IFE=DFE+.001
      FVAL=SM/SME
      WRITE(6,1044)IDFS,SS,SM,FVAL
      WRITE(6,1043)IFE,SUME,SME
   95 DO 89 IG=1,NG
      X(IG)=XBARI(I,IG)
      DO 89 J=1,N
      IF(GUSE(IG).EQ.0.0) GO TO 89
      IF(IUSE(J).EQ.0) GO TO 89
      JJ=II-I+J
      IF(J.GT.I) JJ=J*(J-1)/2+I
      X(IG)=X(IG)-(XBARI(J,IG)-XBAR(J))*COV(JJ)
   89 CONTINUE
      KK=0
      DO 88 K=1,NG
      K1=K*(K+1)/2
      DO 88 J=1,K
      KK=KK+1
      IF(GUSE(K ).EQ.0.0) GO TO 88
      IF(GUSE(J ).EQ.0.0) GO TO 88
      J1=J*(J+1)/2
      KJ=K*(K-1)/2+J
      TEMP(KK) = 0.0
      HSTUFF = SQRT((BIG(K1,1) + BIG(J1,1) - 2.0 * BIG(KJ,1)) * COV(II)
     1 / DFL)
      IF(HSTUFF .NE. 0.0) TEMP(KK) = (X(K) - X(J)) / HSTUFF
   88 CONTINUE
      WRITE(6,1088)
      CALLPRDLOM(TEMP,NG,-1.,SMALL(1,3),GNAME,GUSE)
      CALL TCONTR(WORK,NCC,BIG,X,DFL/COV(II),GUSE,NG,GNAME,TEMP)
   85 CONTINUE
      GO TO 75
      END
      SUBROUTINE READIN(X,IX,IG)
      COMMON/CONTR/NV,NG,NI,NT,FMT(180)
      DIMENSION X(1),IX(1)
      DATA IIG/1/
C
      IG=0
 1    READ (NT,FMT,END=2) (X(I), I=1,NV)
      IF(NI.LE.0) GO TO 10
      IF(IX(NI).LT.1 .OR. IX(NI).GT.NG) IX(NI) = X(NI) + .00001
      IG = IX(NI)
      X(NI)=IX(NI)
C
      IF((IG.LT.1).OR.(IG.GT.NG)) IG=0
 2    RETURN
   10 IG=IIG
      DO 15 I=1,NV
      IF(X(I).NE.0.0) RETURN
   15 CONTINUE
      IIG=IIG+1
      IF(IIG.LE.NG) GO TO 1
      IG=0
      IIG=1
      RETURN
      END
      SUBROUTINE TCONTR(WORK,NCC,BIG,X,DF,GUSE,NG,GNAME,TEMP)
      DIMENSION WORK(NG,NCC),BIG(1),X(1),GUSE(1),GNAME(1),TEMP(1)
      DATA TVALUE/4H  T   /
C
 1000 FORMAT(/// 50H T-VALUES FOR CONTRASTS IN ADJUSTED GROUP MEANS     
     * //12(3X,A6))
 1010 FORMAT(12F9.5)
C
      IF(NCC.EQ.0) RETURN
      II=0
      DO 10 I=1,NG
      IF(GUSE(I).EQ.0.0) GO TO 10
      II=II+1
      TEMP(II)=GNAME(I)
   10 CONTINUE
      WRITE(6,1000)(TEMP(I),I=1,II),TVALUE
      DO 100 ICC=1,NCC
      T=0.0
      SIG=0.0
      II=0
      DO 30 I=1,NG
      IF(GUSE(I).EQ.0.0) GO TO 30
      II=II+1
      TEMP(II)=WORK(I,ICC)
      T=T+WORK(I,ICC)*X(I)
      DO 20 J=1,NG
      IF(GUSE(J).EQ.0.0) GO TO 20
      IJ=I*(I-1)/2+J
      IF(J.GT.I) IJ=J*(J-1)/2+I
      SIG=SIG+WORK(I,ICC)*WORK(J,ICC)*BIG(IJ)
   20 CONTINUE
   30 CONTINUE
      T=T/SQRT(SIG/DF)
  100 WRITE(6,1010)(TEMP(I),I=1,II),T
      RETURN
      END
      SUBROUTINE PRDLOM(A,N,DF,W,ANAME,USE)
      DIMENSION A(1),W(1),ANAME(1),USE(1)
      DOUBLE PRECISION STD
      DATA STD/6HST.DEV   /
C
 1000 FORMAT(   1X,A6,3X,10F11.4)
 1001 FORMAT( / 7X,10(5X,A6))
 1002 FORMAT(1H )
C
      IC=0
    1 ICP=IC+1
      II=0
    5 IC=IC+1
      IF(USE(IC).EQ.0.0) GO TO 6
      II=II+1
      W(II)=ANAME(IC)
    6 IF(IC.LT.N.AND.II.LT.10) GO TO 5
      WRITE(6,1001)(W(I),I=1,II)
      WRITE(6,1002)
      DO 30 I=ICP,N
      IF(USE(I).EQ.0.0) GO TO 30
      II=0
      J=ICP-1
   10 J=J+1
      IF(USE(J).EQ.0.0) GO TO 20
      II=II+1
      IJ=I*(I-1)/2+J
      IF(DF.NE.0.0) GO TO 15
      I1=I*(I+1)/2
      J1=J*(J+1)/2
      W(II)=    A(IJ) /SQRT(    A(I1)*A(J1) )  *A(I1)/ABS(A(I1))
      GO TO 20
   15 W(II)=A(IJ)/DF
   20 IF(J.LT.I.AND.II.LT.10) GO TO 10
      WRITE(6,1000)ANAME(I),(W(IJ),IJ=1,II)
   30 CONTINUE
      WRITE(6,1002)
      II=0
      I=ICP-1
   35 I=I+1
      IF(USE(I).EQ.0.0) GO TO 40
      II=II+1
      IJ=I*(I+1)/2
      IF(DF.GT.0.0) W(II)=SQRT(ABS(A(IJ)/DF))
   40 IF(I.LT.N.AND.II.LT.10) GO TO 35
      IF(DF.GT.0.0)WRITE(6,1000)STD,(W(J),J=1,II)
  100 IF(I.LT.N) GO TO 1
      RETURN
      END
      SUBROUTINE MACLOM(COV,XBAR,X,W,PREVNO,N)
      DIMENSION COV(1),XBAR(N),X(N),W(N)
C
      IF(PREVNO.NE.0.0) GO TO 30
      M=0
      DO 10 I=1,N
      XBAR(I)=0.0
      DO 10 J=1,I
      M=M+1
   10 COV(M)=0.0
   30 M=0
      PREVP1=PREVNO+1.0
      DO 50 I=1,N
      XDELTA=(X(I)-XBAR(I))*PREVNO
      W(I)  =(X(I)-XBAR(I))/PREVP1
      XBAR(I)=XBAR(I)+W(I)
      DO 50 J=1,I
      M=M+1
   50 COV(M)=COV(M)+XDELTA*W(J)
      PREVNO=PREVP1
      RETURN
      END
      SUBROUTINE BARTOT(XBI,XB,GRN,NG,N,P)
      DIMENSION XBI(N,NG),XB(1),GRN(NG),P(NG)
C
      TOTN=0.0
      DO 10 I=1,N
   10 XB(I)=0.0
      DO 20 IG=1,NG
      IF(P(IG).EQ.0.0) GO TO 20
      TOTN=TOTN+GRN(IG)
      DO 15 I=1,N
   15 XB(I)=XB(I)+XBI(I,IG)*GRN(IG)
   20 CONTINUE
      DO 30 I=1,N
   30 XB(I)=XB(I)/TOTN
      RETURN
      END
      SUBROUTINE WITLOM(WI,W,NG,N,P,DF,GRN)
      DIMENSION WI(1),W(1),P(1),GRN(1)
C
      DF=0.0
      NN=N*(N+1)/2
      DO 10 I=1,NN
   10 W(I)=0.0
      DO 30 IG=1,NG
      IF(P(IG).EQ.0.0) GO TO 30
      DF=DF+GRN(IG)-1.0
      M=NN*(IG-1)
      DO 20 I=1,NN
      M=M+1
   20 W(I)=W(I)+WI(M)
   30 CONTINUE
      RETURN
      END
      SUBROUTINE BETLOM(XBI,B,GRN,NG,N,P,DF)
      DIMENSION XBI(N,NG),B(1),GRN(NG),P(NG)
C
      DF=0.0
      TOTN=0.0
      DO 10 I=1,NG
      IF(P(I).EQ.0.0) GO TO 10
      DF=DF+1.0
      TOTN=TOTN+GRN(I)
   10 CONTINUE
      M=N*(N-1)/2+1
      CALL BARTOT(XBI,B(M),GRN,NG,N,P)
      MI=M-1
      MII=M-1
      M=0
      DO 20 I=1,N
      MJ=MII
      MI=MI+1
      DO 20 J=1,I
      MJ=MJ+1
      M=M+1
      B(M)=-B(MI)*B(MJ)*TOTN
      DO 20 IG=1,NG
      IF(P(IG).NE.0.0) B(M)=B(M)+XBI(I,IG)*XBI(J,IG)*GRN(IG)
   20 CONTINUE
      RETURN
      END
      SUBROUTINE TOTLOM(WI,XBI,T,GRN,NG,N,P,DF)
      DIMENSION WI(1),XBI(N,NG),T(1),GRN(1),P(1)
C
      CALL BETLOM(XBI,T,GRN,NG,N,P,DF)
      DF=0.0
      NN=N*(N+1)/2
      DO 30 IG=1,NG
      IF(P(IG).EQ.0.0) GO TO 30
      DF=DF+GRN(IG)
      M=NN*(IG-1)
      DO 20 I=1,NN
      M=M+1
   20 T(I)=T(I)+WI(M)
   30 CONTINUE
      RETURN
      END
      SUBROUTINE INVLOM(A,P,U,V,N)
      DIMENSION A(1),P(N),U(N),V(N)
C
      M=0
      KOUNT=0
      DO 1 I=1,N
      M=M+I
      V(I)=A(M)*P(I)
      IF(P(I).NE.0.0) KOUNT=KOUNT+1
      IF(V(I).NE.0.) K=I
    1 CONTINUE
    6 M=K*(K-1)/2
      L=1
      DO 2 I=1,N
      M=M+L
      IF(I.GE.K) L=I
      U(I)=A(M)
    2 A(M)=0.
      B=U(K)
      V(K)=0.0
      U(K)=-1.
      M=0
      KOUNT=KOUNT-1
      T=0.0
      DO 5 I=1,N
      Y=-U(I)/B
      DO 4 J=1,I
      M=M+1
    4 A(M)=A(M)+Y*U(J)
      IF(V(I).EQ.0.0) GO TO 5
      H=A(M)/V(I)
      IF(H.LT.T) GO TO 5
      T=H
      K=I
    5 CONTINUE
      IF(T.GT.1.E-5) GO TO 6
      U(1)=0.0
      IF(KOUNT.EQ.0) RETURN
      U(1)=1.0
      RETURN
      END
      SUBROUTINE CAGLOM(COV,XBARI,XBAR,CAG,GRN,NG,NV,USEG,USEI,DF)
      DIMENSION COV(1),XBARI(NV,NG),XBAR(NV),CAG(1),GRN(NG),USEG(NG),
     *    USEI(NV)
C
      DO 100 I=1,NG
      IF(USEG(I).EQ.0.0) GO TO 100
      DO 90 J=1,I
      IF(USEG(J).EQ.0.0) GO TO 90
      II=I*(I-1)/2+J
      CAG(II)=0.0
      IF(I.EQ.J) CAG(II)=1.0/GRN(I)
      DO 80 K=1,NV
      IF(USEI(K).EQ.0.0) GO TO 80
      DO 70 L=1,K
      IF(USEI(L).EQ.0.0) GO TO 70
      KK=K*(K-1)/2+L
      COVDF=COV(KK)/DF
      CAG(II)=CAG(II)+(XBARI(K,I)-XBAR(K))*(XBARI(L,J)-XBAR(L))*COVDF
      IF(K.NE.L)
     *CAG(II)=CAG(II)+(XBARI(L,I)-XBAR(L))*(XBARI(K,J)-XBAR(K))*COVDF
   70 CONTINUE
   80 CONTINUE
   90 CONTINUE
  100 CONTINUE
      RETURN
      END
      SUBROUTINE SETUP
      COMMON/MEMORY/LENGTH,LEXICN,IBLOCK(8000)
C
      LENGTH=8000
      LEXICN=1
      DO 10 I=1,LENGTH
   10 IBLOCK(I)=0
      RETURN
      END
      SUBROUTINE RECORD(LABEL,LOC,NO)
      COMMON/MEMORY/LENGTH,LEXICN,IBLOCK(8000)
C
  100 FORMAT(//  80H THIS PROBLEM REQUIRES MORE DYNAMICALLY ALLOCATABLE
     *MEMORY THAN IS AVAILABLE.                )
C
      IBLOCK(LEXICN)=LABEL
      IBLOCK(LEXICN+1)=NO
      LOC=LEXICN+2
      LEXICN=LOC+NO
      IF(LEXICN.LE.LENGTH) RETURN
      WRITE(6,100)
      STOP
      END
      SUBROUTINE LOOKUP(LABEL,LOC,NO)
      COMMON/MEMORY/LENGTH,LEXICN,IBLOCK(8000)
C
      I=1
   10 IF(IBLOCK(I).EQ.LABEL) GO TO 20
      I=I+IBLOCK(I+1)+2
      IF(I.LT.LEXICN) GO TO 10
      LOC=0
      NO=0
      RETURN
   20 LOC=I+2
      NO=IBLOCK(I+1)
      RETURN
      END
      SUBROUTINE DELETE(LABEL)
      COMMON/MEMORY/LENGTH,LEXICN,IBLOCK(8000)
C
      CALL LOOKUP(LABEL,LOC,NO)
      IF(LOC.LE.0) RETURN
      LOC=LOC-2
      NO=NO+2
      LEXICN=LEXICN-NO
      DO 10 I=LOC,LEXICN
      J=I+NO
      IBLOCK(I)=IBLOCK(J)
   10 IBLOCK(J)=0
      RETURN
      END
      SUBROUTINE DUMPB
      COMMON/MEMORY/LENGTH,LEXICN,IBLOCK(8000)
C
 1000 FORMAT(/1H4,A6,2I8//)
 2000 FORMAT(I4,E18.8,5X,A6,2X,I10)
 3000 FORMAT(1H1,49H DYNAMIC STORAGE DUMP.  NEXT AVAILABLE LOCATION =I6)
C
      WRITE(6,3000)LEXICN
      M=0
   10 N=M+3
      M=N+IBLOCK(N-1)-1
      WRITE(6,1000)IBLOCK(N-2),N,M
      JBLOCK=IBLOCK(N)+1
      NEXT=IBLOCK(N)
      L=1
      DO 20 J=N,M
      LAST=JBLOCK
      JBLOCK=NEXT
      NEXT=IBLOCK(J+1)
      IF((LAST.NE.JBLOCK).OR.(JBLOCK.NE.NEXT))WRITE(6,2000)L,(JBLOCK,K=1
     1,3)
   20 L=L+1
      IF((M+1).GE.LEXICN) GO TO 10
      RETURN
      END
      SUBROUTINE RESERV(LABEL,LOCATE,NO)
C
      CALL DELETE(LABEL)
      CALL RECORD(LABEL,LOCATE,NO)
      RETURN
      END
      BLOCK DATA
      LOGICAL PRINT,FATAL
C  IF 'NEXT'=0 A NEW BATCH OF PARAGRAPHS WILL BE READ.
C  IF 'NEXT'.LE.0 INFORMATION WILL BE READ FROM THE P.R.R.-BUFFER.
      COMMON/GETNXT/NEXT
      DATA NEXT  /0/
C  IF 'PRINT'=.TRUE. REPORTS OF DETECTED SYNTAX ERRORS WILL BE PRINTED.
      COMMON/GETPRT/PRINT
      DATA PRINT /.TRUE./
C  IF 'FATAL'=.TRUE. PROGRAM STOPS WHEN SYNTAX ERROR IS DETECTED.
      COMMON/GETFTL/FATAL
      DATA FATAL /.FALSE./
C  'IN'= INPUT UNIT NUMBER.
      COMMON/GETINT/IN
      DATA IN    /5/
C  'IFMT'=INPUT FORMAT.
      COMMON/GETIFM/IFMT(2)
      DATA IFMT(1)/4H(16A/,IFMT(2)/2H5)/
C  'NCR'=NO. OF CHARACTERS READ FROM A UNIT RECORD OF THE INPUT UNIT.
      COMMON/GETNCR/NCR
      DATA NCR   /80/
C  'NCHW=NO. OF CHARACTERS PER MEMORY WORD.
      COMMON/GETNCW/NCHW
      DATA NCHW  /5/
C  'PARBUF' IS THE P.R.R.-BUFFER.
      COMMON/GETBUF/PARBUF(200)
      DATA PARBUF/200*1H /
C  'NCHB'=P.R.R.-BUFFER SIZE (NO. OF CHARACTERS).
      COMMON/GETBSZ/NCHB
      DATA NCHB  /1000/
C  'THING' IS THE P.R.R.-ITEM-BUFFER.
      COMMON/GETTNG/THING(2)
      DATA THING /2*1H0/
C  'NCHN'=NO. OF CHARACTERS PER VARIABLE NAMES (P.R.R.-ITEM-BUFFER SIZE)
      COMMON/GETNCN/NCHN
      DATA NCHN  /8/
      END
      SUBROUTINE GETME(PNAME,THIS,KIND,LENGTH,MANY,VALUES,IERROR )
C  'PNAME'= NAME OF THE PARAGRAPH FROM WHICH INFORMATION IS TO BE READ.
C  'THIS'= NAME OF THE VARIABLE FOR WHICH VALUES ARE TO BE READ.
C  IF 'KIND'=0 LOGICAL IS EXPECTED,
C  IF 'KIND'=1 INTEGER VALUE IS EXPECTED,
C  IF 'KIND'=2 REAL VALUE IS EXPECTED,
C  IF 'KIND'.GE.3 LITERAL VALUE IS EXPECTED (KIND=NO. OF CHARACTERS TO
C  'LENGTH'= MAXIMUM NUMBER OF VALUES TO BE STORED.
C  'MANY'= NUMBER OF VALUES FOUND.
C  'VALUES' IS THE ARRAY WHERE THE VALUES ARE TO BE STORED.
C  'IERROR' IS THE ERROR INDICATOR (IERROR=0 MEANS NO ERROR).
      COMMON/GETNXT/NEXT
      COMMON/GETNCW/NCHW
      COMMON/GETBUF/PARBUF(200)
      COMMON/GETTNG/THING(2)
      COMMON/GETNCN/NCHN
      COMMON/GETPRT/PRINT
      COMMON/GETFTL/FATAL
      DIMENSION LOGIC(4,8),E(12,12),EFE(144),VALUES(LENGTH),TIMES(2)
      DOUBLE PRECISION PNAME,THIS
      LOGICAL TOFLAG,BYFLAG,EQUAL,GETSAM,NO,PRINT,FATAL
      LOGICAL OK
      EQUIVALENCE (F,EFE)
      EQUIVALENCE (THING,ITHING),(NO,VALOGC)
      EQUIVALENCE(DEL,IDEL)
      EQUIVALENCE (ICTO,CTO),(ICFROM,CFROM)
      DATA AND,THE,OF,HIS,ARE,HNO,TO,BY,TIMES(1),TIMES(2)              /
     14HAND ,4HTHE ,4HOF  ,4HIS  ,4HARE ,4HNO  ,4HTO  ,4HBY  ,4HTIME,
     24HS   /
      DATA STAR,COMMA,DOT,PLUS,DASH,EQUALS,BLANK                       /
     14H*   ,4H,   ,4H.   ,4H+   ,4H-   ,4H=   ,4H    /
      DATA EFE    /'PARA','GRAP','H NA','ME N','OT F','OUND','.    ',
     1' ',' ',' ',' ',' ',    'ILLE','GAL ','SPEC','IAL ','CHAR','ACTE',
     2'R EN','COUN','TERE','D.  ','    ','    ',
     3             'ILLE','GAL ','SEQU','ENCE',' OF ','ITEM','S.  ',
     4' ',' ',' ',' ',' ','NO V','ARIA','BLE ','MENT','IONE','D IN',
     5' FRO','NT O','F EQ','UAL ','SIGN','.   ',
     6             'NO  ','EQUA','L  P','RECE','EDS ','THE ','NUMB',
     7'ER O','R LI','TERA','L.  ','    ',
     7             'NUMB','ER F','OUND',' WHE','RE L','ITER','AL I',
     8'S EX','PECT','ED. ','    ','    ',
     9             'LITE','RAL ','FOUN','D WH','ERE ','NUMB','ER I',
     1'S EX','PECT','ED. ','    ','    ','MORE',' THA','N ON','E  T',
     2'O OR',' A  ','TIME','S  I','N AN',' IMP','LIED',' DO.','MORE',
     3' THA','N ON','E  T','O OR',' A  ','TIME','S  I','N AN',
     4' IMP','LIED',' DO.','MORE',' THA','N ON','E  B','Y  O','R NO',
     4'  TO','  OR',' TIM','ES  ','IN L','IST.','IMPL','IED ',
     5 'IED ','LIST','S AR','E NO','T AL','LOWE','D WI','THIM',' A B',
     6'AND.','RANG','E OF',' IMP','LIED',' LIS','T IS',' LES',
     7'S TH','AN S','TEP-','SIZE','.   '/
C
C                        A    N    L    =
C
      DATA LOGIC     /   7,   6,   6,   9,
     1                   9,   3,   3,   3,
     2                   9,   4,   4,   4,
     4                   2,   9,   9,   9,
     5                   9,   5,   5,   5,
     6                   1,   1,   1,   1,
     7                   8,   1,   1,   9,
     8                  10,  10,  10,   9/
C
C  INITIALIZATIONS FOR THE WHOLE SUBROUTINE
      OK=.TRUE.
      IF(KIND.GE.0) GO TO 3
      WRITE(6,2)KIND
    2 FORMAT(42H1THE VALUE OF KIND MUST BE .GE.0 , BUT IS ,I6)
      STOP
 3    CONTINUE
      CALL GETSTR(PNAME,IERROR)
      IF(IERROR.NE.0)GO TO 90
      IWIDTH = 1
      LOC=0
      MANY=-1
      EQUAL=.FALSE.
    4 ITYPE=2
      NTIMES=0
      TOFLAG=.FALSE.
C  INITIALIZATIONS FOR VALUES
    5 IPHASE=MOD(KOUNTV,IWIDTH)+1
      KOUNTV=KOUNTV+1
    6 SIGN=1.
C  THE LOOP
    8 LAST=ITYPE
      NO=.TRUE.
   10 CALL GETHNG(THING,NCHN,LONG,ITYPE)
      IF (ITYPE.EQ.3) GO TO 7
      IF(THING(1) .EQ. STAR) ITYPE = 8
      IF(THING(1).EQ.COMMA .OR. THING(1).EQ.AND .OR. THING(1).EQ.THE
     1 .OR. THING(1).EQ.OF) ITYPE = 6
      IF(THING(1) .EQ. DOT) ITYPE = 7
      IF(THING(1).EQ.PLUS .OR. THING(1).EQ.DASH) ITYPE = 5
      IF(THING(1) .EQ. HNO) GO TO 150
      IF(THING(1) .EQ. TO) GO TO 161
      IF(THING(1) .EQ. BY) GO TO 162
      IF(THING(1) .EQ. TIMES(1)) GO TO 163
    7 IERROR=2
      IF(THING(1).NE.EQUALS .AND. ITYPE.EQ.4) GO TO 90
      IF((THING(1).EQ.HIS.OR.THING(1).EQ.ARE).AND.ITYPE.NE.3) ITYPE=4
    9 IGO TO=LOGIC(LAST,ITYPE)
      IERROR=3
      GO TO (165,20,200,200,50,60,70,80,90,100),IGOTO
   20 IERROR=4
      IF(IWIDTH.EQ.0)GO TO 90
      EQUAL=.TRUE.
      GO TO 5
   30 IERROR=6
      ITIMES=THING(1)+.0000001
      IF(KIND.NE.1.AND.KIND.NE.2)GO TO 89
      THING(1)=SIGN*THING(1)
      IF(KIND.EQ.1) ITHING=THING(1)+SIGN*.0000001
      VALUES(MANY)=THING(1)
      GO TO 5
   40 IERROR=7
      IF(KIND.LT.3) GO TO 90
      LOW=(KIND-1)/NCHW+1
      LOWW=LOW*MANY-LOW +1
      NEXT=NEXT-LONG-3
      CALL GETHNG(VALUES(LOWW),KIND,LONG,ITYPE)
      GO TO 5
 50   IF(THING(1) .EQ. DASH) SIGN = -1.0
      GO TO 10
   60 IF(TOFLAG.OR.NTIMES.NE.0)GO TO 166
      EQUAL=.FALSE.
      IF(LOC.NE.0) GO TO 999
      IWIDTH=0
      NTIMES=0
      KOUNTV=0
      TOFLAG=.FALSE.
      BYFLAG=.FALSE.
   70 IF(GETSAM(PNAME,THING))GO TO 10
      IWIDTH=IWIDTH+1
      IF(.NOT.GETSAM(THIS,THING))GO TO 8
      MANY=1
      VALUES(1)=VALOGC
      IF(KIND.EQ.0)GO TO 999
      MANY=0
      LOC=IWIDTH
      GO TO 8
   80 ITYPE=2
      GO TO 8
C  ERROR REPORTS
   89 NEXTT=NEXT
      CALL GETHNG(THING,5,LONG,ITYPE)
      IF(THING(1) .EQ. TIMES(1)) GO TO 163
      NEXT=NEXTT
   90 NEXTT=(NEXT-2)/NCHW
      OK=.FALSE.
      IF(IERROR.EQ.1) GO TO 94
      WORDL=PARBUF(NEXTT+1)
      LOW=MOD(NEXT-1,NCHW)+1
      IF(LOW.EQ.1)GO TO 92
      DO   91 J=LOW,NCHW
   91 CALL PUTCHR(WORDL,J,BLANK)
   92 IF(PRINT)WRITE(6,93)(E(J,IERROR),J=1,12),(PARBUF(J),J=1,NEXTT),WOR
     1DL
   93 FORMAT(48H1SYNTAX ERROR IN LAST FIELD OF PARAGRAPH BELOW. //
     11X,12A5//(1X,20A5))
   94 IF(FATAL)STOP
  100 IF(TOFLAG.OR.NTIMES.NE.0)GO TO 166
      IF(KIND.NE.0.OR.MANY.GT.0)GO TO 999
      MANY=0
      NO=.FALSE.
      VALUES(1)=VALOGC
  999 IF(OK)IERROR=0
      RETURN
  150 NO=.FALSE.
      GO TO 10
  161 IF(LOC.EQ.0)GO TO 10
      IERROR=9
      IF(TOFLAG.OR.NTIMES.NE.0)GO TO 90
      TOFLAG=.TRUE.
      CFROM=VALUES(MANY)
      MANY=MANY-1
      GO TO 10
  162 IF(LOC.EQ.0)GO TO 10
      IERROR=10
      IF(BYFLAG.OR..NOT.TOFLAG.OR.NTIMES.NE.0)GO TO 90
      CTO=VALUES(MANY)
      MANY=MANY-1
      BYFLAG=.TRUE.
      GO TO 10
  163 IF(LOC.EQ.0)GO TO 10
      IERROR=8
      IF(TOFLAG.OR.NTIMES.NE.0)GO TO 90
      NTIMES=ITIMES
      MANY=MANY-1
      GO TO 10
  165 IF(.NOT.TOFLAG.AND.NTIMES.EQ.0) GO TO 10
  166 IERROR=11
      IF(IWIDTH.NE.1) GO TO 90
      IF(.NOT.TOFLAG)GO TO 169
      IF(BYFLAG)GO TO 167
      CTO = VALUES(MANY)
      IDEL=1
      IF(KIND.EQ.2)DEL=1.0
      VALUES(MANY)=DEL
  167 DEL=VALUES(MANY)
      IF(KIND.EQ.2)NTIMES=ABS((CTO-CFROM)/DEL)+1.0000001
      IF(KIND.NE.2)NTIMES=IABS((ICTO-ICFROM)/IDEL)+1
      VALUES(MANY)=CFROM
  169 L=1
      IF(KIND.GE.3) L=(KIND-1)/NCHW+1
      LLL=MANY*L
      IERROR=12
      IF(NTIMES.LT.2) GO TO 90
      DO 170 I=2,NTIMES
      MANY=MANY+1
      IF(MANY.GT.LENGTH) GO TO 170
      IF(KIND.EQ.2)VALUES(MANY)=VALUES(MANY-1)+DEL
      IF(KIND.EQ.2) GO TO 170
      DO 168 LL=1,L
      LLL=LLL+1
      LOWER=LLL-L
      THING(1)=VALUES(LOWER)
      IF(KIND.EQ.1)ITHING=ITHING+IDEL
  168 VALUES(LLL)=THING(1)
  170 CONTINUE
      TOFLAG=.FALSE.
      BYFLAG=.FALSE.
      NTIMES=0
      GO TO 9
  200 IERROR=5
      IF(.NOT.EQUAL) GO TO 90
      IF(LOC.EQ.0) GO TO 6
      IF(IPHASE.NE.LOC) GO TO 5
      MANY=MANY+1
      IF(MANY.GT.LENGTH) GO TO 5
      GO TO (90,90,30,40),IGOTO
      RETURN
      END
      SUBROUTINE GETHNG(THING,NNK,NK,ITYPE)
C     DELIMITER OTHER THAN BLANK=4
C     LITERAL DEFINED BY '*XXX* WHERE * NOT EQUAL X =3
C     NUMERIC REAL INCLUDING DECIMAL POINT, UNSIGNED =2
C     ALPHABETIC NOT INCLUDING BLANK OR SPECIALS = 1
      COMMON/GETNXT/NEXT
      COMMON/GETBUF/PARBUF(200)
      COMMON/GETNCW/NCHW
      DIMENSION THING(2)
      DATA BLANK/4H    /
C
      NNKK =((NNK - 1) / NCHW + 1)*NCHW
      DO 3 I=1,NNKK
    3 CALL PUTCHR(THING,I,BLANK)
      ITYPE=4
      NK=0
    1 NK=NK+1
 2    CONTINUE
      CHR=GETINP(NEXT)
      ICH=IBCD(CHR)
      GO TO (101,201,301,500),ITYPE
  500 IF(ICH.EQ.1) GO TO 2
      IF(ICH.LE.11) GO TO 200
      IF(ICH.LE.37) GO TO 100
      IF(ICH.EQ.45) GO TO 300
C TERMINATORS
      IC=IBCD(GETINP(NEXT))
      NEXT=NEXT-1
      IF(ICH.EQ.48.AND.IC.GE.2.AND.IC.LE.11) GO TO 200
      THING(1) = CHR
    5 RETURN
C ALPHABETIC
  100 ITYPE=1
  101 IF(ICH.LT.2.OR.ICH.GT.37) GO TO 299
  102 IF(NK.LE.NNK) CALL PUTCHR(THING,NK,CHR)
      GO TO 1
C NUMBERS
  200 ITYPE=2
      THING(1) = 0.0
      FIRST=10.
      SECOND=1.0
      IF(ICH.EQ.48) GO TO 290
  201 IF(ICH.LT.2.OR.ICH.GT.11) GO TO 290
      SECOND=SECOND*FIRST/10.
      THING(1) = THING(1) * FIRST + FLOAT(ICH-2) * SECOND
      GO TO 1
  290 IF(ICH.NE.48.OR.FIRST.NE.10.) GO TO 299
      FIRST=1.0
      GO TO 1
  299 NEXT=NEXT-1
  298 NK=NK-1
      RETURN
C     LITERAL
  300 STOPCH=GETINP(NEXT)
      ITYPE=3
      GO TO 2
  301 IF(CHR.EQ.STOPCH)GO TO 298
      GO TO 102
      END
      FUNCTION GETINP(NEXT)
      COMMON/GETINT/IN
      COMMON/GETIFM/IFMT(2)
      COMMON/GETNCR/NCR
      COMMON/GETNCW/NCHW
      COMMON/GETBUF/PARBUF(200)
      COMMON/GETBSZ/NCHB
      DATA BLANKS /4H    /
C
 10   IF(NEXT.GT.0)GO TO 3
      NINCOL=0
      ISTART=1
      NEXT=1
      NWORDS=(NCR-1)/NCHW+1
    1 IEND=ISTART+NWORDS-1
      NINCOL=NINCOL+NCR
      IF(IEND*NCHW.GT.NCHB) GO TO 4
      READ (IN,IFMT)(PARBUF(I),I=ISTART,IEND)
      ISTART=IEND+1
      GO TO 6
    3 MYNEXT=NEXT-NINCOL
      IF(MYNEXT.EQ.1)GO TO 1
    6 DO 2 I=1,NCHW
    2 CALL PUTCHR (GETINP,I,BLANKS)
      CALL GETCHR(PARBUF,NEXT,GETINP)
      NEXT=NEXT+1
    7 RETURN
    4 WRITE(6,5)
    5 FORMAT(32H1PARAMETER BUFFER SIZE EXCEEDED.)
      STOP
      END
      SUBROUTINE GETSTR(PNAME,IERROR)
      COMMON/GETNXT/NEXT
      COMMON/GETTNG/THING(2)
      COMMON/GETNCN/NCHN
      DOUBLE PRECISION PNAME
      LOGICAL GETSAM
      DATA STAR,ENDW,THE/4H*   ,4HEND ,4HTHE /
C
 10   IERROR=0
      IF(NEXT.GT.0) NEXT=1
      INDEX=1
    1 CALL GETHNG(THING,NCHN,LENGTH,ITYPE)
      IF(THING(1).EQ.THE .OR. THING(1).EQ.STAR) GO TO 1
      IF(GETSAM(PNAME,THING)) INDEX=NEXT
8765  FORMAT(3X,A5)
      IF(THING(1) .EQ. ENDW) GO TO 3
    2 CALL GETHNG(THING,1,LENGTH,ITYPE)
      IF(THING(1) .EQ. STAR) GO TO 1
      GO TO 2
    3 IF(INDEX.EQ.1) IERROR=1
      NEXT=INDEX
      RETURN
      END
      FUNCTION GETSAM(THIS,THING)
      COMMON/GETNCN/NCHN
      COMMON /GETNCW/ NCHW
      DATA BLANKS /4H    /
      DIMENSION THING(2)
      DOUBLE PRECISION THIS
      LOGICAL GETSAM
      DATA A,E,AI,O,U,DOTEND/4HA   ,4HE   ,4HI   ,4HO   ,4HU   ,4H.   /
C
      DO 6 I=1,NCHW
      CALL PUTCHR (C,I,BLANKS)
      CALL PUTCHR (CH,I,BLANKS)
      CALL PUTCHR (DUM,I,BLANKS)
    6 CALL PUTCHR (DUM1,I,BLANKS)
      L=1
      GETSAM=.TRUE.
      DO 2 I=1,NCHN
      CALL GETCHR(THIS,I,C)
      IF(C.EQ.DOTEND)GO TO 5
      CALL GETCHR(THING,L,CH)
      IF(C.EQ.CH)GO TO 1
      IF(C.EQ.A.OR.C.EQ.E.OR.C.EQ.AI.OR.C.EQ.O.OR.C.EQ.U)GO TO 2
      IF(.NOT.GETSAM)GO TO 3
      GETSAM=.FALSE.
      IF(I.EQ.1.OR.L.EQ.1) RETURN
      GO TO 2
    1 L=L+1
    2 CONTINUE
      GETSAM=.TRUE.
      RETURN
    3 GETSAM=.TRUE.
      DO 4 I=1,NCHN
      CALL GETCHR(THIS,I,DUM)
      IF(DUM .EQ. DOTEND) GO TO 5
      CALL GETCHR(THING,I,DUM1)
      IF(DUM .EQ. DUM1) GO TO 4
      IF(.NOT.GETSAM)RETURN
      GETSAM=.FALSE.
    4 CONTINUE
    5 GETSAM=.TRUE.
      RETURN
      END
      FUNCTION IBCD(A)
C     ASSIGNS AN INTEGER VALUE TO AN ALPHABETIC CHARACTER
      DIMENSION SEQ(48)
      DATA SEQ/4H    ,4H0   ,4H1   ,4H2   ,4H3   ,4H4   ,4H5   ,4H6   ,
     14H7   ,4H8   ,4H9   ,4HA   ,4HB   ,4HC   ,4HD   ,4HE   ,4HF   ,
     24HG   ,4HH   ,4HI   ,4HJ   ,4HK   ,4HL   ,4HM   ,4HN   ,4HO   ,
     34HP   ,4HQ   ,4HR   ,4HS   ,4HT   ,4HU   ,4HV   ,4HW   ,4HX   ,
     44HY   ,4HZ   ,4H+   ,4H-   ,4H$   ,4H*   ,4H(   ,4H)   ,4H,   ,
     54H'   ,4H/   ,4H=   ,4H.   /
C
      DO 1 I=1,48
      IF (A.EQ.SEQ(I)) GO TO 2
    1 CONTINUE
      I=49
    2 IBCD=I
      RETURN
      END


























