C                                          *** STAT PACK ***
C     READ DATA FROM MAGTAPE.
C     CALLING SEQUENCE: CALL TAPEI(NV,NC,MV,MC,DATA,COR,VMN,STD,FMT)
C     WHERE NV - IS THE NUMBER OF COLUMNS ACTAULLY FILLED (VARIABLES)
C           NC - IS THE NUMBER OF ROWS ACTUALLY FILLED (CASES)
C           MV - MAXIMUM NUMBER OF VARIABLES, AS SPECIFIED IN MAIN.
C           MC - MAXIMUM NUMBER OF CASES AS SPECIFIED IN MAIN.
C           DATA - MATRIX FOR DATA DIMENSIONED FOR MAXIMUM
C           COR - CORRELATION MATRIX.
C           VMN - VECTOR CONTAINING VARIABLE MEANS.
C           STD - VECTOR CONTAINING STANDARD DEVIATIONS.
C           FMT - OBJECT TIME FORMAT
C
C     PROGRAM ALLOWS USER TO ACCESS A MAGTAPE FOR USE IN STAT PACK.
C     THROUGH A SERIES OF QUESTIONS THE PROGRAM WILL ISSUE MOUNT
C     REQUESTS TO THE OPERATOR.  USING THE PLEASE TERMINAL,
C     IT WILL SKIP X NUMBER OF FILES AND FINALLY SELECT ONLY
C     OBSERVATIONS MEETING CERTAIN REQUIREMENTS AS SET FORTH BY THE
C     USER. UP TO 50 VARIABLES, WITH UP TO 50 QUALIFIERS.
C
      SUBROUTINE TAPEI(NV,NC,MV,MC,DATA,COR,VMN,STD,FMT)
      DIMENSION DATA(MC,MV),COR(MV,MV),VMN(1),STD(1),FMT(80)
      DIMENSION V(50,3),IIN(30),IO(70),X(50)
      COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      BELL="034000000000
      CALL JOBNUM(IJOB)
      CALL GETPPN(IPROJ,IPROG)
      ITAP=16
      DO 101 I=1,MV
      VMN(I)=0
      STD(I)=0
      DO 101 J=1,MV
101   COR(J,I)=0
3     WRITE(IDLG,1)
1     FORMAT('0PLEASE GIVE SOME IDENTIFICATION FOR THE TAPE? ',$)
      READ(ICC,2,END=7)(IO(I),I=1,26)
2     FORMAT(70A1)
      IF((IO(1).NE.'H').OR.(IO(2).NE.'E').OR.(IO(3).NE.'L').OR
     1.(IO(4).NE.'P')) GO TO 5
      WRITE(IDLG,4)
4     FORMAT('0SIMPLY TYPE IN SOME ID FOR THE TAPE YOU WISH TO READ'
     1,' FROM'/' IN MOST CASES IF YOU KNOW THE CENTER NUMBER',
     2' THIS WILL BE SUFFICIENT')
      GO TO 3
5     IF(IO(1).EQ.'!') RETURN
      DO 6 I=26,1,-1
      IF(IO(I).NE.' ') GO TO 9
6     CONTINUE
7     WRITE(IDLG,8)
8     FORMAT('0NO ID USED - RETURN TO MAIN')
      RETURN
C
C     TTY40 IS SET UP TO BE THE INSTALATION "PLEASE TERMINAL"
C     IT IS HERE USED FOR COMUNICATIONG WITH THE OPERATOR AS 
C     TO WHICH TAPE TO MOUNT WHERE.
C
9     OPEN(UNIT=7,DEVICE='TTY40',ACCESS='SEQINOUT')
      CALL BUSY(7)
      WRITE(7,2)(BELL,J=1,10)
      WRITE(7,10) IPROJ,IPROG,IJOB,(IO(J),J=1,I)
10    FORMAT('0STP MTA MOUNT REQUEST',4X,O6,',',O6,5X,'JOB',I3/
     1' OPERATOR PLEASE MOUNT, WRITE PROTECTED, THE TAPE ',26A1)
      WRITE(7,110)
110   FORMAT(' RESPOND WITH ONE OF THE FOLLOWING:'/
     3'  -DEVICE NUMBER'/' ?-NEED MORE INFORMATION ABOUT TAPE ID'/
     4' X-NO DRIVE AVAILABLE'/' F-TAPE NOT FOUND'/
     5' !-TAPE MAY NOT BE MOUNTED FOR PROJ,PROG NUMBER'/)
11    READ(7,2) ANS
      IF(ANS.EQ.'1') GO TO 27
      IF(ANS.EQ.'0') GO TO 27
      IF(ANS.NE.'X') GO TO 13
      WRITE(IDLG,12)
12    FORMAT(' NO DRIVES AVAILABLE, PLEASE TRY AGAIN LATER')
      GO TO 30
13    IF(ANS.NE.'F') GO TO 15
      WRITE(IDLG,14)
14    FORMAT(' WE ARE UNABLE TO LOCATE THE TAPE YOU REQUESTED'/
     1' PLEASE CONTACT US')
      GO TO 30
15    IF(ANS.NE.'!') GO TO 17
      WRITE(IDLG,16)
16    FORMAT(' THE TAPE REQUESTED IS SPECIFIED FOR CERTAIN PROJECT'/
     1' PROGRAMMER NUMBER ONLY, YOURS IS NOT ONE OF THEM')
      GO TO 30
17    IF(ANS.NE.'?') GO TO 25
20    WRITE(IDLG,18)
18    FORMAT(' OPERATOR NEEDS MORE ID INFORMATION, PLEASE TYPE IN'/
     1' MORE ID, OR A "!" TO EXIT? ',$)
      READ(ICC,2) (IO(I),I=1,50)
      IF(IO(1).EQ.'!') GO TO 30
      DO 19 I=50,1,-1
      IF(IO(I).NE.' ') GO TO 21
19    CONTINUE
      GO TO 20
21    WRITE(7,22)(IO(J),J=1,I)
22    FORMAT(' FURTHUR ID INFO: ',50A1)
      WRITE(7,23)
23    FORMAT(' RESPOND WITH APPROPRIATE CHARACTER: ',$)
      GO TO 11
25    WRITE(7,26)
26    FORMAT(' ANSWER NOT POSSIBLE')
      WRITE(7,23)
      GO TO 11
27    ENCODE(5,28,DEV) ANS
28    FORMAT('MTA',A1,' ')
      OPEN(UNIT=ITAP,DEVICE=DEV,ACCESS='SEQIN')
      CALL RELEAS(ITAP)
      IF(IERR.EQ.0) GO TO 32
      WRITE(7,29)
29    FORMAT(' DRIVE ALREADY ASSIGNED TO ANOTHER JOB')
      WRITE(7,23)
      GO TO 11
30    WRITE(7,31)
31    FORMAT(' THANK YOU'/' .'/)
      CALL RELEAS (7)
      RETURN
32    WRITE(7,31)
      CALL RELEAS(7)
      WRITE(IDLG,33) DEV
33    FORMAT(' TAPE HAS BEEN MOUNTED ON ',A4,' WRITE PROTECTED. BE'/
     1' SURE TO ASK TO HAVE THE TAPE DISMOUNTED WHEN DONE')
36    WRITE(IDLG,34)
34    FORMAT(' WHAT POSITION DOES THE FILE OCCUPY ON THE TAPE? ',$)
      READ(ICC,35) IPOS
35    FORMAT(I)
      IF(IPOS.GT.0) GO TO 38
      WRITE(IDLG,37)
37    FORMAT(' NOT A VALID ANSWER')
      GO TO 36
38    REWIND(ITAP)
      L=IPOS-1
      IF(L.LT.1) GO TO 40
C     IF RUNNING UNDER F10 THIS WILL WORK SIMPLY REMOVE THE C'S.
C     IF THE COMMAND IS NEEDED AND IS BEING RUN UNDER F40 SOME SKIPFILE
C     SUBSTITUTE WILL HAVE TO BE WRITTEN.  THIS COMMAND WILL PROBABLY BE
C     SCRAPED OR REWRITTEN BEFOR THE NEXT RELEASE.
C
C      DO 39 I=1,L
C39    SKIP FILE ITAP
C     FINALLY READ DATA FROM TAPE.
40    WRITE(IDLG,41)
41    FORMAT(' HOW MANY VARIABLES? ',$)
      READ(ICC,35) INV
      IF((INV.GE.1).AND.(INV.LE.50)) GO TO 43
      WRITE(IDLG,97)
97    FORMAT(' MINIMUM ANSWER OF 1, MAXIMUM OF 50')
      GO TO 40
43    WRITE(IDLG,42)
42    FORMAT(' LIST QUALIFIERS 1 PER LINE'/)
      DO 44 I=1,50
50    WRITE(IDLG,48)
48    FORMAT(' ? ',$)
      READ(ICC,45,END=73)(V(I,J),J=1,3)
45    FORMAT(F,A2,1X,F)
      IF(V(I,2).NE.'EL') GO TO 61
      WRITE(IDLG,46)
46    FORMAT('0QUALIFYING FIELDS ARE USED FOR SUBSETTING DATA'/
     1' THE FORM IS: VARIABLE TO BE LOOKED AT,QUALIFIER,VALUE'/
     2' QUALIFIERS ARE: "EQ"- EQUAL; "NE"- NOT EQUAL; "GT"-',
     3' GREATER THAN'/'  "GE"- GREATER THAN OR EQUAL TO; "LT"- LESS',
     4' THAN;'/'  "LE" - LESS THAN OR EQUAL TO'/' A QUALIFIER MIGHT',
     5' LOOK LIKE THIS')
      WRITE(IDLG,47)
47    FORMAT(' 1,LT,75 - MEANING TAKE ONLY THOSE CASES WHERE VARIABLE'/
     1' ONE IS LESS THAN 75.  UP TO 50 QUALIFIERS MAY BE USED AT ONE'/
     2' TIME.  TO STOP INSERTION OF QUALIFIERS OR IF NO QUALIFIERS ARE'/
     3' TO BE USED, RETURN, TYPE "STOP", OR USE A CONTROL Z(^Z)'/)
      GO TO 43
61    IF((V(I,1).EQ.0).AND.(V(I,2).EQ.'  ')) GO TO 73
      IF(V(I,2).EQ.'TO') GO TO 73
      IF((V(I,1).GT.0).AND.(V(I,1).LE.INV)) GO TO 51
      WRITE(IDLG,49)
49    FORMAT(' VARIABLE SPECIFIED NOT POSSIBLE - REENTER LINE')
      GO TO 50
51    IF(V(I,2).NE.'EQ') GO TO 52
      V(I,2)=1
      GO TO 44
52    IF(V(I,2).NE.'NE') GO TO 53
      V(I,2)=2
      GO TO 44
53    IF(V(I,2).NE.'LT') GO TO 54
      V(I,2)=3
      GO TO 44
54    IF(V(I,2).NE.'LE') GO TO 55
      V(I,2)=4
      GO TO 44
55    IF(V(I,2).NE.'GT') GO TO 56
      V(I,2)=5
      GO TO 44
56    IF(V(I,2).NE.'GE') GO TO 57
      V(I,2)=6
      GO TO 44
57    WRITE(IDLG,58) V(I,2)
58    FORMAT(' QUALIFIER "',A2,'" NOT POSSIBLE -REENTER LINE')
      GO TO 50
44    CONTINUE
      WRITE(IDLG,59)
59    FORMAT(' NO MORE QUALIFIERS ACCEPTED MAXIMUM OF 50')
      I=51
73    NQ=I-1
60    WRITE(IDLG,62)
62    FORMAT(' LIST THE VARIABLES TO BE KEPT, SEPERATED BY COMMAS'/)
      READ(ICC,63) IIN
63    FORMAT(30I)
      DO 64 I=1,30
      IF(IIN(I).EQ.0) GO TO 65
64    CONTINUE
      I=31
65    N=I-1
      IF(N.LE.MV) GO TO 67
      WRITE(IDLG,66)
66    FORMAT(' MORE VARIABLES SPECIFIED THAN ROOM ALLOCATED')
      GO TO 60
67    DO 68 I=1,N
      IF((IIN(I).GT.0).AND.(IIN(I).LE.INV)) GO TO 69
      WRITE(IDLG,70) IIN(I)
70    FORMAT(' VARIABLE ',I3,' NOT POSSIBLE')
      GO TO 60
69    DO 71 J=1,I
      IF(J.EQ.I) GO TO 71
      IF(IIN(I).NE.IIN(J)) GO TO 71
      WRITE(IDLG,72) IIN(I)
72    FORMAT(' VARIABLE ',I3,' APPEARS TWICE INT THE LIST')
      GO TO 60
71    CONTINUE
68    CONTINUE
      I=1
      LC=0
80    READ(ITAP,FMT,END=84)(X(J),J=1,INV)
      LC=LC+1
      IF(NQ.LT.1) GO TO 98
      DO 81 J=1,NQ
      L=V(J,2)
      M=V(J,1)
      GO TO (91,92,93,94,95,96)L
91    IF(X(M).EQ.V(J,3)) GO TO81
      GO TO 80
92    IF(X(M).NE.V(J,3)) GO TO 81
      GO TO 80
93    IF(X(M).LT.V(J,3)) GO TO 81
      GO TO 80
94    IF(X(M).LE.V(J,3)) GO TO81
      GO TO 80
95    IF(X(M).GT.V(J,3)) GO TO 81
      GO TO 80
96    IF(X(M).GE.V(J,3)) GO TO 81
      GO TO 80
81    CONTINUE
98    DO 82 J=1,N
      L=IIN(J)
      DATA (I,J)=X(L)
      VMN(J)=VMN(J)+X(L)
      DO 82 K=1,J
      M=IIN(K)
82    COR(K,J)=COR(K,J)+X(L)*X(M)
      I=I+1
      IF(I.LE.MC) GO TO 80
      WRITE(IDLG,83)LC
83    FORMAT(' ***WARNING*** YOU HAVE COMPLETED THE SPECIFIED DATA',
     1' SET'/' NO MORE DATA ACCEPTED; SELECTED FROM SAMPLE OF',I7)
      NC=MC
      NV=N
      GO TO 103
84    NC=I-1
      NV=N
      IF(NC.GT.1) GO TO 100
      WRITE(IDLG,102)
102   FORMAT(' NO DATA IN SET SPECIFIED')
      RETURN
100   WRITE(IDLG,99) NC,LC
99    FORMAT(' DATA SET CONSISTS OF ',I4,' OBSERVATIONS'/' AS',
     1' SELECTED FROM A SAMPLE OF',I6)
103   DO 85 I=1,NV
      DO 85 J=I,NV
85    COR(J,I)=NC*COR(I,J)-VMN(I)*VMN(J)
      DO 86 I=1,NV
      STD(I)=SQRT(COR(I,J)/(NC*(NC-1)))
86    VMN(I)=VMN(I)/NC
      DO 87 I=1,NV
      DO 87 J=I,NV
      IF(I.EQ.J) GO TO 87
      IF(COR(I,I)*COR(J,J).EQ.0) GO TO 88
      COR(I,J)=COR(J,I)/SQRT(COR(I,I)*COR(J,J))
      COR(J,I)=COR(I,J)
      GO TO 87
88    COR(I,J)=0
      COR(J,I)=0
87    CONTINUE
      DO 89 I=1,NV
89    COR(I,I)=1.0
      RETURN
      END
C                               *** STAT PACK ***
C     SUBROUTINE FOR ONE WAY ANOVA WITH REPEATED MEASURES.
C     CALLING SEQUENCE: CALL ANVR(NV,NC,MV,MC,DATA,VMN,STD,NAMES)
C     WHERE NV - NUMBER OF VARIABLES ACTUALL IN USE
C           NC - NUMBER OF OBSERVATIONS ACTUALLY IN USE
C           MV - MAXIMUM NUMBER OF VARIABLES POSSIBLE
C           MC - MAXIMUM NUMBER OF OBSERVATIONS POSSIBLE
C           DATA - MATRIX CONTAINING DATA DIMENSIONED FOR MAXIMUMS
C           VMN - VECTOR CONTAINING VARIABLE MEANS
C           STD - VECTOR CONTAINING VARIABLE STANDARD DEVIATIONS
C           NAMES - VECTOR CONTAINING VARIABLE NAMES
C
      SUBROUTINE ANVR(NV,NC,MV,MC,DATA,VMN,STD,NAMES)
      DIMENSION DATA(MC,MV),VMN(1),NAMES(1),IV(50),IVA(50),STD(1)
      COMMON /DEV/ ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON /EXTRA/ HEDR(70),NSZ
1     IF(ICC.NE.2) WRITE(IDLG,2)
2     FORMAT(' WHICH VARIABLES? ',$)
      IRET=0
      CALL ALPHA(IVA,50,NN,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IHELP.EQ.1) GO TO 1
      IF(IERR.EQ.1) GO TO 1
      K=1
      DO 3 I=1,NN
      IV(I)=IVA(I)
      IF(IVA(I).GT.0) GO TO 3
      IV(I)=K
      K=K+1
3     CONTINUE
      GO TO 9
4     J=NN
5     IF(IVA(J).GT.0) GO TO 6
      IV(J)=IV(J)+1
      IF(IV(J).LE.NV) GO TO 7
6     J=J-1
      IF(J.GE.1) GO TO 5
      RETURN
7     K=IV(J)
      IF(J.EQ.NN) GO TO 9
      DO 8 I=J+1,NN
      IF(IVA(I).GT.0) GO TO 8
      K=K+1
      IF(K.GT.NV) GO TO 6
      IV(I)=K
8     CONTINUE
9     DO 10 I=1,NN-1
      DO 10 K=I+1,NN
      IF(IV(I).EQ.IV(K)) GO TO 4
10    CONTINUE
C
C     BEGIN ANALYSIS
C
      G=0
      SUMX2=0
      SUMT2=0
      SUMP2=0
      DO 15 I=1,NC
      P=0
      DO 16 J=1,NN
      X=DATA(I,IV(J))
      SUMX2=SUMX2+X**2
16    P=P+X
      G=G+P
15    SUMP2=SUMP2+P**2
      DO 17 J=1,NN
17    SUMT2=SUMT2+(NC*VMN(IV(J)))**2
      SSBET=(SUMP2/NN)-G**2/(NN*NC)
      IDFBET=NC-1
      SSWITH=SUMX2-(SUMP2/NN)
      IDFWTH=NC*(NN-1)
      SSTRT=(SUMT2/NC)-(G**2/(NN*NC))
      IDFTRT=(SUMT2/NC)-(G**2/(NN*NC))
      IDFTRT=NN-1
      SSRES=SUMX2-(SUMT2/NC)-SSBET
      IDFRES=(NN-1)*(NC-1)
      SSTOT=SUMX2-(G**2/(NN*NC))
      IDFTOT=(NN*NC)-1
      AMSTRT=SSTRT/IDFTRT
      AMSRES=SSRES/IDFRES
      F=AMSTRT/AMSRES
      PROB=FISHER(IDFTRT,IDFRES,F)
      IF(IOUT.NE.21) WRITE(IOUT,7766)(HEDR(I),I=1,NSZ)
7766  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,20)
20    FORMAT('0',10X,'***** 1-WAY ANOVA WITH REPEATED MEASURES *****')
      WRITE(IOUT,21)
21    FORMAT('0TRET.',3X,'SIZE',6X,'MEAN',8X,'STD. DEV.')
      LINES=6
      DO 22 I=1,NN
      IF(IOUT.NE.21) GO TO 22
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 22
      CALL PRNTHD
      WRITE(IOUT,21)
      LINES=4
22    WRITE(IOUT,23) NAMES(IV(I)),NC,VMN(IV(I)),STD(IV(I))
23     FORMAT(1X,A5,2X,I5,4X,G10.4,1X,G)
      IF(IOUT.NE.21) GO TO 30
      LINES=LINES+7
      IF(LINES.LE.LINPP) GO TO 30
      LINES=9
30    WRITE(IOUT,24)
24    FORMAT('0SOURCE',3X,'SUM OF SQ.',4X,'D.F.',3X,'MEAN SQ.',6X,
     1'F',9X,'PROB')
      WRITE(IOUT,25) SSBET,IDFBET
25    FORMAT(' BETWEEN',1X,G,I4)
      WRITE(IOUT,26)SSWITH,IDFWTH
26    FORMAT(' WITHIN ',1X,G,I4)
      WRITE(IOUT,27) SSTRT,IDFTRT,AMSTRT,F,PROB
27    FORMAT(' TREAT.',2X,G,I4,3X,G10.4,1X,G11.4,1X,F7.4)
      WRITE(IOUT,28)SSRES,IDFRES,AMSRES
28    FORMAT(' RESID.',2X,G,I4,3X,G10.4)
      WRITE(IOUT,29) SSTOT,IDFTOT
29    FORMAT(' TOTAL',3X,G,I4)
      GO TO 4
      END
C                                     *** STAT PACK ***
C     SUBROUTINE FOR EXPONENTIAL SMOOTHING MODEL.
C     CALLING SEQUENCE: CALL EXPSM(NV,NC,MV,MC,DATA,Y,NAMES)
C     WHERE NV - NUMBER OF VARIABLES ACTUALLY USED
C           NC - NUMBER OF OBSERVATIONS ACTUALLY USED
C           MV - MAXIMUM NUMBER OF VARIABLES POSSIBLE
C           MC - MAXIMUM NUMBER OF OBSERVATIONS ACTUALLY USED
C           DATA - MATRIX CONTAINING DATA.
C           Y - EXTRA VECTOR AT LEAST NC LONG
C           NAMES - VECTOR CONTAINING VARIABLE NAMES
C
C     ROUTINE REQUESTED BY WMU MANAGEMENT DEPARTMENT, WHO SUBMITTED
C     A BASIC PROGRAM.  NO OTHER REFERENCE IS AVAILABLE AT THIS TIME.
C
      SUBROUTINE EXPSM(NV,NC,MV,MC,DATA,Y,NAMES)
      DIMENSION DATA(MC,MV),NAMES(1),IV(20)
      DIMENSION ACT(50),E(50),S(50),Y(1),OPTS(10)
      COMMON /DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON/EXTRA/HEDR(70),NSZ
      U3=0
      IRET=0
1     IF(ICC.NE.2) WRITE(IDLG,2)
2     FORMAT(' WHICH VARIABLES? ',$)
      CALL ALPHA(IV,20,NN,IRET,IHELP,IERR,NAMES,NV)
      IF(IRET.EQ.1) RETURN
      IF(IERR.EQ.1) GO TO 1
      IF(IHELP.NE.1) GO TO 320
      WRITE(IDLG,11)
11    FORMAT('0THIS PROGRAM IS AN EXPONENTIAL SMOOTHING MODEL'/
     1' CONTAINING STEADY STATE, TREND, AND  SEASONAL TERMS.'/
     2' EACH TERM IS THE FORM -'/
     3'0EST(T)=A*ACT(T-1)+(1-A)*EST(T-1)'/
     4'0WHERE:'/
     5'0  EST(T)=ESTIMATED VALUE FOR PEROID T'/
     6'0  ACT(T-1)=ACTUAL VALUE FOR PEROID T-1'/
     7'0  EST(T-1)=ESTIMATED VALUE FOR PEROID T-1'/
     8'0  A=WEIGHTING FACTOR (0<A<1)')
      WRITE(IDLG,12)
12    FORMAT('0THE WEIGHTING FACTOR DETERMINES THE EMPHASIS'/
     1' PLACED ON PAST DATA VERSUS THE EMPHASIS PLACED'/
     2' ON NEW INFORMATION ABOUT THE TERM WHICH ENTERED'/
     3' THE ANALYSIS IN THE LAST PEROID.  A LARGE VALUE OF'/
     4' A ALLOWS RAPID ADJUSTMENT TO CHANGES IN THE TERM,'/
     5' BUT WILL CAUSE THE MODEL TO REACT QUICKLY TO'/
     6' RANDOM CHANGES.  A SMALL VALUE OF A DAMPENS'/
     7' THE EFFECT OF RANDOM VARIATIONS BUT WILL MAKE'/
     8' THE MODEL LESS RESPONSIVE TO CHANGES IN THE TERM.'/
     9' THE GENERALLY ACCEPTED VALUES FOR THE'/
     1' WEIGHTING FACTORS ARE:'/
     2'0  STEADY STATE  0<A<0.1'/
     3'   TREND         0<A<0.05'/
     4'   SEASONAL      0<A<0.05')
      WRITE(IDLG,13)
13    FORMAT('0THE PROGRAM HAS THE FOLLOWING FEATURES;')
      WRITE(IDLG,14)
14    FORMAT('01. SEASONAL TERM'/
     1'   A. ADDITIVE        Y=SS+T+C'/
     2'   B. MULTIPLICATIVE  Y=(SS+T)*C'/
     3'          WHERE:'/
     4'            SS=STEADY STATE TERM'/
     5'            T=TREND TERM'/
     6'            C=SEASONAL TERM')
      WRITE(IDLG,15)
15    FORMAT('02. INITIAL TREND'/
     1'    A. CALCULATED BY COMPUTER'/
     2'    B. INPUT BY USER'/
     3'03. OUTPUT'/
     4'    A. FULL'/
     5'    B. PARTIAL VARIANCE OF ACTUAL VALUES FROM'/
     6'          ESTIMATED VALUES AND PROJECTED VALUES'/
     7'04. NATURAL LOG TRANSFORMATION OF DATA')
      WRITE(IDLG,16)
16    FORMAT('0THE PROGRAM ANALYZES THE FIRST TWO CYCLES OF'/
     1' DATA TO DETERMINE THE SEASONAL PATERN.  THOSE PEROIDS'/
     2' THAT CONSISTENTLY DEVIATE FROM THE EXPECTED VALUE'/
     3' (I.E. SUM OF ESTIMATED SS AND T) BY A GIVEN PERCENTAGE'/
     4' (DETERMINED BY THE USER) IN THE FIRST TWO'/
     5' CYCLES ARE ASSUMED TO HAVE SEASONAL EFFECTS')
      WRITE(IDLG,17)
17    FORMAT(' OPTIONS INCLUDE:'/
     1' NLOGY - NATURAL LOG TRANSFORMATION  OF DEPENDENT VAR.'/
     2' NLOGT - NATURAL LOG TRANSFORMATION OF TIME VARIABLE'/
     3' TREND - ENTER USER TREND LINE'/
     4' SHORT - SHORT OUTPUT (TREND LINE, VARIANCE, PROJ. VALUES)'/
     5' MULTI - MULTIPLICATIVE RATHER THAN ADDITIVE SEASONAL TERMS'/
     6'0IF NO OPRIONS ARE DESIRED TYPE A RETURN'/'0')
      GO TO 1
320   IF(ICC.NE.2) WRITE(IDLG,300)
300   FORMAT('+LIST OPTIONS SEPARATED BY COMMAS'/)
      READ(ICC,301) OPTS
301   FORMAT(10(A5,1X))
      U=1
      U3=0
      U4=0
      Z8=1
      U2=0
      IF(OPTS(1).EQ.'!') RETURN
      IF(OPTS(1).NE.'HELP') GO TO 302
      WRITE(IDLG,17)
      GO TO 320
302   DO 303 I=1,10
      IF(OPTS(I).EQ.' ') GO TO 3
      IF(OPTS(I).NE.'NLOGY') GO TO 304
      U2=1
      GO TO 303
304   IF(OPTS(I).NE.'TREND') GO TO 305
      U=0
      GO TO 303
305   IF(OPTS(I).NE.'NLOGT') GO TO 306
      U3=1
      GO TO 303
306   IF(OPTS(I).NE.'MULTI') GO TO 307
      U4=1
      GO TO 303
307   IF(OPTS(I).NE.'SHORT') GO TO 308
      Z8=0
      GO TO 303
308   WRITE(IDLG,309) OPTS(I)
309   FORMAT(' OPTION "',A5,'" DOES NOT EXIST'/)
      GO TO 320
303   CONTINUE
3     IF(ICC.NE.2) WRITE(IDLG,4)
4     FORMAT(' HOW MANY OBSERVATIONS PER CYCLE? ',$)
      READ(ICC,5) ANS
5     FORMAT(A5)
      IF(ANS.EQ.'!') RETURN
      IF(ANS.EQ.' ') GO TO 3
      IF(ANS.NE.'HELP') GO TO 6
      WRITE(IDLG,16)
      GO TO 3
6     REREAD 7,IP
7     FORMAT(I)
      IF(NC.GT.2*IP) GO TO 25
      WRITE(IDLG,8)
8     FORMAT('0MUST HAVE AT LEAST TWO CYCLES OF DATA')
      GO TO 3
25    IF(ICC.NE.2) WRITE(IDLG,26)
26    FORMAT(' WEIGHTING FACTORS FOR:'/)
27    IF(ICC.NE.2) WRITE(IDLG,28)
28    FORMAT('+STEADY STATE? ',$)
      READ(ICC,5,END=27) ANS
      IF(ANS.EQ.'!') RETURN
      IF(ANS.NE.'HELP') GO TO 32
      WRITE(IDLG,12)
      GO TO 25
32    REREAD 29,A9
29    FORMAT(F)
30    IF(ICC.NE.2) WRITE(IDLG,31)
31    FORMAT('+TREND? ',$)
      READ(ICC,5,END=30) ANS
      IF(ANS.EQ.'!') RETURN
      IF(ANS.NE.'HELP') GO TO 33
      WRITE(IDLG,12)
      GO TO 30
33    REREAD 29,B9
34    IF(ICC.NE.2) WRITE(IDLG,35)
35    FORMAT('+SEASONAL? ',$)
      READ(ICC,5,END=34) ANS
      IF(ANS.EQ.'!') RETURN
      IF(ANS.NE.'HELP') GO TO 36
      WRITE(IDLG,12)
      GO TO 34
36    REREAD 29,C9
37    IF(ICC.NE.2) WRITE(IDLG,38)
38    FORMAT('0HOW MANY PEROIDS TO BE PROJECTED? ',$)
      READ(ICC,5,END=37) ANS
      IF(ANS.EQ.'!') RETURN
      IF(ANS.EQ.'HELP') GOTO 37
      REREAD 7,IZ
39    IF(ICC.NE.2) WRITE(IDLG,40)
40    FORMAT(' WHAT IS THE PERCENTAGE CRITERION FOR SEASONAL TERMS? ',$)
      READ(ICC,5,END=39) ANS
      IF(ANS.EQ.'!') RETURN
      IF(ANS.NE.'HELP') GO TO 41
      WRITE(IDLG,16)
      GO TO 39
 41    REREAD 29,T1
      IF(T1.GT.1.00) T1=T1/100
      IF(U.EQ.1) GO TO 154
47    IF(ICC.NE.2) WRITE(IDLG,46)
46    FORMAT(' Y-INTERSECTION? ',$)
      READ(ICC,5,END=47) ANS
      IF(ANS.EQ.'!') RETURN
      IF(ANS.EQ.'HELP') GO TO 47
      REREAD 29,A
48    IF(ICC.NE.2) WRITE(IDLG,49)
49    FORMAT('0SLOPE? ',$)
      READ(ICC,5,END=48) ANS
      IF(ANS.EQ.'!') RETURN
      IF(ANS.EQ.'HELP') GO TO 48
      REREAD 29,B
C
C     QUESTIONS ANSWERED NOW DO ANALYSIS
C
154   ALL=0
      DO 53 I=1,NN
      IF(IV(I).GT.0) GO TO 53
      ALL=1
53    CONTINUE
      IF(ALL.EQ.1) NN=NV
      DO 60 I=1,NN
      IF(ALL.EQ.0) IVV=IV(I)
      IF(ALL.EQ.1) IVV=I
      IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(J),J=1,NSZ)
5566  FORMAT('1',70A1)
      IF(IOUT.EQ.21) CALL PRNTHD
      WRITE(IOUT,200)
200   FORMAT('0',15X,'***** CURVE SMOOTHING MODEL *****')
      TYST='ADD.'
      IF(U4.EQ.1) TYST='MULT.'
      WRITE(IOUT,201) NAMES(IVV),TYST
201   FORMAT(10X,'FOR VARIABLE: ',A5,', WITH ',A5,' SEASONAL TERMS')
      IF(U2.EQ.1) WRITE(IOUT,202) NAMES(IVV)
202   FORMAT(10X,'WITH NATURAL LOG TRANSFORMATION OF VARIABLE: ',A5)
      IF(U3.EQ.1) WRITE(IOUT,203)
203   FORMAT(10X,'WITH NATURAL LOG TRANSFORMATION OF TIME')
      TYST=T1*100.
      WRITE(IOUT,204) TYST
204   FORMAT(10X,'PERCENTAGE CRITERIAN FOR SEASONAL TERMS IS ',F6.1,
     1'%')
      WRITE(IOUT,205) A9,B9,C9
205   FORMAT(10X,'WEIGHTING FACTORS WERE: ',F6.3,' FOR STEADY STATE'/
     112X,F6.3,' FOR TREND, AND ',F6.3,' FOR SEASONAL')
      LINES=9
      DO 61 J=1,50
      S(J)=0
      ACT(J)=0
      E(J)=0
      IF(U4.EQ.0) GO TO 61
      ACT(J)=1.
      E(J)=1.
61    CONTINUE
      D=0
      IC1=0
      V=0
      C2=0
      P9=0
      X2=0
      X9=0
      Y9=0
      T2=0
      DO 62 J=1,NC
      Z1=J
      IF(U3.EQ.1) Z1=ALOG(Z1)
      Y(J)=DATA(J,IVV)
      IF(U2.EQ.1) Y(J)=ALOG(Y(J))
      X2=X2+Z1**2
      X9=X9+Z1
      P9=P9+Y(J)*Z1
      Y9=Y9+Y(J)
62    CONTINUE
      IF(U.EQ.1) B=(NC*P9-(X9*Y9))/(NC*X2-X9**2)
      IF(U.EQ.1) A=(Y9/NC)-B*(X9/NC)
      WRITE(IOUT,63)A,B
63    FORMAT('0THE TREND LINE IS Y=',G,'+',G,'X')
      LINES=LINES+3
      A2=A
      B2=B
      DO 64 J=1,IP
      Z1=J
      IF(U3.EQ.0) GO TO 65
      Z1=ALOG(Z1)
      AL3=B*Z1+A
      AL4=B*ALOG(FLOAT(J+IP))+A
      GO TO 66
65    AL3=B*Z1+A
      AL4=B*(Z1+P)+A
66    D1=Y(J)-AL3
      D2=Y(J+IP)-AL4
      P1=D1/AL3
      P2=D2/AL4
      IF((P1.GT.T1).AND.(P2.GT.T1)) GO TO 164
      IF((P1.LT.-T1).AND.(P2.LT.-T1)) GO TO 164
      GO TO 64
164   S(J)=1
      ACT(J)=D1
      E(J)=D1
      IF(U4.NE.1) GO TO 64
      ACT(J)=Y(J)/AL3
      E(J)=ACT(J)
64    CONTINUE
      IC1=1
      J=1
      C2=1.
      IF(S(IC1).EQ.0) GO TO 67
      C2=C9*ACT(1)+(1-C9)*E(1)
      GO TO 166
67    IF(U4.EQ.0) C2=0
166   IF(Z8.EQ.0) GO TO 170
      WRITE(IOUT,68)
68    FORMAT('0',5X,'ACTUAL',4X,'PREDICTED',3X,'DEVIATION',2X,
     1'% DEVIATION',2X,'MEAN AVG DEV.')
      LINES=LINES+2
      GO TO 170
167    IF(S(IC1).NE.0) GO TO 168
      C2=1
      IF(U4.EQ.0) C2=0
      GO TO 169
168   C2=C9*(ACT(IC1))+(1-C9)*E(IC1)
169   A2=A9*D9+(1-A9)*(A1+B1)
      B2=B9*(A2-A1)+(1-B9)*B1
170   Y1=A2+B2+C2
      IF(U4.NE.0) Y1=C2*(A2+B2)
      IF(S(IC1).NE.0) GO TO 69
      D9=Y(J)
      GO TO 71
69    E(IC1)=Y1-(A2+B2)
      ACT(IC1)=Y(J)-(A2+B2)
      IF(U4.NE.1) GO TO 70
      E(IC1)=Y1/(A2+B2)
      ACT(IC1)=Y(J)/(A2+B2)
70    D9=A2+B2
71    A1=A2
      B1=B2
      IF(U2.EQ.0) GO TO 172
      Y(J)=EXP(Y(J))
      Y1=EXP(Y1)
172   D=Y(J)-Y1
      V=V+D**2
      P3=0
      IF(Y1.NE.0) P3=ABS((D/Y1)*100)
      T2=T2+ABS(D)
      T3=T2/J
      IF(Z8.EQ.0) GO TO 210
      IF(IOUT.NE.21) GO TO 211
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 211
      CALL PRNTHD
      WRITE(IOUT,68)
      LINES=5
211   WRITE(IOUT,72) J,Y(J),Y1,D,P3,T3
72    FORMAT(1X,I3,5G12.4)
210   J=J+1
      IC1=IC1+1
      IF(IC1.GT.IP) IC1=1
      IF(J.LE.NC) GO TO 167
      VAR=V/NC
      IF(IZ.LT.1) GO TO 173
      IF(Z8.NE.0) GO TO 212
      WRITE(IOUT,174)
174   FORMAT('0',15X,'PREDICTED')
      LINES=LINES+2
212   K=1
      DO 74 J=1,IP
74    ACT(J)=C9*ACT(J)+(1-C9)*E(J)
      A2=A9*D9+(1-A9)*(A1+B1)
      B2=B9*(A2-A1)+(1.-B9)*B1
      Y1=A2+B2+ACT(IC1)
      IF(U4.EQ.1) Y1=ACT(IC1)*(A2+B2)
      GO TO 76
75    Y1=A2+K*B2+ACT(IC1)
      IF(U4.EQ.1) Y1=(A2+K*B2)*ACT(IC1)
76    IC1=IC1+1
      IF(IC1.GT.IP) IC1=1
      IF(U2.EQ.1) Y1=EXP(Y1)
      L=K+NC
      IF(IOUT.NE.21) GO TO 213
      LINES=LINES+1
      IF(LINES.LE.LINPP) GO TO 213
      CALL PRNTHD
      IF(Z8.EQ.0) WRITE(IOUT,174)
      IF(Z8.NE.0) WRITE(IOUT,72)
      LINES=5
213   WRITE(IOUT,176) L,Y1
176   FORMAT(1X,I3,12X,G12.4)
      K=K+1
      IF(K.LE.IZ) GO TO 75
173   IF(IOUT.NE.21) GO TO 214
      LINES=LINES+2
      IF(LINES.LE.LINPP) GO TO 214
      CALL PRNTHD
      LINES=4
214   WRITE(IOUT,73) VAR
73    FORMAT('0VARIANCE IS ',G12.4)
60    CONTINUE
      RETURN
      END