Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/bnk1.ban
There are 3 other files named bnk1.ban in the archive. Click here to see a list.
C                                    *** BANK ***
C
C     THIS SUBROUTINE CONCERNED WITH THE CREATION OF A BANK FROM
C     ASCII DATA.  THE FILE IS CREATED IN TWO PARTS THE FIRST IS THE
C     NAMES AND DESCRIPTIONS ENTERED INTO A FILE CALLED HEADR.TMP
C     NEXT THE DATA IS STORED IN DZBA.TMP AS THE CORRECT
C     BLOCKS BUT THE SEQUENCE IS OFF. FINALY THE FIRST BLOCK IS
C     WRITTEN THE DATA IS READ FROM DZBA AND THEN THE HEADR FILE.
C
      SUBROUTINE MABNK
      COMMON /DEV/ IDLG,ICC,IBNK,IUPGR,ITMPRY,MPROG
      COMMON /GEN/ IPROJA,IPROGA,NV,NO,BNKNM,DATCR,NPROJR,NPROGR
      DIMENSION D(7000), NAMES(500), NAME(80), DATMIS(500,6), FMT(125)
      DIMENSION Z(125),NNS(18,6),FMTT(600),KDSC(8,500),XX(9),ITYPE(500)
      DIMENSION NAMDES(40),NAMV(5),MPLC(4),MDATA(20),FT(600),SAV(5)
      DIMENSION DATED(2),NSAV(5),INPUT(80),MSAV(5),LSAV(5),IPATH(3)
      EQUIVALENCE (D,FMTT),(D(650),FT,KDSC),(D(5000),ITYPE)
      EQUIVALENCE (D(6000),NAMES),(Z,NNS),(SAV,NSAV),(INPUT,D(6700))
      EQUIVALENCE (MISS,AMISS),(ILBKT,BKTLFT)
      DOUBLE PRECISION BNKNM,DATCR,FILNAM,DEFNAM,FMTFIL,NDMFIL
      DATA XX/'A','I','F','G','E','(',')','D','O'/
      DATA DEFNAM/'INPUT.DAT'/
      DATA ILBKT,IRBKT/"555004020100,"565004020100/
      DATA MISS/"400000000000/
      IUSER=2
      WRITE(IDLG,3) BNKNM
3     FORMAT(' CREATING A NEW BANK TO BE NAMED - ',A10)
C
C     CHECK FOR NAME
C
C
C     INPUT DEVICE AND FILE NAME IF APLICABLE
C
900   WRITE(IDLG,901)
901   FORMAT('0INPUT? ',$)
      READ(ICC,204,END=746) INPUT
      IF(INPUT(1).EQ.'!') GO TO 746
      DO 905 I=80,1,-1
      IF(INPUT(I).NE.' ') GO TO 906
905   CONTINUE
      IEND=0
      GO TO 904
906   IEND=I
      I=0
907   I=I+1
909   IF(I.EQ.IEND) GO TO 910
      IF(INPUT(I).NE.' ') GO TO 907
      DO 908 J=I+1,IEND
908   INPUT(J-1)=INPUT(J)
      INPUT(IEND)=' '
      IEND=IEND-1
      GO TO 909
910   IF((INPUT(1).NE.'H').OR.(INPUT(2).NE.'E').
     1OR.(INPUT(3).NE.'L').OR.(INPUT(4).NE.'P').OR.(INPUT(5).NE.' '))
     2 GO TO 904
      WRITE(IDLG,902)
902   FORMAT('0THIS ANSWER DEFINES WHERE THE INPUT DATA IS TO BE FOUND.'
     1/'IT USUALLY CONSISTS OF A DEVICE, A FILENAME AND EXTENSION,'/
     2' AND POSSIBLY A PROJECT PROGRAMMER NUMBER. POSSIBLE DEVICES ARE:'
     3/'     TTY: - TELETYPE'/'     DSK: - DISK'/
     3'     CDR: - CARD READER'/
     4'     DTA#: - DECTAPE (MUST BE MOUNTED ALREADY'/
     5'     MTA#: - MAGTAPE (MUST BE MOUNTED AND POSITIONED)'/
     6'0DEFALUTS:'/
     7'   IF NO INPUT DEVICE IS SPECIFIED, BUT A FILE NAME IS GIVEN,'/
     8'   THE DISK WILL BE USED AS THE DEVICE.'/
     9'0  IF A DEVICE REQUIREING A FILE NAME IS GIVEN BUT NO FILE'/
     1'   NAME IS INDICATED, INPUT.DAT WILL BE ASSUMED.'/
     2'0  IF NO RESPONSE IS GIVEN TTY: WILL BE USED.'/
     3'0  IF DSK: IS SPECIFIED WITHOUT A PROJECT-PROGRAMMER NUMBER'/
     4'   THE USERS PROJECT PROGRAMMER NUMBER WILL BE ASSUMED.'/
     5'0EXAMPLES:'/'     TTY:'/'     DSK:DATA.DAT'/)
      GO TO 900
903   RETURN
904   DEV='TTY'
      FILNAM=DEFNAM
      IPATH(1)=0
      IPATH(2)=0
      IPATH(3)=0
      IF(IEND.EQ.0) GO TO 970
C
C     DEVICE
C
      I=1
911   I=I+1
      IF(I.GT.IEND) GO TO 914
      IF(INPUT(I).EQ.':') GO TO 913
      IF(INPUT(I).EQ.ILBKT) GO TO 914
      GO TO 911
913   L=I-1
      ENCODE(L,204,DEV)(INPUT(J),J=1,L)
      L=I
      GO TO 912
914   L=0
      DEV='DSK'
C
C     FILE NAME
C
912   DO 915 J=1,10
915   NAMDES(J)=' '
      J=0
      POINT=0
916   L=L+1
      IF(L.GT.IEND) GO TO 920
      IF(INPUT(L).EQ.'.') POINT=1
      IF(INPUT(L).EQ.ILBKT) GO TO 920
      IF(J.LT.10) GO TO 918
      WRITE(IDLG,917)
917   FORMAT(' A COLON MUST FOLLOW THE DEVICE AND FILE NAME MAY BE'/
     1' NO LONGER THAN 10 CHARACTERS')
      GO TO 900
918   J=J+1
      NAMDES(J)=INPUT(L)
      GO TO 916
920   IF(POINT.EQ.1) GO TO 921
      IF(J.GT.9) GO TO 921
      J=J+1
      NAMDES(J)='.'
921   ENCODE(10,204,FILNAM)(NAMDES(J),J=1,10)
C
C     PROJECT NUMBER
C
      IF(INPUT(L).NE.ILBKT) GO TO 970
      DO 930 J=1,10
930   NAMDES(J)=' '
      J=0
931   L=L+1
      IF(L.GT.IEND) GO TO 935
      IF(INPUT(L).EQ.IRBKT) GO TO 935
      IF(INPUT(L).EQ.',') GO TO 940
      IF((INPUT(L).GE.'0').AND.(INPUT(L).LE.'7')) GO TO 933
      WRITE(IDLG,932)
932   FORMAT(' ILLEGAL CHARACTER IN PROJECT NUMBER')
      GO TO 900
933   IF(J.LE.6) GO TO 936
935   WRITE(IDLG,934)
934   FORMAT(' MUST BE A COMMA BETWEEN PROJCT AND PROGRAMMER NUMBER')
      GO TO 900
936   J=J+1
      NAMDES(J)=INPUT(L)
      GO TO 931
940   IF(J.GT.0) GO TO 941
      IPATH(1)=0
      GO TO 949
941   IF(NAMDES(10).NE.' ') GO TO 943
      DO 942 K=9,1,-1
942   NAMDES(K+1)=NAMDES(K)
      NAMDES(1)=' '
      GO TO 941
943   ENCODE(10,204,DATED) (NAMDES(J),J=1,10)
      DECODE(10,944,DATED) IPATH(1)
944   FORMAT(O10)
949   DO 950 J=1,10
950   NAMDES(J)=' '
      J=0
951   L=L+1
      IF(L.GT.IEND) GO TO 956
      IF(INPUT(L).EQ.IRBKT) GO TO 956
      IF((INPUT(L).GE.'0').AND.(INPUT(L).LE.'7')) GO TO 953
      WRITE(IDLG,952)
952   FORMAT(' ILLEGAL CHARACTER IN PROGRAMMER NUMBER')
      GO TO 900
953   IF(J.LE.6) GO TO 954
      WRITE(IDLG,955)
955   FORMAT(' PROGRAMMER NUMBER TOO LONG')
      GO TO 900
954   J=J+1
      NAMDES(J)=INPUT(L)
      GO TO 951
956   IF(J.GT.0) GO TO 957
      IPATH(2)=0
      GO TO 970
957   IF(NAMDES(10).NE.' ') GO TO 958
      DO 959 K=9,1,-1
959   NAMDES(K+1)=NAMDES(K)
      NAMDES(1)=' '
      GO TO 957
958   ENCODE(10,204,DATED)(NAMDES(J),J=1,10)
      DECODE(10,944,DATED) IPATH(2)
970   CALL EXISTS(DEV,FILNAM,IERR,IPATH(1),IPATH(2))
      IF(IERR.EQ.0) GO TO 972
      WRITE(IDLG,971)
971   FORMAT(' ? FILE DOES NOT EXIST')
      GO TO 900
972   OPEN(UNIT=IUSER,DEVICE=DEV,ACCESS='SEQIN',FILE=FILNAM,
     1 DIRECTORY=IPATH)
26    WRITE (IDLG,27)
27    FORMAT (' HOW MANY VARIABLES? ',$)
      READ (ICC,28,END=25) NV
28    FORMAT (I)
      IF (NV.LE.500) GO TO 30
      WRITE (IDLG,29)
29    FORMAT (' THE MAXIMUM FOR THIS PROGRAM IS 500-FOR MORE SEE DICK
     1HOUCHARD')
25    RETURN
30    WRITE (IDLG,330)
C
C     FORMATTING FOR MABNK UP TO 400 CHARACTERS
C
330   FORMAT (' ENTER FORMAT ENCLOSED IN PARENTHESIS'/)
      KOUNT=0
      LFILE=0
      ICARDS=1
      L=1
      DO 208 I=1,600
208   FMTT(I)=' '
200   K=L+79
      IF(K.GT.600)K=600
      IF(LFILE.EQ.1) READ(MPROG,204,END=25)(FMTT(I),I=L,K)
      IF(LFILE.EQ.0)READ (ICC,204,END=25) (FMTT(I),I=L,K)
      IF((L.EQ.1).AND.(FMTT(1).EQ.'!')) GO TO 746
      IF((L.EQ.1).AND.(FMTT(1).EQ.'@')) GO TO 546
      IF((L.EQ.1).AND.(FMTT(1).NE.'(')) GO TO 212
      DO 201 N=K,L,-1
      IF(FMTT(N).NE.' ') GO TO 202
201   CONTINUE
202   DO 203 J=L,N
      IF(FMTT(J).EQ.'(') KOUNT=KOUNT+1
      IF(FMTT(J).EQ.')') KOUNT=KOUNT-1
      IF(FMTT(J).EQ.'/') ICARDS=ICARDS+1
203   CONTINUE
      IF(N.LT.600) GO TO 209
      WRITE(IDLG,210)
210   FORMAT(' FORMAT TOO LONG')
      GO TO 30
212   WRITE(IDLG,213)
213   FORMAT(' FORMAT MUST BE ENCLOSED IN PARENTHESIS')
      GO TO 30
546   DO 547 I=2,11
      IF(FMTT(I).NE.BKTLFT) GO TO 547
      WRITE(IDLG,548)
548   FORMAT(' NO BRACKETS WHEN SPECIFYING FILE FOR FORMAT')
      GO TO 30
547   CONTINUE
      ENCODE(10,204,FMTFIL)(FMTT(I),I=2,11)
      CALL EXIST(FMTFIL,IERR,NPROJR,NPROGR)
      IF(IERR.EQ.0) GO TO 550
      WRITE(IDLG,549)
549   FORMAT(' FILE SPECIFIED FOR FORMAT NOT AVAILABLE')
      GO TO 30
550   IF(LFILE.NE.1) GO TO 552
      WRITE(IDLG,551)
551   FORMAT(' FORMAT FILE MAY NOT BE SPECIFIED IN A FORMAT FILE')
      GO TO 30
552   LFILE=1
      OPEN(UNIT=MPROG,DEVICE='DSK',FILE=FMTFIL,ACCESS='SEQIN')
      GO TO 200
209   L=N+1
      IF(KOUNT.GT.0) GO TO 200
      IF(KOUNT.LT.0) WRITE(IDLG,206)
206   FORMAT(' UNBALANCED PARENTHESIS')
      IF(KOUNT.LT.0) GO TO 30
      ENCODE(600,204,FMT(1))FMTT
204   FORMAT(600A1)
C
C     REMOVE ALL BUT IMPORTANT INFO FROM FORMAT
C
      IF(LFILE.EQ.1) CLOSE(UNIT=MPROG)
      I=0
500   I=I+1
508   IF(I.GT.N) GO TO 512
      DO 501 J=1,9
      IF(FMTT(I).EQ.XX(J)) GO TO 500
501   CONTINUE
      IF((FMTT(I).LT.'0').OR.(FMTT(I).GT.'9')) GO TO 504
      DO 502 K=1,4
      IF((K+I).GT.N) GO TO 504
      DO 503 J=1,9
      IF(FMTT(K+I).NE.XX(J)) GO TO 503
      IF(J.EQ.7) GO TO 504
      GO TO 500
503   CONTINUE
      IF((FMTT(K+I).LT.'0').OR.(FMTT(K+I).GT.'9')) GO TO 504
502   CONTINUE
C     GET RID OF CHARACTER
504   DO 505 J=I+1,N
505   FMTT(J-1)=FMTT(J)
      N=N-1
      GO TO 508
C
C     GET RID OF PARENTHESIS
512   ISW=0
      I=0
      M=1
513   I=I+1
      IF(I.GT.N) GO TO 530
      IF(FMTT(I).EQ.XX(6)) GO TO 513
      IF(FMTT(I).EQ.XX(7)) GO TO 513
      IF((FMTT(I).GE.'0').AND.(FMTT(I).LE.'9')) GO TO 514
      FT(M)=FMTT(I)
      M=M+1
      IF(M.LT.600) GO TO 513
      GO TO 541
514   ISW=1
      DO 515 K=1,5
515   SAV(K)=' '
      J=1
516   SAV(J)=FMTT(I)
      I=I+1
      J=J+1
      IF((FMTT(I).GE.'0').AND.(FMTT(I).LE.'9')) GO TO 516
517   IF(SAV(5).NE.' ') GO TO 519
      DO 518   J=4,1,-1
518   SAV(J+1)=SAV(J)
      SAV(1)=' '
      GO TO 517
519   ENCODE(5,204,WORD) SAV
      DECODE (5,520,WORD) LOOP
520   FORMAT(I5)
      IF(FMTT(I).EQ.XX(6)) GO TO 525
      DO 521 J=1,LOOP
      FT(M)=FMTT(I)
      M=M+1
      IF(M.GT.600) GO TO 541
521   CONTINUE
      GO TO 513
525   L=I+1
      KOUNT=1
526   IF(FMTT(L).EQ.XX(6)) KOUNT=KOUNT+1
      IF(FMTT(L).EQ.XX(7)) KOUNT=KOUNT-1
      IF(KOUNT.EQ.0) GO TO 527
      L=L+1
      GO TO 526
527   IF((I+1).GT.(L-1)) GO TO 532
      DO 528 J=1,LOOP
      DO 529 K=I+1,L-1
      FT(M)=FMTT(K)
      M=M+1
      IF(M.GT.600) GO TO 541
529   CONTINUE
528   CONTINUE
532   I=L
      GO TO 513
530   N=M-1
      IF(ISW.EQ.0) GO TO 540
      DO 531 I=1,N
531   FMTT(I)=FT(I)
      GO TO 512
541   PAUSE 'PROBLEM SEE DICK HOUCHARD'
      RETURN
540   K=1
      IF(NV.EQ.N) GO TO 543
      WRITE(IDLG,544)
544   FORMAT(' CAUTION - NUMBER OF VARIABLES DOES NOT AGREE WITH FORMAT'
     1)
543   IF(ICARDS.GT.1) WRITE(IDLG,545) ICARDS
545   FORMAT('0MULTIPLE RECORD FORMAT - ',I4,' RECORDS READ PER READ')
      DO 542 I=1,NV
      ITYPE(I)=0
      IF(FT(K).EQ.'A') ITYPE(I)=1
      IF(FT(K).EQ.'O') ITYPE(I)=2
      IF(FT(K).EQ.'I') ITYPE(I)=2
      K=K+1
      IF(K.GT.N) K=1
C
C     FORMAT BROKEN DOWN
C
542   CONTINUE
C
C     NAME AND DESCRIPTION(AUTO MADE)
C
      SAV(1)='V'
      SAV(5)=' '
      DO 400 I=1,NV
      ENCODE(3,401,K) I
401   FORMAT(I3)
      DECODE(3,204,K)(SAV(J),J=2,4)
402   IF(SAV(2).NE.' ') GO TO 405
      DO 403 J=3,4
403   SAV(J-1)=SAV(J)
      SAV(4)=' '
      GO TO 402
405   ENCODE(5,204,NAMES(I)) SAV
      DATMIS(I,1)=0
      ENCODE(40,404,KDSC(1,I)) I,BNKNM
404   FORMAT('ORIGINAL VARIABLE NUMBER ',I3,' -',A10)
400   CONTINUE
C
C
C     CHANCE TO CHANGE AUTOMATIC NAME AND DESCRIPTIONC
      LFILE=0
C
      WRITE(IDLG,409)
409   FORMAT('0ENTER NAMES, DESCRIPTIONS AND MISSING DATA'/)
440   IF(LFILE.EQ.0) WRITE(IDLG,441)
441   FORMAT('+? ',$)
      IF(LFILE.EQ.1) READ(MPROG,204,END=570) INPUT
      IF(LFILE.EQ.0) CALL GES(INPUT,80,ICHECK)
      IF(ICHECK.EQ.2) GO TO 700
      IF((INPUT(1).NE.'H').OR.(INPUT(2).NE.'E').OR.(INPUT(3).NE.'L').
     1OR.(INPUT(4).NE.'P')) GO TO 406
      WRITE(IDLG,407)
407   FORMAT(
     1'0THE VARIABLES HAVE ALREADY BEEN GIVEN THE NAMES: V1, V2,'/
     2' V3, V4, ...., AND DESCRIPTIONS: THIS IS THE ORIGINAL'/
     3' VARIABE NO 1, ETC.  NO MISSING DATA SYMBOLS HAVE BEEN'/
     4' ASSUMED.  TO CHANGE THESE, TYPE THE VARIABLE NO, AN EQUALS'/
     5' SIGN, THE NAME OF THE VARIABLE (UP TO 5 CHARACTERS, FIRST'/
     6' MUST BE A LETTER), A SEMICOLON, THE DESCRIPTION (UP TO 40'/
     7' CHARACTERS), A SLASH AND A MISSING DATA SYMBOL.  UP TO 5'/
     8' MISSING DATA SMBOLS MAY BE SPECIFIED FOR ONE VARIABLE.'/
     9' EXAMPLE:'/
     1' 3=SEX ;SEX OF RESPONDANT/3/0/9'/
     2' ANY PORTION (NAME,DESCRIPTION, OR MISSING DATA) WHIICH IS'/
     3' NOT INCLUDED , WILL NOT BE CHANGED.  THE NAME MUST BEGIN IN'/
     4' THE FIRST POSITION FOLLOWING THE EQUALS, BUT NONE OF THE'/
     5' OTHER PORTIONS REQUIRE SPECIAL POSITIONING.  RANGES OF'/
     6' VARIABLES MAY BE CHANGED WITH ONE COMMAND, BY INDICATING THE'/
     7' LOWEST VARIABLE NUMBER OF THE RANGE, A MINUS, AND THE LARGEST'/
     8' VARIABLE NUMBER OF THE RANGE.  IF NAMES ARE TO BE CHANGED'/
     9' FOR RANGES, A QUESTION MARK MUST BE IN THE NAME.  THE')
      WRITE(IDLG,408)
408   FORMAT(
     1' QUESTION MARK IN THE VARIABLE WILL BE REPLACED WITH A'/
     2' NUMBER, STARTING WITH ONE FOR THE FIRST VARIABLE IN THE'/
     3' RANGE, TWO FOR THE SECOND, ETC.  IF THERE ARE MORE THAN 9'/
     4' VARIABLES IN THE RANGE, TWO QUESTION MARKS MUST BE IN THE'/
     5' NAME.  MISSING DATA MUST BE OF THE SAME TYPE AS VARIABLE'/
     6' IT IS SPECIFIED FOR (ALPHA MISSING DATA SYMBOLS MUST BE'/
     7' ENCLOSED IN QUOTES)'/
     8'0WHEN ALL CHANGES HAVE BEEN MADE TYPE A CARRIAGE RETURN <CR>,'/
     9' TO CONTINUE WITH PROGRAM'/)
      GO TO 440
406   IF(INPUT(1).EQ.'!') GO TO 746
      IF(INPUT(1).EQ.' ') GO TO 700
      IF(INPUT(1).EQ."155004020100) GO TO 700
      IF(INPUT(1).EQ.'@') GO TO 561
      N=1
      ISW=0
      ISM=0
442   DO 443 I=1,3
443   NSAV(I)=' '
      J=1
447   IF(INPUT(N).EQ.'-') GO TO 448
      IF(INPUT(N).EQ.'=') GO TO 448
      IF((INPUT(N).LE.'9').AND.(INPUT(N).GE.'0')) GO TO 446
444   WRITE(IDLG,445)
445   FORMAT(' ILLEGAL VARIABLE NUMBER'/)
      GO TO 440
446   IF(J.GT.3) GO TO 444
      NSAV(J)=INPUT(N)
      J=J+1
      N=N+1
      GO TO 447
561   DO 562 I=2,11
      IF(INPUT(I).NE.ILBKT) GO TO 562
      WRITE(IDLG,563)
563   FORMAT(' NO BRACKETS ON VARIABLE DESCRIPTION FILE'/)
      GO TO 440
562   CONTINUE
      ENCODE(10,204,NDMFIL) (INPUT(I),I=2,11)
      CALL EXIST(NDMFIL,IERR,NPROJR,NPROGR)
      IF(IERR.EQ.0) GO TO 565
      WRITE(IDLG,564)
564   FORMAT(' FILE FOR DESCRIPTION IS UNAVAILABLE'/)
      GO TO 440
565   IF(LFILE.EQ.0) GO TO 567
      WRITE(IDLG,566)
566   FORMAT(' DESCRIPTION FILE MAY NOT SPECIFY A DESCRIPTION FILE')
      GO TO 440
567   LFILE=1
      OPEN(UNIT=MPROG,DEVICE='DSK',FILE=NDMFIL,ACCESS='SEQIN')
      GO TO 440
570   CLOSE(UNIT=MPROG)
      LFILE=0
      GO TO 440
C
448   IF(J.EQ.1) GO TO 444
449   IF(NSAV(3).NE.' ') GO TO 450
      NSAV(3)=NSAV(2)
      NSAV(2)=NSAV(1)
      NSAV(1)=' '
      GO TO 449
450   ENCODE(3,204,L) (NSAV(J),J=1,3)
      DECODE(3,439,L) ITMP
439   FORMAT(I3)
      IF((ITMP.LT.1).OR.(ITMP.GT.NV)) GO TO 444
      IF(INPUT(N).EQ.'=') GO TO 455
      IF(ISW.EQ.0) GO TO 452
      WRITE(IDLG,451)
451   FORMAT(' 2 RANGES INDICATED FOR SINGLE LINE'/)
      GO TO 440
452   ISW=1
      IBG=ITMP
      N=N+1
      GO TO 442
455   IF(ISW.EQ.1) GO TO 456
      IBG=ITMP
      IEND=ITMP
      GO TO 457
456   IEND=ITMP
      IF(IBG.LE.IEND) GO TO 457
      WRITE(IDLG,458)
458   FORMAT(' RANGE MUST BE SPECIFIED FROM LOW TO HIGH'/)
      GO TO 440
457   NRN=IEND-IBG+1
      N=N+1
C
C     NAME FIRST
C
      DO 460 I=1,5
460   NSAV(I)=' '
      J=1
465   IF(INPUT(N).EQ.' ') GO TO 466
      IF(INPUT(N).EQ.';') GO TO 466
      IF(INPUT(N).EQ.'/') GO TO 466
      IF(J.NE.1) GO TO 463
      IF((INPUT(N).LE.'Z').AND.(INPUT(N).GE.'A')) GO TO 463
461   WRITE(IDLG,462)
462   FORMAT(' ILLEGAL NAME'/)
      GO TO 440
463   IF(INPUT(N).EQ.'-') GO TO 461
      IF(INPUT(N).EQ.',') GO TO 461
      IF(INPUT(N).EQ.'(') GO TO 461
      IF(INPUT(N).EQ.')') GO TO 461
      IF(J.GT.5) GO TO 464
      NSAV(J)=INPUT(N)
      J=J+1
464   N=N+1
      IF(N.LE.80) GO TO 465
466   IF(J.EQ.1) GO TO 600
      NQ=0
      DO 467 J=1,5
      IF((NQ.GT.1).AND.(NSAV(J).NE.'?')) GO TO 468
      IF(NSAV(J).NE.'?') GO TO 467
      NQ=NQ+1
467   CONTINUE
468   IF(NRN.EQ.1) GO TO 470
      IF((NRN.LT.10).AND.(NQ.GE.1)) GO TO 470
      IF((NRN.LT.100).AND.(NQ.GE.2)) GO TO 470
      IF(NQ.GE.3) GO TO 470
      WRITE(IDLG,469)
469   FORMAT(' TOO MANY VARIABLES IN RANGE FOR NO. OF  ?'/)
      GO TO 440
470   DO 491 I=IBG,IEND
      DO 472 J=1,5
472   MSAV(J)=NSAV(J)
      IF(NQ.EQ.0) GO TO 490
      J=I-IBG+1
      ENCODE(5,471,L) J
471   FORMAT(I5)
      DECODE(5,204,L) LSAV
      DO 473 L=1,5
      IF(LSAV(L).NE.' ') GO TO 474
473   CONTINUE
474   DO 475 M=1,5
      IF(MSAV(M).EQ.'?') GO TO 476
475   CONTINUE
476   DO 477 J=L,5
      MSAV(M)=LSAV(J)
      M=M+1
477   CONTINUE
      IF(M.GT.5) GO TO 490
478   IF(MSAV(M).NE.'?') GO TO 490
      IF(M.EQ.5) GO TO 480
      DO 479 J=M,4
479   MSAV(J)=MSAV(J+1)
480   MSAV(5)=' '
      GO TO 478
490   ENCODE(5,204,NTMP) MSAV
      IF(NTMP.EQ.'OBS') GO TO 492
      IF(NTMP.EQ.'STOP') GO TO 492
      IF(NTMP.EQ.'HELP') GO TO 492
      IF(NTMP.EQ.'ALL') GO TO 492
      IF(NTMP.EQ.'EMPTY') GO TO 492
      GO TO 494
492   WRITE(IDLG,493) NTMP
493   FORMAT(' "',A5,'" IS A RESERVED NAME')
      GO TO 491
494   DO 481 J=1,NV
      IF(I.EQ.J) GO TO 481
      IF(NAMES(J).NE.NTMP) GO TO 481
      WRITE(IDLG,482) J,NTMP
482   FORMAT(' VARIABLE ',I3,' ALREADY HAS THE NAME ',A5/)
      GO TO 491
481   CONTINUE
      NAMES(I)=NTMP
491   CONTINUE
C
C
C
600   IF(INPUT(N).EQ.';') GO TO 601
      IF(INPUT(N).EQ.'/') GO TO 620
      N=N+1
      IF(N.LE.80) GO TO 600
      GO TO 440
C
C     DESCRIPTION
C
601   DO 602 J=1,40
602   NAMDES(J)=' '
      J=1
603   N=N+1
      IF(N.LE.80) GO TO 604
      GO TO 605
604   IF(INPUT(N).EQ.'/') GO TO 605
      IF(J.GT.40) GO TO 603
      NAMDES(J)=INPUT(N)
      J=J+1
      GO TO 603
605   DO 606 I=IBG,IEND
606   ENCODE(40,204,KDSC(1,I)) NAMDES
      GO TO 600
C
C     MISSING DATA
C
620   N=N+1
      IF(ISM.EQ.1) GO TO 600
      IF(NRN.LT.2) GO TO 623
      DO 622 I=IBG,IEND
      IF(ITYPE(I).EQ.ITYPE(IBG)) GO TO 622
      WRITE(IDLG,621)
621   FORMAT(' THE SAME SYMBOLS FOR MISSING DATA CANNOT BE USED FOR'/
     1' TWO DIFFERENT TYPE VARIABLES - NO MISSING DATA ACCEPTED THIS'/
     2' STATEMENT'/)
      ISM=1
      GO TO 600
622   CONTINUE
623   ISR=0
      IF((INPUT(N).NE.'V').OR.(INPUT(N+1).NE.'A').OR.(INPUT(N+2).
     1NE.'L').OR.(INPUT(N+3).NE.'I').OR.(INPUT(N+4).NE.'D').OR.
     2(INPUT(N+5).NE.':')) GO TO 624
      N=N+6
      ISR=1
      IST=0
624   GO TO (630,680,800) (ITYPE(IBG)+1)
C
C     FLOATING
C
630   DO 631 I=1,15
631   NAMDES(I)=' '
      IPD=0
      IEXP=0
      J=1
632   IF(INPUT(N).EQ.' ') GO TO 660
      IF(INPUT(N).EQ.'-') GO TO 634
      IF(INPUT(N).EQ.'E') GO TO 640
      IF(INPUT(N).EQ.'.') GO TO 636
      IF(INPUT(N).EQ.'/') GO TO 660
      IF(INPUT(N).EQ.';') GO TO 660
      IF((INPUT(N).LE.'9').AND.(INPUT(N).GE.'0')) GO TO 643
      WRITE(IDLG,645) INPUT(N)
645   FORMAT(' ILLEGAL CHARACTER "',A1,'" IN MISSING DATA SYMBOL'/)
      GO TO 600
643   IF(J.GT.15) GO TO 633
639   NAMDES(J)=INPUT(N)
      J=J+1
633   N=N+1
      IF(N.LE.80) GO TO 632
      GO TO 660
634   IF(J.EQ.1) GO TO 639
      GO TO 653
C
636   IF(IPD.EQ.0) GO TO 638
      WRITE(IDLG,637)
637   FORMAT(' ONLY 1 DECIMLE POINT PER MISSING VALUE'/)
      GO TO 600
638   IPD=1
      GO TO 639
C
640   IF(IEXP.EQ.0) GO TO 642
      WRITE(IDLG,641)
641   FORMAT(' ONLY 1 E SIGN PER VALUE'/)
      GO TO 600
642   IEXP=1
      GO TO 639
C
653   N=N+1
      IF(ISR.EQ.1) GO TO 647
      WRITE(IDLG,646)
646   FORMAT(' VALID: WAS NOT INDICATED - RANGES MAY NOT BE USED'/)
      GO TO 600
647   IF(IST.EQ.0) GO TO 649
      WRITE(IDLG,648)
648   FORMAT(' TWO - CANNOT BE USED IN THE SAME STATEMENT'/)
      GO TO 600
649   ENCODE(15,204,NAMDES(37))(NAMDES(J),J=1,15)
      DECODE(15,650,NAMDES(37)) TMPB
650   FORMAT(G)
      IST=1
      GO TO 630
C
660   IF(ISR.EQ.1) GO TO 661
      ENCODE(15,204,NAMDES(37)) (NAMDES(J),J=1,15)
      DECODE(15,650,NAMDES(37)) TMPB
      GO TO 670
661   IF(IST.EQ.1) GO TO 663
      WRITE(IDLG,662)
662   FORMAT(' NO - FOR VALID RANGE'/)
      GO TO 600
663   ENCODE(15,204,NAMDES(37))(NAMDES(J),J=1,15)
      DECODE(15,650,NAMDES(37)) TMPE
      IF(TMPB.LT.TMPE) GO TO 670
      SAV(1)=TMPB
      TMPB=TMPE
      TMPE=SAV(1)
      GO TO 670
C
C     ALPHANUMERIC MISSING DATA SYMBOLS
C
680   DO 681 I=1,5
681   NAMDES(I)=' '
      J=1
      IF(INPUT(N).NE.1H') GO TO 683
      N=N+1
682   IF(INPUT(N).EQ.' ') GO TO 693
      IF(INPUT(N).EQ.'/') GO TO 683
      IF(INPUT(N).EQ.';') GO TO 683
      IF(INPUT(N).EQ.1H') GO TO 687
695   IF(J.GT.5) GO TO 685
      NAMDES(J)=INPUT(N)
      J=J+1
      N=N+1
      IF(N.LE.80) GO TO 682
683   WRITE(IDLG,684)
684   FORMAT(' ALPHA MISSING DATA SYMBOLS MUST BE ENCOLOSED IN QUOTES'/)
      GO TO 600
685   WRITE(IDLG,686)
686   FORMAT(' MAXIMUM SIZE FOR ALPHA VARIABLE IS 6 CHARACTERS'/)
      GO TO 600
687   N=N+1
      IF(INPUT(N).EQ.'-') GO TO 690
      IF(ISR.EQ.0) GO TO 689
      IF(IST.EQ.1) GO TO 688
      WRITE(IDLG,662)
      GO TO 600
688   ENCODE(5,204,TMPE)(NAMDES(J),J=1,5)
      IF(TMPB.LE.TMPE) GO TO 670
      SAV(1)=TMPB
      TMPB=TMPE
      TMPE=SAV(1)
      GO TO 670
689   ENCODE(5,204,TMPB)(NAMDES(J),J=1,5)
      GO TO 670
690   IF(ISR.EQ.0) GO TO 692
      IF(IST.EQ.1) GO TO 691
      ENCODE(5,204,TMPB)(NAMDES(J),J=1,5)
      IST=1
      N=N+1
      GO TO 680
691   WRITE(IDLG,648)
      GO TO 600
692   WRITE(IDLG,646)
      GO TO 600
693   DO 694 I=1,5
      IF(INPUT(N+I).EQ.1H') GO TO 695
694   CONTINUE
      GO TO 683
C
C     FIXED
C
800   DO 801 I=1,15
801   NAMDES(I)=' '
      J=1
802   IF(INPUT(N).EQ.' ') GO TO 812
      IF(INPUT(N).EQ.'-') GO TO 806
      IF(INPUT(N).EQ.'/') GO TO 812
      IF(INPUT(N).EQ.';') GO TO 812
      IF((INPUT(N).LE.'9').AND.(INPUT(N).GE.'0')) GO TO 803
      WRITE(IDLG,645) INPUT(N)
      GO TO 600
803   IF(J.GT.15) GO TO 805
804   NAMDES(J)=INPUT(N)
      J=J+1
805   N=N+1
      IF(N.LE.80) GO TO 802
      GO TO 812
C
806   IF(J.EQ.1) GO TO 804
      GO TO 807
C
807   N=N+1
      IF(ISR.EQ.1) GO TO 809
      WRITE(IDLG,646)
      GO TO 600
809   IF(IST.EQ.0) GO TO 810
      WRITE(IDLG,648)
      GO TO 600
810   ENCODE(15,204,NAMDES(37))(NAMDES(J),J=1,15)
      DECODE(15,811,NAMDES(37)) TMPB
811   FORMAT(I)
      IST=1
      GO TO 800
812   IF(ISR.EQ.1) GO TO 813
      ENCODE(15,204,NAMDES(37))(NAMDES(J),J=1,15)
      DECODE(15,811,NAMDES(37)) TMPB
      GO TO 670
813   IF(IST.EQ.1) GO TO 814
      WRITE(IDLG,662)
      GO TO 600
814   ENCODE(15,204,NAMDES(37))(NAMDES(J),J=1,15)
      DECODE(15,811,NAMDES(37)) TMPE
      IF(TMPB.LE.TMPE) GO TO 670
      SAV(1)=TMPB
      TMPB=TMPE
      TMPE=SAV(1)
      GO TO 670
C
C     PUT MISSING VALUES WHERE THEY BELONG
C
670   DO 679 I=IBG,IEND
      IF(ISR.EQ.1) GO TO 672
      J=DATMIS(I,1)
      NN=J+1
      IF(J.LT.0) NN=-J+1
      IF(NN.LE.5) GO TO 678
      WRITE(IDLG,671) I
671   FORMAT(' TOO MANY MISSING DATA FOR VARIABLE ',I3/)
      GO TO 679
678   DATMIS(I,NN+1)=TMPB
      IF(J.LT.0) DATMIS(I,1)=-NN
      IF(J.GE.0) DATMIS(I,1)=NN
      GO TO 679
672   IF(DATMIS(I,1).GE.0) GO TO 674
      WRITE(IDLG,673) I
673   FORMAT(' 1 VALID RANGE ALREADY ACCEPTED FOR VARIABLE ',I3/)
      GO TO 679
674   NN=DATMIS(I,1)
      IF((NN+2).LE.5) GO TO 675
      WRITE(IDLG,671) I
      GO TO 679
675   IF(NN.EQ.0) GO TO 677
      DO 676 J=2,NN
676   DATMIS(I,J+2)=DATMIS(I,J)
677   DATMIS(I,2)=TMPB
      DATMIS(I,3)=TMPE
      DATMIS(I,1)=-(DATMIS(I,1)+2)
679   CONTINUE
      GO TO 600
C
C     BEGIN WORK (DONE WITH QUESTIONS) FIRST CREATE TMP FILE OF HEADR
C
700   IF(LFILE.EQ.1) CLOSE (UNIT=MPROG)
      OPEN (UNIT=ITMPRY,DEVICE='DSK',ACCESS='SEQOUT',FILE='HEADR.TMP',
     1MODE='BINARY')
      NNBL=(NV+5)/6
      DO 701 I=1,NNBL
      IVBG=(I-1)*6+1
      IVEND=IVBG+5
      IF(IVEND.GT.NV) IVEND=NV
      DO 702 J=IVBG,IVEND
      NNS(1,J-IVBG+1)=NAMES(J)
      DO 703 K=1,8
703   NNS(K+1,J-IVBG+1)=KDSC(K,J)
      NNS(10,J-IVBG+1)=ITYPE(J)
702   CONTINUE
      WRITE(ITMPRY) Z
701   CONTINUE
      CLOSE(UNIT=ITMPRY)
C
C     BEGIN ANALYSIS OF DATA NOW
C
      OPEN(UNIT=ITMPRY,DEVICE='DSK',ACCESS='RANDOM',MODE='BINARY',
     1FILE='BANK.TMP',RECORD SIZE=126)
      NPR=7000/NV
      IF(NPR.GT.125) NPR=125
      NERR=0
      NO=0
      NBKK=0
      ATEND=0
      IF(DEV.NE.'TTY') GO TO 705
      WRITE(IDLG,714)
714   FORMAT('0ENTER DATA NOW, WHEN FINISHED TYPE A CONTROL Z (^Z)')
705   NIBLK=0
706   N=0
      NFTR=NPR
      IF((NIBLK+NFTR).GT.125) NFTR=125-NIBLK
707   IBG=N*NV+1
      IEND=IBG+NV-1
      READ(IUSER,FMT,END=731,ERR=739) (D(I),I=IBG,IEND)
      NO=NO+1
713   N=N+1
      IF(N.LT.NFTR) GO TO 707
C
C     MISSING DATA REPLACED HERE
C
708   DO 750 I=1,NV
      L=DATMIS(I,1)
      IF(L.EQ.0) GO TO 750
      IF(L.GT.0) GO TO 755
C     RANGE
      L=-L
      DO 751 J=1,N
      DATA=D((J-1)*NV+I)
      IF((DATA.GE.DATMIS(I,2)).AND.(DATA.LE.DATMIS(I,3))) GO TO 752
      D((J-1)*NV+I)=AMISS
      GO TO 751
752   IF(L.LE.2) GO TO 751
      DO 753 M=4,L+1
      IF(DATA.NE.DATMIS(I,M)) GO TO 753
      D((J-1)*NV+I)=AMISS
      GO TO 751
753   CONTINUE
751   CONTINUE
      GO TO 750
C     INDIVIDUAL
755   DO 756 J=1,N
      DATA=D((J-1)*NV+I)
      DO 757 M=2,L+1
      IF(DATA.NE.DATMIS(I,M)) GO TO 757
      D((J-1)*NV+I)=AMISS
      GO TO 756
757   CONTINUE
756   CONTINUE
750   CONTINUE
C
C
C
      IF(NIBLK.NE.0) GO TO 720
      IF(N.EQ.125) GO TO 710
      DO 709 I=N,125
709   Z(I)=AMISS
710   DO 712 I=1,NV
      DO 711 J=1,N
711   Z(J)=D((J-1)*NV+I)
      KK=NBKK*NV+I
712   WRITE(ITMPRY#KK) Z
      GO TO 730
720   DO 722 I=1,NV
      KK=NBKK*NV+I
      READ(ITMPRY#KK) Z
      DO 721 J=1,N
721   Z(J+NIBLK)=D((J-1)*NV+I)
722   WRITE(ITMPRY#KK) Z
730   NIBLK=NIBLK+N
      IF(ATEND.EQ.1) GO TO 735
      IF(NIBLK.LT.125) GO TO 706
      NBKK=NBKK+1
      GO TO 705
739   NO=NO+1
      NERR=NERR+1
      IF(NERR.GT.5) GO TO 743
740   WRITE(IDLG,741) NO
741   FORMAT(' ERROR READING OBSERVATION ',I6)
      DO 742 I=IBG,IEND
742   D(I)=AMISS
      IF(DEV.NE.'TTY') GO TO 713
      WRITE(IDLG,745)
745   FORMAT(' PLEASE REENTER THE ENTIRE OBSERVATION '/)
      NO=NO-1
      NERR=0
      GO TO 707
743   IF((NERR/NO).GT.5) GO TO 740
      WRITE(IDLG,744)
744   FORMAT(' MORE THAN 5 ERRORS PER HUNDRED OBSERVATIONS - BYE')
746   CLOSE(UNIT=IBNK,DISPOSE='DELETE')
      RETURN
731   ATEND=1
      IF(N.GT.0) GO TO 708
735   NAMANS=1
      VERSON='V2'
      CALL DATE(DATED)
      WRITE(IBNK#1) NV,NO,NAMANS,DATED(1),DATED(2),NPROJR,
     1NPROGR,VERSON,(K,I=1,117)
      NBKK=(NO+124)/125
      KK=2
      DO 760 I=1,NV
      DO 761 J=1,NBKK
      NIBLK=(J-1)*NV+I
      READ(ITMPRY#NIBLK)Z
      WRITE(IBNK#KK)Z
      KK=KK+1
761   CONTINUE
760   CONTINUE
      CLOSE(UNIT=ITMPRY,DISPOSE='DELETE')
      OPEN(UNIT=ITMPRY,DEVICE='DSK',ACCESS='SEQIN',MODE='BINARY',
     1FILE='HEADR.TMP')
      KK=NBKK*NV+1
736   READ(ITMPRY,END=737) Z
      KK=KK+1
      WRITE(IBNK#KK) Z
      GO TO 736
737   CLOSE(UNIT=IBNK)
      CLOSE(UNIT=IUSER)
      CLOSE(UNIT=ITMPRY,DISPOSE='DELETE')
      WRITE (IDLG,738) BNKNM,DATED,NV,NO
738   FORMAT('1BANK: ',A10,5X,'CREATED: ',2A5/' HAVING ',I3,
     1' VARIABLES, AND ',I6,' OBSERVATIONS')
      RETURN
      END