C ALGORITHM 606, COLLECTED ALGORITHMS FROM ACM. C ALGORITHM APPEARED IN ACM-TRANS. MATH. SOFTWARE, VOL.9, NO. 4, C DEC., 1983, P. 418-426. C***********************************************************************MAN 1 C *MAN 2 C THIS IS PROGRAM NITDRV FROM NITPACK *MAN 3 C *MAN 4 C BY *MAN 5 C *MAN 6 C P.W.GAFFNEY *MAN 7 C J.W.WOOTEN *MAN 8 C K.A.KESSEL *MAN 9 C W.R.MCKINNEY *MAN 10 C *MAN 11 C *MAN 12 C VERSION: TRANSPORTABLE...JUNE 3, 1983 *MAN 13 C *MAN 14 C PURPOSE: *MAN 15 C *MAN 16 C NITDRV IS THE DRIVER PROGRAM FOR SUBROUTINE NIT. *MAN 17 C *MAN 18 C***********************************************************************MAN 19 C *MAN 20 C ** USE OF NIT ** *MAN 21 C *MAN 22 C IT IS EXPECTED THAT NIT WILL BE RUN INTERACTIVELY. FOR *MAN 23 C THIS, UNITS 5 AND 6 SHOULD BE ABLE TO COMMUNICATE WITH THE USER'S *MAN 24 C TERMINAL IN THE FOLLOWING WAY: *MAN 25 C *MAN 26 C FILE 5 - TO READ RESPONSES FROM THE TERMINAL. *MAN 27 C *MAN 28 C FILE 6 - TO WRITE OUTPUT TO THE TERMINAL. *MAN 29 C *MAN 30 C***********************************************************************MAN 31 C *MAN 32 C ** INPUT FOR NIT ** *MAN 33 C *MAN 34 C BEFORE EXECUTION OF NITDRV AND NIT, THE FOLLOWING FILES *MAN 35 C MUST EXIST: *MAN 36 C *MAN 37 C FILE 1 - EXISTING INTERNAL TEXT FILE. *MAN 38 C *MAN 39 C FILE 3 - EXISTING EXTERNAL TEXT FILE. *MAN 40 C *MAN 41 C***********************************************************************MAN 42 C *MAN 43 C ** OUTPUT FROM NIT ** *MAN 44 C *MAN 45 C OUTPUT FROM NIT WILL BE TO THE FOLLOWING FILES: *MAN 46 C *MAN 47 C FILE 6 - ALL OUTPUT MESSAGES FROM NIT, INCLUDING ERROR MESSAGES. *MAN 48 C *MAN 49 C FILE 11 - LOG FILE OF USER REQUESTS FOR HELP. *MAN 50 C *MAN 51 C FILE 12 - SUGGESTIONS OFFERED BY USERS OF NIT. *MAN 52 C *MAN 53 C *MAN 54 C***********************************************************************MAN 55 C *MAN 56 C ** CALLING SEQUENCE FOR SUBROUTINE NIT ** *MAN 57 C *MAN 58 C CALL NIT(IMODE, IFAULT) *MAN 59 C *MAN 60 C *MAN 61 C ** PARAMETER LIST FOR SUBROUTINE NIT ** *MAN 62 C *MAN 63 C *MAN 64 C INPUT PARAMETERS: *MAN 65 C *MAN 66 C IMODE - IS AN INTEGER SET ON ENTRY TO NIT ACCORDING TO *MAN 67 C THE FOLLOWING: *MAN 68 C *MAN 69 C IMODE = 1 THIS IS THE FIRST TIME NIT IS BEING CALLED, *MAN 70 C OR THE DATA FILES HAVE BEEN MODIFIED OR CHANGED *MAN 71 C SINCE THE LAST CALL TO NIT. *MAN 72 C *MAN 73 C IMODE.GT.1 ON SUBSEQUENT CALLS TO NIT IF THE *MAN 74 C SAME TREES ARE USED. *MAN 75 C *MAN 76 C IMODE IS LEFT UNCHANGED ON EXIT. MAN 77 C *MAN 78 C OUTPUT PARAMETERS: *MAN 79 C *MAN 80 C IFAULT - IS AN INTEGER SET TO ONE OF THE *MAN 81 C FOLLOWING VALUES ON EXIT: *MAN 82 C *MAN 83 C IFAULT = 0 EXECUTION NORMAL, NO ERRORS ENCOUNTERED. *MAN 84 C *MAN 85 C IFAULT = 1 EXECUTION ABNORMAL, ERRORS ENCOUNTERED. *MAN 86 C FOR MORE INFORMATION EXAMINE THE ERROR *MAN 87 C MESSAGES WRITTEN TO UNIT 6. *MAN 88 C *MAN 89 C *MAN 90 C***********************************************************************MAN 91 C *MAN 92 C *MAN 93 C ** BEGIN EXECUTABLE STATEMENTS FOR NITDRV ** *MAN 94 C *MAN 95 INTEGER IMODE, IFAULT MAN 96 C MAN 97 C SET IMODE TO 1 FOR THE MAN 98 C FIRST CALL TO NIT MAN 99 C MAN 100 IMODE = 1 MAN 101 C MAN 102 C MAKE CALL TO SUBROUTINE NIT MAN 103 C MAN 104 CALL NIT(IMODE, IFAULT) MAN 105 C MAN 106 C CHECK FOR ERRORS ENCOUNTERED MAN 107 C AND WRITE OUT NORMAL OR MAN 108 C ABNORMAL EXECUTION MESSAGE MAN 109 C MAN 110 IF (IFAULT.EQ.0) WRITE (6,99999) MAN 111 IF (IFAULT.EQ.1) WRITE (6,99998) MAN 112 C MAN 113 C END OF NITDRV MAN 114 C MAN 115 STOP MAN 116 99999 FORMAT (/44H NIT EXECUTION NORMAL, NO ERRORS ENCOUNTERED) MAN 117 99998 FORMAT (/43H NIT EXECUTION ABNORMAL, ERRORS ENCOUNTERED) MAN 118 END MAN 119 C NIT 1 C-----------------------------------------------------------------------NIT 2 C NIT 3 SUBROUTINE NIT(IMODE, IFAULT) NIT 4 C C*********************************************************************** C * C THIS IS SUBROUTINE NIT FROM NITPACK * C * C BY * C * C P.W.GAFFNEY * C J.W.WOOTEN * C K.A.KESSEL * C W.R.MCKINNEY * C * C * C VERSION: TRANSPORTABLE...JUNE 3, 1983 * C * C PURPOSE: * C * C NIT PERFORMS THE INTERACTIVE FUNCTION OF NITPACK. * C SPECIFICALLY NIT USES THE OUTPUT FROM NITREE TO * C DISPLAY THE QUESTIONS AND POSSIBLE RESPONSES THAT * C ARE AVAILABLE TO A USER DURING A NIT SESSION. * C * C * C*********************************************************************** C * C **** QUALITY ASSURANCE AND SOFTWARE STANDARD **** * C * C THE SUBROUTINES THAT COMPRISE NIT * C HAVE BEEN WRITTEN TO CONFORM TO THE FORTRAN IV * C ANSI STANDARD 1966, AND THEY HAVE BEEN VERIFIED * C USING THE BELL TELEPHONE LABORATORIES FORTRAN * C VERIFIER: PFORT. * C THE SUBROUTINES HAVE BEEN EXTENSIVELY TESTED ON * C A VARIETY OF TESTS AND TREES, AND THEY HAVE BEEN * C ANALYSED FOR ERRORS USING THE DAVE SYSTEM FROM * C THE UNIVERSITY OF COLORADO. * C TO MAKE THE CODE EASY TO READ THE SUBROUTINES * C HAVE BEEN REFORMATTED USING POLISH. * C * C*********************************************************************** C * C ** CALLING SEQUENCE FOR SUBROUTINE NIT ** * C * C CALL NIT(IMODE, IFAULT) * C * C * C ** PARAMETER LIST FOR SUBROUTINE NIT ** * C * C * C INPUT PARAMETERS: * C * C IMODE - IS AN INTEGER SET ON ENTRY TO NIT ACCORDING TO * C THE FOLLOWING: * C * C IMODE = 1 MEANS THAT THIS IS THE FIRST CALL TO NIT * C OR THAT THE TREE FILES HAVE BEEN MODIFIED * C SINCE THE LAST CALL TO NIT. * C * C IMODE.GT.1 ON SUBSEQUENT CALLS TO NIT WITH THE * C SAME TREE FILES. * C * C IMODE IS LEFT UNCHANGED ON EXIT. C * C OUTPUT PARAMETERS: * C * C IFAULT - IS AN INTEGER SET TO ONE OF THE * C FOLLOWING VALUES ON EXIT: * C * C IFAULT = 0 EXECUTION NORMAL, NO ERRORS ENCOUNTERED. * C * C IFAULT = 1 EXECUTION ABNORMAL, ERRORS ENCOUNTERED. * C FOR MORE INFORMATION EXAMINE THE ERROR * C MESSAGES WRITTEN TO UNIT 6. * C * C * C*********************************************************************** C * C ** USE OF NIT ** * C * C IT IS EXPECTED THAT NIT WILL BE RUN INTERACTIVELY. FOR * C THIS REASON UNITS 5 AND 6 SHOULD BE ABLE TO COMMUNICATE WITH * C THE TERMINAL IN THE FOLLOWING WAY: * C * C FILE 5 - TO READ RESPONSES FROM THE TERMINAL. * C * C FILE 6 - TO WRITE OUTPUT TO THE TERMINAL. * C * C*********************************************************************** C * C ** NIT INPUT AND OUTPUT ** * C * C ALL OF THE INPUT AND OUTPUT FOR NIT IS PERFORMED IN * C SUBROUTINE NITIO. EACH CALL TO NITIO IS NUMBERED AND * C GOES TO A DIFFERENT STATEMENT IN NITIO. THIS DEVICE * C IS USEFUL FOR MODIFYING AND MONITORING THE INPUT AND * C OUTPUT IN DIFFERENT APPLICATIONS OF NIT. * C * C * C ** CALLING SEQUENCE FOR NITIO ** * C * C CALL NITIO(ARRAY, LEN, FILE, XCALL, NUM) * C * C * C ** PARAMETER LIST FOR NITIO ** * C * C ALL PARAMETERS ARE OF TYPE INTEGER. * C * C ARRAY - AN INTEGER ARRAY OF LENGTH LEN WHICH MAY EITHER BE * C READ IN OR WRITTEN OUT DEPENDING ON THE VALUE OF * C XCALL. * C * C LEN - DIMENSION OF THE VARIABLE ARRAY. * C * C FILE - THE UNIT NUMBER OF THE FILE FOR INPUT AND OUTPUT. * C TO SUPPRESS INPUT/OUTPUT SET FILE TO A VALUE LESS * C THAN OR EQUAL TO ZERO ON ENTRY. * C * C XCALL - THE VARIABLE WHICH DETERMINES THE PARTICULAR * C INPUT OR OUTPUT STATEMENTS TO BE EXECUTED. * C * C NUM - AN INTEGER VARIABLE WHICH MAY ALSO BE OUTPUT IN * C NITIO IF XCALL IS EITHER EQUAL TO 8 OR 36. * C * C * C THE CODE FOR ALL INPUT TO AND OUTPUT FROM THE TERMINAL IS * C OF THE FORM: * C * C CALL NITIO(ARRAY, LEN, ZZZ, XCALL, NUM) * C CALL NITIO(ARRAY, LEN, LFILE, XCALL, NUM) * C * C WHERE ZZZ IS EITHER EQUAL TO TTY FOR INPUT OR TTYO FOR OUTPUT * C AND LFILE IS THE UNIT NUMBER FOR THE FILE WHICH CONTAINS ALL * C THE TEXT THAT IS DISPLAYED ON THE TERMINAL BY NIT AND THE USER * C DURING A NIT SESSION. * C * C*********************************************************************** C * C ** PROMPTING IN NIT ** * C * C THE PROMPTING IN NIT IS ACCOMPLISHED BY NIT DISPLAYING A * C MENU-TYPE SELECTION. A QUESTION IS DISPLAYED FOLLOWED BY * C POSSIBLE ANSWERS IN PARENTHESES AND THE TEXT ASSOCIATED * C WITH EACH ANSWER. * C * C IN ADDITION TO THE POSSIBLE RESPONSES DISPLAYED ON THE * C TERMINAL, THE USER MAY ALSO PROVIDE ONE OF THE FOLLOWING * C EIGHT IMPLICIT RESPONSES: * C * C B FOR BEGINNING A NIT SESSION AGAIN * C P FOR MOVING TO THE PREVIOUS QUESTION * C Q FOR QUITTING A NIT SESSION IMMEDIATELY * C H OR ? FOR HELP * C S FOR MAKING SUGGESTIONS * C J FOR A DYNAMIC GOTO * C N TO SEE THIS MESSAGE * C * C * C*********************************************************************** C * C ** EXTERNAL TEXT ** * C * C IF THE EXTERNAL TEXT FILE FACILITY WAS USED TO STORE LONG * C TEXT, THEN THERE ARE TWO FURTHER IMPLICIT RESPONSES THAT THE * C USER MAY MAKE. THESE ARE: * C * C C FOR CONTINUING TO THE NEXT PAGE OF TEXT * C AND L FOR MOVING DIRECTLY TO THE LAST PAGE OF TEXT * C * C A TYPICAL SCREEN DISPLAY IN THIS SITUATION WILL CONSIST OF * C A PAGE OF TEXT AND THEN TWO LINES OF THE FOLLOWING FORM: * C * C ** THE LAST LINE DISPLAYED IS LINE NUMBER XX ** * C ** PRESS C TO CONTINUE, OR L TO JUMP TO THE LAST PAGE ** * C * C WHERE XX IS THE NUMBER OF THE LINE OF EXTERNAL TEXT THAT * C WAS LAST DISPLAYED ON THE TERMINAL. * C * C AT THIS POINT, A USER MAY ANSWER WITH ANY OF THE IMPLICIT * C RESPONSES OR A POSITIVE INTEGER INDICATING THE LINE NUMBER * C OF TEXT THAT IS TO APPEAR FIRST ON THE NEXT PAGE. * C * C * C*********************************************************************** C * C MAIN VARIABLES USED IN NIT: * C * C AREA - IS AN ARRAY OF LENGTH MXAREA. IT IS USED TO * C HOLD BOTH THE SELECTED TREE AND THE * C ASSOCIATED TEXT. * C * C DIGITS - IS AN ARRAY OF LENGTH 10 USED TO HOLD THE * C CHARACTER VALUES OF THE DIGITS. * C * C HDSIZE - IS AN ARRAY OF LENGTH NOTREE. IT IS USED TO * C STORE THE LENGTHS OF THE HEADERS. * C * C HEADER - IS A TWO DIMENSIONAL ARRAY WHOSE FIRST DIMENSION * C IS 80 AND WHOSE SECOND DIMENSION IS NOTREE. * C HEADER IS USED TO HOLD THE NAMES THAT APPEAR ON * C THE TREE CARDS. * C * C IDIM - IS A VARIABLE SET TO THE LENGTH OF THE * C ARRAY IOPT. * C IT IS DEFAULTED TO THE VALUE OF 200. * C * C IOPT - IS AN ARRAY OF LENGTH IDIM AND PROVIDES * C FOR A LARGE INTERFACE BETWEEN NIT AND THE * C EXTERNAL SUBROUTINE. * C * C LASTSZ - IS A VARIABLE SET TO THE NUMBER OF LINES THAT * C DETERMINES WHETHER OR NOT THE LAST PAGE OF TEXT * C WILL ACTUALLY BE CONSIDERED A PAGE. IF THE NUMBER * C OF LINES IS GREATER THAN LASTSZ, THEN A PAUSE IS * C GIVEN AT THE END OF THE TEXT. IF THE NUMBER OF * C LINES IS LESS THAN OR EQUAL TO LASTSZ, THEN NO * C PAUSE WILL BE ISSUED AT THE END OF THE TEXT. * C IT IS DEFAULTED TO THE VALUE 5. * C * C MXAREA - IS A VARIABLE SET TO THE LENGTH OF THE ARRAY * C AREA. * C IT IS DEFAULTED TO THE VALUE 16000. * C * C MXSPNS - IS A VARIABLE SET TO THE LENGTH OF THE ARRAY * C RESPNS. ITS VALUE SHOULD BE GREATER THAN OR EQUAL * C TO ( MXAREA / 24 ) + (THE MAXIMUM NUMBER OF JUMPS * C A USER IS EXPECTED TO MAKE) TO INSURE ENOUGH STORAGE * C FOR THE ARRAY RESPNS. * C IT IS DEFAULTED TO THE VALUE 800. * C * C MWAY - IS A VARIABLE WHICH IS SET TO THE MAXIMUM * C NUMBER OF BRANCHES THAT EMANATE FROM A BOX * C OF THE TREE. * C IT IS DEFAULTED TO THE VALUE 40. * C * C NOTP1 - IS A VARIABLE WHICH IS SET TO THE VALUE OF NOTREE+1. * C IT IS DEFAULTED TO THE VALUE 26. * C * C NOTREE - IS A VARIABLE SET TO THE NUMBER OF TREES. * C IT IS DEFAULTED TO THE VALUE 25. * C * C OFFSET - IS AN ARRAY OF LENGTH NOTP1. IT IS USED TO HOLD * C THE ABSOLUTE OFFSETS TO ALL THE TREES. * C * C PAGESZ - THE MAXIMUM NUMBER OF LINES OF EXTERNAL * C TEXT WHICH MAY BE DISPLAYED ON THE TTY * C BEFORE A PROMPT IS ISSUED. IT PREVENTS * C TEXT FROM GOING OFF THE SCREEN TOO FAST * C AND ALSO LETS THE USER LOOK AT ONLY A * C PART OF THE EXTERNAL TEXT IF HE WISHES. * C IT IS DEFAULTED TO THE VALUE OF 20. * C * C RESPNS - IS AN ARRAY OF LENGTH MXSPNS. IT IS USED TO * C STORE THE PATH TRAVERSED DOWN A TREE. RESPNS * C IS USED WHEN MOVING TO A PREVIOUS QUESTION. * C * C TRTBL - IS AN ARRAY SET OF LENGTH MWAY. IT IS * C USED TO HOLD THE POSSIBLE ANSWERS TO A QUESTION. * C * C * C ALL OF THE VARIABLES USED IN NIT ARE OF TYPE * C INTEGER UNLESS OTHERWISE SPECIFIED. * C * C * C*********************************************************************** C * C SUBROUTINES CALLED: * C * C EOLINE - FUNCTION TO RETURN THE POSITION OF THE * C LAST NON-BLANK CHARACTER IN AN ARRAY. * C * C HLPLOG - SUBROUTINE WHICH LOGS A USER'S REQUEST * C FOR HELP AND WHETHER OR NOT HELP WAS * C AVAILABLE. * C * C NITIO - PERFORMS ALL OF THE INPUT AND OUTPUT * C OPERATIONS FOR NIT. * C * C OUTHLP - THIS ROUTINE IS CALLED WHENEVER HELP IS * C REQUESTED OR A SUGGESTION IS MADE. THE * C PURPOSE OF THE ROUTINE IS TO ALLOW THE * C IMPLEMENTOR OF NIT TO RECORD SPECIFIC * C INFORMATION IN THE ASSOCIATED LOG FILES. * C FOR EXAMPLE, IT MAY BE USEFUL TO RECORD * C THE DATE, TIME, AND USER'S IDENTIFICATION * C IN THESE FILES. THE OUTPUT FROM OUTHLP IS * C PLACED IN THE APPROPRIATE LOG FILES. BECAUSE * C THIS ROUTINE WILL USUALLY BE SYSTEM DEPENDENT, * C WE HAVE INCLUDED ONLY A DUMMY SUBROUTINE FOR * C COMPLETENESS. * C * C OUTSID - THE SUBROUTINE WHICH PROVIDES A FORTRAN * C INTERFACE TO OTHER SOFTWARE. SINCE THIS * C INTERFACE IS AT THE DISPOSAL OF THE USER * C WE HAVE PROVIDED A DUMMY SUBROUTINE FOR * C COMPLETENESS. * C * C POINTX - SUBROUTINE TO POINT TO THE TREE CARD OF THE * C TREE SELECTED IN THE EXTERNAL TEXT FILE. * C * C PROMPT - PROMPTS THE USER WITH QUESTIONS AND POSSIBLE * C RESPONSES. * C * C SETHFL - SUBROUTINE USED TO RESET THE VALUE OF HFILE, * C THE FILE USED TO LOG USER REQUESTS FOR HELP. * C * C SETLFL - SUBROUTINE USED TO RESET THE VALUE OF LFILE, * C THE FILE USED TO MAKE A COPY OF ALL OF THE * C TERMINAL INPUT AND OUTPUT OF NIT. * C * C SETLSZ - SUBROUTINE USED TO RESET THE VALUE OF LASTSZ, * C THE VALUE USED TO CHECK IF A PAUSE IS ISSUED * C AT THE END OF EXTERNAL TEXT. * C * C SETPSZ - SUBROUTINE USED TO RESET THE VALUE OF PAGESZ, * C THE VALUE USED TO DETERMINE THE NUMBER OF LINES * C USED FOR A PAGE OF EXTERNAL TEXT. * C * C SETSFL - SUBROUTINE USED TO RESET THE VALUE OF SFILE, * C THE FILE USED TO STORE USER SUGGESTIONS. * C * C SETTY - SUBROUTINE USED TO RESET THE VALUE OF TTY, * C THE FILE USED FOR THE USER INPUT IN NIT. * C * C SETTYO - SUBROUTINE USED TO RESET THE VALUE OF TTYO, * C THE FILE USED FOR THE OUTPUT FROM * C NIT EXCEPT FOR ERROR MESSAGES. * C * C STRIPR - TO IDENTIFY ANY LEADING ELEMENTS OF AN ARRAY * C WHICH MAY CORRESPOND TO NUMERICAL CHARACTERS, * C AND CONVERT ANY THAT ARE FOUND INTO AN INTEGER. * C * C SUGGST - SUBROUTINE TO WRITE TO A FILE SUGGESTIONS * C MADE BY A USER. * C * C XTEXT - CALLED TO PRINT OUT A MESSAGE OF EXTERNAL * C TEXT TO THE TERMINAL. * C * C * C THESE SUBROUTINES ARE ARRANGED IN ALPHABETICAL * C ORDER FOLLOWING SUBROUTINE NIT. * C * C * C*********************************************************************** C * C ** COMMUNICATION WITH THE EXTERNAL SUBROUTINE OUTSID ** * C * C IN ORDER TO INSURE THAT OUTSID HAS ACCESS TO ANY VARIABLES * C WHICH IT MIGHT NEED, WE HAVE CREATED THE ARRAY IOPT. IOPT * C CONTAINS THE VALUES OF MOST OF THE VARIABLES USED IN NIT. * C WITH IOPT, THE INTERFACE BETWEEN NIT AND OUTSID IS KEPT * C RELATIVELY SIMPLE WHILE AT THE SAME TIME IT PROVIDES * C MAXIMUM FLEXIBILITY. * C THE VALUES IN THE IOPT ARRAY ARE AS FOLLOWS: * C * C * C ** VALUES OF IOPT OUTPUT FROM OUTSID ** * C * C IOPT(1) - ERROR FLAG. ON RETURN FROM OUTSID THIS VARIABLE * C SHOULD BE SET TO 0 IF NO ERRORS WERE ENCOUNTERED * C OR SET TO 1 IF AN ERROR WAS ENCOUNTERED. IF IT * C IS SET TO 1, NIT THEN RETURNS WITH IFAULT = 1. * C * C IOPT(2) - FLAG FOR A MNEMONIC COMMAND OR A CHANGE IN THE * C PATH OF THE TREE. IT CAN HAVE THE FOLLOWING * C VALUES: * C IOPT(2) = 0 CONTINUE AS USUAL * C IOPT(2) = 1 MEANS BEGIN THE NIT * C SESSION AGAIN * C IOPT(2) = 2 MEANS QUITTING THE NIT * C SESSION IMMEDIATELY, * C NIT RETURNS WITH * C IFAULT = 0. * C IOPT(2) = 3 (RESERVED FOR GRANIT) * C IOPT(2) = 4 ON EXIT FROM OUTSID THE FLOW * C OF EXECUTION IN NIT IS DETERMINED * C ACCORDING TO THE VALUE OF IOPT(3). * C * C IOPT(3) - FLAG TO DETERMINE WHICH BOX IS TO BE ENTERED * C NEXT. THE NEXT BOX WILL BE DETERMINED BY ONE * C OF THE FOLLOWING: * C IOPT(3).LT.0 MEANS 'BACK UP' THE TREE. * C THE ABSOLUTE VALUE OF IOPT(3) * C DETERMINES THE NUMBER OF LEVELS * C RETRACED. * C IOPT(3).GE.0 MEANS CONTROL IS PASSED TO THE * C BOX WHOSE NUMBER IS THE VALUE OF * C IOPT(3). * C * C NOTE: IF IOPT(2) DOES NOT EQUAL 4 THEN THE * C VALUE IN IOPT(3) IS IGNORED. * C * C IOPT(4) - FLAG WHICH MEANS THAT THE VALUES IN THE IOPT * C ARRAY FROM IOPT(5) THROUGH IOPT(10) HAVE BEEN * C CHANGED. * C * C * C VARIABLES WHICH MAY BE CHANGED IN OUTSID * C * C IOPT(5) = PAGESZ NUMBER OF LINES USED AS A PAGE * C FOR PRINTING EXTERNAL TEXT * C THE DEFAULT VALUE FOR PAGESZ IS 20. * C IOPT(6) = LASTSZ NUMBER OF LINES USED TO CHECK IF * C THE LAST PAGE OF EXTERNAL TEXT IS * C LONG ENOUGH TO HAVE A PAUSE * C THE DEFAULT VALUE FOR LASTSZ IS 5. * C IOPT(7) = TTY UNIT NUMBER TO READ FROM THE TERMINAL * C THE DEFAULT VALUE FOR TTY IS 5. * C IOPT(8) = TTYO UNIT NUMBER TO WRITE TO THE TERMINAL * C THE DEFAULT VALUE FOR TTYO IS 6. * C IOPT(9) = HFILE UNIT NUMBER FOR THE FILE WHICH CONTAINS * C HELP MONITORING INFORMATION * C THE DEFAULT VALUE FOR HFILE IS 11. * C IOPT(10) = SFILE UNIT NUMBER FOR THE FILE WHICH CONTAINS * C SUGGESTIONS * C THE DEFAULT VALUE FOR SFILE IS 12. * C IOPT(11) = LFILE UNIT NUMBER FOR THE FILE WHICH CONTAINS * C ALL THE TEXT DISPLAYED ON THE TERMINAL BY * C NIT AND THE USER DURING A NIT SESSION * C THE DEFAULT VALUE FOR LFILE IS 0. * C * C * C IOPT(12) THROUGH IOPT(20) ARE RESERVED FOR THE EXPERT'S USE. * C * C * C ** VALUES OF IOPT INPUT TO OUTSID ** * C * C * C UNIT NUMBERS IN THE IOPT ARRAY * C * C IOPT = VARIABLE MEANING * C IOPT(21) = IN UNIT NUMBER OF THE INTERNAL TEXT FILE * C IOPT(22) = XIN UNIT NUMBER OF THE EXTERNAL TEXT FILE * C IOPT(23) = NOUT UNIT NUMBER TO WRITE OUT ERROR MESSAGES * C * C * C UPPER CASE RESPONSES IN THE IOPT ARRAY * C * C IOPT = VARIABLE MEANING * C IOPT(31) = B UPPER CASE RESPONSE TO BEGIN AGAIN * C IOPT(32) = C UPPER CASE RESPONSE TO CONTINUE TO * C TO THE NEXT PAGE OF EXTERNAL TEXT * C IOPT(33) = H UPPER CASE RESPONSE TO REQUEST HELP * C IOPT(34) = L UPPER CASE RESPONSE TO MOVE TO THE * C LAST PAGE OF EXTERNAL TEXT * C IOPT(35) = N UPPER CASE RESPONSE TO GET A LIST OF * C VALID RESPONSES * C IOPT(36) = P UPPER CASE RESPONSE TO MOVE TO THE * C PREVIOUS QUESTION * C IOPT(37) = Q UPPER CASE RESPONSE TO QUIT * C IOPT(38) = S UPPER CASE RESPONSE TO MAKE A SUGGESTION * C IOPT(39) = JJ UPPER CASE RESPONSE TO TO JUMP TO * C ANOTHER BOX * C * C * C LOWER CASE RESPONSES IN THE IOPT ARRAY * C * C IOPT = VARIABLE MEANING * C IOPT(51) = LB LOWER CASE RESPONSE TO BEGIN AGAIN * C IOPT(52) = LC LOWER CASE RESPONSE TO CONTINUE TO * C TO THE NEXT PAGE OF EXTERNAL TEXT * C IOPT(53) = LH LOWER CASE RESPONSE TO REQUEST HELP * C IOPT(54) = LL LOWER CASE RESPONSE TO MOVE TO THE * C LAST PAGE OF EXTERNAL TEXT * C IOPT(55) = LN LOWER CASE RESPONSE TO GET A LIST OF * C VALID RESPONSES * C IOPT(56) = LP LOWER CASE RESPONSE TO MOVE TO THE * C PREVIOUS QUESTION * C IOPT(57) = LQ LOWER CASE RESPONSE TO QUIT * C IOPT(58) = LS LOWER CASE RESPONSE TO MAKE A SUGGESTION * C IOPT(59) = LJ LOWER CASE RESPONSE TO TO JUMP TO * C ANOTHER BOX * C * C * C CHARACTER DATA IN THE IOPT ARRAY * C * C IOPT = VARIABLE MEANING * C IOPT(71) = TEND CHARACTER REPRESENTATION OF A SLASH * C IOPT(72) = ASTER CHARACTER REPRESENTATION OF A ASTERICK * C IOPT(73) = BLANK CHARACTER REPRESENTATION OF A BLANK * C IOPT(74) = QM CHARACTER REPRESENTATION OF A QUESTION MARK * C IOPT(75) = DASH CHARACTER REPRESENTATION OF A DASH * C IOPT(76) = PLUS CHARACTER REPRESENTATION OF A PLUS * C IOPT(77) = X CHARACTER REPRESENTATION OF A X * C * C * C DEFAULT VALUES IN THE IOPT ARRAY * C * C IOPT = VARIABLE MEANING * C IOPT(81) = NOTREE MAXIMUM NUMBER OF TREES * C IOPT(82) = NOTP1 MAXIMUM NUMBER OF TREES + 1 * C IOPT(83) = MXAREA LENGTH OF THE ARRAY AREA * C IOPT(84) = MWAY MAXIMUM NUMBER OF PATHS THAT CAN * C COME FROM A BOX * C IOPT(85) = MXSPNS LENGTH OF THE ARRAY RESPNS * C IOPT(86) = IDIM LENGTH OF THE ARRAY IOPT * C * C * C CHARACTER VALUES OF THE DIGITS IN THE IOPT ARRAY * C * C IOPT = VARIABLE MEANING * C IOPT(91) = DIGITS(1) CHARACTER REPRESENTATION OF A ZERO * C IOPT(92) = DIGITS(2) CHARACTER REPRESENTATION OF A ONE * C IOPT(93) = DIGITS(3) CHARACTER REPRESENTATION OF A TWO * C IOPT(94) = DIGITS(4) CHARACTER REPRESENTATION OF A THREE * C IOPT(95) = DIGITS(5) CHARACTER REPRESENTATION OF A FOUR * C IOPT(96) = DIGITS(6) CHARACTER REPRESENTATION OF A FIVE * C IOPT(97) = DIGITS(7) CHARACTER REPRESENTATION OF A SIX * C IOPT(98) = DIGITS(8) CHARACTER REPRESENTATION OF A SEVEN * C IOPT(99) = DIGITS(9) CHARACTER REPRESENTATION OF A EIGHT * C IOPT(100) = DIGITS(10) CHARACTER REPRESENTATION OF A NINE * C * C * C KEY VALUES IN THE IOPT ARRAY * C * C IOPT = VARIABLE MEANING * C IOPT(101) = SEL NUMBER OF THE TREE SELECTED * C IOPT(102) = NTREE NUMBER OF ROWS IN THE TREE SELECTED * C (SECOND DIMENSION OF THE ARRAY TREE) * C IOPT(103) = WRDS NUMBER OF WORDS OF INTERNAL TEXT FOR * C THE TREE SELECTED * C (DIMENSION OF THE ARRAY MESSG) * C IOPT(104) = XBOX THE TREE NUMBER OF THE XBOX THAT * C PRODUCED THIS CALL TO OUTSID * C * C * C*********************************************************************** C * C FORMAT OF THE INPUT FILE FOR INTERNAL TEXT: * C * C * C COL. # 1 5 91 5 92 5 93 5 94 ... * C 1) * MATRIX OPERATIONS * C 2) 62 54 125 1 * C 3) 49 -1 0 105 0 1 * C 3 9 0 601 1 2 * C . . . . . . * C . . . . . . * C . . . . . . * C 54 -1 -1 12303 0 104 * C 4) IS A A COMPLEX MATRIX? ... USE F04ADF * C . . . . . . * C . . . . . . * C . . . . . . * C 1) * MESH GENERATORS * C . . . . . . * C . . . . . . * C . . . . . . * C 5) / * C * C EXPLANATIONS: * C * C 1) TREE CARD ... THE NAME OF THE TREE * C * C 2) TOTALS LINE ... THIS LINE CONTAINS FOUR NUMBERS: * C * C I J K L * C * C WHERE I IS ( THE NUMBER OF LINES BETWEEN TWO SUCCESSIVE TREE * C CARDS - 1 ) * C * C J IS ( THE NUMBER OF LINES TO THE FIRST TEXT LINE ) * C * C K IS ((THE NUMBER OF CHARACTERS + PADS) / 4 ) * C * C L IS ( THE RENUMBERED BOX THAT STARTS THE TREE). * C * C 3) TREE LINES ... THESE LINES CONTAIN SIX NUMBERS: * C * C M N P Q R S * C * C WHERE M IS A POSITIVE INTEGER. LINE M IN THIS TABLE POINTS * C TO THE NEXT POSSIBLE ANSWER IN THE MENU, E.G., * C LINE 1 INDICATES THAT THE NEXT ANSWER IS AT * C LINE 49. * C * C N IS AN INTEGER WHICH DETERMINES WHETHER THE PRESENT * C NODE IS A TERMINAL NODE, A QUESTION OR A LINE. * C IF N = -1 AND M = (LINE M) THEN TERMINAL NODE. * C IF N = -1 AND M .NE. (LINE M) THEN QUESTION. * C OTHERWISE NODE IS A LINE AND IN THIS CASE * C LINE N IN THIS TABLE IS THE NEXT POSSIBLE * C QUESTION OR TERMINAL NODE. * C * C P IS AN INTEGER WHICH IF -1 FLAGS THE TEXT STRING * C POINTED TO BY Q TO BE PASSED TO THE EXTERNAL * C SUBROUTINE OUTSID. * C * C Q IS A POSITIVE INTEGER WHICH POINTS TO THE TEXT FOR ALL* C THE LINES AND BOXES. IT IS COMPOSED OF (STARTING* C POSITION OF THE TEXT * 100) + (THE TEXT LENGTH).* C * C R IS A POSITIVE INTEGER WHICH REPRESENTS THE ACTION * C TAKEN IF THE PRESENT NODE IS A LINE. * C IF R = 1 THEN THE TREE IS DESCENDED. * C IF R = -1 THEN THE LINE IS FOR HELP. * C ELSE R IS OF NO SIGNIFICANCE. * C * C S IS A POSITIVE INTEGER. IT IS THE NUMBER ASSIGNED BY * C THE USER IN THE TREE TABLE. * C * C 4) TEXT * C * C THE TEXT ARRAY IS WRITTEN OUT SEQUENTIALLY TO THE FILE. THE * C NUMBER OF CHARACTERS IS ALWAYS A MULTIPLE OF 4 AND DOES * C NOT EXCEED 80 CHARACTERS IN A RECORD. * C * C 5) LAST CARD ... THE LAST CARD SHOULD BE: * C * C / * C * C WHERE THE SLASH ('/') APPEARS IN COLUMN 1. * C * C*********************************************************************** C * C FORMAT OF THE INPUT FILE FOR EXTERNAL TEXT: * C * C * C COL. # 1 5 91 5 92 5 93 5 94 ... * C 1) * MATRIX OPERATIONS * C 2) 62 * C 3) 1 4 * C 4) THE TEXT FOR EACH NUMBER FOLLOWS IN THE FIRST 80 COLUMNS... * C . . . . . . * C . . . . . . * C . . . . . . * C 3) 5 7 * C 4) THIS TEXT IS ANOTHER FILE * C . . . . . . * C . . . . . . * C . . . . . . * C 1) * MESH GENERATORS * C . . . . . . * C . . . . . . * C . . . . . . * C 5) / * C * C EXPLANATIONS: * C * C 1) TREE CARD ... THE NAME OF THE TREE * C * C 2) TREE TOTAL LINE ... THIS LINE CONTAINS THE NUMBER OF CARDS * C BETWEEN THIS CARD AND THE NEXT TREE CARD.* C * C 3) FILE TOTALS LINES ... THIS LINE CONTAINS TWO NUMBERS: * C * C I J * C * C WHERE THE ITH PIECE OF EXTERNAL TEXT ASSOCIATED WITH * C THIS TREE CONTAINS J LINES. * C * C 4) TEXT * C * C THE EXTERNAL TEXT IS WRITTEN OUT TO THE FILE EXACTLY THE * C WAY IT WAS READ IN. THE ONLY PROCESSING THAT TAKES PLACE IS * C THAT THE CARDS ARE COUNTED. * C * C 5) LAST CARD ... THE LAST CARD SHOULD BE: * C * C / * C * C WHERE THE SLASH ('/') APPEARS IN COLUMN 1. * C * C*********************************************************************** C * C FORTRAN UNIT NUMBERS: * C * C 1 - EXISTING INTERNAL TEXT, IF ANY. * C 3 - EXISTING EXTERNAL TEXT, IF ANY. * C 5 - READS FROM THE TTY. * C 6 - WRITES TO THE TTY. * C 11 - LOGS USER REQUESTS FOR HELP FROM A BOX * C 12 - NOTES ANY SUGGESTIONS MADE BY A USER * C * C*********************************************************************** C DECLARATION STATEMENTS * C*********************************************************************** C * INTEGER TTY, IN, TTYO, ASTER, CDS, WRDS, NTREE, HEADER, * OFFSET, CHAR(80), ERR, PST, I, STKPTR, SEL, TEMP, J, * LAST, LSTSEL, NEXT, NUMCDS, BLANK, B, P, Q, AREA, * INONE, WRDST, EOLINE, HDSIZE, XIN, TEND, MXAREA, NOUT, * LFILE, JJ, LJ, DIGITS(10), LINE(80), MWAY, TRTBL, * NOTREE, NOTP1, LASTSZ, IDIM, DASH, PLUS, X, IFAULT, * PAGESZ, MXSPNS, IOPT, C, L, RESPNS, IMODE, LH, LS, * HFILE, SFILE, H, S, QM, LB, LP, LQ, LN, LL, LC, N LOGICAL ERROR, TWICE C C*********************************************************************** C DECLARATIONS THAT DEPEND UPON DEFAULT VALUES * C*********************************************************************** C * C DIMENSION OFFSET(NOTP1) * DIMENSION OFFSET(26) C C DIMENSION AREA(MXAREA) DIMENSION AREA(16000) C C DIMENSION TRTBL(MWAY) DIMENSION TRTBL(40) C C DIMENSION HDSIZE(NOTREE) DIMENSION HDSIZE(25) C C DIMENSION HEADER(80,NOTREE) DIMENSION HEADER(80,25) C C DIMENSION RESPNS(MXSPNS) DIMENSION RESPNS(800) C C DIMENSION IOPT(IDIM) DIMENSION IOPT(200) C C*********************************************************************** C DATA STATEMENTS FOR DEFAULT VALUES * C*********************************************************************** C * DATA NOTREE /25/ DATA NOTP1 /26/ DATA MXAREA /16000/ DATA MWAY /40/ DATA MXSPNS /800/ DATA IDIM /200/ DATA PAGESZ /20/ DATA LASTSZ /5/ C C*********************************************************************** C DATA STATEMENTS FOR CHARACTER DATA * C*********************************************************************** C * DATA TEND /1H// DATA ASTER /1H*/ DATA BLANK /1H / DATA QM /1H?/ DATA DASH /1H-/ DATA PLUS /1H+/ DATA X /1HX/ C C*********************************************************************** C DATA STATEMENTS FOR POSSIBLE RESPONSES * C*********************************************************************** C * DATA B /1HB/ DATA C /1HC/ DATA H /1HH/ DATA JJ /1HJ/ DATA L /1HL/ DATA N /1HN/ DATA P /1HP/ DATA Q /1HQ/ DATA S /1HS/ C C*********************************************************************** C DATA STATEMENTS FOR LOWER CASE RESPONSES * C*********************************************************************** C * DATA LB /1HB/ DATA LC /1HC/ DATA LH /1HH/ DATA LJ /1HJ/ DATA LL /1HL/ DATA LN /1HN/ DATA LP /1HP/ DATA LQ /1HQ/ DATA LS /1HS/ C C*********************************************************************** C DATA STATEMENTS FOR USE BY SUBROUTINE STRIPR * C*********************************************************************** C * DATA DIGITS(1) /1H0/ DATA DIGITS(2) /1H1/ DATA DIGITS(3) /1H2/ DATA DIGITS(4) /1H3/ DATA DIGITS(5) /1H4/ DATA DIGITS(6) /1H5/ DATA DIGITS(7) /1H6/ DATA DIGITS(8) /1H7/ DATA DIGITS(9) /1H8/ DATA DIGITS(10) /1H9/ C C*********************************************************************** C DATA STATEMENTS FOR UNIT NUMBERS * C*********************************************************************** C * DATA LFILE /0/ DATA IN /1/ DATA XIN /3/ DATA TTY /5/ DATA TTYO /6/ DATA NOUT /6/ DATA HFILE /11/ DATA SFILE /12/ C C*********************************************************************** C START OF EXECUTABLE CODE * C*********************************************************************** C * C INITIALIZE IFAULT FOR NO * C ERRORS ENCOUNTERED * C * IFAULT = 0 C C REWIND THE INTERNAL AND C EXTERNAL TEXT FILES C REWIND IN REWIND XIN LSTSEL = 0 INONE = 0 C C BRANCH TO PRINT OUT TREE C HEADERS IF NIT HAS ALREADY C BEEN CALLED WITH THE SAME C DATA FILES C IF (IMODE.NE.1) GO TO 60 C C INITIALIZE IOPT ARRAY C C SET VALUES IN IOPT FOR C VARIABLES WHICH MAY BE C CHANGED IN THE EXTERNAL C SUBROUTINE C IOPT(5) = PAGESZ IOPT(6) = LASTSZ IOPT(7) = TTY IOPT(8) = TTYO IOPT(9) = HFILE IOPT(10) = SFILE IOPT(11) = LFILE C C SET VALUES IN IOPT FOR C UNIT NUMBERS USED C IOPT(21) = IN IOPT(22) = XIN IOPT(23) = NOUT C C SET VALUES IN IOPT FOR C POSSIBLE RESPONSES C IOPT(31) = B IOPT(32) = C IOPT(33) = H IOPT(34) = L IOPT(35) = N IOPT(36) = P IOPT(37) = Q IOPT(38) = S IOPT(39) = JJ C C SET VALUES IN IOPT FOR C LOWER CASE RESPONSES C IOPT(51) = LB IOPT(52) = LC IOPT(53) = LH IOPT(54) = LL IOPT(55) = LN IOPT(56) = LP IOPT(57) = LQ IOPT(58) = LS IOPT(59) = LJ C C SET VALUES IN IOPT FOR C CHARACTERS C IOPT(71) = TEND IOPT(72) = ASTER IOPT(73) = BLANK IOPT(74) = QM IOPT(75) = DASH IOPT(76) = PLUS IOPT(77) = X C C SET VALUES IN IOPT FOR C DEFAULT VALUES C IOPT(81) = NOTREE IOPT(82) = NOTP1 IOPT(83) = MXAREA IOPT(84) = MWAY IOPT(85) = MXSPNS IOPT(86) = IDIM C C SET VALUES IN IOPT FOR C CHARACTER DIGITS C IOPT(91) = DIGITS(1) IOPT(92) = DIGITS(2) IOPT(93) = DIGITS(3) IOPT(94) = DIGITS(4) IOPT(95) = DIGITS(5) IOPT(96) = DIGITS(6) IOPT(97) = DIGITS(7) IOPT(98) = DIGITS(8) IOPT(99) = DIGITS(9) IOPT(100) = DIGITS(10) C C FOR HEADER AND STACK USE C NUMCDS = 0 STKPTR = 0 NEXT = 1 AREA(1) = BLANK C C ** CALL NUMBER 1 TO NITIO C ** TYPE OUT INTRODUCTION TO NIT C C*********************************************************************** C * C FOR EXAMPLE, THE OUTPUT TO UNIT 6 (THE TERMINAL) AFTER * C THIS CALL IS: * C * C NIT WILL PROMPT YOU WITH QUESTIONS. ANSWER THEM BY TYPING THE * C NUMBER OF THE CORRECT ANSWER FOLLOWED BY A CARRIAGE RETURN. * C * C*********************************************************************** C * 10 CALL NITIO(AREA, 1, TTYO, 1, 0) CALL NITIO(AREA, 1, LFILE, 1, 0) C C STORE VALID RESPONSES C AREA(1) = B AREA(2) = P AREA(3) = Q AREA(4) = QM AREA(5) = H AREA(6) = S AREA(7) = JJ AREA(8) = N C C ** CALL NUMBER 2 TO NITIO C ** SHOW USER ADDITIONAL RESPONSES C CALL NITIO(AREA, 8, TTYO, 2, 0) CALL NITIO(AREA, 8, LFILE, 2, 0) IF (INONE.EQ.1) GO TO 60 C C STORE THE TREE NAMES AND C THE OFFSET TO THE FIRST C LINE OF THE TREE LINES C C C ** CALL NUMBER 3 TO NITIO C ** READ IN THE TREE CARD C 20 CALL NITIO(AREA, 80, IN, 3, 0) C C VERIFY CARD IS A TREE NAME C IF (AREA(1).EQ.TEND) GO TO 50 IF (AREA(1).NE.ASTER) GO TO 280 C C DETERMINE LENGTH OF HEADER C AND STORE IN HDSIZE C LAST = EOLINE(AREA,80,BLANK) HDSIZE(NEXT) = LAST - 1 C C PACK AREA NAME INTO THE C HEADER HOLDER C DO 30 I=2,LAST J = I - 1 HEADER(J,NEXT) = AREA(I) 30 CONTINUE C C ** CALL NUMBER 4 TO NITIO C ** READ IN THE TREE TOTALS LINE C CALL NITIO(AREA, 1, IN, 4, 0) CDS = AREA(1) NUMCDS = NUMCDS + 2 STKPTR = STKPTR + 1 NEXT = NEXT + 1 C C STORE THE OFFSET IN STACK C OFFSET(STKPTR) = NUMCDS NUMCDS = NUMCDS + CDS IF (CDS.EQ.0) GO TO 20 C C SKIP TO THE NEXT TREE CARD C DO 40 I=1,CDS C C ** CALL NUMBER 5 TO NITIO C ** READ A CARD TO SKIP IT C CALL NITIO(AREA, 1, IN, 5, 0) 40 CONTINUE GO TO 20 C C NOW AFTER FOUND ALL HEADERS C TYPE THEM ALL C 50 IF (NEXT.EQ.1) GO TO 270 OFFSET(NEXT) = NUMCDS + 2 REWIND IN 60 TWICE = .FALSE. INONE = 0 C C CHECK FOR PRINT VALID C RESPONSES C 70 IF (.NOT.TWICE) GO TO 80 CHAR(1) = B CHAR(2) = P CHAR(3) = Q CHAR(4) = QM CHAR(5) = H CHAR(6) = S CHAR(7) = JJ CHAR(8) = N C C ** CALL NUMBER 6 TO NITIO C ** TYPE OUT VALID RESPONSES C CALL NITIO(CHAR, 8, TTYO, 6, 0) CALL NITIO(CHAR, 8, LFILE, 6, 0) C C ** CALL NUMBER 7 TO NITIO C ** TYPE OUT MENU HEADING, I.E. C 'NIT TREES-SELECT FROM:' C 80 CALL NITIO(CHAR, 1, TTYO, 7, 0) CALL NITIO(CHAR, 1, LFILE, 7, 0) DO 100 I=1,STKPTR NEXT = I + 1 IF ((OFFSET(NEXT)-OFFSET(I)).LE.2) GO TO 100 LAST = HDSIZE(I) DO 90 J=1,LAST LINE(J) = HEADER(J,I) 90 CONTINUE J = I C C ** CALL NUMBER 8 TO NITIO C ** TYPE OUT TREE TITLES C CALL NITIO(LINE, LAST, TTYO, 8, J) CALL NITIO(LINE, LAST, LFILE, 8, J) 100 CONTINUE TWICE = .FALSE. C C ** CALL NUMBER 9 TO NITIO C ** TYPE OUT PROMPT CHARACTER C 110 CALL NITIO(CHAR, 1, TTYO, 9, 0) CALL NITIO(CHAR, 1, LFILE, 9, 0) C C ** CALL NUMBER 10 TO NITIO C ** READ IN ANSWER FROM TTY C CALL NITIO(CHAR, 80, TTY, 10, 0) LAST = EOLINE(CHAR,80,BLANK) C C ** CALL NUMBER 11 TO NITIO C ** WRITE OUT A USERS RESPONSE C CALL NITIO(CHAR, LAST, LFILE, 11, 0) C C DETERMINE TREE SELECTED AND C CHECK FOR A VALID ANSWER C I = 1 CALL STRIPR(SEL, CHAR, ERR, I, DIGITS, BLANK) IF (SEL.GE.1 .AND. SEL.LE.STKPTR) GO TO 210 IF ((CHAR(ERR).EQ.Q) .OR. (CHAR(ERR).EQ.LQ)) GO TO 290 IF ((CHAR(ERR).NE.B) .AND. (CHAR(ERR).NE.LB)) GO TO 120 GO TO 60 C C CHECK ANSWER FOR USER C WANTING NIT HELP C 120 IF ((CHAR(ERR).NE.N) .AND. (CHAR(ERR).NE.LN)) GO TO 130 INONE = 1 GO TO 10 C C CHECK ANSWER FOR USER C WANTING TO MAKE A SUGGESTION C 130 IF ((CHAR(ERR).NE.S) .AND. (CHAR(ERR).NE.LS)) GO TO 140 CALL SUGGST(0, 0, XIN, SFILE, TTY, TTYO, TEND, BLANK, * LFILE) GO TO 60 C C CHECK IF USER WANTED TO C LOOK AT THE HELP FILE C FOR THIS BOX C 140 IF (CHAR(ERR).EQ.H) GO TO 150 IF (CHAR(ERR).EQ.LH) GO TO 150 IF (CHAR(ERR).EQ.QM) GO TO 150 GO TO 160 C C ** CALL NUMBER 12 TO NITIO C ** TYPE OUT NO HELP AVAILABLE C 150 CALL NITIO(LINE, 1, TTYO, 12, 0) CALL NITIO(LINE, 1, LFILE, 12, 0) C C LOG USER REQUEST FOR HELP C CALL HLPLOG(0, 0, 0, XIN, HFILE, BLANK) GO TO 60 C C CHECK FOR MOVING TO THE C PREVIOUS QUESTION WHICH C IS AN INAPPROPRIATE RESPONSE C 160 IF ((CHAR(ERR).NE.P) .AND. (CHAR(ERR).NE.LP)) GO TO 170 C C ** CALL NUMBER 13 TO NITIO C ** TYPE OUT INAPPROPRIATE C ** RESPONSE MESSAGE C CALL NITIO(LINE, 1, TTYO, 13, 0) CALL NITIO(LINE, 1, LFILE, 13, 0) GO TO 60 C C CHECK FOR EXTERNAL C TEXT RESPONSES C 170 IF (CHAR(ERR).EQ.C) GO TO 180 IF (CHAR(ERR).EQ.LC) GO TO 180 IF (CHAR(ERR).EQ.L) GO TO 180 IF (CHAR(ERR).EQ.LL) GO TO 180 GO TO 190 C C ** CALL NUMBER 14 TO NITIO C ** TYPE OUT NOT EXTERNAL C ** TEXT MESSAGE C 180 CALL NITIO(LINE, 1, TTYO, 14, 0) CALL NITIO(LINE, 1, LFILE, 14, 0) GO TO 60 C C CHECK ANSWER FOR A C DYNAMIC JUMP C 190 IF ((CHAR(ERR).NE.JJ) .AND. (CHAR(ERR).NE.LJ)) GO TO 200 C C ** CALL NUMBER 15 TO NITIO C ** DISPLAY INAPPROPRIATE C ** RESPONSE FOR NO TREE C ** YET SELECTED C CALL NITIO(LINE, 1, TTYO, 15, 0) CALL NITIO(LINE, 1, LFILE, 15, 0) GO TO 60 C C IMPROPER RESPONSE, PROMPT C AGAIN OR PRINT HEADERS AGAIN C C ** CALL NUMBER 16 TO NITIO C ** TYPE OUT IMPROPER RESPONSE C 200 CALL NITIO(CHAR, 1, TTYO, 16, 0) CALL NITIO(CHAR, 1, LFILE, 16, 0) IF (TWICE) GO TO 70 TWICE = .NOT.TWICE GO TO 110 C C PROPER RESPONSE SO SET INPUT C FILE TO BEGINNING OF DESIRED C TREE IF PREVIOUS TREE IS SAME C AS PRESENT DISPLAY PRESENTLY C 210 IF (SEL.LT.LSTSEL) GO TO 220 IF (SEL.EQ.LSTSEL) GO TO 250 TEMP = LSTSEL + 1 TEMP = OFFSET(SEL) - OFFSET(TEMP) + 1 GO TO 230 C C CALCULATE OFFSET FROM THE C BEGINNING OF THE FILE C 220 REWIND IN TEMP = OFFSET(SEL) - 1 230 DO 240 I=1,TEMP C C ** CALL NUMBER 17 TO NITIO C ** READ A CARD TO SKIP IT C CALL NITIO(AREA, 1, IN, 17, 0) 240 CONTINUE LSTSEL = SEL C C ** CALL NUMBER 18 TO NITIO C ** READ IN FILE TOTALS LINE C ** FOR TREE SELECTED C CALL NITIO(AREA, 4, IN, 18, 0) C C CHECK FOR NULL DATA TREE C IF (AREA(1).LE.0) GO TO 260 C C DIVIDE UP THE ARRAY AREA C NTREE = AREA(2) WRDS = AREA(3)*4 PST = AREA(4) WRDST = NTREE*8 + 1 TEMP = WRDST - 1 C C ** CALL NUMBER 19 TO NITIO C ** READ IN THE TREE LINES C CALL NITIO(AREA, TEMP, IN, 19, 0) C C ** CALL NUMBER 20 TO NITIO C ** READ IN THE TREE TEXT C CALL NITIO(AREA(WRDST), WRDS, IN, 20, 0) 250 CONTINUE IF (PST.LE.0) GO TO 260 C C SET VALUES IN IOPT ACCORDING C TO THIS TREE SELECTION C IOPT(101) = SEL IOPT(102) = NTREE IOPT(103) = WRDS C C PERFORM QUESTION AND ANSWER C WITH THE USER C CALL PROMPT(TRTBL, MWAY, PST, ERROR, AREA(1), NTREE, * AREA(WRDST), WRDS, RESPNS, MXSPNS, SEL, B, C, L, P, Q, * XIN, TTY, TTYO, BLANK, DIGITS, IOPT, IFAULT, MXAREA, * DASH, PLUS, X, IDIM, ASTER, PAGESZ, HFILE, SFILE, QM, * N, H, S, LB, LP, LQ, LC, LL, LN, LH, LS, LASTSZ, TEND, * NOUT, LFILE, JJ, LJ) IF (ERROR) GO TO 290 GO TO 70 C C ** CALL NUMBER 21 TO NITIO C ** TYPE OUT NULL DATA TREE C ** ERROR MESSAGE C 260 CALL NITIO(CHAR, 1, NOUT, 21, 0) CALL NITIO(CHAR, 1, LFILE, 21, 0) GO TO 70 C C ** CALL NUMBER 22 TO NITIO C ** TYPE OUT MESSAGE FOR C ** NO TREES AVAILABLE C 270 CALL NITIO(AREA, 1, NOUT, 22, 0) CALL NITIO(AREA, 1, LFILE, 22, 0) IFAULT = 1 GO TO 290 C C ** CALL NUMBER 23 TO NITIO C ** TYPE OUT ERROR MESSAGE C ** FOR IMPROPER TREE FILE C ** FORMAT C 280 CALL NITIO(CHAR, 1, NOUT, 23, 0) CALL NITIO(CHAR, 1, LFILE, 23, 0) IFAULT = 1 C C END OF SUBROUTINE NIT C 290 CONTINUE RETURN END C EOL 1 C-----------------------------------------------------------------------EOL 2 C EOL 3 INTEGER FUNCTION EOLINE(LINE, LEN, BLANK) EOL 4 C C*********************************************************************** C * C FUNCTION TO RETURN THE LAST NON-BLANK CHARACTER OF AN ARRAY. * C IF THE ARRAY CONTAINS ONLY BLANKS, THEN EOLINE HAS THE * C VALUE 1. * C * C*********************************************************************** C * INTEGER LEN, LINE(LEN), BLANK, END, II C C FIND THE LAST NON-BLANK C CHARACTER C END = LEN + 1 DO 10 II=1,LEN END = END - 1 IF (LINE(END).NE.BLANK) GO TO 20 10 CONTINUE C C RETURN THE VALUE OF EOLINE C 20 CONTINUE EOLINE = END RETURN END C HLP 1 C-----------------------------------------------------------------------HLP 2 C HLP 3 SUBROUTINE HLPLOG(IHELP, BOX, SEL, XIN, HFILE, BLANK) HLP 4 C C*********************************************************************** C * C SUBROUTINE TO LOG A USERS REQUEST FOR HELP. THE INFORMATION * C WHICH IS WRITTEN TO UNIT HFILE, INCLUDES THE TREE NAME, * C THE NUMBER OF THE TREE, THE BOX NUMBER, AND WHETHER OR * C NOT HELP WAS AVAILABLE. A CALL IS MADE TO SUBROUTINE * C OUTHLP TO ALSO WRITE OUT ANY SYSTEM DEPENDENT INFORMATION. * C * C IF IHELP = 0, THEN NO HELP WAS AVAILABLE. * C IF IHELP = 1, THEN HELP WAS AVAILABLE. * C * C----------------------------------------------------------------------* C * C SUBROUTINES USED: * C * C EOLINE - THIS FUNCTION RETURNS THE POSITION OF THE LAST NON-BLANK* C CHARACTER IN AN ARRAY. * C * C NITIO - ROUTINE USED FOR ALL OF THE INPUT AND * C OUTPUT IN NIT. * C * C OUTHLP - SUBROUTINE TO WRITE OUT ANY USEFUL SYSTEM * C DEPENDENT INFORMATION AVAILABLE TO THE EXPERT * C SUCH AS DATE AND TIME. * C * C POINTX - POINTS TO THE TREE CARD OF ANY TREE IN THE EXTERNAL * C TEXT FILE. * C * C*********************************************************************** C * INTEGER BOX, SEL, XIN, HFILE, IHELP, EOLINE, LINE(80), * BLANK, LAST C C CHECK IF USER IS AT C THE BEGINNING OF NIT C IF (SEL.GT.0) GO TO 10 C C ** CALL NUMBER 24 TO NITIO C ** WRITE NO INFORMATION AVAILABLE C ** AND NO TREE SELECTED C CALL NITIO(LINE, 1, HFILE, 24, 0) GO TO 20 C C GET THE NUMBER OF THE C TREE AND THE BOX NUMBER C 10 LINE(1) = BOX LINE(2) = SEL C C ** CALL NUMBER 25 TO NITIO C ** WRITE OUT THE TREE NUMBER C ** AND THE BOX NUMBER C CALL NITIO(LINE, 2, HFILE, 25, 0) C C OBTAIN TREE NAME FOR A C TREE SELECTED C CALL POINTX(SEL, XIN) C C ** CALL NUMBER 26 TO NITIO C ** READ IN THE TREE NAME C CALL NITIO(LINE, 80, XIN, 26, 0) LAST = EOLINE(LINE,80,BLANK) C C ** CALL NUMBER 27 TO NITIO C ** WRITE OUT THE TREE NAME C CALL NITIO(LINE, LAST, HFILE, 27, 0) C C WRITE OUT ANY AVAILABLE C INFORMATION C 20 CALL OUTHLP(HFILE) C C ** CALL NUMBER 28 TO NITIO C ** WRITE OUT HELP NOT AVAILABLE C IF (IHELP.EQ.0) CALL NITIO(LINE, 1, HFILE, 28, 0) C C ** CALL NUMBER 29 TO NITIO C ** WRITE OUT HELP WAS AVAILABLE C IF (IHELP.EQ.1) CALL NITIO(LINE, 1, HFILE, 29, 0) C C RETURN TO CALLING PROGRAM C RETURN END C NIT 1 C-----------------------------------------------------------------------NIT 2 C NIT 3 SUBROUTINE NITIO(ARRAY, LEN, FILE, XCALL, NUM) NIT 4 C C*********************************************************************** C * C SUBROUTINE WHICH CONDUCTS ALL OF THE INPUT AND OUTPUT * C FOR NIT. THE PARTICULAR I/O OPERATION DEPENDS ON THE * C VALUE OF XCALL. * C * C*********************************************************************** C * INTEGER FILE, LEN, NUM, XCALL, ARRAY(LEN), I C C CHECK FOR A UNIT NUMBER C BEING SET FOR NO OUTPUT C IF (FILE.LE.0) GO TO 880 C C CHOOSE THE RIGHT I/O STATEMENT C GO TO (10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110, 120, * 130, 140, 150, 160, 170, 180, 190, 200, 210, 220, 230, * 240, 250, 260, 270, 280, 290, 300, 310, 320, 330, 340, * 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450, * 460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, * 570, 580, 590, 600, 610, 620, 630, 640, 650, 660, 670, * 680, 690, 700, 710, 720, 730, 740, 750, 760, 770, 780, * 790, 800, 810, 820, 830, 840, 850, 860, 870), XCALL C C DISPLAY NIT INTRODUCTION C 10 WRITE (FILE,99986) GO TO 880 C C DISPLAY ADDITIONAL RESPONSES C 20 WRITE (FILE,99985) (ARRAY(I),I=1,LEN) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 30 READ (FILE,99999) (ARRAY(I),I=1,LEN) GO TO 880 C C READ IN A LINE IN 8I6 FORMAT C 40 READ (FILE,99998) (ARRAY(I),I=1,LEN) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 50 GO TO 30 C C DISPLAY POSSIBLE ANSWERS C 60 WRITE (FILE,99991) (ARRAY(I),I=1,LEN) GO TO 880 C C DISPLAY TREE HEADER QUESTION C 70 WRITE (FILE,99989) GO TO 880 C C DISPLAY A NUMBER IN C PARENTHESES FOLLOWED BY C A LINE IN 74A1 FORMAT C 80 IF (NUM.LT.10) WRITE (FILE,99993) NUM, (ARRAY(I),I=1,LEN) IF (NUM.GE.10) WRITE (FILE,99994) NUM, (ARRAY(I),I=1,LEN) GO TO 880 C C DISPLAY PROMPT CHARACTER C 90 WRITE (FILE,99997) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 100 GO TO 30 C C WRITE OUT A LINE IN C (1X,80A1) FORMAT C 110 WRITE (FILE,99980) (ARRAY(I),I=1,LEN) GO TO 880 C C WRITE OUT A MESSAGE SAYING C NO HELP IS AVAILABLE C 120 WRITE (FILE,99973) GO TO 880 C C TYPE OUT INAPPROPRIATE C RESPONSE MESSAGE C 130 WRITE (FILE,99970) GO TO 880 C C TYPE OUT INAPPROPRIATE C RESPONSE FOR NON-EXTERNAL C TEXT C 140 WRITE (FILE,99968) GO TO 880 C C TYPE OUT INAPPROPRIATE C RESPONSE FOR A PREMATURE C GOTO C 150 WRITE (FILE,99963) GO TO 880 C C DISPLAY IMPROPER RESPONSE C 160 WRITE (FILE,99996) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 170 GO TO 30 C C READ IN A LINE IN 8I6 FORMAT C 180 GO TO 40 C C READ IN A LINE IN 8I6 FORMAT C 190 GO TO 40 C C READ IN A LINE IN 80A1 FORMAT C 200 GO TO 30 C C DISPLAY NULL DATA TREE C 210 WRITE (FILE,99988) GO TO 880 C C DISPLAY NO TREES AVAILABLE C 220 WRITE (FILE,99992) GO TO 880 C C DISPLAY IMPROPER TREE FILE C 230 WRITE (FILE,99987) GO TO 880 C C LOG USER REQUEST FOR C NO TREE SELECTED C 240 WRITE (FILE,99969) GO TO 880 C C WRITE OUT TREE NUMBER AND C BOX NUMBER FOR HELP REQUEST C 250 WRITE (FILE,99967) (ARRAY(I),I=1,LEN) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 260 GO TO 30 C C WRITE OUT USER REQUEST FOR C HELP WITH TREE NAME C 270 WRITE (FILE,99978) (ARRAY(I),I=1,LEN) GO TO 880 C C WRITE OUT HELP WAS NOT C AVAILABLE C 280 WRITE (FILE,99966) GO TO 880 C C WRITE OUT HELP WAS AVAILABLE C 290 WRITE (FILE,99965) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 300 GO TO 30 C C READ IN A LINE IN 8I6 FORMAT C 310 GO TO 40 C C READ IN A LINE IN 80A1 FORMAT C 320 GO TO 30 C C DISPLAY ADDITIONAL RESPONSES C 330 GO TO 20 C C DISPLAY POSSIBLE ANSWERS C 340 GO TO 60 C C DISPLAY A LINE IN 80A1 FORMAT C 350 WRITE (FILE,99995) (ARRAY(I),I=1,LEN) GO TO 880 C C DISPLAY A NUMBER IN C PARENTHESES FOLLOWED C BY A LINE IN 74A1 FORMAT C 360 GO TO 80 C C SHOW USER RESPONSES FOR HELP C 370 WRITE (FILE,99975) (ARRAY(I),I=1,LEN) GO TO 880 C C DISPLAY PROMPT CHARACTER C 380 GO TO 90 C C READ IN A LINE IN 80A1 FORMAT C 390 GO TO 30 C C WRITE OUT A LINE IN C (1X,80A1) FORMAT C 400 GO TO 110 C C DISPLAY NIT INTRODUCTION C 410 GO TO 10 C C WRITE OUT A MESSAGE SAYING C NO HELP IS POSSIBLE C 420 GO TO 120 C C DISPLAY QUESTION FOR BOX C NUMBER FOR A DYNAMIC GOTO C 430 WRITE (FILE,99961) GO TO 880 C C DISPLAY ERROR MESSAGE FOR C INVALID BOX INPUT BY USER C 440 WRITE (FILE,99960) (ARRAY(I),I=1,LEN) GO TO 880 C C DISPLAY WARNING MESSAGE FOR C A LINE USED FOR A DYNAMIC GOTO C 450 WRITE (FILE,99959) (ARRAY(I),I=1,LEN) GO TO 880 C C TYPE OUT INAPPROPRIATE C RESPONSE FOR NON-EXTERNAL C TEXT C 460 GO TO 140 C C DISPLAY IMPROPER RESPONSE C 470 GO TO 160 C C WRITE OUT INVALID BOX C NUMBER RETURNED BY OUTSID C 480 WRITE (FILE,99974) (ARRAY(I),I=1,LEN) GO TO 880 C C WRITE OUT A WARNING MESSAGE C FOR OUTSID RETURNING A LINE C 490 WRITE (FILE,99962) (ARRAY(I),I=1,LEN) GO TO 880 C C DISPLAY A LINE IN 80A1 FORMAT C 500 GO TO 350 C C DISPLAY AREA ARRAY OVERFLOW C 510 WRITE (FILE,99990) GO TO 880 C C DISPLAY RESPNS ARRAY OVERFLOW C 520 WRITE (FILE,99958) (ARRAY(I),I=1,LEN) GO TO 880 C C WRITE OUT NO TREE SELECTED C FOR THIS SUGGESTION C 530 WRITE (FILE,99979) GO TO 880 C C WRITE OUT TREE NUMBER AND C BOX NUMBER FOR A SUGGESTION C 540 WRITE (FILE,99977) (ARRAY(I),I=1,LEN) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 550 GO TO 30 C C WRITE OUT TREE NAME C FOR A SUGGESTION C 560 WRITE (FILE,99978) (ARRAY(I),I=1,LEN) GO TO 880 C C WRITE OUT THE INSTRUCTIONS C FOR MAKING A SUGGESTION C 570 WRITE (FILE,99972) (ARRAY(I),I=1,LEN) GO TO 880 C C WRITE OUT START OF C SUGGESTION MARKER C 580 WRITE (FILE,99976) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 590 GO TO 30 C C WRITE OUT A LINE IN C (1X,80A1) FORMAT C 600 GO TO 110 C C WRITE OUT A LINE IN C (1X,80A1) FORMAT C 610 GO TO 110 C C READ IN A LINE IN 80A1 FORMAT C 620 GO TO 30 C C READ IN A LINE IN 80A1 FORMAT C 630 GO TO 30 C C READ IN A LINE IN 8I6 FORMAT C 640 GO TO 40 C C READ IN A LINE IN 80A1 FORMAT C 650 GO TO 30 C C DISPLAY EXTERNAL TEXT QUESTION C 660 WRITE (FILE,99984) (ARRAY(I),I=1,LEN) GO TO 880 C C DISPLAY PROMPT CHARACTER C 670 GO TO 90 C C READ IN A LINE IN 80A1 FORMAT C 680 GO TO 30 C C WRITE OUT A LINE IN C (1X,80A1) FORMAT C 690 GO TO 110 C C DISPLAY IMPROPER RESPONSE C 700 GO TO 160 C C DISPLAY POSSIBLE ANSWERS C 710 WRITE (FILE,99971) (ARRAY(I),I=1,LEN) GO TO 880 C C WRITE OUT A MESSAGE SAYING C NO HELP IS AVAILABLE C 720 GO TO 120 C C DISPLAY INAPPROPRIATE RESPONSE C FOR EXTERNAL TEXT C 730 WRITE (FILE,99964) (ARRAY(I),I=1,LEN) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 740 GO TO 30 C C DISPLAY A LINE IN 80A1 FORMAT C 750 WRITE (FILE,99999) (ARRAY(I),I=1,LEN) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 760 GO TO 30 C C DISPLAY A LINE IN 80A1 FORMAT C 770 GO TO 750 C C DISPLAY COMMAND PROMPT FOR C EXTERNAL TEXT QUESTION C 780 WRITE (FILE,99983) (ARRAY(I),I=1,LEN) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 790 GO TO 30 C C WRITE OUT A LINE IN C (1X,80A1) FORMAT C 800 GO TO 110 C C DISPLAY IMPROPER RESPONSE C 810 GO TO 160 C C DISPLAY POSSIBLE ANSWERS FOR C EXTERNAL TEXT QUESTION C 820 WRITE (FILE,99982) (ARRAY(I),I=1,LEN) GO TO 880 C C WRITE OUT A MESSAGE SAYING C NO HELP IS AVAILABLE C 830 GO TO 120 C C DISPLAY INAPPROPRIATE RESPONSE C FOR EXTERNAL TEXT C 840 GO TO 730 C C READ IN A LINE IN 80A1 FORMAT C 850 GO TO 30 C C DISPLAY END OF TEXT MESSAGE C 860 WRITE (FILE,99981) GO TO 880 C C READ IN A LINE IN 80A1 FORMAT C 870 GO TO 30 C C RETURN TO CALLING ROUTINE C 880 CONTINUE RETURN 99999 FORMAT (80A1) 99998 FORMAT (8I6) 99997 FORMAT (2H *) 99996 FORMAT (/17H INVALID RESPONSE) 99995 FORMAT (/(1X, 80A1)) 99994 FORMAT (2H (, I2, 2H) , 74A1/(5X, 74A1)) 99993 FORMAT (3H (, I1, 2H) , 74A1/(5X, 74A1)) 99992 FORMAT (/31H *** ERROR - NO TREES AVAILABLE) 99991 FORMAT (/35H THE FOLLOWING ARE VALID RESPONSES:/5X, * 32HANY NUMBER LISTED IN PARENTHESES/5X, A1, 9H FOR BEGI, * 25HNNING A NIT SESSION AGAIN/5X, A1, 15H FOR MOVING TO , * 21HTHE PREVIOUS QUESTION/5X, A1, 19H FOR QUITTING A NIT, * 20H SESSION IMMEDIATELY/5X, A1, 4H OR , A1, 9H FOR HELP/ * 5X, A1, 23H FOR MAKING SUGGESTIONS/5X, A1, 9H FOR A DY, * 10HNAMIC GOTO/5X, A1, 20H TO SEE THIS MESSAGE) 99990 FORMAT (32H *** ERROR - AREA ARRAY OVERFLOW) 99989 FORMAT (/24H NIT TREES-SELECT FROM: ) 99988 FORMAT (27H *** ERROR - NULL DATA TREE) 99987 FORMAT (41H *** ERROR - DATA FILE IN IMPROPER FORMAT) 99986 FORMAT (/45H NIT WILL PROMPT YOU WITH QUESTIONS. ANSWER T, * 17HHEM BY TYPING THE/28H NUMBER OF THE CORRECT ANSWE, * 32HR FOLLOWED BY A CARRIAGE RETURN.) 99985 FORMAT (/41H IN ADDITION, THE FOLLOWING RESPONSES MAY/ * 22H BE TYPED AT ANY TIME:/5X, A1, 18H FOR BEGINNING A N, * 16HIT SESSION AGAIN/5X, A1, 24H FOR MOVING TO THE PREVI, * 12HOUS QUESTION/5X, A1, 28H FOR QUITTING A NIT SESSION , * 11HIMMEDIATELY/5X, A1, 4H OR , A1, 9H FOR HELP/5X, A1, * 23H FOR MAKING SUGGESTIONS/5X, A1, 17H FOR A DYNAMIC GO, * 2HTO/5X, A1, 20H TO SEE THIS MESSAGE) 99984 FORMAT (/20H THIS TEXT CONTAINS , I5, 14H LINES AND IS , * I4, 12H PAGES LONG./27H DO YOU WISH TO LOOK AT IT?/ * 9H (1) YES/8H (2) NO) 99983 FORMAT (/43H ** THE LAST LINE DISPLAYED IS LINE NUMBER , * I5, 17X, 2H**/10H ** PRESS , A1, 19H TO CONTINUE, , * 3HOR , A1, 33H TO JUMP TO THE LAST PAGE **) 99982 FORMAT (/45H VALID RESPONSES FOR EXTERNAL TEXT QUESTIONS , * 4HARE:/5X, 41HANY POSITIVE NUMBER TO GO TO THAT LINE OF, * 14H EXTERNAL TEXT/5X, A1, 26H FOR BEGINNING A NIT SESSI, * 8HON AGAIN/5X, A1, 33H FOR MOVING TO THE PREVIOUS QUEST, * 3HION/5X, A1, 39H FOR QUITTING A NIT SESSION IMMEDIATELY * /5X, A1, 4H OR , A1, 9H FOR HELP/5X, A1, 11H FOR MAKING, * 12H SUGGESTIONS/5X, A1, 19H FOR A DYNAMIC GOTO/5X, A1, * 43H FOR CONTINUING ON TO THE NEXT PAGE OF TEXT/5X, A1, * 37H FOR JUMPING TO THE LAST PAGE OF TEXT/5X, A1, * 20H TO SEE THIS MESSAGE) 99981 FORMAT (/45H ** END OF TEXT, TYPE A CARRIAGE RETURN TO CO, * 10HNTINUE ** ) 99980 FORMAT (1X, 80A1) 99979 FORMAT (//28H ***** SUGGESTION MADE *****/12H NO TREE SEL, * 9HECTED YET) 99978 FORMAT (6H I.E. , 80A1) 99977 FORMAT (//26H **** SUGGESTION MADE ****/14H AT BOX NUMBER, * 2H: , I5/17H IN TREE NUMBER: , I5) 99976 FORMAT (12H SUGGESTION:) 99975 FORMAT (/7H (TYPE , A1, 9H OR , A1, 13H FOR HEL, * 2HP)) 99974 FORMAT (/44H *** ERROR - INVALID BOX RETURNED BY OUTSID./ * 12H BOX NUMBER , I5, 11H NOT FOUND.) 99973 FORMAT (/43H SORRY, NO HELP IS AVAILABLE AT THIS POINT.) 99972 FORMAT (/32H TYPE AS MANY LINES AS YOU WISH,/9H BUT USE , * 28HONLY 80 CHARACTERS PER LINE./20H END BY TYPING A SLA, * 4HSH, , 1H', 1A1, 1H', 4H, IN/22H COLUMN 1 FOLLOWED BY , * 18HA CARRIAGE RETURN.//12H SUGGESTION:) 99971 FORMAT (/45H VALID RESPONSES FOR EXTERNAL TEXT QUESTIONS , * 4HARE:/5X, 32HANY NUMBER LISTED IN PARENTHESES/5X, * 52HANY OTHER NUMBER TO GO TO THAT LINE OF EXTERNAL TEXT/ * 5X, A1, 34H FOR BEGINNING A NIT SESSION AGAIN/5X, A1, * 36H FOR MOVING TO THE PREVIOUS QUESTION/5X, A1, * 39H FOR QUITTING A NIT SESSION IMMEDIATELY/5X, A1, * 4H OR , A1, 9H FOR HELP/5X, A1, 20H FOR MAKING SUGGESTI, * 3HONS/5X, A1, 19H FOR A DYNAMIC GOTO/5X, A1, 8H FOR CON, * 35HTINUING ON TO THE NEXT PAGE OF TEXT/5X, A1, 6H FOR J, * 31HUMPING TO THE LAST PAGE OF TEXT/5X, A1, 9H TO SEE T, * 11HHIS MESSAGE) 99970 FORMAT (/38H INAPPROPRIATE RESPONSE AT THIS POINT,/ * 37H YOU ARE NOW AT THE BEGINNING OF NIT.) 99969 FORMAT (//27H ***** HELP REQUESTED *****/13H NO TREE SELE, * 8HCTED YET) 99968 FORMAT (/38H INAPPROPRIATE RESPONSE AT THIS POINT,/ * 30H YOU ARE NOT IN EXTERNAL TEXT.) 99967 FORMAT (//25H **** HELP REQUESTED ****/15H FROM BOX NUMBE, * 3HR: , I5/17H IN TREE NUMBER: , I5) 99966 FORMAT (23H HELP WAS NOT AVAILABLE/) 99965 FORMAT (19H HELP WAS AVAILABLE/) 99964 FORMAT (/24H INAPPROPRIATE RESPONSE,/17H THIS TEXT CONTAI, * 8HNS ONLY , I5, 7H LINES.) 99963 FORMAT (/38H INAPPROPRIATE RESPONSE AT THIS POINT,/ * 52H YOU MUST FIRST SELECT A TREE BEFORE USING A DYNAMIC, * 6H GOTO.) 99962 FORMAT (/44H * WARNING - LINE NUMBER RETURNED BY OUTSID./ * 17H THE LINE NUMBER , I5, 21H LEADS TO BOX NUMBER , * I5//33H NIT WILL CONTINUE FROM THIS BOX.) 99961 FORMAT (/45H WHAT IS THE NUMBER OF THE BOX YOU WISH TO GO, * 4H TO?) 99960 FORMAT (/32H *** ERROR - INVALID BOX NUMBER./9H BOX NUMB, * 3HER , I5, 11H NOT FOUND.) 99959 FORMAT (/35H * WARNING - THIS IS A LINE NUMBER./7H THE LI, * 10HNE NUMBER , I5, 21H LEADS TO BOX NUMBER , * I5//33H NIT WILL CONTINUE FROM THIS BOX.) 99958 FORMAT (/35H *** ERROR - RESPNS ARRAY OVERFLOW./7H PLEASE, * 32H TRY NOT TO USE SO MANY JUMPS OR/16H INCREASE THE SI, * 23HZE OF THE RESPNS ARRAY./25H DIMENSION OF RESPNS ARRA, * 15HY IS MXSPNS AND/10H MXSPNS = , I6//14H CONTACT THE L, * 37HOCAL NIT EXPERT FOR MORE INFORMATION.) END C OUT 1 C-----------------------------------------------------------------------OUT 2 C OUT 3 SUBROUTINE OUTHLP(LOUT) OUT 4 C C*********************************************************************** C * C SUBROUTINE TO RETRIEVE AND WRITE OUT TO UNIT NUMBER * C LOUT ANY USEFUL AND AVAILABLE INFORMATION SUCH AS * C THE DATE, TIME, AND NAME OF THE USER. THIS SUBROUTINE * C IS CALLED ONLY WHEN A REQUEST IS MADE FOR HELP OR * C A SUGGESTION IS MADE BY A USER. THE INFORMATION * C THAT IS OUTPUT FROM OUTHLP WILL APPEAR IN THE LOG * C FILE OF REQUESTS FOR HELP AND THE FILE OF USER * C SUGGESTIONS. * C * C THE OUTPUT FROM OUTHLP SHOULD GO TO UNIT NUMBER * C LOUT SO THAT IT WILL APPEAR IN THE APPROPRTIATE * C OUTPUT FILE. * C * C*********************************************************************** C * INTEGER LOUT RETURN END C OUT 1 C-----------------------------------------------------------------------OUT 2 C OUT 3 SUBROUTINE OUTSID(A, LENA, IOPT, TREE, MESSG) OUT 4 C INTEGER A, LENA, IOPT, TREE, MESSG C C DECLARE DUMMY DIMENSIONS DIMENSION A(LENA), IOPT(1), MESSG(1), TREE(8,1) C C SET NN TO THE NUMBER OF THE TREE SELECTED IN NIT C C NN = IOPT(101) C C CALL SUBROUTINE STRIP1 C TO IDENTIFY THE FIRST CHARACTER, J, OF C THE TEXT IN THE X-BOX C C CALL STRIP1(A, B, J) C GO TO (1,2),J C C CALL SUBROUTINE PICKER TO OPEN THE NASTI C DATA BASE, SEARCH FOR AND PRINT THE C DOCUMENTATION ON F04ACF. C C 1 CALL PICKER(F04ACF, NN) C GO TO 3 C C CALL SUBROUTINE PATHWY TO OPEN THE GRANIT C DATA BASE, SEARCH FOR AND PLOT THE C PATHS IN THE TREE THAT LEAD TO F04ACF. C C 2 CALL PATHWY(F04ACF, NN) C C RETURN TO NIT C C 3 CONTINUE RETURN END C POI 1 C-----------------------------------------------------------------------POI 2 C POI 3 SUBROUTINE POINTX(SEL, XIN) POI 4 C C*********************************************************************** C * C THIS SUBROUTINE POINTS TO THE TREE CARD OF THE TREE * C SELECTED IN THE EXTERNAL TEXT FILE. * C * C----------------------------------------------------------------------* C * C SUBROUTINES USED * C * C NITIO - ROUTINE USED FOR ALL OF THE INPUT AND * C OUTPUT IN NIT. * C * C*********************************************************************** C * INTEGER SEL, CDS, SELM1, XIN, I, J, DUMMY(1) C C CHECK IF THE FIRST TREE C IS THE CORRECT TREE C REWIND XIN IF (SEL.EQ.1) GO TO 30 DUMMY(1) = 1 SELM1 = SEL - DUMMY(1) C C READ THROUGH THE NUMBER C OF UNWANTED TREES C DO 20 I=1,SELM1 C C READ THE TREE CARD AND C THE TOTALS LINE C C ** CALL NUMBER 30 TO NITIO C ** READ IN THE TREE CARD C CALL NITIO(DUMMY, 1, XIN, 30, 0) C C ** CALL NUMBER 31 TO NITIO C ** READ IN THE TREE TOTALS LINE C CALL NITIO(DUMMY, 1, XIN, 31, 0) CDS = DUMMY(1) C C READ THROUGH THE UNWANTED TEXT C IF (CDS.EQ.0) GO TO 20 DO 10 J=1,CDS C C ** CALL NUMBER 32 TO NITIO C ** READ IN A CARD TO SKIP IT C CALL NITIO(DUMMY, 1, XIN, 32, 0) 10 CONTINUE 20 CONTINUE C C RETURN TO CALLING ROUTINE C 30 CONTINUE RETURN END C PRO 1 C-----------------------------------------------------------------------PRO 2 C PRO 3 SUBROUTINE PROMPT(TRTBL, MWAY, PST, ERROR, CTRE, TREDIM, PRO 4 * CMSG, MSGDIM, CHST, TOP, SEL, B, C, L, P, Q, XIN, TTY, * TTYO, BLANK, DIGITS, IOPT, IFAULT, MXAREA, DASH, PLUS, * X, IDIM, ASTER, PAGESZ, HFILE, SFILE, QM, N, H, S, LB, * LP, LQ, LC, LL, LN, LH, LS, LASTSZ, TEND, NOUT, LFILE, * JJ, LJ) C C*********************************************************************** C * C THIS ROUTINE QUERIES THE USER THROUGHOUT THE ENTIRE NIT * C SESSION. THE ROUTINE HAS BEEN DESIGNED IN SUCH A WAY THAT * C IT IS STRAIGHTFORWARD FOR THE EXPERT IMPLEMENTING NITPACK * C TO DETERMINE THE PRECISE INPUT/OUTPUT STATEMENT THAT IS * C INVOKED AT ANY TIME. * C * C----------------------------------------------------------------------* C * C SUBROUTINES CALLED: * C * C EOLINE - THIS FUNCTION RETURNS THE POSITION OF THE LAST NON-BLANK* C CHARACTER IN AN ARRAY. * C * C HLPLOG - SUBROUTINE WHICH LOGS A USERS REQUEST * C FOR HELP AND WHETHER OR NOT HELP WAS * C AVAILABLE. * C * C NITIO - ROUTINE USED FOR ALL OF THE INPUT AND * C OUTPUT IN NIT. * C * C OUTSID - THIS IS THE NAME OF THE ROUTINE WHICH IS USED * C IN THE EXTERNAL SUBROUTINE FEATURE OF NIT. * C * C SETHFL - SUBROUTINE USED TO RESET THE VALUE OF HFILE, * C THE FILE USED TO LOG USER REQUESTS FOR HELP. * C * C SETLFL - SUBROUTINE USED TO RESET THE VALUE OF LFILE, * C THE FILE USED TO MAKE A COPY OF ALL OF THE * C TERMINAL INPUT AND OUTPUT OF NIT. * C * C SETLSZ - SUBROUTINE USED TO RESET THE VALUE OF LASTSZ, * C THE VALUE USED TO CHECK IF A PAUSE IS ISSUED * C AT THE END OF EXTERNAL TEXT. * C * C SETPSZ - SUBROUTINE USED TO RESET THE VALUE OF PAGESZ, * C THE VALUE USED TO DETERMINE THE NUMBER OF LINES * C USED FOR A PAGE OF EXTERNAL TEXT. * C * C SETSFL - SUBROUTINE USED TO RESET THE VALUE OF SFILE, * C THE FILE USED TO STORE USER SUGGESTIONS. * C * C SETTY - SUBROUTINE USED TO RESET THE VALUE OF TTY, * C THE FILE USED FOR THE USER INPUT IN NIT. * C * C SETTYO - SUBROUTINE USED TO RESET THE VALUE OF TTYO, * C THE FILE USED FOR THE OUTPUT FROM * C NIT EXCEPT FOR ERROR MESSAGES. * C * C STRIPR - TO IDENTIFY ANY LEADING ELEMENTS OF AN ARRAY * C WHICH MAY CORRESPOND TO NUMERICAL CHARACTERS, * C AND CONVERT ANY THAT ARE FOUND INTO AN INTEGER. * C * C SUGGST - SUBROUTINE TO WRITE TO A FILE SUGGESTIONS * C MADE BY A USER. * C * C XTEXT - ROUTINE USED TO PRINT OUT THE EXTERNAL TEXT. * C * C*********************************************************************** C * INTEGER TRTBL, CHST, CINP(80), CACT, CCNT, TREDIM, TOP, * CMND, CMSG, CMST, CNXT, CRET, CSEL, CTRE, MSGDIM, XIN, * NS, TTY, TTYO, I, CLVL, PST, B, C, L, P, Q, SEL, DASH, * ASTER, PLUS, X, IDIM, IMODE, MWAY, BLANK, DIGITS(10), * LFILE, IHELP, PAGESZ, IOPT, IFAULT, MXAREA, IVAL, XBOX, * NOUT, JJ, LJ, LASTSZ, HFILE, SFILE, LB, LC, LH, LL, LP, * LS, LN, LQ, N, H, IXTEXT, TEND, EOLINE, S, QM DIMENSION CTRE(8,TREDIM), CMSG(MSGDIM), CHST(TOP), * TRTBL(MWAY), IOPT(IDIM) LOGICAL TWICE, ERROR, NPICK, LJUMP C C INITIALIZATION C IFAULT = 0 TWICE = .FALSE. CLVL = 1 CNXT = PST NPICK = .FALSE. CHST(CLVL) = CNXT CHST(CLVL+1) = 0 CINP(1) = BLANK C C CHECK FOR AREA ARRAY OVERFLOW C IF (MXAREA.LT.(MSGDIM+TREDIM*8)) GO TO 420 C C CHECK AND STORE VALID RESPONSES C 10 IF (.NOT.TWICE) GO TO 30 20 CINP(1) = B CINP(2) = P CINP(3) = Q CINP(4) = QM CINP(5) = H CINP(6) = S CINP(7) = JJ CINP(8) = N C C ** CALL NUMBER 33 TO NITIO C ** DISPLAY ADDITIONAL RESPONSES C ** FOR AN N ANSWER C IF (NPICK) CALL NITIO(CINP, 8, TTYO, 33, 0) IF (NPICK) CALL NITIO(CINP, 8, LFILE, 33, 0) NPICK = .FALSE. IF (.NOT.TWICE) GO TO 30 C C CHECK FOR VALID RESPONSES C TO BE TYPED AND FOR C EXTERNAL TEXT C C ** CALL NUMBER 34 TO NITIO C ** TYPE OUT POSSIBLE ANSWERS C CALL NITIO(CINP, 8, TTYO, 34, 0) CALL NITIO(CINP, 8, LFILE, 34, 0) TWICE = .FALSE. 30 LJUMP = .FALSE. IF (CTRE(4,CNXT).GT.0) GO TO 50 IHELP = 0 IXTEXT = 1 CCNT = 0 GO TO 70 40 CALL XTEXT(-CTRE(4,CNXT), SEL, XIN, TTYO, BLANK, B, C, L, * P, Q, TTY, IMODE, DIGITS, PAGESZ, HFILE, SFILE, QM, N, * H, S, LB, LP, LQ, LC, LL, LN, LH, LS, TEND, * CTRE(6,CNXT), LASTSZ, IHELP, LFILE, JJ, LJ) IF (IMODE.EQ.0) GO TO 60 IF (IMODE.EQ.1) GO TO 470 IF (IMODE.EQ.2) GO TO 400 IF (IMODE.EQ.3) GO TO 480 IF (IMODE.EQ.4) GO TO 170 IF (IMODE.EQ.5) GO TO 210 C C DISPLAY TREE MESSAGE FOR C THIS LEVEL C 50 CONTINUE I = CTRE(4,CNXT)/100 CMST = (I-1)*4 + 1 CMND = (CTRE(4,CNXT)+1-I*100)*4 C C ** CALL NUMBER 35 TO NITIO C ** DISPLAY QUESTION C CALL NITIO(CMSG(CMST), CMND, TTYO, 35, 0) CALL NITIO(CMSG(CMST), CMND, LFILE, 35, 0) 60 CONTINUE CCNT = 0 IHELP = 0 IXTEXT = 0 C C GET LINK TO NEXT COMMAND C TREE NODE C 70 CNXT = CTRE(1,CNXT) C C EXIT LOOP IF HEADER FOUND C IF (CTRE(2,CNXT).EQ.(-1)) GO TO 90 IF (CTRE(5,CNXT).LT.0) GO TO 80 IF (IXTEXT.EQ.1) GO TO 70 CCNT = CCNT + 1 TRTBL(CCNT) = CNXT C C LOCATE POSSIBLE ANSWERS C I = CTRE(4,CNXT)/100 CMST = (I-1)*4 + 1 CMND = (CTRE(4,CNXT)+1-I*100)*4 C C DISPLAY POSSIBLE ANSWERS C C ** CALL NUMBER 36 TO NITIO C ** DISPLAY NUMBER AND ANSWER C CALL NITIO(CMSG(CMST), CMND, TTYO, 36, CCNT) CALL NITIO(CMSG(CMST), CMND, LFILE, 36, CCNT) GO TO 70 C C SET IHELP FOR HELP BEING C POSSIBLE C 80 IHELP = 1 GO TO 70 C C CHECK FOR TERMINAL NODE C 90 IF (IXTEXT.EQ.1) GO TO 40 IF ((IHELP.EQ.1) .AND. (CCNT.EQ.0)) GO TO 100 IF (CCNT.EQ.0) GO TO 400 GO TO 110 C C STORE POSSIBLE RESPONSES C FOR HELP 100 CINP(1) = QM CINP(2) = H C C ** CALL NUMBER 37 TO NITIO C ** SHOW USER HELP IS POSSIBLE C ** IF IT IS THE ONLY ANSWER C CALL NITIO(CINP, 2, TTYO, 37, 0) CALL NITIO(CINP, 2, LFILE, 37, 0) C C PROMPT WITH *, THEN C INPUT SELECTION C C ** CALL NUMBER 38 TO NITIO C ** DISPLAY PROMPT CHARACTER C 110 CALL NITIO(CINP, 1, TTYO, 38, 0) CALL NITIO(CINP, 1, LFILE, 38, 0) C C ** CALL NUMBER 39 TO NITIO C ** READ IN ANSWER SELECTED C CALL NITIO(CINP, 80, TTY, 39, 0) LAST = EOLINE(CINP,80,BLANK) C C ** CALL NUMBER 40 TO NITIO C ** WRITE OUT USERS RESPONSE C CALL NITIO(CINP, LAST, LFILE, 40, 0) C C CHECK IF VALID RESPONSE C I = 1 CALL STRIPR(CSEL, CINP, NS, I, DIGITS, BLANK) IF ((CSEL.GT.0) .AND. LJUMP) GO TO 230 IF (LJUMP .AND. (CINP(NS).EQ.BLANK)) GO TO 230 IF ((CSEL.GE.1) .AND. (CSEL.LE.CCNT)) GO TO 290 C C ANSWER WAS NOT A VALID INTEGER, C NOW CHECK ANSWER FOR OTHER C VALID RESPONSES C C CHECK ANSWER FOR MOVING TO C THE PREVIOUS QUESTION C IF ((CINP(NS).NE.P) .AND. (CINP(NS).NE.LP)) GO TO 120 IF (LJUMP) GO TO 30 CACT = -1 TWICE = .FALSE. GO TO 410 C C CHECK ANSWER FOR BEGINNING AGAIN C 120 IF ((CINP(NS).NE.B) .AND. (CINP(NS).NE.LB)) GO TO 130 GO TO 470 C C CHECK ANSWER FOR USER WANTING C A LIST OF VALID RESPONSES C 130 IF ((CINP(NS).NE.N) .AND. (CINP(NS).NE.LN)) GO TO 140 NPICK = .TRUE. TWICE = .FALSE. C C ** CALL NUMBER 41 TO NITIO C ** DISPLAY NIT INTRODUCTION C CALL NITIO(CINP, 1, TTYO, 41, 0) CALL NITIO(CINP, 1, LFILE, 41, 0) GO TO 20 C C CHECK ANSWER FOR USER WANTING C TO MAKE A SUGGESTION C 140 IF ((CINP(NS).NE.S) .AND. (CINP(NS).NE.LS)) GO TO 150 TWICE = .FALSE. CMST = CTRE(6,CNXT) CALL SUGGST(CMST, SEL, XIN, SFILE, TTY, TTYO, TEND, * BLANK, LFILE) GO TO 10 C C CHECK ANSWER FOR QUITTING C 150 IF ((CINP(NS).NE.Q) .AND. (CINP(NS).NE.LQ)) GO TO 160 GO TO 480 C C CHECK RESPONSE FOR USER C REQUESTING HELP C 160 IF (CINP(NS).EQ.H) GO TO 170 IF (CINP(NS).EQ.LH) GO TO 170 IF (CINP(NS).EQ.QM) GO TO 170 GO TO 200 C C LOG USER REQUEST FOR HELP C 170 CALL HLPLOG(IHELP, CTRE(6,CNXT), SEL, XIN, HFILE, BLANK) C C CHECK IF HELP IS POSSIBLE C IF (IHELP.EQ.1) GO TO 180 C C ** CALL NUMBER 42 TO NITIO C ** DISPLAY NO HELP AVAILABLE C ** TO USER C CALL NITIO(CINP, 1, TTYO, 42, 0) CALL NITIO(CINP, 1, LFILE, 42, 0) GO TO 30 C C STACK BOX SO THAT THE C PATH HAS COME THIS WAY C 180 CHST(CLVL) = CNXT IF (CLVL.GT.TOP) GO TO 460 CLVL = CLVL + 1 C C FIND THE AVAILABLE HELP C 190 CNXT = CTRE(1,CNXT) IF (CTRE(5,CNXT).GE.0) GO TO 190 CNXT = CTRE(2,CNXT) GO TO 380 C C CHECK ANSWER FOR USER WANTING C TO MAKE A DYNAMIC GO TO C 200 IF ((CINP(NS).NE.JJ) .AND. (CINP(NS).NE.LJ)) GO TO 260 210 LJUMP = .TRUE. TWICE = .FALSE. C C STACK BOX IF IT IS NOT C ALREADY IN THE STACK C I = CLVL - 1 IF (CNXT.EQ.CHST(I)) GO TO 220 CHST(CLVL) = CNXT IF (CLVL.GT.TOP) GO TO 460 CLVL = CLVL + 1 C C ** CALL NUMBER 43 TO NITIO C ** DISPLAY DYNAMIC GOTO QUESTION C 220 CALL NITIO(CINP, 1, TTYO, 43, 0) CALL NITIO(CINP, 1, LFILE, 43, 0) GO TO 110 C C SET IMODE FOR A VALID INTEGER C AND TRY TO PERFORM GOTO C 230 IMODE = CSEL GO TO 330 C C ** CALL NUMBER 44 TO NITIO C ** DISPLAY ERROR FOR AN C ** INVALID BOX NUMBER C 240 CALL NITIO(CINP, 1, TTYO, 44, 0) CALL NITIO(CINP, 1, LFILE, 44, 0) GO TO 210 C C ** CALL NUMBER 45 TO NITIO C ** DISPLAY WARNING MESSAGE FOR C ** A LINE NUMBER AND CONTINUE C 250 CALL NITIO(CINP, 2, TTYO, 45, 0) CALL NITIO(CINP, 2, LFILE, 45, 0) GO TO 360 C C CHECK FOR INAPPROPRIATE RESPONSE C 260 IF (CINP(NS).EQ.C) GO TO 270 IF (CINP(NS).EQ.LC) GO TO 270 IF (CINP(NS).EQ.L) GO TO 270 IF (CINP(NS).EQ.LL) GO TO 270 GO TO 280 C C ** CALL NUMBER 46 TO NITIO C ** TYPE OUT INAPPROPRIATE RESPONSE C ** FOR NON-EXTERNAL TEXT C 270 CALL NITIO(CINP, 1, TTYO, 46, 0) CALL NITIO(CINP, 1, LFILE, 46, 0) TWICE = .FALSE. IF (LJUMP) GO TO 210 GO TO 10 C C ANSWER NOT VALID C 280 IF (TWICE) GO TO 10 C C ** CALL NUMBER 47 TO NITIO C ** TYPE OUT IMPROPER RESPONSE C CALL NITIO(CINP, 1, TTYO, 47, 0) CALL NITIO(CINP, 1, LFILE, 47, 0) IF (LJUMP) GO TO 210 TWICE = .TRUE. GO TO 110 C C RESPONSE WAS A VALID NUMBER C 290 CONTINUE TWICE = .FALSE. C C STACK QUESTION BOX AS C PART OF THE PATH C CHST(CLVL) = CNXT IF (CLVL.GT.TOP) GO TO 460 CLVL = CLVL + 1 C C FIND THE ANSWER SELECTED C CNXT = TRTBL(CSEL) CACT = CTRE(5,CNXT) C C CHECK FOR A NEGATIVE ACTION C IF (CACT.EQ.0) GO TO 430 IF (CACT.LT.0) GO TO 410 C C POSITIVE ACTION C CNXT = CTRE(2,CNXT) IF (CTRE(1,CNXT).NE.CNXT) GO TO 10 C C CHECK FOR A TERMINAL NODE C IF (CTRE(3,CNXT).NE.(-1)) GO TO 380 C C TERMINAL NODE POSITION C C GET STRING FOR THE C EXTERNAL SUBROUTINE C 300 I = CTRE(4,CNXT)/100 CMST = (I-1)*4 + 1 CMND = (CTRE(4,CNXT)+1-I*100)*4 C C INITIALIZE IOPT FLAGS FOR C POSSIBLE RETURN VALUES C IOPT(1) = 0 IOPT(2) = 0 IOPT(3) = 0 IOPT(4) = 0 C C SET VALUE IN IOPT FOR THIS XBOX C XBOX = CTRE(6,CNXT) IOPT(104) = XBOX C C HAVE EXTERNAL ROUTINE CALL C CALL OUTSID(CMSG(CMST), CMND, IOPT, CTRE, CMSG) C C CHECK FOR ERROR RETURNED C IN OUTSID C IFAULT = IOPT(1) IF (IFAULT.EQ.0) GO TO 310 GO TO 480 C C CHECK FOR OUTSID WANTING C TO CHANGE VARIABLES C 310 IVAL = IOPT(4) IF (IVAL.NE.1) GO TO 320 C C RESET THE VALUE OF PAGESZ TO C IOPT(5) C IVAL = IOPT(5) CALL SETPSZ(PAGESZ, IVAL) C C RESET THE VALUE OF LASTSZ TO C IOPT(6) C IVAL = IOPT(6) CALL SETLSZ(LASTSZ, IVAL) C C RESET THE VALUE OF TTY TO C IOPT(7) C IVAL = IOPT(7) CALL SETTY(TTY, IVAL) C C RESET THE VALUE OF TTYO TO C IOPT(8) C IVAL = IOPT(8) CALL SETTYO(TTYO, IVAL) C C RESET THE VALUE OF HFILE TO C IOPT(9) C IVAL = IOPT(9) CALL SETHFL(HFILE, IVAL) C C RESET THE VALUE OF SFILE TO C IOPT(10) C IVAL = IOPT(10) CALL SETSFL(SFILE, IVAL) C C RESET THE VALUE OF LFILE TO C IOPT(11) C IVAL = IOPT(11) CALL SETLFL(LFILE, IVAL) C C CHECK FOR OUTSID WANTING TO C CHANGE ITS NORMAL RETURN PATH C 320 CONTINUE IMODE = IOPT(2) IF (IMODE.EQ.1) GO TO 470 IF (IMODE.EQ.2) GO TO 480 IF (IMODE.NE.4) GO TO 400 C C DETERMINE IF A DYNAMIC GOTO C OR BACKING UP THE TREE IS C TO TAKE PLACE C IMODE = IOPT(3) IF (IMODE.LT.0) GO TO 370 C C FIND THE RETURNED BOX NUMBER C FROM OUTSID C 330 DO 340 I=1,TREDIM IF (CTRE(6,I).EQ.IMODE) GO TO 350 340 CONTINUE CINP(1) = IMODE IF (LJUMP) GO TO 240 C C ** CALL NUMBER 48 TO NITIO C ** DISPLAY INVALID BOX NUMBER C ** RETURNED BY OUTSID C CALL NITIO(CINP, 1, NOUT, 48, 0) CALL NITIO(CINP, 1, LFILE, 48, 0) C C INVALID BOX RETURNED BY OUTSID C IFALUT = 1 GO TO 480 C C CHECK IF THE TREE NODE C RETURNED FROM OUTSID C IS A LINE OR A BOX C 350 IF (CTRE(2,I).LT.0) GO TO 360 C C IF OUTSID RETURNED A LINE, C CONTINUE WITH THE BOX THIS C LINE LEADS TO AND DISPLAY C A WARNING MESSAGE C CINP(1) = IMODE I = CTRE(2,I) CINP(2) = CTRE(6,I) IF (LJUMP) GO TO 250 C C ** CALL NUMBER 49 TO NITIO C ** DISPLAY WARNING MESSAGE C ** FOR OUTSID RETURNING C ** A LINE NUMBER C CALL NITIO(CINP, 2, NOUT, 49, 0) CALL NITIO(CINP, 2, LFILE, 49, 0) C C CONTINUE THROUGH THE TREE C 360 CNXT = I LJUMP = .FALSE. IF (CTRE(3,CNXT).LT.0) GO TO 300 GO TO 10 C C PREPARE TO BACK UP THE C TREE MORE THAN ONE LEVEL C 370 CACT = IMODE GO TO 410 C C PRINT OUT TEXT AT LEAF NODE C 380 IF (CTRE(4,CNXT).LT.0) GO TO 390 I = CTRE(4,CNXT)/100 CMST = (I-1)*4 + 1 CMND = (CTRE(4,CNXT)+1-I*100)*4 C C ** CALL NUMBER 50 TO NITIO C ** TYPE OUT TERMINAL NODE TEXT C CALL NITIO(CMSG(CMST), CMND, TTYO, 50, 0) CALL NITIO(CMSG(CMST), CMND, LFILE, 50, 0) GO TO 400 C C PRINT OUT EXTERNAL TEXT C TO SCREEN C 390 IHELP = 0 CALL XTEXT(-CTRE(4,CNXT), SEL, XIN, TTYO, BLANK, B, C, L, * P, Q, TTY, IMODE, DIGITS, PAGESZ, HFILE, SFILE, QM, N, * H, S, LB, LP, LQ, LC, LL, LN, LH, LS, TEND, * CTRE(6,CNXT), LASTSZ, IHELP, LFILE, JJ, LJ) IF (IMODE.EQ.0) GO TO 400 IF (IMODE.EQ.1) GO TO 470 IF (IMODE.EQ.2) GO TO 400 IF (IMODE.EQ.3) GO TO 480 IF (IMODE.EQ.5) GO TO 210 C C NEGATIVE ACTION C 400 CONTINUE CACT = -1 410 CLVL = CLVL + CACT IF (CLVL.LE.0) GO TO 470 IF (CNXT.EQ.CHST(CLVL)) GO TO 400 CNXT = CHST(CLVL) GO TO 440 C C ** CALL NUMBER 51 TO NITIO C ** TYPE OUT AREA ARRAY OVERFLOW C 420 CALL NITIO(CINP, 1, NOUT, 51, 0) CALL NITIO(CINP, 1, LFILE, 51, 0) IFAULT = 1 GO TO 480 C C FIND RETURN ACTION C 430 CONTINUE CNXT = CTRE(1,CNXT) 440 IF (CTRE(2,CNXT).NE.(-1)) GO TO 430 CRET = CTRE(5,CNXT) IF (CRET.EQ.0) GO TO 10 CLVL = CLVL + CRET IF (CLVL.GT.0) GO TO 450 IF (CLVL.LT.0) ERROR = .TRUE. RETURN 450 CNXT = CHST(CLVL) GO TO 430 C C RESPNS ARRAY HAS NOW C BEEN FILLED C 460 IFAULT = 1 CINP(1) = TOP C C ** CALL NUMBER 52 TO NITIO C ** TYPE OUT RESPNS ARRAY OVERFLOW C CALL NITIO(CINP, 1, TTYO, 52, 0) CALL NITIO(CINP, 1, LFILE, 52, 0) GO TO 480 C C RETURN ERROR FALSE FOR C NIT TO BEGIN AGAIN C 470 CONTINUE ERROR = .FALSE. RETURN C C RETURN ERROR TRUE FOR C NIT TO RETURN C 480 CONTINUE ERROR = .TRUE. RETURN C END C SET 1 C-----------------------------------------------------------------------SET 2 C SET 3 SUBROUTINE SETHFL(HFILE, IVAL) SET 4 C C*********************************************************************** C * C SUBROUTINE TO RESET THE VALUE OF HFILE TO THE * C VALUE OF IVAL. * C * C*********************************************************************** C * INTEGER HFILE, IVAL HFILE = IVAL RETURN END C SET 1 C-----------------------------------------------------------------------SET 2 C SET 3 SUBROUTINE SETLFL(LFILE, IVAL) SET 4 C C*********************************************************************** C * C SUBROUTINE TO RESET THE VALUE OF LFILE TO THE * C VALUE OF IVAL. * C * C*********************************************************************** C * INTEGER LFILE, IVAL LFILE = IVAL RETURN END C SET 1 C-----------------------------------------------------------------------SET 2 C SET 3 SUBROUTINE SETLSZ(LASTSZ, IVAL) SET 4 C C*********************************************************************** C * C SUBROUTINE TO RESET THE VALUE OF LASTSZ TO THE * C VALUE OF IVAL. * C * C*********************************************************************** C * INTEGER LASTSZ, IVAL LASTSZ = IVAL RETURN END C SET 1 C-----------------------------------------------------------------------SET 2 C SET 3 SUBROUTINE SETPSZ(PAGESZ, IVAL) SET 4 C C*********************************************************************** C * C SUBROUTINE TO RESET THE VALUE OF PAGESZ TO THE * C VALUE OF IVAL. * C * C*********************************************************************** C * INTEGER PAGESZ, IVAL PAGESZ = IVAL RETURN END C SET 1 C-----------------------------------------------------------------------SET 2 C SET 3 SUBROUTINE SETSFL(SFILE, IVAL) SET 4 C C*********************************************************************** C * C SUBROUTINE TO RESET THE VALUE OF SFILE TO THE * C VALUE OF IVAL. * C * C*********************************************************************** C * INTEGER SFILE, IVAL SFILE = IVAL RETURN END C SET 1 C-----------------------------------------------------------------------SET 2 C SET 3 SUBROUTINE SETTY(TTY, IVAL) SET 4 C C*********************************************************************** C * C SUBROUTINE TO RESET THE VALUE OF TTY TO THE * C VALUE OF IVAL. * C * C*********************************************************************** C * INTEGER TTY, IVAL TTY = IVAL RETURN END C SET 1 C-----------------------------------------------------------------------SET 2 C SET 3 SUBROUTINE SETTYO(TTYO, IVAL) SET 4 C C*********************************************************************** C * C SUBROUTINE TO RESET THE VALUE OF TTYO TO THE * C VALUE OF IVAL. * C * C*********************************************************************** C * INTEGER TTYO, IVAL TTYO = IVAL RETURN END C STR 1 C-----------------------------------------------------------------------STR 2 C STR 3 SUBROUTINE STRIPR(N, BUFX, N1, IN, DIGITS, BLANK) STR 4 C C*********************************************************************** C * C THE PURPOSE OF THIS SUBROUTINE IS TO IDENTIFY ANY LEADING * C ELEMENTS OF BUFX, BEGINNING WITH BUFX(IN), WHICH MAY CORRESPOND * C TO AN INTEGER IN THE RANGE 0 THROUGH 9. IF THERE ARE NO SUCH * C ELEMENTS IN BUFX, THEN ON EXIT N WILL HAVE THE VALUE ZERO AND * C N1 WILL BE SET TO THE POSITION OF THE FIRST NON-BLANK CHARACTER * C AT OR BEYOND BUFX(IN). OTHERWISE, N IS SET TO THE NUMBER WHICH * C IS COMPOSED OF THE CONSECUTIVE INTEGERS THAT HAVE BEEN IDENTIFIED. * C IN THIS CASE, N1 WILL BE SET TO THE POSITION OF THE NEXT CHARACTER * C WHICH IS NOT AN INTEGER, BUT WHICH MAY BE A BLANK. * C * C----------------------------------------------------------------------* C * C VARIABLES USED: * C * C N - INTEGER SET TO THE COMPUTED VALUE OF THE STRING * C OF NUMERICAL CHARACTERS * C * C BUFX - CHARACTER ARRAY TO BE SEARCHED FOR NUMERICAL * C CHARACTERS * C * C N1 - POSITION IN THE ARRAY BUFX AT WHICH CONVERSION WAS * C STOPPED DUE TO THE CHARACTER STORED AT BUFX(N1) * C BEING INVALID FOR CONVERSION * C * C IN - POSITION IN THE ARRAY BUFX AT WHICH CONVERSION IS * C TO BEGIN * C * C DIGITS - AN ARRAY WHICH HOLDS THE CHARACTER VALUES OF * C THE DIGITS * C * C BLANK - AN INTEGER SET TO THE CHARACTER VALUE OF A BLANK * C * C*********************************************************************** C * INTEGER DIGITS(10), BUFX(1), N, N1, I, IN, BLANK, INMAX C C INITIALIZE INTEGER AND POSITION C N = 0 N1 = IN - 1 INMAX = IN + 80 C C FIND FIRST NON-BLANK CHARACTER C 10 N1 = N1 + 1 IF (N1.GT.INMAX) GO TO 40 IF (BUFX(N1).EQ.BLANK) GO TO 10 C C FIND CHARACTER VALUE OF C THE INTEGER C 20 I = 0 30 I = I + 1 IF (I.GT.10) GO TO 40 IF (BUFX(N1).NE.DIGITS(I)) GO TO 30 C C DETERMINE THE VALUE OF C THE INTEGER C N = N*10 + I - 1 N1 = N1 + 1 GO TO 20 C C RETURN TO CALLING ROUTINE C 40 CONTINUE RETURN END C SUG 1 C-----------------------------------------------------------------------SUG 2 C SUG 3 SUBROUTINE SUGGST(BOX, SEL, XIN, SFILE, TTY, TTYO, TEND, SUG 4 * BLANK, LFILE) C C*********************************************************************** C * C SUBROUTINE WHICH WRITES OUT USER SUGGESTIONS FOR IMPROVEMENT * C TO UNIT NUMBER SFILE. ALSO WRITTEN IS HEADER INFORMATION * C INCLUDING TREE NAME AND BOX NUMBER FROM WHICH THE SUGGESTION * C WAS MADE. THE END OF THE SUGGESTION IS DENOTED BY A / BEING * C TYPED IN COLUMN 1 FOLLOWED BY A CARRAIGE RETURN. A CALL IS * C MADE TO SUBROUTINE OUTHLP TO ALSO WRITE OUT ANY SYSTEM * C DEPENDENT INFORMATION. * C * C----------------------------------------------------------------------* C * C SUBROUTINES USED: * C * C EOLINE - THIS FUNCTION RETURNS THE POSITION OF THE LAST NON-BLANK* C CHARACTER IN AN ARRAY. * C * C NITIO - ROUTINE USED FOR ALL OF THE INPUT AND * C OUTPUT IN NIT. * C * C OUTHLP - SUBROUTINE TO WRITE OUT ANY USEFUL SYSTEM * C DEPENDENT INFORMATION AVAILABLE TO THE EXPERT * C SUCH AS DATE AND TIME. * C * C POINTX - POINTS TO THE TREE CARD OF ANY TREE IN THE EXTERNAL * C TEXT FILE. * C * C*********************************************************************** C * INTEGER BOX, SEL, XIN, SFILE, LAST, EOLINE, LINE(80), * BLANK, TTY, TTYO, TEND, LFILE C C SEE IF A TREE SELECTION C HAS BEEN MADE C IF (SEL.GT.0) GO TO 10 C C WRITE HEADER TO SFILE FOR C NO TREE SELECTION C C ** CALL NUMBER 53 TO NITIO C ** WRITE HEADER MESSAGE TO C ** SFILE FOR COMING SUGGESTION C CALL NITIO(LINE, 1, SFILE, 53, 0) GO TO 20 C C GET THE NUMBER OF THE TREE C AND THE BOX NUMBER C 10 LINE(1) = BOX LINE(2) = SEL C C ** CALL NUMBER 54 TO NITIO C ** WRITE OUT THE TREE NUMBER C ** AND THE BOX NUMBER C CALL NITIO(LINE, 2, SFILE, 54, 0) C C OBTAIN TREE NAME FOR C A TREE SELECTED C CALL POINTX(SEL, XIN) C C ** CALL NUMBER 55 TO NITIO C ** READ IN THE TREE NAME C CALL NITIO(LINE, 80, XIN, 55, 0) LAST = EOLINE(LINE,80,BLANK) C C ** CALL NUMBER 56 TO NITIO C ** WRITE OUT THE TREE NAME C CALL NITIO(LINE, LAST, SFILE, 56, 0) C C GET THE VALUE OF THE C END OF LINE MARKER C 20 LINE(1) = TEND C C ** CALL NUMBER 57 TO NITIO C ** DISPLAY INSTRUCTIONS TO USER C ** FOR MAKING A SUGGESTION C CALL NITIO(LINE, 1, TTYO, 57, 0) CALL NITIO(LINE, 1, LFILE, 57, 0) C C WRITE OUT ANY AVAILABLE C INFORMATION C CALL OUTHLP(SFILE) C C ** CALL NUMBER 58 TO NITIO C ** WRITE OUT START OF C ** SUGGESTION MARKER C CALL NITIO(LINE, 1, SFILE, 58, 0) C C ** CALL NUMBER 59 TO NITIO C ** READ IN ONE LINE OF C ** THE SUGGESTION C 30 CALL NITIO(LINE, 80, TTY, 59, 0) LAST = EOLINE(LINE,80,BLANK) C C ** CALL NUMBER 60 TO NITIO C ** WRITE OUT THE USERS C ** SUGGESTION C CALL NITIO(LINE, LAST, LFILE, 60, 0) C C CHECK IF IT IS THE END C OF THE SUGGESTION C IF ((LAST.EQ.1) .AND. (LINE(1).EQ.TEND)) GO TO 40 C C ** CALL NUMBER 61 TO NITIO C ** WRITE OUT ONE LINE C ** OF THE SUGGESTION C CALL NITIO(LINE, LAST, SFILE, 61, 0) GO TO 30 C C RETURN TO CALLING PROGRAM C 40 CONTINUE RETURN END C XTE 1 C-----------------------------------------------------------------------XTE 2 C XTE 3 SUBROUTINE XTEXT(NO, SEL, XIN, TTYO, BLANK, B, C, L, P, XTE 4 * Q, TTY, IMODE, DIGITS, PAGESZ, HFILE, SFILE, QM, N, H, * S, LB, LP, LQ, LC, LL, LN, LH, LS, TEND, BOX, LASTSZ, * IHELP, LFILE, JJ, LJ) C C*********************************************************************** C * C THIS SUBROUTINE PRINTS TO THE TERMINAL THE EXTERNAL * C TEXT SELECTED. * C * C ON EXIT, IMODE IS SET TO ONE OF THE FOLLOWING: * C * C IMODE = 0 TO CONTINUE AS USUAL * C IMODE = 1 FOR BEGINNING THE NIT SESSION AGAIN * C IMODE = 2 FOR MOVING TO THE PREVIOUS QUESTION * C IMODE = 3 FOR QUITTING A NIT SESSION IMMEDIATELY * C IMODE = 4 FOR A USER REQUEST FOR HELP * C IMODE = 5 FOR A DYNAMIC GOTO * C * C----------------------------------------------------------------------* C * C SUBROUTINES USED: * C * C EOLINE - THIS FUNCTION RETURNS THE POSITION OF THE LAST NON-BLANK* C CHARACTER IN AN ARRAY. * C * C HLPLOG - SUBROUTINE WHICH LOGS A USERS REQUEST * C FOR HELP AND WHETHER OR NOT HELP WAS * C AVAILABLE. * C * C NITIO - ROUTINE USED FOR ALL OF THE INPUT AND * C OUTPUT IN NIT. * C * C POINTX - POINTS TO THE TREE CARD OF ANY TREE IN THE EXTERNAL * C TEXT FILE. * C * C STRIPR - TO IDENTIFY ANY LEADING ELEMENTS OF AN ARRAY * C WHICH MAY CORRESPOND TO NUMERICAL CHARACTERS, * C AND CONVERT ANY THAT ARE FOUND INTO AN INTEGER. * C * C SUGGST - SUBROUTINE TO WRITE TO A FILE SUGGESTIONS * C MADE BY A USER. * C * C*********************************************************************** C * INTEGER NO, BLANK, SEL, CDS, LAST, EOLINE, NUM, CARD(80), * XIN, TTYO, I, B, C, L, P, Q, TTY, PAGESZ, LASTSZ, * IMODE, DIGITS(10), NPAGES, IHELP, NLINE, HFILE, QM, N, * S, TEND, SFILE, BOX, H, LN, LP, LQ, LB, LL, LC, LFILE, * LH, LS, JJ, LJ C C POINT TO THE CORRECT TREE C IN THE EXTERNAL FILE C CALL POINTX(SEL, XIN) C C INITIALIZE VARIABLES C CARD(1) = BLANK IMODE = 0 NLINE = 1 C C ** CALL NUMBER 62 TO NITIO C ** READ IN THE TREE CARD C CALL NITIO(CARD, 1, XIN, 62, 0) C C ** CALL NUMBER 63 TO NITIO C ** READ IN THE TREE TOTALS LINE C 10 CALL NITIO(CARD, 1, XIN, 63, 0) C C SEARCH FOR THE CORRECT C TEXT TO BE PRINTED C C ** CALL NUMBER 64 TO NITIO C ** READ IN THE FILE TOTALS LINE C 20 CALL NITIO(CARD, 2, XIN, 64, 0) NUM = CARD(1) CDS = CARD(2) C C READ THROUGH THE UNWANTED TEXT C IF (NUM.EQ.NO) GO TO 40 DO 30 I=1,CDS C C ** CALL NUMBER 65 TO NITIO C ** READ IN A CARD TO SKIP IT C CALL NITIO(CARD, 1, XIN, 65, 0) 30 CONTINUE GO TO 20 C C AFTER THE TEXT HAS BEEN FOUND, C CHECK IF THE WHOLE TEXT C CAN FIT ON A SINGLE PAGE C 40 CONTINUE IF (CDS.LE.PAGESZ) GO TO 150 IF (NLINE.GT.1) GO TO 110 CARD(1) = CDS C C CALCULATE NUMBER OF PAGES NEEDED C NPAGES = (CDS-1)/PAGESZ + 1 CARD(2) = NPAGES C C ** CALL NUMBER 66 TO NITIO C ** DISPLAY QUESTION DOES USER C ** WISH TO SEE THIS TEXT C CALL NITIO(CARD, 2, TTYO, 66, 0) CALL NITIO(CARD, 2, LFILE, 66, 0) C C ** CALL NUMBER 67 TO NITIO C ** DISPLAY PROMPT CHARACTER C CALL NITIO(CARD, 1, TTYO, 67, 0) CALL NITIO(CARD, 1, LFILE, 67, 0) C C ** CALL NUMBER 68 TO NITIO C ** READ IN THE ANSWER C CALL NITIO(CARD, 80, TTY, 68, 0) LAST = EOLINE(CARD,80,BLANK) C C ** CALL NUMBER 69 TO NITIO C ** TYPE OUT USERS RESPONSE C CALL NITIO(CARD, LAST, LFILE, 69, 0) C C GET ANSWER FROM USER C LAST = 1 CALL STRIPR(NUM, CARD, I, LAST, DIGITS, BLANK) C C SET IMODE DEPENDING ON C A VALID ANSWER C IF (NUM.EQ.1) GO TO 150 IF ((CARD(I).EQ.B) .OR. (CARD(I).EQ.LB)) IMODE = 1 IF ((CARD(I).EQ.C) .OR. (CARD(I).EQ.LC)) GO TO 150 IF ((CARD(I).EQ.H) .OR. (CARD(I).EQ.LH)) GO TO 70 IF ((CARD(I).EQ.L) .OR. (CARD(I).EQ.LL)) GO TO 120 IF ((CARD(I).EQ.N) .OR. (CARD(I).EQ.LN)) GO TO 50 IF ((CARD(I).EQ.P) .OR. (CARD(I).EQ.LP)) IMODE = 2 IF ((CARD(I).EQ.Q) .OR. (CARD(I).EQ.LQ)) IMODE = 3 IF ((CARD(I).EQ.JJ) .OR. (CARD(I).EQ.LJ)) IMODE = 5 IF ((CARD(I).EQ.S) .OR. (CARD(I).EQ.LS)) GO TO 60 IF (CARD(I).EQ.QM) GO TO 70 IF (NUM.EQ.2) IMODE = 2 IF (NUM.GT.2) GO TO 90 IF (IMODE.GT.0) GO TO 260 C C ** CALL NUMBER 70 TO NITIO C ** DISPLAY INVALID RESPONSE C ** MESSAGE C CALL NITIO(CARD, 1, TTYO, 70, 0) CALL NITIO(CARD, 1, LFILE, 70, 0) C C STORE VALID RESPONSES C 50 CONTINUE CARD(1) = B CARD(2) = P CARD(3) = Q CARD(4) = QM CARD(5) = H CARD(6) = S CARD(7) = JJ CARD(8) = C CARD(9) = L CARD(10) = N C C ** CALL NUMBER 71 TO NITIO C ** DISPLAY POSSIBLE ANSWERS C CALL NITIO(CARD, 10, TTYO, 71, 0) CALL NITIO(CARD, 10, LFILE, 71, 0) GO TO 40 C C CALL SUGGST TO LET USER C MAKE A SUGGESTION C 60 CALL SUGGST(BOX, SEL, XIN, SFILE, TTY, TTYO, TEND, BLANK, * LFILE) GO TO 10 C C CHECK IF HELP IS AVAILABLE C 70 IF (IHELP.NE.1) GO TO 80 IMODE = 4 GO TO 260 C C ** CALL NUMBER 72 TO NITIO C ** TYPE OUT NO HELP AVAILABLE C 80 CALL NITIO(CARD, 1, TTYO, 72, 0) CALL NITIO(CARD, 1, LFILE, 72, 0) C C LOG USERS REQUEST FOR HELP C CALL HLPLOG(IHELP, BOX, SEL, XIN, HFILE, BLANK) GO TO 10 C C CHECK FOR A VALID LINE NUMBER C 90 IF (NUM.LE.CDS) GO TO 100 CARD(1) = CDS C C ** CALL NUMBER 73 TO NITIO C ** DISPLAY INAPPROPRIATE C ** RESPONSE MESSAGE C CALL NITIO(CARD, 1, TTYO, 73, 0) CALL NITIO(CARD, 1, LFILE, 73, 0) GO TO 40 C C BRANCH TO READ THROUGH BEGINNING C TEXT FOR A VALID NUMBER C 100 NUM = NUM - 1 GO TO 130 C C PREPARE TO READ THROUGH C BEGINNING OF TEXT C 110 NUM = NLINE - PAGESZ - 1 NLINE = 1 IF (NLINE.GT.NUM) GO TO 150 GO TO 130 C C CALCULATE BEGINNING OF THE C LAST PAGE C 120 CONTINUE NUM = CDS - PAGESZ IF (NUM.LT.NLINE) GO TO 150 C C READ THROUGH TO THE LAST PAGE C 130 DO 140 I=NLINE,NUM C C ** CALL NUMBER 74 TO NITIO C ** READ IN A CARD TO SKIP IT C CALL NITIO(CARD, 1, XIN, 74, 0) 140 CONTINUE NLINE = NUM + 1 C C CALCULATE END OF THE PAGE C TO BE TYPED C 150 CONTINUE NUM = NLINE + PAGESZ - 1 IF (NUM.GT.CDS) NUM = CDS C C WRITE OUT THE EXTERNAL C TEXT TO THE TERMINAL C CARD(1) = BLANK C C ** CALL NUMBER 75 TO NITIO C ** TYPE OUT A BLANK LINE C CALL NITIO(CARD, 1, TTYO, 75, 0) CALL NITIO(CARD, 1, LFILE, 75, 0) DO 160 I=NLINE,NUM C C ** CALL NUMBER 76 TO NITIO C ** READ IN A LINE OF C ** EXTERNAL TEXT C CALL NITIO(CARD, 80, XIN, 76, 0) LAST = EOLINE(CARD,80,BLANK) C C ** CALL NUMBER 77 TO NITIO C ** TYPE OUT A LINE OF C ** EXTERNAL TEXT C CALL NITIO(CARD, LAST, TTYO, 77, 0) CALL NITIO(CARD, LAST, LFILE, 77, 0) 160 CONTINUE C C CALCULATE START OF THE C NEXT PAGE C NLINE = NLINE + PAGESZ IF (NLINE.GT.CDS) GO TO 250 C C STORE LINE NUMBER C 170 CARD(1) = NLINE - 1 CARD(2) = C CARD(3) = L C C ** CALL NUMBER 78 TO NITIO C ** DISPLAY EXTERNAL TEXT C ** COMMAND PROMPT C CALL NITIO(CARD, 3, TTYO, 78, 0) CALL NITIO(CARD, 3, LFILE, 78, 0) C C ** CALL NUMBER 79 TO NITIO C ** READ IN ANSWER TO EXTERNAL C ** TEXT QUESTION C CALL NITIO(CARD, 80, TTY, 79, 0) LAST = EOLINE(CARD,80,BLANK) C C ** CALL NUMBER 80 TO NITIO C ** TYPE OUT USERS RESPONSE C CALL NITIO(CARD, LAST, LFILE, 80, 0) C C DETERMINE ANSWER FROM USER C LAST = 1 CALL STRIPR(NUM, CARD, I, LAST, DIGITS, BLANK) C C SET IMODE AND/OR BRANCH C FOR A VALID ANSWER C IF (NUM.GT.0) GO TO 220 IF ((CARD(I).EQ.B) .OR. (CARD(I).EQ.LB)) IMODE = 1 IF ((CARD(I).EQ.C) .OR. (CARD(I).EQ.LC)) GO TO 150 IF ((CARD(I).EQ.H) .OR. (CARD(I).EQ.LH)) GO TO 200 IF ((CARD(I).EQ.L) .OR. (CARD(I).EQ.LL)) GO TO 120 IF ((CARD(I).EQ.N) .OR. (CARD(I).EQ.LN)) GO TO 180 IF ((CARD(I).EQ.P) .OR. (CARD(I).EQ.LP)) IMODE = 2 IF ((CARD(I).EQ.Q) .OR. (CARD(I).EQ.LQ)) IMODE = 3 IF ((CARD(I).EQ.JJ) .OR. (CARD(I).EQ.LJ)) IMODE = 5 IF ((CARD(I).EQ.S) .OR. (CARD(I).EQ.LS)) GO TO 190 IF (CARD(I).EQ.QM) GO TO 200 IF (IMODE.GT.0) GO TO 260 C C ** CALL NUMBER 81 TO NITIO C ** DISPLAY IMPROPER RESPONSE C CALL NITIO(CARD, 1, TTYO, 81, 0) CALL NITIO(CARD, 1, LFILE, 81, 0) C C STORE VALID RESPONSES 180 CONTINUE CARD(1) = B CARD(2) = P CARD(3) = Q CARD(4) = QM CARD(5) = H CARD(6) = S CARD(7) = JJ CARD(8) = C CARD(9) = L CARD(10) = N C C ** CALL NUMBER 82 TO NITIO C ** DISPLAY POSSIBLE ANSWERS C ** TO EXTERNAL QUESTION C CALL NITIO(CARD, 10, TTYO, 82, 0) CALL NITIO(CARD, 10, LFILE, 82, 0) GO TO 170 C C CALL SUGGST TO ALLOW THE USER C TO MAKE A SUGGESTION C 190 CALL SUGGST(BOX, SEL, XIN, SFILE, TTY, TTYO, TEND, BLANK, * LFILE) GO TO 10 C C CHECK IF HELP IS AVAILABLE C 200 IF (IHELP.NE.1) GO TO 210 IMODE = 4 GO TO 260 C C STORE ANSWER FOR MAKING C A SUGGESTION C 210 CARD(1) = S C C ** CALL NUMBER 83 TO NITIO C ** TYPE OUT NO HELP AVAILABLE C CALL NITIO(CARD, 1, TTYO, 83, 0) CALL NITIO(CARD, 1, LFILE, 83, 0) C C LOG USERS REQUEST FOR HELP C CALL HLPLOG(IHELP, BOX, SEL, XIN, HFILE, BLANK) GO TO 10 C C CHECK FOR NUMBER OF PRESENT LINE C 220 IF (NUM.EQ.NLINE) GO TO 150 C C CHECK FOR INVALID LINE NUMBER C IF (NUM.LE.CDS) GO TO 230 CARD(1) = CDS C C ** CALL NUMBER 84 TO NITIO C ** DISPLAY INAPPROPRIATE C ** RESPONSE MESSAGE C CALL NITIO(CARD, 1, TTYO, 84, 0) CALL NITIO(CARD, 1, LFILE, 84, 0) GO TO 170 C C IF NUM IS GREATER THAN THE C PRESENT LINE, THEN READ C THROUGH THE TEXT TILL NUM C IS REACHED C 230 IF (NUM.LT.NLINE) GO TO 240 NUM = NUM - 1 GO TO 130 C C REWIND EXTERNAL TEXT AND GO C BACK TO THE BEGINNING OF C THIS TEXT C 240 NLINE = NUM + PAGESZ CALL POINTX(SEL, XIN) C C ** CALL NUMBER 85 TO NITIO C ** READ THROUGH THE TREE CARD C CALL NITIO(CARD, 1, XIN, 85, 0) GO TO 10 C C CHECK IF END OF TEXT MESSAGE C IS TO BE DISPLAYED C 250 NUM = NUM + PAGESZ - NLINE IF (NUM.LE.LASTSZ) GO TO 260 C C ** CALL NUMBER 86 TO NITIO C ** DISPLAY END OF TEXT MESSAGE C CALL NITIO(CARD, 1, TTYO, 86, 0) CALL NITIO(CARD, 1, LFILE, 86, 0) C C ** CALL NUMBER 87 TO NITIO C ** READ IN A CARRIAGE C ** RETURN TO CONTINUE C CALL NITIO(CARD, 1, TTY, 87, 0) C C RETURN TO CALLING ROUTINE C 260 CONTINUE RETURN END C***********************************************************************MAN 1 C *MAN 2 C THIS IS PROGRAM TREDRV FROM NITPACK *MAN 3 C *MAN 4 C BY *MAN 5 C *MAN 6 C P.W.GAFFNEY *MAN 7 C J.W.WOOTEN *MAN 8 C K.A.KESSEL *MAN 9 C W.R.MCKINNEY *MAN 10 C *MAN 11 C *MAN 12 C VERSION: TRANSPORTABLE...JUNE 3, 1983 *MAN 13 C *MAN 14 C PURPOSE: *MAN 15 C *MAN 16 C TREDRV IS THE DRIVER PROGRAM FOR SUBROUTINE NITREE. *MAN 17 C *MAN 18 C***********************************************************************MAN 19 C *MAN 20 C ** INPUT FOR NITREE ** *MAN 21 C *MAN 22 C BEFORE EXECUTION OF TREDRV AND NITREE, THE FOLLOWING FILES *MAN 23 C MUST EXIST: *MAN 24 C *MAN 25 C FILE 1 - EXISTING INTERNAL TEXT FILE. *MAN 26 C *MAN 27 C FILE 3 - EXISTING EXTERNAL TEXT FILE. *MAN 28 C *MAN 29 C FILE 7 - USER INPUT FILE TO NITREE. *MAN 30 C *MAN 31 C***********************************************************************MAN 32 C *MAN 33 C ** OUTPUT FROM NITREE ** *MAN 34 C *MAN 35 C THE OUTPUT FROM NITREE WILL BE TO THE FOLLOWING FILES: *MAN 36 C *MAN 37 C FILE 2 - NEW INTERNAL TEXT FILE. *MAN 38 C *MAN 39 C FILE 4 - NEW EXTERNAL TEXT FILE. *MAN 40 C *MAN 41 C FILE 6 - ALL OF THE OUTPUT MESSAGES, INCLUDING ERROR MESSAGES, *MAN 42 C FROM TREDRV AND NITREE ARE TO UNIT NUMBER 6. *MAN 43 C *MAN 44 C *MAN 45 C***********************************************************************MAN 46 C *MAN 47 C ** TEMPORARY FILES USED BY NITREE ** *MAN 48 C *MAN 49 C NITREE WILL USE THE FOLLOWING TEMPORARY FILES WHICH MAY BE *MAN 50 C DISCARDED AFTER EXECUTION: *MAN 51 C *MAN 52 C FILE 8 - TEMPORARY OUTPUT OF EXTERNAL TEXT. *MAN 53 C *MAN 54 C***********************************************************************MAN 55 C *MAN 56 C ** CALLING SEQUENCE FOR SUBROUTINE NITREE ** *MAN 57 C *MAN 58 C CALL NITREE(MODE, IFAULT) *MAN 59 C *MAN 60 C *MAN 61 C ** PARAMETER LIST FOR SUBROUTINE NITREE ** *MAN 62 C *MAN 63 C *MAN 64 C INPUT PARAMETERS: *MAN 65 C *MAN 66 C MODE - IS AN INTEGER WHICH MUST BE SET TO ONE *MAN 67 C OF THE FOLLOWING VALUES ON ENTRY: *MAN 68 C *MAN 69 C MODE = 1 TO INDICATE THAT NEW TREES ARE TO BE ADDED *MAN 70 C AND/OR ARE TO REPLACE THE EXISTING TREES IN *MAN 71 C THE TREE FILES. *MAN 72 C *MAN 73 C MODE = 2 TO INDICATE THAT THE TREES NAMED IN FILE 7 ARE *MAN 74 C TO BE DELETED FROM THE EXISTING TREES. *MAN 75 C *MAN 76 C MODE IS LEFT UNCHANGED ON EXIT. *MAN 77 C *MAN 78 C *MAN 79 C OUTPUT PARAMETERS: *MAN 80 C *MAN 81 C IFAULT - IS AN INTEGER SET TO ONE OF THE *MAN 82 C FOLLOWING VALUES ON EXIT: *MAN 83 C *MAN 84 C IFAULT = 0 EXECUTION NORMAL, NO ERRORS ENCOUNTERED. *MAN 85 C *MAN 86 C IFAULT = 1 EXECUTION ABNORMAL, ERRORS ENCOUNTERED. *MAN 87 C FOR MORE INFORMATION EXAMINE THE ERROR *MAN 88 C MESSAGES WRITTEN TO UNIT 6. *MAN 89 C *MAN 90 C *MAN 91 C***********************************************************************MAN 92 C *MAN 93 C ** FIRST CALL TO NITREE ** *MAN 94 C *MAN 95 C IF THIS IS THE FIRST TIME NITREE IS BEING CALLED AND THERE *MAN 96 C ARE NO EXISTING INTERNAL OR EXTERNAL TEXT FILES, THEN THE *MAN 97 C FOLLOWING FILES MUST BE CREATED: *MAN 98 C *MAN 99 C 1) FILE 1 *MAN 100 C *MAN 101 C THE ONE AND ONLY CARD IN THIS FILE SHOULD BE: *MAN 102 C *MAN 103 C / *MAN 104 C *MAN 105 C WHERE THE SLASH ('/') APPEARS IN COLUMN 1. *MAN 106 C *MAN 107 C 2) FILE 3 *MAN 108 C *MAN 109 C THE ONE AND ONLY CARD IN THIS FILE SHOULD BE: *MAN 110 C *MAN 111 C / *MAN 112 C *MAN 113 C WHERE THE SLASH ('/') APPEARS IN COLUMN 1. *MAN 114 C *MAN 115 C *MAN 116 C***********************************************************************MAN 117 C *MAN 118 C *MAN 119 C ** BEGIN EXECUTABLE STATEMENTS FOR TREDRV ** *MAN 120 C *MAN 121 INTEGER MODE, IFAULT MAN 122 C MAN 123 C SET MODE TO 1 TO ADD TREES MAN 124 C TO THE EXISTING TREE FILES. MAN 125 C MAN 126 MODE = 1 MAN 127 C MAN 128 C MAKE CALL TO SUBROUTINE NITREE MAN 129 C MAN 130 CALL NITREE(MODE, IFAULT) MAN 131 C MAN 132 C CHECK FOR ERRORS ENCOUNTERED MAN 133 C AND WRITE OUT NORMAL OR MAN 134 C ABNORMAL EXECUTION MESSAGE MAN 135 C MAN 136 IF (IFAULT.EQ.0) WRITE (6,99999) MAN 137 IF (IFAULT.EQ.1) WRITE (6,99998) MAN 138 C MAN 139 C END OF TREDRV MAN 140 C MAN 141 STOP MAN 142 99999 FORMAT (/45H NITREE EXECUTION NORMAL, NO ERRORS ENCOUNTER, MAN 143 * 2HED) MAN 144 99998 FORMAT (/45H NITREE EXECUTION ABNORMAL, ERRORS ENCOUNTERE, MAN 145 * 1HD) MAN 146 END MAN 147 C NIT 1 C-----------------------------------------------------------------------NIT 2 C NIT 3 SUBROUTINE NITREE(MODE, IFAULT) NIT 4 C C*********************************************************************** C * C THIS IS SUBROUTINE NITREE FROM NITPACK * C * C BY * C * C P.W.GAFFNEY * C J.W.WOOTEN * C K.A.KESSEL * C W.R.MCKINNEY * C * C * C VERSION: TRANSPORTABLE...JUNE 3, 1983 * C * C PURPOSE: * C * C NITREE CONVERTS A PAPER DECISION TREE INTO ONE THAT * C CAN BE USED INTERACTIVELY AT A COMPUTER * C TERMINAL. * C * C*********************************************************************** C * C **** QUALITY ASSURANCE AND SOFTWARE STANDARD **** * C * C THE SUBROUTINES THAT COMPRISE NITREE * C HAVE BEEN WRITTEN TO CONFORM TO THE FORTRAN IV * C ANSI STANDARD 1966, AND THEY HAVE BEEN VERIFIED * C USING THE BELL TELEPHONE LABORATORIES FORTRAN * C VERIFIER: PFORT. * C THE SUBROUTINES HAVE BEEN EXTENSIVELY TESTED ON * C A VARIETY OF TESTS AND TREES, AND THEY HAVE BEEN * C ANALYSED FOR ERRORS USING THE DAVE SYSTEM FROM * C THE UNIVERSITY OF COLORADO. * C TO MAKE THE CODE EASY TO READ THE SUBROUTINES * C HAVE BEEN REFORMATTED USING POLISH. * C * C*********************************************************************** C * C ** CALLING SEQUENCE FOR SUBROUTINE NITREE ** * C * C CALL NITREE(MODE, IFAULT) * C * C * C ** PARAMETER LIST FOR SUBROUTINE NITREE ** * C * C * C INPUT PARAMETERS: * C * C MODE - IS AN INTEGER WHICH MUST BE SET TO ONE * C OF THE FOLLOWING VALUES ON ENTRY: * C * C MODE = 1 TO INDICATE THAT NEW TREES ARE TO BE ADDED * C AND/OR REPLACE THE EXISTING TREES IN THE * C TREE FILES. * C * C MODE = 2 TO INDICATE THAT THE TREES NAMED IN FILE 7 ARE * C TO BE DELETED FROM THE EXISTING TREES. * C * C MODE IS LEFT UNCHANGED ON EXIT. * C * C * C OUTPUT PARAMETERS: * C * C IFAULT - IS AN INTEGER SET TO ONE OF THE * C FOLLOWING VALUES ON EXIT: * C * C IFAULT = 0 EXECUTION NORMAL, NO ERRORS ENCOUNTERED. * C * C IFAULT = 1 EXECUTION ABNORMAL, ERRORS ENCOUNTERED. * C FOR MORE INFORMATION EXAMINE THE ERROR * C MESSAGES WRITTEN TO UNIT 6. * C * C * C*********************************************************************** C * C MAIN VARIABLES USED IN NITREE: * C * C BFMX - IS THE MAXIMUM LENGTH OF A SINGLE INTERNAL TEXT * C STRING. BFMX SHOULD NOT BE LARGER THAN 400. TEXT * C LONGER THAN BFMX CHARACTERS SHOULD BE EXTERNAL TEXT. * C IT IS DEFAULTED TO THE VALUE 400. * C * C BUFF - IS AN ARRAY OF LENGTH BFMX WHICH IS USED TO HOLD * C A SINGLE STRING OF INTERNAL TEXT. * C * C CARD - IS AN ARRAY OF LENGTH 80 USED TO HOLD A LINE OF * C THE INPUT FILE. * C * C CARD2 - IS AN ARRAY OF LENGTH 80 USED TO HOLD A LINE OF * C OF THE EXISTING INTERNAL OR EXTERNAL TEXT. * C * C DIGITS - IS AN ARRAY OF LENGTH 10 USED TO HOLD THE * C CHARACTER VALUES OF THE DIGITS. * C * C MXTRE - IS A VARIABLE WHICH IS SET TO THE SECOND DIMENSION * C OF THE ARRAY TREE. * C IT IS DEFAULTED TO THE VALUE 1000. * C * C MXTXT - IS A VARIABLE SET TO THE LENGTH OF THE ARRAY TEXT. * C IT IS DEFAULTED TO THE VALUE 8000. * C * C TEXT - IS AN ARRAY OF LENGTH MXTXT WHICH IS USED TO HOLD * C THE INTERNAL TEXT. * C * C TREE - IS A TWO DIMENSIONAL ARRAY WHOSE FIRST DIMENSION IS 8 * C AND WHOSE SECOND DIMENSION IS MXTRE. IT IS USED TO * C HOLD THE TREE STRUCTURE OBTAINED FROM THE * C CONNECTIVITY TABLE SUPPLIED BY THE USER. * C * C * C ALL OF THE VARIABLES USED IN NITREE ARE OF TYPE * C INTEGER UNLESS OTHERWISE SPECIFIED. * C * C * C*********************************************************************** C * C SUBROUTINES CALLED: * C * C CONECT - READS THE CONNECTIVITY TABLE SUPPLIED BY THE USER AND * C CONNECTS THE NODES. * C * C EOLINE - FUNCTION WHICH RETURNS THE POSITION IN AN * C ARRAY OF THE LAST NON-BLANK CHARACTER IN * C THE ARRAY. * C * C OUTPUT - READS THE TEMPORARY FILE CREATED BY TEXTIN AND MAKES * C THE DATA FILES THAT ARE READ BY NIT. * C * C PTEXT - PACKS THE INTERNAL TEXT INTO THE TEXT ARRAY * C AND RETURNS THE VALUES OF THE POINTERS. * C * C STRIPR - IDENTIFIES ANY LEADING ELEMENTS OF AN ARRAY * C WHICH MAY CORRESPOND TO NUMERICAL CHARACTERS, * C AND CONVERTS ANY THAT ARE FOUND INTO AN INTEGER. * C * C TEXTIN - READS THE TREE TEXT SUPPLIED BY THE USER. CHECKS FOR * C CORRECT FORMAT AND RENUMBERS THE NODES. OUTPUTS THE * C EXTERNAL TEXT TO A TEMPORARY FILE. THE INTERNAL TEXT * C IS STORED IN THE TEXT ARRAY AND THE TEXT POINTERS ARE * C STORED IN THE TREE ARRAY. * C * C TREEIO - PERFORMS ALL OF THE INPUT AND OUTPUT * C OPERATIONS FOR NITREE. * C * C * C THESE SUBROUTINES ARE ARRANGED IN ALPHABETICAL * C ORDER FOLLOWING SUBROUTINE NITREE. * C * C * C*********************************************************************** C * C ** FIRST CALL TO NITREE ** * C * C IF THIS IS THE FIRST TIME NITREE IS BEING CALLED AND THERE * C ARE NO EXISTING INTERNAL OR EXTERNAL TEXT FILES, THEN THE * C FOLLOWING FILES MUST BE CREATED: * C * C 1) FILE 1 - EXISTING INTERNAL TEXT FILE * C * C THE ONE AND ONLY CARD IN THIS FILE SHOULD BE: * C * C / * C * C WHERE THE SLASH ('/') APPEARS IN COLUMN 1. * C * C 2) FILE 3 - EXISTING EXTERNAL TEXT FILE * C * C THE ONE AND ONLY CARD IN THIS FILE SHOULD BE: * C * C / * C * C WHERE THE SLASH ('/') APPEARS IN COLUMN 1. * C * C * C*********************************************************************** C * C FORMAT OF NEW TREES WHEN IMODE = 1 * C * C 1) TREE CARD ... THE FIRST LINE OF INPUT CONTAINS: * C * C * NAME OF TREE (THE * IS IN COLUMN 1) * C * C 2) TREE TEXT ... EACH LINE OF INPUT CONTAINS: * C * C NNNN TEXT * C * C WHERE NNNN IS THE NUMBER OF THE LINE OR BOX OF THE TREE. * C THIS NUMBER SHOULD START IN COLUMN 1. * C TEXT IS THE TEXT ASSOCIATED WITH THE LINE OR BOX. IF THE * C TEXT IS LONGER THAN 80 COLUMNS, THEN BEGIN SUCCESSIVE * C LINES IN COLUMN 2. * C * C NOTE: WE SUGGEST THAT ALL EXTERNAL TEXT SHOULD * C BE TYPED WITHIN COLUMNS 1 THROUGH 72. * C * C 3) END OF TEXT IS DELIMITED BY: * C * C * (BEGINNING IN COLUMN 1) * C * C 4) CONNECTIVITY TABLE ... EACH LINE OF INPUT CONTAINS: * C * C I J K * C * C WHERE I AND K ARE THE NUMBERS ASSOCIATED WITH THE BOXES * C CONNECTED BY LINE NUMBER J. THE NUMBERS I AND K * C INCLUDE ANY ASSOCIATED ASTERISKS OR CROSSES. * C * C THE BEGINNING OF THE TREE IS IDENTIFIED BY: * C * C S L * C * C WHERE S IS THE LETTER S (BEGINNING IN COLUMN 1) * C AND L IS THE NUMBER OF THE BOX STARTING THE TREE. * C * C 5) LAST CARD ... THE LAST CARD SHOULD BE: * C * C / * C * C WHERE THE SLASH ('/') APPEARS IN COLUMN 1. * C * C * C*********************************************************************** C * C NOTE: THE ORDER IN WHICH RESPONSES APPEAR IN THE TREE * C TEXT (PART 2 ABOVE) IS THE SAME ORDER IN WHICH * C NIT WILL DISPLAY THEM IN THE MENU. FOR EXAMPLE, * C IN THE FOLLOWING TREE: * C * C *TREE DUMMY * C 10 TEXT1 (RESPONSE) * C 31 BOXA * C 33 BOXB * C 15 TEXT3 (RESPONSE) * C 5 TEXT2 (RESPONSE) * C 32 BOXC * C 1 QUESTION? * C * * C S 1 * C 1 15 31 * C 1 5 32 * C 1 10 33 * C * C * C THE FOLLOWING WILL BE OUTPUT BY NIT AFTER THIS * C TREE HAS BEEN SELECTED: * C * C QUESTION? * C (1) TEXT1 * C (2) TEXT3 * C (3) TEXT2 * C * * C * C * C IN ORDER TO MODIFY THE TREE SO THAT THE RESPONSES * C APPEAR IN A MORE NATURAL ORDER, THE TREE COULD LOOK * C LIKE THIS: * C * C *TREE DUMMY * C 10 TEXT1 (RESPONSE) * C 5 TEXT2 (RESPONSE) * C 31 BOXA * C 33 BOXB * C 15 TEXT3 (RESPONSE) * C 32 BOXC * C 1 QUESTION? * C * * C S 1 * C 1 15 31 * C 1 5 32 * C 1 10 33 * C * C * C WHEN THE OUTPUT FROM NIT WOULD APPEAR AS FOLLOWS: * C * C QUESTION? * C (1) TEXT1 * C (2) TEXT2 * C (3) TEXT3 * C * * C * C * C*********************************************************************** C * C FORMAT OF INPUT WHEN MODE = 2 * C * C 1) *COMPLEX ARITHMETIC * C 1) *MATRIX OPERATIONS * C . . . . . . * C . . . . . . * C . . . . . . * C 2) / * C * C EXPLANATIONS: * C * C 1) TREE CARD ... THE NAME OF THE TREE TO BE DELETED * C * C * NAME OF TREE (THE * IS IN COLUMN 1) * C * C 2) LAST CARD ... THE LAST CARD SHOULD BE: * C * C / * C * C WHERE THE SLASH ('/') APPEARS IN COLUMN 1. * C * C*********************************************************************** C * C NOTE: IF MORE THAN ONE TREE IS TO BE PROCESSED, THEN * C THE TREES SHOULD COME ONE AFTER THE OTHER AND THE LAST * C CARD SHOULD COME AFTER THE LAST TREE TO BE PROCESSED. * C (THERE SHOULD ONLY BE ONE LAST CARD IN THE INPUT FILE.) * C * C*********************************************************************** C * C FORTRAN UNIT NUMBERS: * C * C 1 - EXISTING INTERNAL TEXT FILE. * C 2 - NEW INTERNAL TEXT CREATED BY NITREE. * C 3 - EXISTING EXTERNAL TEXT FILE. * C 4 - NEW EXTERNAL TEXT CREATED BY NITREE. * C 6 - WRITES TO THE TTY OR TO AN OUTPUT FILE. * C 7 - THE DATA FILE THAT WAS PREPARED BY THE USER. * C 8 - USE FOR TEMPORARY STORAGE OF EXTERNAL TEXT. * C * C * C*********************************************************************** C DECLARATION STATEMENTS * C*********************************************************************** C * INTEGER BLANK, ENDLIN, IN, ASTER, MXTXT, MXTRE, TTYO, * TEXT, MNTRE, OUT, I, LEN, TREE, LTEXT, CARD(80), * CARD2(80), PSTART, XTRNI, XTRNO, TMP, XTRNS, CRDS, * FILE, DIGITS(10), NITO, NIT, BUFF, EOLINE, BFMX, * IFAULT, IMODE, X, QM, LAST, MODE, ESS LOGICAL ERROR, NOTIT, OVER C C*********************************************************************** C DECLARATIONS THAT DEPEND UPON DEFAULT VALUES * C*********************************************************************** C * C DIMENSION TEXT(MXTXT) * DIMENSION TEXT(8000) C C DIMENSION TREE(8,MXTRE) DIMENSION TREE(8,1000) C C DIMENSION BUFF(BFMX) DIMENSION BUFF(400) C C*********************************************************************** C DATA STATEMENTS FOR DEFAULT VALUES * C*********************************************************************** C * DATA MXTXT /8000/ DATA BFMX /400/ DATA MXTRE /1000/ C C*********************************************************************** C DATA STATEMENTS FOR CHARACTER DATA * C*********************************************************************** C * DATA ENDLIN /1H// DATA ASTER /1H*/ DATA BLANK /1H / DATA X /1HX/ DATA ESS /1HS/ DATA QM /1H?/ C C*********************************************************************** C DATA STATEMENTS FOR USE BY SUBROUTINE STRIPR * C*********************************************************************** C * DATA DIGITS(1) /1H0/ DATA DIGITS(2) /1H1/ DATA DIGITS(3) /1H2/ DATA DIGITS(4) /1H3/ DATA DIGITS(5) /1H4/ DATA DIGITS(6) /1H5/ DATA DIGITS(7) /1H6/ DATA DIGITS(8) /1H7/ DATA DIGITS(9) /1H8/ DATA DIGITS(10) /1H9/ C C*********************************************************************** C DATA STATEMENTS FOR UNIT NUMBERS * C*********************************************************************** C * DATA NIT /1/ DATA NITO /2/ DATA XTRNI /3/ DATA XTRNO /4/ DATA TTYO /6/ DATA IN /7/ DATA TMP /8/ C C*********************************************************************** C START OF EXECUTABLE CODE * C*********************************************************************** C * C INITIALIZATION * C * CARD(1) = BLANK CARD2(1) = BLANK BUFF(1) = BLANK TEXT(1) = BLANK IMODE = MODE TREE(1,1) = 0 ERROR = .FALSE. OVER = .FALSE. C C CHECK FOR INCORRECT INPUT C VALUES OF IMODE C IF ((IMODE.LT.1) .OR. (IMODE.GT.2)) GO TO 160 C C*********************************************************************** C THE FOLLOWING BLOCK OF CODE TRANSFERS ALL THE TREES THAT ARE NOT * C TO BE CHANGED. * C*********************************************************************** C * C READ IN THE FIRST CARD * C OF THE NEW DATA * C * CALL TREEIO(CARD, 80, IN, 1) IF (CARD(1).NE.ASTER) GO TO 180 10 LEN = EOLINE(CARD,80,BLANK) C C ASSIGN TEMPORARY UNIT NUMBERS C FILE = NIT OUT = NITO C C READ IN THE TREE CARDS OF C THE EXISTING TREES C 20 CALL TREEIO(CARD2, 80, FILE, 1) IF (CARD2(1).EQ.ENDLIN) GO TO 100 IF (CARD2(1).NE.ASTER) GO TO 180 LAST = EOLINE(CARD2,80,BLANK) C C CHECK TO SEE IF THERE IS AN C OLD TREE OF THE SAME NAME C NOTIT = .TRUE. IF (LEN.NE.LAST) GO TO 40 DO 30 I=2,LEN IF (CARD(I).NE.CARD2(I)) GO TO 40 30 CONTINUE NOTIT = .FALSE. C C WRITE OUT TREE CARD IF TREE C IS NOT TO BE DELETED C 40 IF ((IMODE.EQ.1) .OR. (NOTIT)) CALL TREEIO(CARD2, LAST, * OUT, 3) C C READ IN THE TITLES CARD TO C KNOW HOW MANY CARDS ARE LEFT C TO THE NEXT TREE CARD C CALL TREEIO(CARD2, 80, FILE, 1) CALL STRIPR(CRDS, CARD2, LAST, 1, DIGITS, BLANK) IF (NOTIT) GO TO 60 C C READ THROUGH THE TREES TO C BE REPLACED OR DELETED C IF (CRDS.EQ.0) GO TO 90 DO 50 I=1,CRDS CALL TREEIO(CARD2, 1, FILE, 1) 50 CONTINUE GO TO 90 C C READ THROUGH AND WRITE OUT C THE TREES NOT BEING REPLACED C 60 IF (CRDS.EQ.0) GO TO 80 DO 70 I=1,CRDS LAST = EOLINE(CARD2,80,BLANK) CALL TREEIO(CARD2, LAST, OUT, 3) CALL TREEIO(CARD2, 80, FILE, 1) 70 CONTINUE 80 LAST = EOLINE(CARD2,80,BLANK) CALL TREEIO(CARD2, LAST, OUT, 3) GO TO 20 C C*********************************************************************** C THIS PROCEDURE IS REPEATED UNTIL AN EXISTING TREE IS FOUND * C OR AN END OF FILE IS ENCOUNTERED. AT THIS POINT THE EXTERNAL * C FILE GOES THROUGH THE SAME PROCESS. * C*********************************************************************** C * C CHECK IF TEMPORARY FILES * C NEED TO BE REASSIGNED * C * 90 IF (FILE.EQ.XTRNI) GO TO 120 C C WRITE OUT TREE PROCESSING C MESSAGES C LAST = EOLINE(CARD,80,BLANK) I = LAST - 1 IF (IMODE.EQ.1) CALL TREEIO(CARD(2), I, TTYO, 8) IF (IMODE.EQ.2) CALL TREEIO(CARD(2), I, TTYO, 24) C C REASSIGN TEMPORARY FILES C FILE = XTRNI OUT = XTRNO GO TO 20 C C*********************************************************************** C AT THIS POINT THE END OF FILE ON THE EXISTING DATA FILE HAS BEEN * C REACHED WHICH INDICATES THAT THE TREE WE HAVE FROM THE NEW INPUT * C DOES NOT APPEAR IN THE FILE. THEREFORE, THE TREE WILL BE ADDED * C TO THE END OF THE OUTPUT FILE. * C*********************************************************************** C * 100 IF (FILE.NE.XTRNI) GO TO 110 OVER = .TRUE. LAST = EOLINE(CARD,80,BLANK) I = LAST - 1 IF (IMODE.EQ.2) GO TO 170 C C WRITE OUT TREE CARDS TO C THE FILES C CALL TREEIO(CARD(2), I, TTYO, 7) CALL TREEIO(CARD, LAST, NITO, 3) CALL TREEIO(CARD, LAST, XTRNO, 3) GO TO 120 110 FILE = XTRNI OUT = XTRNO GO TO 20 C C CHECK IF A TREE IS TO BE DELETED C 120 IF (IMODE.EQ.2) GO TO 150 C C*********************************************************************** C THE PROPER POSITION FOR THE NEW TREE HAS BEEN LOCATED. THE * C NEW DATA IS NOW PROCESSED BY THE FOLLOWING ROUTINES: * C TEXTIN, CONECT, AND OUTPUT. * C*********************************************************************** C * C TEXTIN READS THE TREE TEXT. * C * CALL TEXTIN(TREE, MXTRE, TEXT, MXTXT, BUFF, BFMX, ERROR, * LTEXT, MNTRE, TTYO, IN, TMP, XTRNS, CRDS, ASTER, BLANK, * DIGITS, X, QM) IF (ERROR) GO TO 190 C C CONECT CONNECTS TOGETHER THE C TREE TEXT BY READING THE C CONNECTIVITY TABLES. C CALL CONECT(TREE, MXTRE, PSTART, ERROR, CARD, MNTRE, * TTYO, IN, DIGITS, ENDLIN, ASTER, ESS, BLANK) IF (ERROR) GO TO 190 C C OUTPUT WRITES OUT THE NEW C DATA TO THE OUTPUT FILES. C CALL OUTPUT(TREE, MXTRE, TEXT, MXTXT, PSTART, LTEXT, * MNTRE, NITO, TMP, XTRNO, XTRNS, CRDS, BLANK) C C CHECK FOR END OF FILES OR C MORE TREES TO BE READ IN C IF ((CARD(1).EQ.ASTER) .AND. OVER) GO TO 100 IF (OVER) GO TO 200 IF (CARD(1).EQ.ASTER) GO TO 10 C C READ IN AND WRITE OUT C REMAINING INTERNAL TEXT FILE C 130 CALL TREEIO(CARD2, 80, NIT, 1) IF (CARD2(1).EQ.ENDLIN) GO TO 140 LAST = EOLINE(CARD2,80,BLANK) CALL TREEIO(CARD2, LAST, NITO, 3) GO TO 130 C C READ IN AND WRITE OUT C REMAINING EXTERNAL TEXT FILE C 140 CALL TREEIO(CARD2, 80, XTRNI, 1) IF (CARD2(1).EQ.ENDLIN) GO TO 200 LAST = EOLINE(CARD2,80,BLANK) CALL TREEIO(CARD2, LAST, XTRNO, 3) GO TO 140 C C READ IN NEXT TREE NAME C TO BE DELETED C 150 CALL TREEIO(CARD, 80, IN, 1) IF (CARD(1).EQ.ASTER) GO TO 10 GO TO 130 C C WRITE OUT ERROR MESSAGE FOR C INCORRECT VALUES OF IMODE C 160 CARD(1) = IMODE CALL TREEIO(CARD, 1, TTYO, 22) GO TO 190 C C WRITE OUT ERROR MESSAGE FOR C TREE TO BE DELETED NOT FOUND C 170 CALL TREEIO(CARD(2), I, TTYO, 23) GO TO 190 C C WRITE OUT ERROR MESSAGE C FOR NO TREE FOUND C 180 CONTINUE CALL TREEIO(CARD, 1, TTYO, 9) C C SET IFAULT TO 1 FOR C AN ERROR ENCOUNTERED C 190 IFAULT = 1 GO TO 210 C C WRITE OUT LAST CARDS C TO THE NEW FILES C 200 CONTINUE CALL TREEIO(CARD, 1, NITO, 5) CALL TREEIO(CARD, 1, XTRNO, 5) C C SET IFAULT TO 0 FOR C NO ERRORS ENCOUNTERED C IFAULT = 0 C C RETURN TO CALLING ROUTINE C 210 CONTINUE RETURN END C CON 1 C-----------------------------------------------------------------------CON 2 C CON 3 SUBROUTINE CONECT(TREE, MXTRE, PSTART, ERROR, CARD, CON 4 * MNTRE, TTYO, IN, DIGITS, ENDLIN, ASTER, ESS, BLANK) C C*********************************************************************** C * C THIS ROUTINE READS THE CONNECTIVITY TABLES AND CONNECTS THE NODES * C TOGETHER. * C * C----------------------------------------------------------------------* C * C SUBROUTINES CALLED: * C * C STRIPR - TO IDENTIFY ANY LEADING ELEMENTS OF AN ARRAY * C WHICH MAY CORRESPOND TO NUMERICAL CHARACTERS, * C AND CONVERT ANY THAT ARE FOUND INTO AN INTEGER. * C * C TREEIO - ROUTINE WHICH PERFORMS ALL OF THE INPUT * C AND OUTPUT OPERATIONS FOR NITREE. * C * C*********************************************************************** C * INTEGER CARD(80), TTYO, IN, POS, I, PARNT, TREE, NODE, * MNTRE, MXTRE, NEXT, PSTART, ENDLIN, FLG, NNODE, ASTER, * BLANK, DIGITS(10), LINE(3), J, ESS DIMENSION TREE(8,MXTRE) LOGICAL ERROR, S C C INITIALIZE STARTING NUMBER C S = .FALSE. PSTART = 1 C C READ A CARD AND CHECK C THE FIRST CHARACTER C 10 CALL TREEIO(CARD, 80, IN, 1) IF (CARD(1).EQ.ASTER) GO TO 120 IF (CARD(1).EQ.ENDLIN) GO TO 120 IF (CARD(1).NE.ESS) GO TO 20 C C DETERMINE STARTING NUMBER C FROM THE S CARD READ IN C CALL STRIPR(PSTART, CARD, NEXT, 2, DIGITS, BLANK) IF (.NOT.S) S = .TRUE. IF (PSTART.GE.0) GO TO 10 CALL TREEIO(LINE, 1, TTYO, 15) GO TO 10 C C DETERMINE THE THREE C LINE NUMBERS C 20 CALL STRIPR(FLG, CARD, NEXT, 1, DIGITS, BLANK) LINE(1) = FLG I = NEXT - 1 IF ((FLG.EQ.0) .AND. (DIGITS(1).NE.CARD(I))) LINE(1) = -1 POS = NEXT + 1 CALL STRIPR(FLG, CARD, NEXT, POS, DIGITS, BLANK) LINE(2) = FLG I = NEXT - 1 IF ((FLG.EQ.0) .AND. (DIGITS(1).NE.CARD(I))) LINE(2) = -1 POS = NEXT + 1 CALL STRIPR(FLG, CARD, NEXT, POS, DIGITS, BLANK) LINE(3) = FLG I = NEXT - 1 IF ((FLG.EQ.0) .AND. (DIGITS(1).NE.CARD(I))) LINE(3) = -1 C C CHECK FOR ILLEGAL LINE NUMBERS C IF (LINE(1).GE.0 .AND. LINE(2).GE.0 .AND. LINE(3).GE.0) * GO TO 30 NEXT = NEXT + 1 C C PRINT ERROR MESSAGE AND RETURN C TO READ IN A NEW CARD FOR C INVALID LINE NUMBERS C CALL TREEIO(CARD, NEXT, TTYO, 16) GO TO 10 C C FIND THE POSITIONS OF THE LINE C NUMBERS IN THE TREE ARRAY C 30 CONTINUE DO 60 J=1,3 DO 40 I=1,MNTRE IF (LINE(J).EQ.TREE(6,I)) GO TO 50 40 CONTINUE GO TO 110 50 LINE(J) = I 60 CONTINUE C C SET VALUES OF PARENT, ANSWER, C AND CHILD NODES C PARNT = LINE(1) NODE = LINE(2) NNODE = LINE(3) C C CHECK FOR AN INVALID LINE C IF (PARNT.NE.NODE .AND. NODE.NE.NNODE) GO TO 70 LINE(1) = TREE(6,NODE) CALL TREEIO(LINE, 1, TTYO, 17) GO TO 10 C C ARRANGE ANSWERS COMING FROM C PARENT SO THAT THEY ARE LINKED C TOGETHER IN THE ORDER THAT C TEXTIN READ THEM IN C 70 I = PARNT IF (TREE(1,I).EQ.PARNT) GO TO 90 80 J = TREE(1,I) IF (J.GT.NODE) GO TO 90 IF (J.EQ.PARNT) GO TO 90 I = J GO TO 80 C C LINK IN ANSWER AND PARENT C NODES C 90 TREE(1,NODE) = TREE(1,I) TREE(1,I) = NODE IF (TREE(5,NODE).EQ.0) TREE(5,NODE) = 1 C C CHECK FOR CHILD ALREADY USED C AS A LINE C IF (TREE(2,NNODE).LE.0) GO TO 100 LINE(1) = TREE(6,NNODE) CALL TREEIO(LINE, 1, TTYO, 18) GO TO 10 C C LINK IN CHILD NODE C 100 TREE(2,NODE) = NNODE TREE(2,NNODE) = -1 IF (TREE(1,NNODE).LE.0) TREE(1,NNODE) = NNODE GO TO 10 C C RETURN ERROR FOR AN UNKNOWN C NUMBER C 110 LINE(1) = NEXT CALL TREEIO(LINE, 1, TTYO, 19) ERROR = .TRUE. RETURN C C CHECK FOR STARTING NUMBER C 120 CONTINUE IF (S) GO TO 130 CALL TREEIO(LINE, 1, TTYO, 20) C C CHECK FOR STARTING NUMBER C IN THE TREE ARRAY AND C RETURN IF FOUND C 130 I = 0 140 I = I + 1 IF (I.GT.MNTRE) GO TO 150 IF (TREE(6,I).NE.PSTART) GO TO 140 TREE(2,I) = -1 PSTART = I RETURN C C RETURN ERROR FOR ILLEGAL C STARTING NUMBER C 150 CONTINUE LINE(1) = PSTART CALL TREEIO(LINE, 1, TTYO, 21) ERROR = .TRUE. RETURN END C EOL 1 C-----------------------------------------------------------------------EOL 2 C EOL 3 INTEGER FUNCTION EOLINE(LINE, LEN, BLANK) EOL 4 C C*********************************************************************** C * C FUNCTION TO RETURN THE LAST NON-BLANK CHARACTER OF AN ARRAY. * C IF THE ARRAY CONTAINS ONLY BLANKS, THEN EOLINE HAS THE * C VALUE 1. * C * C*********************************************************************** C * INTEGER LEN, LINE(LEN), BLANK, END, II C C FIND THE LAST NON-BLANK C CHARACTER C END = LEN + 1 DO 10 II=1,LEN END = END - 1 IF (LINE(END).NE.BLANK) GO TO 20 10 CONTINUE C C RETURN THE VALUE OF EOLINE C 20 CONTINUE EOLINE = END RETURN END C OUT 1 C-----------------------------------------------------------------------OUT 2 C OUT 3 SUBROUTINE OUTPUT(TREE, MXTRE, TEXT, MXTXT, PSTART, OUT 4 * MNTXT, MNTRE, NITO, TMP, XTRNO, XTRNS, CRDS, BLANK) C C*********************************************************************** C * C WRITE OUT THE DATA TO THE FILES. FIRST EXTERNAL TEXT IS WRITTEN * C OUT TO THE NEW EXTERNAL FILE. THEN THE NEW NIT FILE IS * C CREATED BY WRITING OUT THE POINTERS FOLLOWED BY THE TEXT. * C * C----------------------------------------------------------------------* C * C SUBROUTINES CALLED: * C * C EOLINE - FUNCTION TO RETURN THE POSITION OF THE * C LAST NON-BLANK CHARACTER IN AN ARRAY. * C * C TREEIO - ROUTINE WHICH PERFORMS ALL OF THE INPUT * C AND OUTPUT OPERATIONS FOR NITREE. * C * C*********************************************************************** C * C FORMAT OF THE OUTPUT FILE FOR THE INTERNAL TEXT: * C * C * C COL. # 1 5 91 5 92 5 93 5 94 ... * C 1) * MATRIX OPERATIONS * C 2) 62 54 125 1 * C 3) 49 -1 0 105 0 1 * C 3 9 0 601 1 2 * C . . . . . . * C . . . . . . * C . . . . . . * C 54 -1 -1 12303 0 104 * C 4) IS THE MATRIX COMPLEX? ... USE F04ADF * C . . . . . . * C . . . . . . * C . . . . . . * C 1) * MESH GENERATORS * C . . . . . . * C . . . . . . * C . . . . . . * C 5) / * C * C EXPLANATIONS: * C * C 1) TREE CARD ... THE NAME OF THE TREE * C * C 2) TOTALS LINE ... THIS LINE CONTAINS FOUR NUMBERS: * C * C I J K L * C * C WHERE I IS ( THE NUMBER OF LINES BETWEEN TWO SUCCESSIVE TREE * C CARDS - 1 ) * C * C J IS ( THE NUMBER OF LINES TO THE FIRST TEXT LINE ) * C * C K IS ((THE NUMBER OF CHARACTERS + PADS) / 4 ) * C * C L IS ( THE RENUMBERED BOX THAT STARTS THE TREE). * C * C 3) TREE LINES ... THESE LINES CONTAIN SIX NUMBERS: * C * C M N P Q R S * C * C WHERE M IS A POSITIVE INTEGER. LINE M IN THIS TABLE POINTS * C TO THE NEXT POSSIBLE ANSWER IN THE MENU, E.G., * C LINE 1 INDICATES THAT THE NEXT ANSWER IS AT * C LINE 49. * C * C N IS AN INTEGER WHICH DETERMINES WHETHER THE PRESENT * C NODE IS A TERMINAL NODE, A QUESTION OR A LINE. * C IF N = -1 AND M = (LINE M) THEN TERMINAL NODE. * C IF N = -1 AND M .NE. (LINE M) THEN QUESTION. * C OTHERWISE NODE IS A LINE AND IN THIS CASE * C LINE N IN THIS TABLE IS THE NEXT POSSIBLE * C QUESTION OR TERMINAL NODE. * C * C P IS AN INTEGER WHICH IF -1 FLAGS THE TEXT STRING * C POINTED TO BY Q TO BE PASSED TO THE EXTERNAL * C SUBROUTINE OUTSID. * C * C Q IS A POSITIVE INTEGER WHICH POINTS TO THE TEXT FOR ALL* C THE LINES AND BOXES. IT IS COMPOSED OF (STARTING* C POSITION OF THE TEXT * 100) + (THE TEXT LENGTH).* C * C R IS A POSITIVE INTEGER WHICH REPRESENTS THE ACTION * C TAKEN IF THE PRESENT NODE IS A LINE. * C IF R = 1 THEN THE TREE IS DESCENDED. * C IF R = -1 THEN THE LINE IS FOR HELP. * C ELSE R IS OF NO SIGNIFICANCE. * C * C S IS A POSITIVE INTEGER. IT IS THE NUMBER ASSIGNED BY * C THE USER IN THE TREE TABLE. * C * C 4) TEXT ... THE TEXT OF THE TREE EXCLUDING EXTERNAL TEXT * C * C THE TEXT ARRAY IS WRITTEN OUT SEQUENTIALLY TO THE FILE. THE * C NUMBER OF CHARACTERS IS ALWAYS A MULTIPLE OF 4 AND DOES * C NOT EXCEED 80 CHARACTERS IN A RECORD. * C * C 5) THE LAST CARD IN THE FILE. * C * C*********************************************************************** C * C FORMAT OF THE OUTPUT FILE FOR EXTERNAL TEXT: * C * C * C COL. # 1 5 91 5 92 5 93 5 94 ... * C 1) * MATRIX OPERATIONS * C 2) 62 * C 3) 1 4 * C 4) THE TEXT FOR EACH NUMBER FOLLOWS IN THE FIRST 80 COLUMNS... * C . . . . . . * C . . . . . . * C . . . . . . * C 3) 5 7 * C 4) THIS TEXT IS ANOTHER FILE * C . . . . . . * C . . . . . . * C . . . . . . * C 1) * MESH GENERATORS * C . . . . . . * C . . . . . . * C . . . . . . * C 5) / * C * C EXPLANATIONS: * C * C 1) TREE CARD ... THE NAME OF THE TREE * C * C 2) TREE TOTAL LINE ... THIS LINE CONTAINS THE NUMBER OF CARDS * C BETWEEN THIS CARD AND THE NEXT TREE CARD.* C * C 3) FILE TOTALS LINES ... THIS LINE CONTAIN TWO NUMBERS: * C * C I J * C * C WHERE THE ITH PIECE OF EXTERNAL TEXT ASSOCIATED WITH * C THIS TREE CONTAINS J LINES. * C * C 4) TEXT * C * C THE EXTERNAL TEXT IS WRITTEN OUT TO THE FILE EXACTLY THE * C WAY IT WAY READ IN. THE ONLY PROCESSING THAT TAKES PLACE IS * C THE COUNTING OF THE CARDS. ONLY 70 CHARACTERS ARE WRITTEN OUT* C SO THE OUTPUT WILL BE EASILY READ ON ALL TERMINALS. * C * C 5) THE LAST CARD IN THE FILE. * C * C*********************************************************************** C * INTEGER XTRNO, CARD(80), TREE, TEXT, MXTRE, MNTRE, TMP, * NITO, EOLINE, ST, XTRNS, CRDS, MXTXT, MNTXT, PSTART, * BLANK, I, J, N2 DIMENSION TREE(8,MXTRE), TEXT(MXTXT) C C RESOLVE EXTERNAL TEXT C C WRITE OUT TREE TOTAL LINE C REWIND TMP CRDS = CRDS + XTRNS CARD(1) = CRDS CALL TREEIO(CARD, 1, XTRNO, 4) IF (XTRNS.LE.0) GO TO 40 C C WRITE OUT FILES TOTALS LINE C FOR EACH TEXT C DO 30 N2=1,XTRNS I = 0 10 I = I + 1 IF (I.GT.MNTRE) GO TO 30 IF (TREE(4,I).NE.(-N2)) GO TO 10 CARD(1) = N2 CARD(2) = TREE(3,I) CALL TREEIO(CARD, 2, XTRNO, 4) ST = TREE(3,I) IF (ST.LE.0) GO TO 30 C C WRITE OUT THE EXTERNAL TEXT C DO 20 J=1,ST CALL TREEIO(CARD, 80, TMP, 1) I = EOLINE(CARD,80,BLANK) CALL TREEIO(CARD, I, XTRNO, 3) 20 CONTINUE 30 CONTINUE REWIND TMP C C NOW RESOLVE THE INTERNAL TEXT C C WRITE OUT THE TOTALS LINE C 40 CONTINUE CARD(2) = MNTRE CARD(3) = MNTXT/4 CARD(4) = PSTART CARD(1) = CARD(2) + (CARD(3)-1)/20 + 1 CALL TREEIO(CARD, 4, NITO, 4) C C WRITE OUT THE TREE ARRAY C DO 60 I=1,MNTRE DO 50 J=1,8 CARD(J) = TREE(J,I) 50 CONTINUE CALL TREEIO(CARD, 8, NITO, 4) 60 CONTINUE C C WRITE OUT THE TEXT ARRAY NOW C CALL TREEIO(TEXT, MNTXT, NITO, 3) C RETURN END C PTE 1 C-----------------------------------------------------------------------PTE 2 C PTE 3 SUBROUTINE PTEXT(TEXT, MXTXT, BUFF, BFMX, N1, N2, TXTST, PTE 4 * TXTLEN, LTEXT, TTYO, BLANK) C C*********************************************************************** C * C ROUTINE PACKS TEXT INTO THE TEXT ARRAY AND RESOLVES POINTERS. * C IT ALSO CHECKS FOR ANY DUPLICATE OCCURRENCES AND RETURNS THE * C OLD POINTERS INSTEAD OF APPENDING A NEW COPY. * C * C*********************************************************************** C * C SUBROUTINES CALLED: * C * C TREEIO - ROUTINE WHICH PERFORMS ALL OF THE INPUT * C AND OUTPUT OPERATIONS FOR NITREE. * C * C*********************************************************************** C * INTEGER BLANK, I, J, LTEXT, MXTXT, N1, N2, TEXT, TTYO, * TXTLEN, TXTST, BUFF, BFMX DIMENSION TEXT(MXTXT), BUFF(BFMX) C C PAD STRING WITH BLANKS C DO 10 I=1,3 N2 = N2 + 1 BUFF(N2) = BLANK 10 CONTINUE C C DETERMINE TEXT LENGTH AND PACK C INTO TEXT ARRAY LEFT JUSTIFIED C TXTLEN = (N2+1-N1)/4 IF (TXTLEN.LE.0) GO TO 70 C C NOW TRY TO MATCH TEXT C TXTST = 1 J = N1 IF (LTEXT.EQ.0) GO TO 60 I = TXTST 20 IF (TEXT(I).EQ.BUFF(J)) GO TO 30 C C CODE FOR TEXT(I).NE.BUFF(J) C TXTST = TXTST + 1 I = (TXTST-1)*4 + 1 IF (I.GT.LTEXT) GO TO 40 J = N1 GO TO 20 C C CODE FOR TEXT(I).EQ.BUFF(J) C 30 IF ((J+1-N1).EQ.(TXTLEN*4)) GO TO 70 IF (I.GT.LTEXT) GO TO 50 J = J + 1 I = I + 1 GO TO 20 C C ADD BUFF TO THE TEXT C 40 J = N1 50 IF (LTEXT.LT.MXTXT) GO TO 60 CALL TREEIO(BUFF, 1, TTYO, 6) GO TO 70 60 LTEXT = LTEXT + 1 TEXT(LTEXT) = BUFF(J) J = J + 1 IF ((J+1-N1).LE.(TXTLEN*4)) GO TO 50 C C RETURN VALUE OF TXTLEN C 70 CONTINUE TXTLEN = TXTLEN - 1 RETURN END C STR 1 C-----------------------------------------------------------------------STR 2 C STR 3 SUBROUTINE STRIPR(N, BUFX, N1, IN, DIGITS, BLANK) STR 4 C C*********************************************************************** C * C THE PURPOSE OF THIS SUBROUTINE IS TO IDENTIFY ANY LEADING * C ELEMENTS OF BUFX, BEGINNING WITH BUFX(IN), WHICH MAY CORRESPOND * C TO AN INTEGER IN THE RANGE 0 THROUGH 9. IF THERE ARE NO SUCH * C ELEMENTS IN BUFX, THEN ON EXIT N WILL HAVE THE VALUE ZERO AND * C N1 WILL BE SET TO THE POSITION OF THE FIRST NON-BLANK CHARACTER * C AT OR BEYOND BUFX(IN). OTHERWISE, N IS SET TO THE NUMBER WHICH * C IS COMPOSED OF THE CONSECUTIVE INTEGERS THAT HAVE BEEN IDENTIFIED. * C IN THIS CASE, N1 WILL BE SET TO THE POSITION OF THE NEXT CHARACTER * C WHICH IS NOT AN INTEGER, BUT WHICH MAY BE A BLANK. * C * C----------------------------------------------------------------------* C * C VARIABLES USED: * C * C N - INTEGER SET TO THE COMPUTED VALUE OF THE STRING * C OF NUMERICAL CHARACTERS * C * C BUFX - CHARACTER ARRAY TO BE SEARCHED FOR NUMERICAL * C CHARACTERS * C * C N1 - POSITION IN THE ARRAY BUFX AT WHICH CONVERSION WAS * C STOPPED DUE TO THE CHARACTER STORED AT BUFX(N1) * C BEING INVALID FOR CONVERSION * C * C IN - POSITION IN THE ARRAY BUFX AT WHICH CONVERSION IS * C TO BEGIN * C * C DIGITS - AN ARRAY WHICH HOLDS THE CHARACTER VALUES OF * C THE DIGITS * C * C BLANK - AN INTEGER SET TO THE CHARACTER VALUE OF A BLANK * C * C*********************************************************************** C * INTEGER DIGITS(10), BUFX(1), N, N1, I, IN, BLANK, INMAX C C INITIALIZE INTEGER AND POSITION C N = 0 N1 = IN - 1 INMAX = IN + 80 C C FIND FIRST NON-BLANK CHARACTER C 10 N1 = N1 + 1 IF (N1.GT.INMAX) GO TO 40 IF (BUFX(N1).EQ.BLANK) GO TO 10 C C FIND CHARACTER VALUE OF C THE INTEGER C 20 I = 0 30 I = I + 1 IF (I.GT.10) GO TO 40 IF (BUFX(N1).NE.DIGITS(I)) GO TO 30 C C DETERMINE THE VALUE OF C THE INTEGER C N = N*10 + I - 1 N1 = N1 + 1 GO TO 20 C C RETURN TO CALLING ROUTINE C 40 CONTINUE RETURN END C TEX 1 C-----------------------------------------------------------------------TEX 2 C TEX 3 SUBROUTINE TEXTIN(TREE, MXTRE, TEXT, MXTXT, BUFF, BFMX, TEX 4 * ERROR, LTEXT, RENUM, TTYO, IN, TMP, XTRNS, XCRDS, * ASTER, BLANK, DIGITS, X, QM) C C*********************************************************************** C * C GETS A TEXT STRING FROM THE INPUT STREAM, RENUMBERS THE LINE, * C CHECKS FOR EXTERNAL TEXT, CHECKS FOR PARAMETER PASSING, AND * C LOOKS UP ALL THESE FOR EACH NODE. * C * C----------------------------------------------------------------------* C * C SUBROUTINES CALLED: * C * C EOLINE - FUNCTION TO RETURN THE POSITION OF THE * C LAST NON-BLANK CHARACTER IN AN ARRAY. * C * C PTEXT - PACKS TEXT IN TEXT ARRAY AND RETURNS THE POINTER PARTS.* C * C STRIPR - TO IDENTIFY ANY LEADING ELEMENTS OF AN ARRAY * C WHICH MAY CORRESPOND TO NUMERICAL CHARACTERS, * C AND CONVERT ANY THAT ARE FOUND INTO AN INTEGER. * C * C TREEIO - ROUTINE WHICH PERFORMS ALL OF THE INPUT * C AND OUTPUT OPERATIONS FOR NITREE. * C * C*********************************************************************** C * INTEGER BLANK, IN, MXTRE, TREE, TTYO, N1, NTRE, J, LAST, * TXTLEN, TXTST, XTRNS, CARDS, TMP, XCRDS, RENUM, ASTER, * I, BUFF, BFMX, TEXT, EOLINE, LINE(80), MXTXT, LTEXT, X, * QM, DIGITS(10) DIMENSION TREE(8,MXTRE), TEXT(MXTXT), BUFF(BFMX) LOGICAL ERROR C C INITIALIZE VALUES C RENUM = 0 LTEXT = 0 XCRDS = 0 XTRNS = 0 TXTLEN = 0 TXTST = 0 C C READ IN A LINE C 10 CALL TREEIO(BUFF, 80, IN, 1) 20 IF (BUFF(1).EQ.ASTER) GO TO 200 C C GET THE NODE NUMBER C CALL STRIPR(NTRE, BUFF, N1, 1, DIGITS, BLANK) I = N1 - 1 IF ((NTRE.EQ.0) .AND. (BUFF(I).NE.DIGITS(1))) GO TO 160 IF (RENUM.EQ.0) GO TO 40 C C CHECK FOR NODE NUMBER C PREVIOUSLY USED C DO 30 I=1,RENUM IF (TREE(6,I).NE.NTRE) GO TO 30 LINE(1) = NTRE CALL TREEIO(LINE, 1, TTYO, 10) GO TO 10 30 CONTINUE 40 RENUM = RENUM + 1 IF (RENUM.GT.MXTRE) GO TO 150 C C IF THERE ARE NO ERRORS THEN C INITIALIZE THE NODE LINE C TREE(1,RENUM) = RENUM DO 50 I=2,8 TREE(I,RENUM) = 0 50 CONTINUE C C CHECK IF IT IS A C LINE FOR HELP C IF (BUFF(N1).NE.QM) GO TO 60 TREE(5,RENUM) = -1 N1 = 0 LAST = 1 BUFF(1) = QM CALL TREEIO(LINE, 80, IN, 1) GO TO 130 C C CHECK IF PARAMETERS FOR C THE EXTERNAL SUBROUTINE C 60 IF (BUFF(N1).NE.X) GO TO 70 TREE(3,RENUM) = -1 N1 = N1 + 1 LAST = EOLINE(BUFF,80,BLANK) GO TO 80 C C INTERNAL TEXT HANDLER C 70 IF (BUFF(N1).EQ.ASTER) GO TO 100 LAST = EOLINE(BUFF,80,BLANK) C C CHECK FOR INTERNAL TEXT ON C MORE THAN ONE LINE C 80 CALL TREEIO(LINE, 80, IN, 1) IF (LINE(1).NE.BLANK) GO TO 130 J = EOLINE(LINE,80,BLANK) IF ((LAST+J).GE.BFMX) GO TO 180 DO 90 I=1,J LAST = LAST + 1 BUFF(LAST) = LINE(I) 90 CONTINUE GO TO 80 C C OUTPUT EXTERNAL TEXT TO C TEMP FILE C 100 CARDS = 0 XTRNS = XTRNS + 1 N1 = N1 + 1 C C CONTINUE UNTIL TEXT IS OVER C 110 CONTINUE LAST = EOLINE(BUFF,80,BLANK) CARDS = CARDS + 1 XCRDS = XCRDS + 1 J = 0 DO 120 I=N1,LAST J = J + 1 BUFF(J) = BUFF(I) 120 CONTINUE CALL TREEIO(BUFF, J, TMP, 3) CALL TREEIO(BUFF, 80, IN, 1) N1 = 1 IF (BUFF(N1).EQ.BLANK) GO TO 110 C C SET TREE VALUES FOR C EXTERNAL TEXT C TREE(4,RENUM) = -XTRNS TREE(3,RENUM) = CARDS TREE(6,RENUM) = NTRE GO TO 20 C C CALL PTEXT TO PACK TEXT C INTO TEXT ARRAY C 130 CONTINUE N1 = N1 + 1 CALL PTEXT(TEXT, MXTXT, BUFF, BFMX, N1, LAST, TXTST, * TXTLEN, LTEXT, TTYO, BLANK) IF (TXTLEN.LT.0) GO TO 170 C C SET TREE VALUES FOR C INTERNAL TEXT C TREE(4,RENUM) = TXTST*100 + TXTLEN TREE(6,RENUM) = NTRE C C SET BUFFER AND BEGIN AGAIN C TO PROCESS NEXT LINE C DO 140 I=1,80 BUFF(I) = LINE(I) 140 CONTINUE GO TO 20 C C PROCESS SYNTAX ERRORS C C TREE ARRAY OVERFLOW C 150 CALL TREEIO(BUFF, 1, TTYO, 11) GO TO 190 C C NO NODE NUMBER FOUND C 160 CALL TREEIO(BUFF(N1), 1, TTYO, 14) GO TO 190 C C NO TEXT FOUND C 170 CALL TREEIO(LINE, 1, TTYO, 12) GO TO 190 C C TEXT LINE TOO LONG C 180 LINE(1) = BFMX CALL TREEIO(LINE, 1, TTYO, 13) C C SET ERROR FLAG IF AN C ERROR HAS OCCURRED C 190 ERROR = .TRUE. C C RETURN TO CALLING ROUTINE C 200 CONTINUE RETURN END C TRE 1 C-----------------------------------------------------------------------TRE 2 C TRE 3 SUBROUTINE TREEIO(ARRAY, LEN, FILE, MODE) TRE 4 C C*********************************************************************** C * C THIS SUBROUTINE PERFORMS ALL OF THE INPUT AND OUTPUT * C OPERATIONS FOR NITREE. THE INPUT OR OUTPUT PERFORMED * C DEPENDS ON THE VALUE OF MODE. * C * C----------------------------------------------------------------------* C * C VARIABLES USED: * C * C ARRAY - AN ARRAY OF LENGTH LEN WHICH MAY EITHER BE * C READ IN OR WRITTEN OUT DEPENDING ON THE VALUE * C OF MODE. * C * C FILE - THE UNIT NUMBER OF THE FILE TO WHICH THE INPUT OR * C OUTPUT WILL BE PERFORMED. * C * C MODE - THE VARIABLE WHICH DETERMINES THE PARTICULAR * C INPUT OR OUTPUT STATEMENTS TO BE EXECUTED * C * C*********************************************************************** C * INTEGER FILE, LEN, MODE, ARRAY(LEN), I C C GO TO THE PROPER INPUT/OUTPUT C STATEMENT TO BE EXECUTED C GO TO (10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110, 120, * 130, 140, 150, 160, 170, 180, 190, 200, 210, 220, 230, * 240), MODE C C READ IN STATEMENTS C 10 READ (FILE,99999) (ARRAY(I),I=1,LEN) GO TO 250 C 20 READ (FILE,99998) (ARRAY(I),I=1,LEN) GO TO 250 C C OUTPUT STATEMENTS C 30 WRITE (FILE,99999) (ARRAY(I),I=1,LEN) GO TO 250 C 40 WRITE (FILE,99998) (ARRAY(I),I=1,LEN) GO TO 250 C 50 WRITE (FILE,99997) GO TO 250 C C ERROR STATEMENT FOR NO C TREE FOUND C 60 WRITE (FILE,99996) GO TO 250 C C OUTPUT ADDING TREE C 70 WRITE (FILE,99995) (ARRAY(I),I=1,LEN) GO TO 250 C C OUTPUT REPLACING TREE C 80 WRITE (FILE,99994) (ARRAY(I),I=1,LEN) GO TO 250 C C ERROR STATEMENTS FOR NITREE C 90 WRITE (FILE,99993) GO TO 250 C 100 WRITE (FILE,99992) ARRAY(1) GO TO 250 C 110 WRITE (FILE,99991) GO TO 250 C 120 WRITE (FILE,99990) GO TO 250 C 130 WRITE (FILE,99989) ARRAY(1) GO TO 250 C 140 WRITE (FILE,99988) ARRAY(1) GO TO 250 C 150 WRITE (FILE,99987) GO TO 250 C 160 WRITE (FILE,99986) (ARRAY(I),I=1,LEN) GO TO 250 C 170 WRITE (FILE,99985) ARRAY(1) GO TO 250 C 180 WRITE (FILE,99984) ARRAY(1) GO TO 250 C 190 WRITE (FILE,99983) ARRAY(1) GO TO 250 C 200 WRITE (FILE,99982) GO TO 250 C 210 WRITE (FILE,99981) ARRAY(1) GO TO 250 C 220 WRITE (FILE,99978) ARRAY(1) GO TO 250 C 230 WRITE (FILE,99979) (ARRAY(I),I=1,LEN) GO TO 250 C C OUTPUT DELETING TREE MESSAGE C 240 WRITE (FILE,99980) (ARRAY(I),I=1,LEN) GO TO 250 C C RETURN TO CALLING ROUTINE C 250 CONTINUE RETURN 99999 FORMAT (80A1) 99998 FORMAT (8I6) 99997 FORMAT (1H/) 99996 FORMAT (32H *** ERROR - TEXT ARRAY OVERFLOW) 99995 FORMAT (/12H ADDING TREE/1X, 80A1) 99994 FORMAT (/15H REPLACING TREE/1X, 80A1) 99993 FORMAT (27H *** ERROR - TREE NOT FOUND) 99992 FORMAT (31H *** ERROR - DUPLICATE TEXT NO., I5, 7H FIRST , * 8HONE USED) 99991 FORMAT (32H *** ERROR - TREE ARRAY OVERFLOW) 99990 FORMAT (36H *** ERROR - EXPECTED TEXT NOT FOUND) 99989 FORMAT (39H *** ERROR - LINE OF TEXT GREATER THAN , I5, * 11H CHARACTERS) 99988 FORMAT (43H *** ERROR - EXPECTED AN INTEGER BUT FOUND , * A1) 99987 FORMAT (37H *** ERROR - INVALID STARTING ADDRESS) 99986 FORMAT (47H *** ERROR - INVALID LINE IN CONNECTIVITY TABLE * /1X, 80A1) 99985 FORMAT (31H *** ERROR - DUPLICATE LINE NO., I5) 99984 FORMAT (22H *** ERROR - TEXT NO. , I5, 14H ALREADY USED , * 7HAS LINE) 99983 FORMAT (27H *** ERROR - UNKNOWN NUMBER, I5) 99982 FORMAT (44H *** ERROR - S KEY NOT FOUND, ASSUMING S = 1) 99981 FORMAT (20H *** ERROR - BOX NO., I5, 10H NOT FOUND) 99980 FORMAT (/14H DELETING TREE/1X, 80A1) 99979 FORMAT (41H *** ERROR - TREE TO BE DELETED NOT FOUND/1X, * 80A1) 99978 FORMAT (36H *** ERROR - INCORRECT VALUE OF MODE/6H MODE , C * 2H= , I5) END