C23456789112345678921234567893123456789412345678951234567896123456789712
C*
C*	GRADE RECORDING PROGRAM:	INPUT.FOR
C*
C*	AUTHORS:	KENT S. KNAEBEL & KRIS LAKSHMANAN
C*			DEPARTMENT OF CHEMICAL ENGINEERING
C*			OHIO STATE UNIVERSITY
C*			140 W 19 AVENUE
C*			COLUMBUS, OHIO 43210
C*			PHONE:	614 422-6591
C*
C*	VERSION:	1.0 (REVISED MAY 1983)
C*
C*	FUNCTION:	THIS PROGRAM RECORDS THE STUDENT GRADES
C*			AND THE OUTPUT FILE IS USED BY THE
C*			GRADE ANALYSIS PROGRAM. 
C*	
C*	INSTRUCTIONS:	COMPLETE INSTRUCTIONS FOR THIS PROGRAM
C*			ARE GIVEN IN INPUT.RNO FILE
C*
C***************************************************************
C*
C*	THIS PROGRAM IN CONJUNCTION WITH GRADE ANALYSIS PROGRAM
C*	HAS BEEN USED TO COMPUTERIZE OUR GRADING PROCEDURE AND
C*	SEEMED TO BE VERY WELL USED BY MANY VAX SITES ON OUR
C*	CAMPUS. EVERY EFFORT HAS BEEN MADE TO MAKE THIS PROGRAM
C*	ERROR FREE SINCE SENSITIVE STUDENT INFORMATION IS
C*	KEPT IN THIS FILE. IF USERS HAVE PROBLEMS, PLEASE
C*	NOTIFY US.
C*
C***************************************************************
C*
	CHARACTER*80 COURSE, QUARTR, TEMP80, DEF(20)
	CHARACTER*40 BLANK
	CHARACTER*15 NAME(150), TEMP, LABPWT, LABMAX
	CHARACTER*15 LABSSN, LABCOD, LABCOL, LABGRD, LABSUM
	CHARACTER*7 HD(40), THD
	CHARACTER*1 ANSW, CODE(160,40), FILCHR(50), BLANK1(40)
	character*1 dcode(150),dummy, temp1
	CHARACTER LLG*22, LG(11)*2, SSNO(150)*11, TSSNO*12
	CHARACTER FILCOD*3, FILNAM*10, FILFUL*50, FILNO*4
C
	LOGICAL OLD, LOGSSN, LOGCOD(40)
C
	INTEGER*2 TERM_TYPE
C
 	DIMENSION SM(40), SCORE(150,40), WT(40), GR(11), IPIK(150)
C
	EQUIVALENCE (LG(1),LLG), (FILCHR(1),FILFUL), (BLANK1(1),BLANK)
C
	DATA LABSSN /'INCLUDE SS-NO.='/, LLG /'E D D+C-C C+B-B B+A-A '/
	DATA LABGRD /'# RAW  GRADES ='/,  LABSUM /'TOTAL PCT. WT.='/
	DATA LABCOD /'# CODE-SYMBOLS='/,  LABCOL /'"CODE" IS USED='/
	DATA LABMAX /'MAX.POSS.SCORE='/,  LABPWT /'PERCENT WEIGHT='/
	DATA BLANK1 / 40 * ' '/, CODE / 6400 * ' ' /
	data dcode / 150 * ' '/, dummy /' '/
C*
	INPT  = 1
	IPRT  = 3
	NDROP = 0
C*
C*----------------------INPUT-------------------------------------------
C*
	TYPE *,' '
	TYPE *,' '
	TYPE *,'RUNNING ... GRADE RECORDING PROGRAM'
	TYPE *,' '
	TYPE *,' '
	TYPE *,'  Student records, etc. are kept in a data file named'
	TYPE *,'  ROSijk.DAT  where  "ijk"  represents the 3-digit'
	TYPE *,'  course number, e.g. 487.'
	TYPE *,' '
	TYPE *,'  For the first entry of a new course, you should'
	TYPE *,'  enter student NAMES (and perhaps their S.S.No.s)'
	TYPE *,'  then save them in a file named ROSijk.DAT.'
	TYPE *,'  All student NAMES should be CAPITALIZED.'
	TYPE *,'  Once this roster is checked, then'
	TYPE *,'  enter grades in a subsequent session.'
	TYPE *,' '
	TYPE *,'  Grades can be entered two ways: alphabetic'
	TYPE *,'  prompts supplied by the computer, or by your'
	TYPE *,'  supplying a sub-string of each name.'
	TYPE *,' '
	TYPE *,'  In addition, scores or grade components can be'
	TYPE *,'  modified, and students can be added or deleted'
	TYPE *,'  interactively.'
	TYPE *,' '
   1	TYPE *,'Please enter your course number.'
	ACCEPT 900, FILCOD
	FILNAM = 'ROS'//FILCOD//'.DAT'
	TYPE *,'The filename is: ', FILNAM
	TYPE *,'  Is that O.K.?'
	TYPE *,'   ( Y or N )'
	ACCEPT 910, ANSW
	TYPE *,' '
	IF ( ANSW .NE. 'Y' ) GO TO 1
	INQUIRE(FILE=FILNAM,EXIST=OLD,NAME=FILFUL)
	IF ( .NOT. OLD ) TYPE *,'This is a new filename.'
	IF ( .NOT. OLD ) GO TO 15
	DO  4  I = 50,1,-1
	IF ( FILCHR(I) .EQ. ';' ) GO TO 5
   4	CONTINUE
	TYPE *,'VERSION NUMBER NOT FOUND ... TERMINATING'
	GO TO 999
   5	FILNO = FILFUL(I+1:)
	TYPE *,'  There is presently a file by that name in your'
	TYPE *,'  directory.  The VERSION number is: ',FILNO,'.'
	TYPE *,' '
  10	TYPE *,'Would you like to:'
	TYPE *,' 1. Begin with an entirely NEW set of names.'
	TYPE *,' 2. Use the names in the EXISTING file and add grades.'
	TYPE *,'     (choose  1  or  2 )'
	READ(5,*,ERR=10) NEWNAM
	IF ( NEWNAM .LT. 1 .OR. NEWNAM .GT. 2 ) GO TO 10
	IF ( NEWNAM .GT. 1 ) GO TO 80
C*
  15	TYPE *,' '
	TYPE *,'  Two lines of information are required to fully'
	TYPE *,'  identify the file (both should be 20 char. or fewer):'
	TYPE *,'Enter the NAME and/or NUMBER of the course.'
	ACCEPT 900, COURSE
	TYPE *,'Enter the YEAR and QUARTER.'
	ACCEPT 900, QUARTR
C*
	TYPE *,' '
	TYPE *,'  To identify the students, their NAMES are required'
	TYPE *,'  but their Social Security Numbers are optional.'
	TYPE *,' '
	TYPE *,'Do you wish to include Social Security Numbers ?'
  17	TYPE *,'    ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'N' .AND. ANSW .NE. 'Y' ) GO TO 17
	LOGSSN = ( ANSW .EQ. 'Y' )
	TYPE *,'Enter the NAMES when prompted (15 characters or fewer).'
	IF ( .NOT. LOGSSN ) GO TO 18
	TYPE *,'Then enter the Social Security Number on the next line,'
	TYPE *,'as it usually appears  (e.g.  123-45-6789).'
  18	TYPE *,' '
	TYPE *,'After the last entry, type ZZZ when prompted for the'
	TYPE *,'next name.  This signifies the end of the list.'
	TYPE *,' '
	DO  25  I = 1, 200
  19	TYPE 920, I
	ACCEPT 901, NAME(I)
	IF ( NAME(I) .GT. 'ZZ' ) GO TO 30
	IF ( NAME(I) .NE. ' ' ) GO TO 21
	TYPE *,'Do you wish to quit entering names ?'
  20	TYPE *,'    ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'N' .AND. ANSW .NE. 'Y' ) GO TO 20
	IF ( ANSW .EQ. 'Y' ) GO TO 30
	GO TO 19
  21	IF ( .NOT. LOGSSN ) GO TO 25
  22	ACCEPT 900, TSSNO
	IF ( TSSNO(12:12) .NE. ' ' ) GO TO 23
	IF ( TSSNO(4:4) .EQ. '-' .AND. TSSNO(7:7) .EQ. '-' ) GO TO 24
  23	TYPE *,'Error in form of S.S. No. -- use the form: 111-22-3333'
	GO TO 22
  24	SSNO(I) = TSSNO
  25	CONTINUE
  30	N = I - 1
C*
C---------------------------ALPHABETIZE---------------------------------
C*
	DO  40  I = 1, N-1
	DO  40  J = I+1, N
	IF ( NAME(J) .GE. NAME(I) ) GO TO 40
	TEMP    = NAME(I)
	TSSNO   = SSNO(I)
	NAME(I) = NAME(J)
	SSNO(I) = SSNO(J)
	NAME(J) = TEMP
	SSNO(J) = TSSNO
  40	CONTINUE
	GO TO 210
C*
C------------------------INPUT GRADES-----------------------------------
C*
C*
  80	CONTINUE
	SUM = 0.0
	OPEN(UNIT=INPT,NAME=FILNAM,STATUS='OLD')
	READ(INPT,935) COURSE
	READ(INPT,935) QUARTR
	READ(INPT,935) TEMP
	READ(INPT,1010) NACT, NDROP, N
	READ(INPT,935) TEMP
	READ(INPT,925) TEMP, M, TEMP, LOGSSN
	READ(INPT,935) TEMP
C
	IF ( M .GT. 0 ) GO TO 85
C
	DO  82  I = 1, N
	IF ( LOGSSN ) GO TO 81
	READ(INPT,935) NAME(I)
	GO TO 82
  81	READ(INPT,930) SSNO(I), NAME(I)
  82	CONTINUE
	GO TO 210
C
  85	CONTINUE
C
	READ(INPT,935) TEMP
	READ(INPT,945) ( GR(J), J = 1,11)
	READ(INPT,935) TEMP
	READ(INPT,951) TEMP, ANSN
	READ(INPT,935) TEMP
	READ(INPT,915) TEMP, ( HD(J), J = 1,M )
	READ(INPT,950) TEMP,dummy, ( SM(J), TEMP, J = 1,M )
	READ(INPT,950) TEMP,dummy, ( WT(J), TEMP, J = 1,M )
	READ(INPT,914) TEMP, ( LOGCOD(J), J = 1,M )
	READ(INPT,935) TEMP
C
	DO  88  J = 1,M
  88	SUM = SUM + WT(J)
C
	NACTCK = 0
	DO  97  I = 1, N
	IF ( LOGSSN ) GO TO 90
	READ(INPT,950) NAME(I),DCODE(I),
	1 ( SCORE(I,J), CODE(I,J), J = 1, M  )	
	IF ( DCODE(I) .EQ. ' ' ) NACTCK = NACTCK + 1
	GO TO 97
C===  90	IF(M.GT.15)GO TO 92
   90	IF(M.GE.15)GOTO 92
	READ(INPT,950) NAME(I),DCODE(I),
	1 	( SCORE(I,J), CODE(I,J), J = 1, M  )	
	IF ( DCODE(I) .EQ. ' ' ) NACTCK = NACTCK + 1
	READ(INPT,955) SSNO(I)
	GO TO 97
C
  92	read(inpt,935)temp
	READ(INPT,950) NAME(I),dcode(i), 
	1 ( SCORE(I,J), CODE(I,J), J = 1, 14 )
	IF ( DCODE(I) .EQ. ' ' ) NACTCK = NACTCK + 1
	READ(INPT,955) SSNO(I), ( SCORE(I,J), CODE(I,J), J = 15,M  )
  97	CONTINUE
	READ(INPT,935) TEMP
	READ(INPT,925) TEMP, LK
	IF ( LK .LE. 0 ) GO TO 99
	DO  98  I = 1,LK
  98	READ(INPT,935) DEF(I)
  99	IF ( NACT .EQ. NACTCK ) GO TO 210
	TYPE *,' '
	TYPE *,'--------------- ERROR: INPUT DATA ----------------'
	TYPE *,' '
	TYPE *,'# ACTIVE STUDENTS ENTERED =',NACT
	TYPE *,'# ACTIVE STUDENTS COUNTED =',NACTCK
	TYPE *,' '
	TYPE *,' .....terminating execution.'
	GO TO 999
C*
C*-------------------INPUT STUDENTS' SCORES-----------------------------
C*
 100	SUM = 0.0
	DO  102  J = 1,M
 102	SUM = SUM + WT(J)
	TYPE *,' '
 104	TYPE *,'How many grades per student will you enter now ?'
	READ(5,*,ERR=104) L
C*
	IF ( L ) 104, 210, 105
 105	TYPE *,' '
	MP= M+1
	M = M+L
	DO  110  J = MP,M
	WRITE(6,960) J
 106	WRITE(6,965)
	READ(5,900,ERR=106) HD(J)
 107	WRITE(6,970)
	READ(5,*,ERR=107) SM(J)
 108	WRITE(6,975)
	READ(5,*,ERR=108) WT(J)
 109	WRITE(6,980)
	READ(5,910) ANSW
	IF ( ANSW .NE. 'Y' .AND. ANSW .NE. 'N' ) GO TO 109
	LOGCOD(J) = ( ANSW .EQ. 'Y' )
 110	SUM = SUM + WT(J)
	IF ( SUM .LE. 100.0 ) GO TO 115
	TYPE *,'THE SUM OF THE PCT.-WEIGHTS EXCEEDS 100.0 ...'
	TYPE *,' > > > PLEASE FIX THIS LATER! < < <'
	TYPE *,' '
C*
 115	TYPE *,' '
	DO  116  J = MP, M
	IF ( LOGCOD(J) ) GO TO 118
 116	CONTINUE
	GO TO 135
 118	IF ( LK .GT. 0 ) GO TO 120
	TYPE *,' '
	TYPE *,' You indicated that CODE-SYMBOLS are to be used'
	TYPE *,' for some students, for a grade-component.'
	TYPE *,' '
	TYPE *,' Later, as you enter individual grades, you'
	TYPE *,' will be asked for the codes for each student.'
	TYPE *,' '
	TYPE *,' FIRST, however, DEFINE the codes, which will'
	TYPE *,' be retained for future reference.'
	TYPE *,' '
	TYPE *,' You will first be asked for the CODE-SYMBOL,'
	TYPE *,' then its DEFINITION.'
	TYPE *,' '
	TYPE *,' Terminate the table by entering:  ZZZ  '
	TYPE *,' when prompted for the next symbol.'
	TYPE *,' '
	GO TO 125
 120	TYPE *,'   Already, ',LK,' CODE-SYMBOLS have been defined.'
	TYPE *,'   They are:'
	DO  122  I = 1,LK
 122	TYPE *, DEF(I)
	TYPE *,' '
	TYPE *,'Would you like to add to this list ?'
 124	TYPE *,'   ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'Y' .AND. ANSW .NE. 'N' ) GO TO 124
	IF ( ANSW .EQ. 'N' ) GO TO 135
 125	DO  134  I = 1,30
	TYPE 990
	ACCEPT 900, THD
	IF ( THD .GE. 'ZZ' ) GO TO 135
	IF ( THD .GT. ' '  ) GO TO 128
	TYPE *,'   A blank was entered ... do you want to'
	TYPE *,'   STOP entering symbols and definitions ?'
 126	TYPE *,'     ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'Y' .AND. ANSW .NE. 'N' ) GO TO 126
	IF ( ANSW .EQ. 'Y' ) GO TO 135
 128	LK = LK + 1
	ANSW = THD(1:1)
 130	TYPE *,'   Enter the definition (75 char. or less) for: ',ANSW
	ACCEPT 900, TEMP80
	DO  132  II = 74, 80
	IF ( TEMP80(II:II) .NE. ' ' ) GO TO 130
 132	CONTINUE
 134	DEF(I) = '   '//ANSW//' = '//TEMP80
 135	TYPE *,' '
	TYPE *,'How would you like to enter the SCORES:'
	TYPE *,'  A. To be PROMPTED with names in alphabetical order.'
	TYPE *,'  B. To enter a STRING from each name and then'
	TYPE *,'     choose from the possible matches in the roster.'
	TYPE *,'         (select  A  or  B )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'A' .AND. ANSW .NE. 'B' ) GO TO 115
	TYPE *,' '
	IF ( ANSW .EQ. 'A' ) GO TO 185
C*
C---------------------------STRING SELECTION----------------------------
C*
	DO  160  IK = 1,N
	CALL SEARCH( NAME, N, I, IPIK, IK, IFAIL ) 
	IF ( IFAIL .EQ. 1 ) GO TO 210
	IPIK(IK) = I
	TYPE *,'Enter the SCORE(S) of ', NAME(I)
	DO  145  J = MP,M
 140	TYPE 985, HD(J), SM(J)
	READ(5,*,ERR=140) SCORE(I,J)
	IF ( SCORE(I,J) .GT. SM(J) ) GO TO 140
	IF ( .NOT. LOGCOD(J) ) GO TO 145
	TYPE 990
	ACCEPT 910, CODE(I,J)
 145	CONTINUE
	IF ( IK .EQ. N ) GO TO 165
 155	TYPE *,' '
	TYPE *,'Do you want to enter another NAME ?'
	TYPE *,' ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'N' .AND. ANSW .NE. 'Y' ) GO TO 155
	IF ( ANSW .EQ. 'N' ) GO TO 165
 160	CONTINUE
 165	TYPE *,'Scores were entered for',IK,' of ',N,' students.'
	TYPE *,' '
	GO TO 200
C*
C---------------------------ALPHABETIC PROMPTS----------------------------
C*
 185	TYPE *,'Enter data for each student, as prompted.'
	DO  190  I = 1, N
	TYPE 935, NAME(I)
	DO  190  J = MP,M
 186	TYPE 985, HD(J), SM(J)
	READ(5,*,ERR=186) SCORE(I,J)
	IF ( .NOT. LOGCOD(J) ) GO TO 190
	TYPE 990
	ACCEPT 910, CODE(I,J)
 190	CONTINUE
	TYPE *,' '
 200	CONTINUE
	DO  207  I = 1,N
	DO  207  J = 1,M
	IF ( SCORE(I,J) .LE. SM(J) ) GO TO 207
	TYPE *,'> > > > > > > Error detected < < < < < < <'
	TYPE *,'For the student : ', NAME(I)
	TYPE *,' > > > GRADE COMPONENT:    ',HD(J)
	TYPE *,' > > > SCORE entered was:  ',SCORE(I,J)
	TYPE *,' > > > MAXIMUM POSSIBLE is:',SM(J)
 202	TYPE *,'Please RE-ENTER or REVISE that score.'
	READ(5,*,ERR=202) SCORE(I,J)
 207	CONTINUE
C*
C--------------------------SELECT OPTION--------------------------------
C*
 210	TYPE *,' '
	TYPE *,'SELECT AN OPTION:'
	TYPE *,' 0. EXAMINE ALL of the parameters, scores, etc.'
	TYPE *,' 1  EXAMINE the record of a SINGLE STUDENT.'
	TYPE *,' 2. ADD STUDENT(S) with or without score(s).'
	TYPE *,' 3. DELETE STUDENT(S).'
	TYPE *,' 4. REVISE student NAME, S.S. No., or SCORES.'
	TYPE *,' 5. ADD column(s) of SCORES.'
	TYPE *,' 6. CHANGE PARAMETER(S) of grade components.'
	TYPE *,'    (i.e. label, maximum score, or pct. weight).'
	TYPE *,' 7. SPECIFY letter grade CUT-OFFS.'
	TYPE *,' 8. SAVE everything in: ', FILNAM,', then continue.'
	TYPE *,' 9. SAVE everything in: ', FILNAM,', then QUIT.'
	TYPE *,'10. Insert DROP-CODE for a student.'
	TYPE *,'11. DISCARD the latest changes then QUIT.'
 212	TYPE *,'      (select a number)'
	READ(5,*,ERR=212) ANSN
	IF ( ANSN .LT. 0.0 .OR. ANSN .GT. 11.0 ) GO TO 210
	TYPE *,' '
	IGO = IFIX( ANSN )
	I1    = 1
	IN    = N
	IPRT  = 3
	IQUIT = 0
	ISPELL= 0
	IF ( IGO .EQ. 0 ) IPRT  = 6
	IF ( IGO .EQ. 9 ) IQUIT = 1
	GO TO ( 330,400,220,270,350,100,290,342,330,330,2000,999 ),IGO+1
C*
C-------------------------ADD STUDENT(S)--------------------------------
C*
 220	NP = N + 1
	TYPE *,' '
	TYPE *,'Enter the names when prompted (15 char. or fewer).'
	IF ( LOGSSN ) TYPE *,'Then enter the S.S. No. on the next line.'
	IF ( LOGSSN ) TYPE *,'  (e.g. 123-45-6789 )'
	TYPE *,'  After the last entry type ZZZ, when prompted.'
	DO  229  I = NP, 200
	TYPE 920, I
	ACCEPT 901, NAME(I)
	IF ( NAME(I) .GT. 'ZZ' ) GO TO 230
	IF ( NAME(I) .NE. ' '  ) GO TO 224
	TYPE *,'   A blank was entered ... do you want to'
	TYPE *,'   STOP entering names ?'
 223	TYPE *,'     ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'Y' .AND. ANSW .NE. 'N' ) GO TO 223
	IF ( ANSW .EQ. 'Y' ) GO TO 230
 224	IF ( .NOT. LOGSSN ) GO TO 229
 225 	ACCEPT 900, TSSNO
	IF ( TSSNO(12:12) .NE. ' ' ) GO TO 227
	IF ( TSSNO(4:4) .EQ. '-' .AND. TSSNO(7:7) .EQ. '-' ) GO TO 228
 227	TYPE *,'Error in form of S.S. No. -- use the form: 111-22-3333'
	GO TO 225
 228	SSNO(I) = TSSNO
 229	DCODE(I)= ' '
 230	N = I - 1
	nact = n - ndrop
	IF ( M .EQ. 0 ) GO TO 245
C*
	DO  240  I = NP,N
	TYPE *,'Enter the GRADES for --- ', NAME(I),', as prompted.'
	DO  240  J = 1,M
 235	TYPE 985, HD(J), SM(J)
	READ(5,*,ERR=235) SCORE(I,J)
	IF ( SCORE(I,J) .GT. SM(J) ) GO TO 235
	IF ( .NOT. LOGCOD(J) ) GO TO 240
	TYPE 990
	ACCEPT 910, CODE(I,J)
 240	CONTINUE
	ISPELL = 0
C*
C---------------------REVISE ALPHABETIC SEQUENCE------------------------
C*
 245	DO  255  I = 1,N-1
	DO  255  K = I+1,N
	IF ( NAME(K) .GE. NAME(I) ) GO TO 255
	TEMP    = NAME(I)
	NAME(I) = NAME(K)
	NAME(K) = TEMP
	temp1   = dcode(i)
	dcode(I)= dcode(K)
	dcode(K)= temp1
	IF ( .NOT. LOGSSN ) GO TO 247
	TSSNO   = SSNO(I)
	SSNO(I) = SSNO(K)
	SSNO(K) = TSSNO
 247	IF ( M .EQ. 0 ) GO TO 255
	DO  250  J = 1,M
	ANSN = SCORE(I,J)
	SCORE(I,J) = SCORE(K,J)
	SCORE(K,J) = ANSN
	ANSW = CODE(I,J)
	CODE(I,J) = CODE(K,J)
	CODE(K,J) = ANSW
 250	CONTINUE
 255	CONTINUE
	NN = N
	DO  260  I = N,1,-1
	IF ( NAME(I) .GE. 'ZZ' ) NN = NN - 1
	IF ( NAME(I) .LT. 'ZZ' ) GO TO 265
 260	CONTINUE
	TYPE *,'WARNING ... ALL NAMES BUT ONE WERE DELETED.'
 265	N = NN
C
C		IF NAME HAS BEEN RESPELLED -- RETURN THERE
C
	TYPE *,' '
	TYPE *,'The names have been re-alphabetized.'
	IF ( ISPELL .EQ. 1 ) GO TO 352
	GO TO 210
C*
C------------------------DELETE STUDENTS--------------------------------
C*
 270	TYPE *,' '
	TYPE *,'How many students do you wish to delete ?'
	READ(5,*,ERR=270) NN
	IF ( NN ) 210, 210, 275
 275	DO  280  IK = 1,NN
	CALL SEARCH( NAME, N, I, IPIK, IK, IFAIL ) 
	IF ( IFAIL .EQ. 1 ) GO TO 210
 280	NAME(I) = 'ZZZ'
	ISPELL  = 0
	GO TO 245
C*
C----------------CHANGE GRADE-COMPONENT PARAMETERS----------------------
C*
 290	TYPE *,' '
	TYPE *,'What do you want to do ?'
	TYPE *,' A. Change a GRADE PARAMETER.'
	TYPE *,' B. ADD or DELETE a CODE-SYMBOL and definition.'
	TYPE *,' C. Consider other options.'
 295	TYPE *,'  (choose A or B or C )'
	ACCEPT 910, ANSW
	IF ( ANSW.NE.'A' .AND. ANSW.NE.'B' .AND. ANSW.NE.'C' ) GO TO 295
	IF ( ANSW.EQ.'B' ) GO TO 321
	IF ( ANSW.EQ.'C' ) GO TO 210
	TYPE *,'What is the LABEL of the GRADE-COMPONENT to be changed?'
	K = 1
	CALL SEARCH( HD, M, J, IPIK, K, IFAIL ) 
	IF ( IFAIL .EQ. 1 ) GO TO 210
 300	TYPE *,' '
	TYPE *,'For GRADE-COMPONENT: ', HD(J),' ....'
	TYPE *,'What PARAMETER would you like to change ?'
	TYPE *,'  1. LABEL.'
	TYPE *,'  2. MAX. POSSIBLE SCORE.'
	TYPE *,'  3. PCT. WEIGHT of grade.'
	TYPE *,'  4. Whether or not to have SYMBOL-CODES'
	TYPE *,'  5. Consider other options.'
 302	TYPE *,'   (choose a number)'
	READ(5,*,ERR=302) ANSN
	TYPE *,' '
	IF ( ANSN .LT. 1.0 .OR. ANSN .GT. 5.0 ) GO TO 300
	IGO = IFIX( ANSN )
	GO TO ( 305, 310, 312, 316, 290 ), IGO
 305	TYPE *,'The present LABEL is: ', HD(J)
	TYPE *,'Enter the new LABEL.'
	ACCEPT 900, HD(J)
	TYPE *,' '
	GO TO 300
 310	TYPE *,'The present MAX. POSSIBLE SCORE is: ',SM(J)
	TYPE *,'Enter the new MAX. POSSIBLE SCORE.'
	READ(5,*,ERR=310) SM(J)
	TYPE *,' '
	GO TO 300
 312	TYPE *,'The present PCT. WEIGHT is: ', WT(J)
	TYPE *,'Enter the new PCT. WEIGHT of the grade.'
	READ(5,*,ERR=312) WT(J)
	SUM = 0.0
	DO  314  JJ = 1,M
 314	SUM = SUM + WT(JJ)
	GO TO 300
 316	TYPE *,' '
	TYPE *,'  Special CODE-SYMBOLS may be used to indicate the'
	TYPE *,'  status or action being taken on a grade-entry,'
	TYPE *,'  for some students.  For this GRADE COMPONENT,'
	IF ( LOGCOD(J) ) GO TO 318
	TYPE *,'  CODE-SYMBOLS are NOT currently being used.'
	TYPE *,' '
	TYPE *,'Do you want CODE-SYMBOLS for: ', HD(J),' ?'
 317	TYPE *,'      ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'Y' .AND. ANSW .NE. 'N' ) GO TO 317
	TYPE *,' '
	LOGCOD(J) = ( ANSW .EQ. 'Y' )
	IF ( .NOT. LOGCOD(J) ) GO TO 300
	TYPE *,'   Would you like to review and/or add symbols ?'
	TYPE *,'      ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .EQ. 'Y' ) GO TO 321
	GO TO 210
 318	TYPE *,'  CODE-SYMBOLS are now being used.'
	TYPE *,' '
	TYPE *,'Do you want to ERASE the CODE-SYMBOLS for: ', HD(J),' ?'
 319	TYPE *,'      ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'Y' .AND. ANSW .NE. 'N' ) GO TO 319
	TYPE *,' '
	LOGCOD(J) = ( ANSW .EQ. 'N' )
	IF ( LOGCOD(J) ) GO TO 321
	DO  320  I = 1,N
 320	CODE(I,J) = ' '
	GO TO 300
C*
 321	TYPE *,' '
	TYPE *,'  Already, ',LK,' CODE-SYMBOLS have been defined.'
	IF ( LK .GT. 0 ) TYPE *,'They are:'
	DO  322  I = 1,LK
 322	IF ( LK .GT. 0 ) TYPE *, DEF(I)
	TYPE *,' '
	TYPE *,'What would you like to do ?'
	TYPE *,'  A. ADD a CODE-SYMBOL definition.'
	TYPE *,'  B. DELETE a CODE-SYMBOL definition.'
	TYPE *,'  C. Consider other options.'
 323	TYPE *,'  (choose A or B or C )'
	ACCEPT 910, ANSW
	IF ( ANSW .EQ. 'A' ) GO TO 324
	IF ( ANSW .EQ. 'B' ) GO TO 327
	GO TO 210
 324	LK = LK + 1
	TYPE *,' '
	TYPE 990
	ACCEPT 910, ANSW
 325	TYPE *,' '
	TYPE *,'   Enter the definition (75 char. or less) for: ',ANSW
	ACCEPT 900, TEMP80
C
	DO  326  II = 74, 80
	IF ( TEMP80(II:II) .NE. ' ' ) GO TO 325
 326	CONTINUE
C
	DEF(LK) = '   '//ANSW//' = '//TEMP80
	TYPE *,'   Do you want to enter another CODE-SYMBOL ?'
	TYPE *,'      ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .EQ. 'Y' ) GO TO 324
	GO TO 300
 327	TYPE *,'What CODE-SYMBOL would you like to REMOVE ?'
	DO  328  I = 1,LK
 328	FILCHR(I)  = DEF(I)(1:1)
	IK = 1
	CALL SEARCH( FILCHR, LK, I, IPIK, IK, IFAIL ) 
	IF ( IFAIL .EQ. 1 ) GO TO 210
	LK = LK - 1
	DO  329  IK = I,LK
 329	DEF(IK) = DEF(IK+1)
	GO TO 300
C*
C*
C-----------------------OUTPUT GRADE FILE-------------------------------
C*
 330	if(ndrop.eq.0)nact=n
	IF ( IPRT .EQ. 3 ) OPEN(UNIT=IPRT,NAME=FILNAM,STATUS='NEW')
	WRITE(IPRT,*) COURSE
	WRITE(IPRT,*) QUARTR
	WRITE(IPRT,1000) NACT, NDROP, N
	WRITE(IPRT,935) BLANK
	WRITE(IPRT,925) LABGRD, M, LABSSN, LOGSSN
	WRITE(IPRT,935) BLANK
C
	IF ( M .GT. 0 ) GO TO 333
C
	DO  332  I = I1,IN
	IF ( LOGSSN ) GO TO 331
	WRITE(IPRT,935) NAME(I)
	GO TO 332
 331	WRITE(IPRT,930) SSNO(I), NAME(I)
 332	CONTINUE
	GO TO 339
C
 333  	WRITE(IPRT,940) ( LG(J), J = 1,11)
	WRITE(IPRT,945) ( GR(J), J = 1,11)
	WRITE(IPRT,935) BLANK
	WRITE(IPRT,951) LABSUM, SUM
	WRITE(IPRT,935) BLANK
	WRITE(IPRT,915) BLANK, ( HD(J), J = 1,M )
	WRITE(IPRT,950) LABMAX,dummy, ( SM(J), BLANK, J = 1,M )
	WRITE(IPRT,950) LABPWT,dummy, ( WT(J), BLANK, J = 1,M )
	WRITE(IPRT,914) LABCOL, ( LOGCOD(J), J = 1,M )
	WRITE(IPRT,935) BLANK
	DO  337  I = I1,IN
	IF ( LOGSSN ) GO TO 334
	WRITE(IPRT,950) NAME(I), dcode(i),
	1 	( SCORE(I,J), CODE(I,J), J = 1, M  )
	GO TO 337
C****
 334	IF ( M.GT.14) GO TO 335
	WRITE(IPRT,950) NAME(I), dcode(i),
	1 	( SCORE(I,J), CODE(I,J), J = 1, M  )
	WRITE(IPRT,950) SSNO(I)
	GO TO 337
335	write(iprt,949)
	WRITE(IPRT,950) NAME(I), dcode(i),
	1 	( SCORE(I,J), CODE(I,J), J = 1, 14 )
	WRITE(IPRT,955) SSNO(I), ( SCORE(I,J), CODE(I,J), J = 15,M  )
C****
 337	CONTINUE
	WRITE(IPRT,935) BLANK
	WRITE(IPRT,925) LABCOD, LK
	IF ( LK .LE. 0 ) GO TO 339
	DO  338  I = 1,LK
 338	WRITE(IPRT,935) DEF(I)
 339	CONTINUE
	IF ( IPRT .EQ. 3 ) CLOSE(UNIT=IPRT)
	IF ( IQUIT .EQ. 1 ) GO TO 999
	IF ( I1 .NE. IN )   GO TO 210
	I  = I1
	I1 = 1
	IN = N
	TYPE *,' '
	TYPE *,'Do you want to revise any information for:', NAME(I),'?'
 340	TYPE *,'     ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'Y' .AND. ANSW .NE. 'N' ) GO TO 340
	IF ( ANSW .EQ. 'Y' ) GO TO 352
	GO TO 210
C*
C--------------------LETTER GRADE CUT-OFFS------------------------------
C*
 342	DO  345  J = 1, 10
	TYPE 995, LG(J)
 343	READ(5,*,ERR=342) GR(J)
	IF ( J .LE. 1 ) GO TO 345
	IF ( GR(J) .GE. GR(J-1) ) GO TO 345
	TYPE *,'ASCENDING ORDER IS REQUIRED ... PLEASE START AGAIN.'
	GO TO 342
 345	CONTINUE
	GR(11) = 100.0
	GO TO 210
C*
C----------------------REVISE STUDENT(S) DATA --------------------------
C*
 350	KK = 0
 351	TYPE *,' '
	TYPE *,'What is the NAME of the student to be revised ?'
	KK = KK + 1
	CALL SEARCH( NAME, N, I, IPIK, KK, IFAIL ) 
	IF ( IFAIL .EQ. 1 ) GO TO 210
	IF ( KK .GT. 1 ) GO TO 370
 352	TYPE *,' '
	TYPE *,'For the student named: ', NAME(I), ' ....'
	TYPE *,'What do you want to revise ?'
	TYPE *,'  1. The NAME itself.'
	TYPE *,'  2. A numerical SCORE for a grade-component.'
	TYPE *,'  3. The S.S. NUMBER of this student.'
	TYPE *,'  4. DROP or REINSTATE this student.'
	TYPE *,'  5. Consider other options.'
 356	TYPE *,'      (Select a number)'
	READ(5,*,ERR=356) ANSN
	IGO = IFIX( ANSN )
	IF ( IGO .LT. 1 .OR. IGO .GT. 5 ) GO TO 356
	IF ( IGO .EQ. 1 ) GO TO 363
	IF ( IGO .EQ. 2 ) GO TO 365
	IF ( IGO .EQ. 4 ) GO TO 390
	IF ( IGO .EQ. 5 ) GO TO 210
C
C			S.S. NO. CORRECTION
C
	IF ( .NOT. LOGSSN )  GO TO 210
	TYPE *,' '
	TYPE *,' The current    S.S. No.   is: ', SSNO(I)
	TYPE *,' Enter the new  S.S. No.  in the form  123-45-6789'
 357	ACCEPT 900, TSSNO
	IF ( TSSNO(12:12) .NE. ' ' ) GO TO 358
	IF ( TSSNO(4:4) .EQ. '-' .AND. TSSNO(7:7) .EQ. '-' ) GO TO 360
 358	TYPE *,'  Error in form of S.S. NO.'
	TYPE *,'  Try again -- use the form: 111-22-3333'
	GO TO 357
 360	SSNO(I) = TSSNO
	GO TO 352
C
C			SPELLING CORRECTION
C
 363	TYPE *,' '
 	TYPE *,'  The current spelling is: ', NAME(I)
	TYPE *,'  Enter the revised NAME (15 char. or fewer).'
	ACCEPT 901, NAME(I)
	TYPE *,'Just to confirm, you entered:', NAME(I)
	ISPELL = 1
	GO TO 245
C
C			SCORE CORRECTION
C
 365	TYPE *,' '
	TYPE *,'What is the LABEL of the score to be revised ?'
	K = 1
	CALL SEARCH( HD, M, J, IPIK, K, IFAIL )
	IF ( IFAIL .EQ. 1 ) GO TO 210
 370	TYPE *,'For: ', NAME(I),' the present SCORE is: ', SCORE(I,J)
	TYPE *,'Enter the NEW SCORE ...'
	TYPE 985, HD(J), SM(J)
	READ(5,*,ERR=370) SCORE(I,J)
	IF ( SCORE(I,J) .GT. SM(J) ) GO TO 370
 375	TYPE *,' '
	TYPE *,'Do you want to:'
	TYPE *,' A. Revise another score for THIS student.'
	TYPE *,' B. Revise the SAME grade for ANOTHER student.'
	TYPE *,' C. Revise ANOTHER grade for ANOTHER student.'
	TYPE *,' D. Consider other options.'
 380	TYPE *,'  (choose A or B or C or D )'
	ACCEPT 910, ANSW
	IF ( ANSW .EQ. 'A' .OR. ANSW .EQ. 'B' ) GO TO 385
	IF ( ANSW .EQ. 'C' .OR. ANSW .EQ. 'D' ) GO TO 385
	GO TO 380
 385	IF ( ANSW .EQ. 'A' ) GO TO 365
	IF ( ANSW .EQ. 'B' ) GO TO 351
	IF ( ANSW .EQ. 'C' ) GO TO 350
	GO TO 210
 390	TYPE *,' '
	IF ( DCODE(I) .EQ. ' ' ) GO TO 395
	TYPE *,'The student: ', NAME(I),' is currently DROPPED.'
	TYPE *,'Do you want to reinstate this student?'
 392	TYPE *,'     ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'Y' .AND. ANSW .NE. 'N' ) GO TO 392
	IF ( ANSW .EQ. 'N' ) GO TO 352
	DCODE(I) = ' '
	NDROP = NDROP - 1
	NACT  = N - NDROP
	GO TO 352
 395	TYPE *,' '
	TYPE *,'The student: ', NAME(I),' is currently ACTIVE.'
	TYPE *,'Do you want to DROP this student?'
 397	TYPE *,'     ( Y or N )'
	TYPE *,' '
	TYPE *,'If you answer "Y" all of the scores will be kept in'
	TYPE *,'the data-file, but will NOT used to compute averages.'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'Y' .AND. ANSW .NE. 'N' ) GO TO 397
	IF ( ANSW .EQ. 'N' ) GO TO 352
	DCODE(I) = '*'
	NDROP = NDROP + 1
	NACT  = N - NDROP
	GO TO 352
C*
C-------------------INDIVIDUAL STUDENT DATA REVIEW----------------------
C*
 400	CONTINUE
	if(ndrop.eq.0)nact=n
	TYPE *,'What is the NAME of the student ?'
	IK = 1
	CALL SEARCH( NAME, N, I, IPIK, IK, IFAIL )
	IF ( IFAIL .EQ. 1 ) GO TO 210
C*
C-------------------CHECK FOR VT100 OR VT52 TYPE TERMINAL---------------
C*
	CALL LIB$SCREEN_INFO(TERM_TYPE,,,)
C*****
C*****	VERSION 3.0 RUN-TIME LIBRARY RETURNS TERM_TYPE=83 FOR VT100
C*****	TERMINALS- APPARENT BUG IN THIS CALL??. 
C*****
C	IF ( TERM_TYPE .NE. 1 ) GO TO 410
	IF ( TERM_TYPE .NE. 83 ) GO TO 410
	TYPE *,'Do you prefer:'
	TYPE *,'  A.  Simultaneous review & revision.'
	TYPE *,'  B.  Scrolled output & sub-string selection.'
  405	TYPE *,'  (choose A or B)'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'A' .AND. ANSW .NE. 'B' ) GO TO 405
	IF ( ANSW .EQ. 'A' ) GO TO 450
 410	I1   = I
	IN   = I
	IPRT = 6
	GO TO 330
C*
C-------DISPLAY DATA USING CURSOR ADDRESSING AND REVERSE VIDEO
C*
 450	CALL LIB$ERASE_PAGE(1,1)
	CALL REVERSE
	CALL LIB$PUT_SCREEN(COURSE,1,1)
	CALL LIB$PUT_SCREEN(QUARTR,1,41)
	CALL RESET
	CALL LIB$PUT_SCREEN('Name: ',2,5)
	CALL REVERSE
	CALL LIB$PUT_SCREEN(NAME(I),2,12)
c===
	if(dcode(i).eq.'*')then
	call reverse
	call lib$put_screen('DROPOUT',2,30)
	call lib$put_screen(dcode(i),2,37)
	else
	endif
c===
	CALL RESET
	CALL LIB$PUT_SCREEN('S.S. #:',2,60)
	CALL REVERSE
	IF(LOGSSN)THEN
		CALL LIB$PUT_SCREEN(SSNO(I),2,68)
	  ELSE
		CALL LIB$PUT_SCREEN('F',2,68)
	ENDIF
C*		
	NO_COL=1
	IF(M.GT.15)NO_COL=2	
	IS=-39
	DO IK=1,NO_COL
	    IS=IS+39
		CALL LIB$PUT_SCREEN('LABEL',4,3+IS)
		CALL LIB$PUT_SCREEN('GRADE',4,10+IS)
		CALL LIB$PUT_SCREEN('CODE',4,17+IS)
		CALL LIB$PUT_SCREEN('MAX. ',4,22+IS)
		CALL LIB$PUT_SCREEN('% WT.',4,30+IS)
	ENDDO
	CALL RESET
C*
	ILINE=5
	ICOLUMN=2
	DO J=1,M
	    ILINE=ILINE+1
	    IF(ILINE.GT.20)THEN
		ILINE=6
		ICOLUMN=41
	      ELSE
	    ENDIF
		CALL LIB$SET_CURSOR(ILINE,ICOLUMN)
		TYPE 1100,HD(J),SCORE(I,J),CODE(I,J),SM(J),WT(J)
	ENDDO
C*
 700	CALL REVERSE
	CALL LIB$PUT_SCREEN('Do you want to change any score ?',23,1)
	CALL RESET
	CALL LIB$SET_CURSOR(23,35)
	ACCEPT 910,ANSW
	IF(ANSW.EQ.'Y')THEN
C*
 701	CALL LIB$ERASE_LINE(23,1)
	CALL REVERSE
	CALL LIB$PUT_SCREEN('Enter the label of score :',23,1)
	CALL RESET
	CALL LIB$SET_CURSOR(23,33)
	ACCEPT 900,TEMP
	ICOL=2
	DO IJ=1,M
	   ILINE=5+IJ
	   IF(TEMP.EQ.HD(IJ))THEN
 702	      CALL LIB$ERASE_LINE(23,1)
	      CALL REVERSE
	      IF(SCORE(I,IJ).GT.SM(IJ))GOTO 703
		IF(ILINE.GT.20)THEN
			ILINE=ILINE-15
			ICOL=41
		   ELSE
		ENDIF
	      CALL LIB$SET_CURSOR(ILINE,ICOL)
	      TYPE 1100,HD(IJ),SCORE(I,IJ),CODE(I,IJ),SM(IJ),WT(IJ)
 703	      CALL LIB$PUT_SCREEN
	1        ('Enter revised score - max. possible =',23,1)
	      CALL LIB$SET_CURSOR(23,40)
	      TYPE 1105,SM(IJ)
	      CALL RESET
	      CALL LIB$SET_CURSOR(23,50)
	      READ(5,*,ERR=702)SCORE(I,IJ)
	      IF(SCORE(I,IJ).GT.SM(IJ))GOTO 702
	      CALL LIB$SET_CURSOR(ILINE,ICOL)
	      TYPE 1100,HD(IJ),SCORE(I,IJ),CODE(I,IJ),SM(IJ),WT(IJ)
	      CALL LIB$ERASE_LINE(23,1)
	      GOTO 700
 	     ELSE
          ENDIF
	ENDDO
	GOTO 701
C*
	   ELSE
	ENDIF
C*
 750	CALL LIB$ERASE_LINE(23,1)
	CALL REVERSE
	CALL LIB$PUT_SCREEN('Do you want to display another student ?',23,1)
	CALL RESET
	CALL LIB$SET_CURSOR(23,50)
	ACCEPT 910,ANSW
	IF (ANSW.EQ.'Y')THEN
		CALL LIB$ERASE_PAGE(1,1)
		GOTO 400
	   ELSE
		CALL LIB$ERASE_PAGE(1,1)
	ENDIF
	GOTO 210
c===
c===	add drop code to the name
c===
2000	type *,'What is the NAME of the student'
	ik=1
	call search(name,n,i,ipik,ik,IFAIL)
	IF ( IFAIL .EQ. 1 ) GO TO 210
	if (dcode(i).eq.'*')then
		type *, 'This name already has DROP-OUT tag.'
           else
		dcode(i)='*'
		ndrop = ndrop + 1
		nact = n - ndrop
	type *, 'The following name has been included in drop-outs.'
	TYPE *,'      ', NAME(I)
	TYPE *,' '
	TYPE *, 'Although the grades for this student will be kept,'
	type *, 'they will be IGNORED in computation of averages.'
	type 1000, nact, ndrop, n
	endif
	goto 210
C*
C--------------------------FORMATS--------------------------------------
C*
 900	FORMAT( A80 )
 901	FORMAT( A15 )
 910	FORMAT( A1 )
 914	FORMAT( 1X, A15, T18, 14(4X,L1,3X), 2(/1X,T20,14(4X,L1,3X)))
 915	FORMAT( 1X, A15, T18, 14(1X,A7), 2( / 1X, T20, 14(1X,A7) ) )
 920	FORMAT( 1X, 'Enter NAME No.', I4, '   >>> ', $ )
 925	FORMAT( 1X, 1( A15, I3, 4X ), A15, L2 )
 930	FORMAT( 1X, 2( A20 ) )
 935	FORMAT( 1X, A )
 940	FORMAT( 1X, 11(A2,5X))
 945	FORMAT( 1X, 11( F6.1, 1X ) )
 949    format( 1x, 131('-'))
 950	FORMAT( 1X, A15, A1,T18, 14(F7.2,A1), 2(/ 1X, T20, 14(F7.2,A1) ) )
 951	FORMAT( 1X, A15,    T18,    F7.2   )
 955	FORMAT( 1X, 3X, A12, 2( T20, 14(F7.2,A1) / 1X ) )
 960	FORMAT( 1X, 'For set:', I2, ' ... enter ')
 965	FORMAT(1X,'(1) A 7-character LABEL   (e.g.  H.W.012 )   >>>', $)
 970	FORMAT(1X,'(2) The MAX. POSSIBLE SCORE    (e.g. 100.)   >>>', $)
 975	FORMAT(1X,'(3) The PERCENTAGE of the GRADE (e.g. 25.)   >>>', $)
 980	FORMAT(1X,'(4) Do you want a CODE-SYMBOL?    (Y or N)   >>>', $)
 985	FORMAT(1X,'FOR: ',A7,'  (MAX.POSSIBLE SCORE=', F6.1,')  >>>', $)
 990	FORMAT(1X,'Enter the CODE-SYMBOL    >>> ', $)
 995	FORMAT(1X,'Enter the MINIMUM PERCENTAGE for an: ',A2,'.  >>>',$)
C*
1000	FORMAT(1X,'CURRENT NUMBER OF STUDENTS:'/,1X,T12,'ACTIVE =',
	1 T21,I3/1X,T12,'DROPPED=',T21,I3/1X,T12,'TOTAL  =',T21,I3)
1010	FORMAT(1X,T21,I3)
C*
1100	FORMAT(1H+,1X,A,T10,F5.1,T18,A,T22,F5.1,T30,F5.1$)
1105	FORMAT(1H+,F5.1,$)
C*
C-----------------------------------------------------------------------
C*
 999	CONTINUE
C*
C-----------------------------------------------------------------------
C*
	CALL EXIT
	END
C*
C-------------------CHARACTER STRING COUNTER----------------------------
C*
	INTEGER FUNCTION KOUNT( STRING )
	CHARACTER STRING*15, BLANK*1
	DATA BLANK /' '/
	KOUNT = 15
	DO  10  I = 15,1,-1
	IF ( STRING(I:I) .NE. BLANK ) GO TO  20
  10	KOUNT = I - 1
  20	RETURN
	END
C*
C--------------------STRING SEARCHING ROUTINE---------------------------
C*
	SUBROUTINE SEARCH( ARRY, NC, I, IPIK, IK , IFAIL )
	DIMENSION IPIK(*)
	CHARACTER ARRY(*)*(*), TEMP*15
C*
	IF ( NC .LT. 1 ) GO TO 100
	IFAIL= 0
	ILIM = 0
  10	TYPE *,'Enter the string to be found.'
	TYPE *,'  (e.g. XYZ )'
	ACCEPT 900, TEMP
	IF ( TEMP .LT. 'ZZ' .AND. TEMP .NE. ' ' ) GO TO 15
	TYPE *,'Do you want to stop searching ?'
  12	TYPE *,'  ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'N' .AND. ANSW .NE. 'Y' ) GO TO 12
	IF ( ANSW .EQ. 'Y' ) GO TO 100
  15	NN = KOUNT( TEMP )
	DO  50  I = 1,NC
	IF ( ARRY(I)(:NN) .NE. TEMP(:NN) ) GO TO 50
	IF ( IK .LT. 2 ) GO TO 30
	DO  20  II = 1, IK-1
	IF ( IPIK(II) .EQ. I ) GO TO 50
  20	CONTINUE
  30	TYPE *,'How about: ', ARRY(I),' ?'
  40	TYPE *,' ( Y or N )'
	ACCEPT 910, ANSW
	IF ( ANSW .NE. 'N' .AND. ANSW .NE. 'Y' ) GO TO 40
	IF ( ANSW .EQ. 'Y' ) RETURN
  50	CONTINUE
	TYPE *,'NO MATCH FOUND ...'
	TYPE *,'Do you want to:'
	TYPE *,'  A. See the range of possibilities .'
	TYPE *,'  B. Try again.'
	TYPE *,'  C. Consider other options.'
  60	TYPE *,'    ( Select A or B or C )'
	ACCEPT 910, ANSW
	TYPE *,' '
	IF ( ANSW.NE.'A' .AND. ANSW.NE.'B' .AND. ANSW.NE.'C' ) GO TO 60
	IF ( ANSW .EQ. 'A' ) GO TO 65
	IF ( ANSW .EQ. 'B' ) GO TO 10
	GO TO 100
  65	TYPE *,'The range of possibilities is:'
	TYPE *,' '
	DO  90  II = 1, NC
	IF ( IK .LT. 2 ) GO TO 80
	DO  70  IJ = 1,IK-1
	IF ( IPIK(IJ) .EQ. II ) GO TO 90
  70	CONTINUE
  80	TYPE *, ARRY(II)
  90	CONTINUE
	TYPE *,' '
	GO TO 10
 100	IFAIL = 1
	TYPE *,' ..... Searching has stopped.'
	TYPE *,' '
	RETURN
 900	FORMAT( A15 )
 910	FORMAT( A1 )
	END
C*
C----------------SUBROUTINE TO SET VT100 SCREEN TO REVERSE VIDEO---------
C*
	SUBROUTINE REVERSE
	CHARACTER*4 REVERSE_VIDEO
	PARAMETER (REVERSE_VIDEO=CHAR(27)//CHAR(91)//CHAR(55)//CHAR(109))
	CALL LIB$PUT_OUTPUT(REVERSE_VIDEO)
	RETURN
	END
C*
C-----------------SUBROUTINE TO SET VT100 SCREEN TO NORMAL VIDEO---------
C*
	SUBROUTINE RESET
	CHARACTER*4 RESET_VIDEO
	PARAMETER (RESET_VIDEO=CHAR(27)//CHAR(91)//CHAR(48)//CHAR(109))
	CALL LIB$PUT_OUTPUT(RESET_VIDEO)
	RETURN
	END