	PROGRAM ANIMAL
C
C	Animal is a "learning program".
C	Original program by A. Leuhrmann, Dartmouth
C	Translation from BASIC and extensive modifications as follows
C	by Dave Thorson, the Ohio State University, Jan. 1981
C	Modifications:
C	1) Use of "null" answer to questions.
C	2) Multi-Predecessor Processing allowing multiple parents for
C	   a given node and prevention of duplicate answer entries.
C
	LOGICAL*1 NAME(16),INIT(16),SUBJCT(70),PROMPT(70),ANIMAL(70)
	LOGICAL*1 CHAR,NULL,A,B,NEW(70),QUEST(70),VAL(4),SAVE(70),SLASH
	LOGICAL*1 STUFF(79),TEMP(70),ANS
	DATA INIT/'A','N','I','M','A','L','.','T','X','T',
     C' ',' ',' ',' ',' ',' '/
	DATA VAL/'1','.',' ',' '/
	SLASH='\'
	NULL="0
	CALL AZTO09(VAL,RET) ! INITIALIZE AZTO09
1	WRITE(5,2)
	MULTI=0
	IMULTI=-1
2	FORMAT(//////'                           -----  Animal -----'///
     C6X,'[BASIC/FORTRAN conversion and modifications by Dave Thorson]'/
     C//' OPTIONS:'//' Enter	HELP for instructions'//
     C'      	CREATE to create a new "memory" file'//
     C'         INIT to reinitialize (remove all but first two entries)'
     C/'               and use an existing file.'//
     C'      	<CR> (NEW LINE, ENTER, or RETURN key) to use an'/
     C'      		existing file and start Animal'/
     C'               (ANIMAL.TXT file should be available).'//
     C'         EXIT to leave program.')
	READ(5,56,END=9999) ANS
	IF(ANS.EQ.'E'.OR.ANS.EQ.'e') GOTO 9999
	IF(ANS.EQ.'H'.OR.ANS.EQ.'h') GOTO 3000
	IF(ANS.EQ.'I'.OR.ANS.EQ.'i') GOTO 5000
	IF(ANS.NE.'C'.AND.ANS.NE.'c') GOTO 4000
3509	WRITE(5,3500)
3500	FORMAT(' Here you can create a new "memory" file for Animal;'/
     C' you will then be returned to the above menu.'//
     C' Note that if you enter all the examples as answers you will'/
     C' re-create the ANIMAL.TXT example file.  Warning - you may'/
     C' destroy any existing ANIMAL.TXT file by doing this.'//
     C' First of all, enter a file name, up to 16 characters including'/
     C' the .TXT extension, for example,   ANIMAL.TXT'//
     C' Your memory file name: ',$)
	READ(5,3,END=1000) NAME
	IF(NAME(1).EQ.' ') GOTO 1
	WRITE(5,3501)
3501	FORMAT(/////' Now enter the subject area for this section of'/
     C' Animal''s memory.  State in the form of a question, such as'/
     C'0         ARE YOU THINKING OF AN ANIMAL ?'//
     C' Include the ? at the end:')
	READ(5,48,END=1000) SUBJCT
	WRITE(5,3502)
3502	FORMAT(/////' Now enter a prompt for those times when Animal '/
     C' can''t determine the correct object, such as:'/
     C'0         THE ANIMAL YOU WERE THINKING ABOUT WAS A ?'//
     C' Once again, write this as a question and include the "?":')
	READ(5,48,END=1000) PROMPT
	WRITE(5,3503)
3503	FORMAT(/////' Animal needs two objects to create a new world.'/
     C' Enter objects related to the subject area entered above, for'/
     C' example FISH and BIRD.'//' Your first object is a: ',$)
	READ(5,48,END=1000) ANIMAL
	WRITE(5,3504)
3504	FORMAT(/////' Your second object is a: ',$)
	READ(5,48,END=1000) NEW
	WRITE(5,3505) ANIMAL, NEW
3505	FORMAT(/////' Now Animal needs a question it can ask to disting
     Cuish'/' between ',70A1/' and ',70A1/' Enter a question such as'/
     C'         DOES IT SWIM ?        and include the "?":')
	READ(5,54,END=1000) (QUEST(J),J=1,61)
3518	WRITE(5,3506) NEW
3506	FORMAT(/////' For ',70A1/' the answer would be ? (YES/NO): ',$)
	READ(5,56,END=1000) ANS
	IANS=0
	IF(ANS.EQ.'Y'.OR.ANS.EQ.'y') IANS=2
	IF(ANS.EQ.'N'.OR.ANS.EQ.'n') IANS=1
	IF(IANS.EQ.0) GOTO 3518
	I2=1
	IF(IANS.EQ.1) I2=2
3508	WRITE(5,3507)
3507	FORMAT(//'0If this information is correct, enter an M to return'
     C/' to the menu.  Otherwise enter an F to fix it (start over): ',$)
	READ(5,56,END=1000) ANS
	IF(ANS.EQ.'M'.OR.ANS.EQ.'m') GOTO 3540
	IF(ANS.EQ.'F'.OR.ANS.EQ.'f') GOTO 3509
	GOTO 3508
3540	CALL ASSIGN(1,NAME,16)
	WRITE(1,3541) SUBJCT,PROMPT,(QUEST(J),J=1,61),IANS,I2,
     CANIMAL,NEW
3541	FORMAT(9X,70A1/9X,70A1/'*00000000',61A1,'\',2I4/
     C'|00010000',70A1/'|00020000',70A1/'-        end of data file')
	CALL CLOSE(1)
	GOTO 1
5000	WRITE(5,5001)
5001	FORMAT(/////' Reinitialize Section'//
     C' Enter below the name of the file you wish to reinitialize,'/
     C' or enter <CR> to return to the menu.'//
     C' The reinitialization process will delete all entries in the'/
     C' memory file except for the first two, leaving it in the state'/
     C' it was in immediately after it was created.  To change these'/
     C' initial entries, recreate the file with the CREATE command.'//
     C' Entering <CR> will return you to the menu; entering a file'/
     C' name will initialize that file and start up Animal.'/
     C' What is your file name ? ',$)
	READ(5,3,END=1000) NAME
	IF(NAME(1).LE.'@') GOTO 1
	CALL ASSIGN(1,NAME,16)
	DO 5002 I=1,5
	READ(1,56) ANS
5002	CONTINUE
	WRITE(1,5003)
5003	FORMAT('-        end of data file')
	GOTO 4002
3000	WRITE(5,3001)
3001	FORMAT(' Animal is a learning program.  It knows about'/
     C' objects in a small world and how to distinguish them.'/
     C' Animal''s "memory" is stored in a file.  There is a default'/
     C' file called ANIMAL.TXT that you can use, or you may create'/
     C' your own file on a different subject.'//
     C' Return to the above menu at any time by entering a'/
     C' CNTRL-Z.  To get a listing of all the objects Animal knows in'/
     C' its current memory, type in LIST.  Y and N can be used instead'/
     C' of YES and NO.  Put a question mark at the end of all questions'
     C/' YOU type in.'/'  Hit <CR> to return to animal, or A for more
     C advanced ideas.')
3004	READ(5,56,END=1000) ANS
	IF(ANS.EQ.'A'.OR.ANS.EQ.'a') WRITE(5,3002)
	IF(ANS.EQ.'C'.OR.ANS.EQ.'c') WRITE(5,3003)
	IF(ANS.EQ.'S'.OR.ANS.EQ.'s') WRITE(5,3006)
	IF(ANS.EQ.'M'.OR.ANS.EQ.'m') WRITE(5,3005)
	IF(ANS.EQ.'H'.OR.ANS.EQ.'h') WRITE(5,3007)
	IF(ANS.NE.' ') GOTO 3004
3002	FORMAT(////' Animal''s memory is normally based on a binary'/
     C' tree structure; that is, each question has two answers and'/
     C' each answer can be arrived at only through one branch of the'/
     C' tree.  Animal is capable of finding answers in any branch or'/
     C' level of the tree from any starting point.  This is called'/
     C' "Multi-Predecessor Processing" (MPP).'//
     C' To use MPP, simply enter an M in response to the first question'
     C/' (subject) from the file - this is where Animal asks you for'/
     C' YES, LIST or NO.  Animal will then tell you if MPP is ON or'/
     C' OFF; entering M switches it on and off.'//
     C' Any non-standard tree paths made while MPP is ON will still be'/
     C' accessible when MPP is turned OFF.  The OFF mode merely'/
     C' prevents you from generating any new structures that don''t'/
     C' conform to a binary tree network.  MPP is normally OFF.'//
     C' Note also that the same objects can appear more than once'/
     C' in the memory file if generated while MPP is OFF.'//
     C' Enter C to continue or <CR> to return to menu.')
3003	FORMAT(///' Still more advanced ideas for Animal:'//
     C' When Animal asks you if an ANSWER is correct (not a QUESTION),'/
     C' a response of NO will cause Animal to ask you for a new answer.'
     C/' If, for some reason, you do not wish to enter another object'/
     C' in the memory file, but just want to make a further'/
     C' distinction between the current ANSWER and the rest of the'/
     C' objects in Animal''s world, enter a ? (question mark) for the'/
     C' new object.  This new object becomes a NULL object and is not'/
     C' entered in memory.  You will then be asked for a question to'/
     C' distinguish between the current ANSWER and ?.'/
     C' Interpret this as: "How is the current ANSWER different from'/
     C' all other objects not already excluded by previous questions ?'/
     C/' One final point -- it should be possible to use MPP to create'/
     C' short cuts through long question sequences, rather than having'/
     C' to answer each question to get to the bottom of the file.'//
     C' Enter M for still more, or <CR> for menu.')
3005	FORMAT(' The "AT" command:'//
     C' Use the @ symbol to jump around quickly in Animal''s memory.'/
     C' Answer any YES or NO question with @ and Animal will ask you'/
     C' where to jump to.  Enter the name of an object Animal knows'/
     C' about.  If animal can''t find that object in its memory, or if'/
     C' you don''t enter an object name, Animal will go to the first'/
     C' question about that object.'/
     C' If you enter the @ symbol in response to a question asking for'/
     C' more than a yes or no answer, type in the destination immediatel
     Cy'/' following the @ symbol.  If no destination is given Animal'/
     C' will return to the subject question.'/
     C' For example, to find the first question about a zebra:'/
     C' 	DOES IT FLY ? @ZEBRA'/
     C' 	<jump>'/
     C' 	DOES IT HAVE BLACK AND WHITE STRIPES ?'/
     C' Note that the message <jump> is always printed whenever you'/
     C' attempt to jump.  In the above example, if Animal didn''t'/
     C' know about a zebra, OR if only the @ symbol had been entered,'/
     C' the question "ARE YOU THINKING OF AN ANIMAL ?'/
     C'               Enter YES, LIST or NO (leave Animal):" appears.'/
     C' Note that Animal CANNOT distinguish between upper and lower'/
     C' case letters. Zebra, zebra and ZEBRA are three DIFFERENT objects
     C.'//' Enter <CR> for the menu, or H for yet even more.... ',$)
3006	FORMAT(' Creating SUBCLASSES:'//
     C' Because of the basic binary tree structure of Animal, it is'/
     C' only possible to go to ONE other answer from each question;'/
     C' otherwise the previous answer is kept as the "current" one.'/
     C' By using a SUBCLASS, it is possible to branch to two places,'/
     C' neither of which are the previous answer.  The name "subclass"'/
     C' comes from the ability to enter a further subdivision on the'/
     C' current answer without denying that the new entry is a member'/
     C' of the set of objects described by the current answer.  For'/
     C' example, "IS IT A FISH" can have the subclass "RAINBOW TROUT",'/
     C' a new entry that is also a FISH.'//
     C' To create a subclass, enter SUBCLASS or S instead of Y(ES) or'/
     C' N(O) in response to a "IS IT A ...." question.  You will be'/
     C' asked for a name of that subclass (i.e., RAINBOW TROUT) and'/
     C' then for a question to distinguish between RAINBOW TROUT and,'/
     C' say, BIRD.'/
     C' NOTE THAT the previous current answer (FISH) can never be'/
     C' accessed again through these questions, but CAN be reached'/
     C' through the use of Multi-Predecessor Processing or # jumps.'//
     C' Enter <CR> for the menu, or A, C, M, L, or S to review.')
3007	FORMAT(' More about jumping around in memory.....'//
     C' There is one other way to jump around in the file.'/
     C' Using the @ symbol will take you to the first QUESTION about'/
     C' the object (ANSWER) you specify, or to the first (subject)'/
     C' question.  The symbol # will let you jump in a similar'/
     C' manner, except that it takes you to the object itself.'//
     C' For example, if you enter  #ZEBRA  and Animal knows of a'/
     C' ZEBRA, Animal will ask you "Are you thinking of a ZEBRA ?"'//
     C' Using @ZEBRA may have resulted in "DOES IT HAVE FOUR LEGS ?"'//
     C' Both of these will take you to the subject question (i.e.,'/
     C' ARE YOU THINKING OF AN ANIMAL ?"  if no object or an unknown'/
     C' object is specified.'///
     C' Enter L for the last page of help or <CR> for the menu.')
	GOTO 1
4000	WRITE(5,4001)
4001	FORMAT(///////
     C' Enter the name of your data file or <CR> to use'/
     C' ANIMAL.TXT: ',$)
	READ(5,3,END=1000) NAME
3	FORMAT(16A1)
	IF(NAME(1).GT.'@') GOTO 7
	DO 8 I=1,16
	NAME(I)=INIT(I)
8	CONTINUE
7	CALL ASSIGN(1,NAME,16)
C	DETERMINE MAXANS (MAX. NUM. OF ANSWERS IN DATA FILE)
4002	MAXANS=0
	REWIND 1
107	READ(1,56,END=1000) A
	IF(A.EQ.'-') GOTO 108
	IF(A.EQ.'|') MAXANS=MAXANS+1
	GOTO 107
C
C	DETERMINE MULTI-PREDECESSOR NETWORKING:
309	IF(MULTI.EQ.0) GOTO 311
	MULTI=0
	WRITE(5,310)
310	FORMAT(/' [multi-predecessor processing is now OFF]'////)
	GOTO 5
311	MULTI=1
	WRITE(5,312)
312	FORMAT(/' [multi-predecessor processing is now ON]'////)
	GOTO 5
108	IQA=0
	IQB=0  !  GET QUESTION 0,0 FIRST
	REWIND 1
	READ(1,4,END=1000) SUBJCT,PROMPT
4	FORMAT(9X,70A1/9X,70A1)
5	WRITE(5,2006) SUBJCT
2006	FORMAT(///X,70A1/' Enter YES, LIST or NO (leave Animal): ',$)
6	FORMAT(X,70A1)
	READ(5,9,END=1000) ANS
9	FORMAT(A1)
	IF(ANS.EQ.'@'.OR.ANS.EQ.'#') GOTO 6000
	IF(ANS.EQ.'L'.OR.ANS.EQ.'l') CALL LIST
	IF(ANS.EQ.'N'.OR.ANS.EQ.'n') GOTO 1000
	IF(ANS.EQ.'F'.OR.ANS.EQ.'f') GOTO 2000
	IF(ANS.EQ.'M'.OR.ANS.EQ.'m') GOTO 309
	IF(ANS.NE.'Y'.AND.ANS.NE.'y') GOTO 5
	REWIND 1
10	READ(1,11,END=1000) TYPE,IQ1,IQ2,ANIMAL !  GET QUESTION FROM FILE
C	IQ1 IS RELATES QUESTION IQ1 WITH ANSWER IA1
C	IQ2 SPECIFIES MULTIPLE QUESTIONS FOR A GIVEN ANSWER.
C	TYPE SPECIFIES DATA: * IS A QUESTION, | IS ANSWER, - IS END.
11	FORMAT(A1,2I4,70A1)
	IF(TYPE.EQ.'-') GOTO 50
	IF(TYPE.NE.'*') GOTO 10
	IF(IQ1.NE.IQA) GOTO 10 !  WRONG QUESTION FOR ANSWERS.
	IF(IQ2.NE.IQB) GOTO 10 !  NOT ANSWER WE NEED.
12	J=0
	IS0=0
	DO 13 I=1,70 !  FIND SLASHES IN QUESTION LINE
	IF(ANIMAL(I).EQ.'?') IS0=I
	IF(ANIMAL(I).NE.'\') GOTO 13
	IF(J.EQ.0) IS1=I !   SLASH
	GOTO 19
13	CONTINUE
19	IYES=0
	INO=0
	IF(IS0.NE.0) GOTO 114
C	FIND END OF QUESTION:
	DO 113 I=1,IS1-1
	IF(ANIMAL(IS1-I).GE.'A') GOTO 112
113	CONTINUE
	GOTO 10
112	IS0=IS1-I+1
	ANIMAL(IS0)='?'
114	DO 14 I=1,4
	VAL(I)=ANIMAL(IS1+I)
14	CONTINUE
	CALL AZTO09(VAL,RET)
	IYES=RET
	IS2=IS1+4  !  MOVE RIGHT 4 SPACES FOR SECOND NUMBER
	DO 15 I=1,4
	VAL(I)=ANIMAL(IS2+I)
15	CONTINUE
	CALL AZTO09(VAL,RET)
	INO=RET
	LASTM=INO
20	WRITE(5,216)
	WRITE(5,16) (ANIMAL(I),I=1,IS0) ! PRINT OUT QUESTION
	WRITE(5,221)
16	FORMAT('+',A1,$)
216	FORMAT(/X,$)
	READ(5,17,END=1000) ANS
17	FORMAT(A1)
	IF(ANS.EQ.'@'.OR.ANS.EQ.'#') GOTO 6000
	IANS=0
	IF(ANS.EQ.'y'.OR.ANS.EQ.'Y') IANS=IYES
	IF(ANS.EQ.'N'.OR.ANS.EQ.'n') IANS=INO
	IF(IANS.EQ.0) GOTO 20
30	IF(IQA.NE.IANS) IQB=-1  !  FIND QUESTION IQA,0
	IQA=IANS
	IQB=IQB+1
	REWIND 1
116	READ(1,11,END=1000) TYPE,IQ1,IQ2,ANIMAL
	IF(TYPE.EQ.'-') GOTO 117 ! NO MORE QUESTIONS ON THIS SUBJECT
	IF(TYPE.NE.'*') GOTO 116 ! NOT A QUESTION
	IF(IQ1.NE.IQA) GOTO 116 !  NOT THE RIGHT QUESTION
	IF(IQ2.NE.IQB) GOTO 116 !   "   "   "
	GOTO 12 ! GET ALL INFO FROM QUESTION LINE.
C
C	GO BACK FOR SELECTED ANSWER
117	REWIND 1
118	READ(1,11,END=1000) TYPE,IA1,IA2,ANIMAL! IA2 IS A DUMMY
	IF(TYPE.EQ.'-') GOTO 50 !  END OF FILE REACHED.
	IF(TYPE.NE.'|') GOTO 118  !  NOT AN ANSWER LINE.
	IF(IA1.NE.IANS) GOTO 118  !  WRONG ANSWER
119	A=ANIMAL(1)
	ISTOP=0
	CHAR=NULL
	IF(A.EQ.'A'.OR.A.EQ.'E'.OR.A.EQ.'I'.OR.A.EQ.'O'.OR.A.EQ.'U'.
     COR.A.EQ.'a'.OR.A.EQ.'e'.OR.A.EQ.'i'.OR.A.EQ.'o'.OR.A.EQ.'u')
     CCHAR='n'
	DO 22 I=1,70
	J=71-I
	IF(ANIMAL(J).GE.'A') GOTO 23
22	CONTINUE
23	IF(J.LT.70) ANIMAL(J+1)='?'
24	WRITE(5,21) CHAR
21	FORMAT(/' Were you thinking of a',A1/)
	WRITE(5,121) (ANIMAL(I),I=1,J+1)
121	FORMAT('+',A1,$)
	WRITE(5,221)
221	FORMAT('+ ',$)
	DO 124 I=1,70
	SAVE(I)=ANIMAL(I)
124	CONTINUE
	READ(5,17,END=1000) ANS
	ISUB=0  !  clear subclass flag
	IF(ANS.EQ.'@'.OR.ANS.EQ.'#') GOTO 6000
	IF(ANS.EQ.'S'.OR.ANS.EQ.'s') GOTO 70
	IF(ANS.EQ.'Y'.OR.ANS.EQ.'y') GOTO 25
	IF(ANS.EQ.'N'.OR.ANS.EQ.'n') GOTO 50
	GOTO 24
25	WRITE(5,26)
26	FORMAT(//' Excellent !!!  Let''s try again.')
27	IQA=0
	IQB=0
	GOTO 5
C
C	SECTION TO ALLOW SUBCLASS ("OR") TREE STRUCTURES
70	IF(J.GT.68) J=68 ! PREVENT WRITING PAST LINE END
	WRITE(5,71)
71	FORMAT(' Subclass of ',$)
	WRITE(5,121) (ANIMAL(I),I=1,J)
	WRITE(5,72)
72	FORMAT('+'/' Subclass 1 name: ',$)
	ISUB=1
	GOTO 75
C	FINISH UP SUBCLASS BUSINESS:
80	ISUB=2
	CHAR=CHAR2
	IF(IMULTI.GT.0) GOTO 82 ! SUBCLASS NOT YET IN DATABASE
	DO 81 I=1,70
	SAVE(I)=NEW(I)
81	CONTINUE
	MAXANS=MAXANS+1
	IA1=MAXANS
	WRITE(5,73)
73	FORMAT(' Subclass 2 name: ',$)
	GOTO 75
82	IA1=IMULTI
	GOTO 75
50	WRITE(5,49) PROMPT
49	FORMAT(X,70A1/' --------->',$)
75	READ(5,48,END=1000) NEW
48	FORMAT(70A1)
	IF(NEW(1).EQ.'@'.OR.NEW(1).EQ.'#') GOTO 6005
	B=NEW(1)
	CHAR2=NULL
	IF(B.EQ.'A'.OR.B.EQ.'E'.OR.B.EQ.'I'.OR.B.EQ.'O'.OR.B.EQ.'U'.
     COR.B.EQ.'a'.OR.B.EQ.'e'.OR.B.EQ.'i'.OR.B.EQ.'o'.OR.B.EQ.'u')
     CCHAR2='n'
	IF(ISUB.EQ.1) GOTO 76
	WRITE(5,53) CHAR2,NEW,CHAR,SAVE
53	FORMAT(' Please enter a question that distinguishes '/
     C' a',A1,X,70A1/' from a',A1,X,70A1/' ------------------>',$)
	READ(5,54,END=1000)(QUEST(J),J=1,61)
54	FORMAT(61A1)
	IF(QUEST(1).EQ.'@'.OR.QUEST(1).EQ.'#') GOTO 6007
52	FORMAT(' For a',A1,X,70A1/' The answer would be ? (YES/NO): ',$)
56	FORMAT(A1)
C
C	FIND HIGHEST IQB FOR QUESTION # IQA:
76	REWIND 1
	IQMAX=-1
	IMULTI=-1
255	READ(1,256,END=1000) A,IQ1,IQ2,TEMP
256	FORMAT(A1,2I4,70A1)
	IF(A.EQ.'-') GOTO 257
	IF(A.EQ.'|') GOTO 350
	IF(A.NE.'*') GOTO 255
	IF(IQ1.NE.IA1) GOTO 255  !  WRONG QUESTION
	IF(IQMAX.LT.IQ2) IQMAX=IQ2
	GOTO 255
C	CHECK FOR DUPLICATE ENTRIES:
350	IF(MULTI.EQ.0) GOTO 255 ! MULTI-PREDECESSOR OFF
	DO 351 I=1,70
	IF(TEMP(I).NE.NEW(I)) GOTO 255 !  TWO ENTRIES NOT IDENTICAL
351	CONTINUE
	WRITE(5,352)
352	FORMAT(' [entry already exists -- new predecessor added]')
	IMULTI=IQ1
	GOTO 255
257	IQ2=IQMAX+1
	IF(ISUB.EQ.1) GOTO 80
C
C	WRITE NEW QUESTION AND ANIMAL TO END OF FILE:
	REWIND 1
55	READ(1,56,END=1000) ANS !  FIND END OF FILE
	IF(ANS.NE.'-') GOTO 55
	BACKSPACE 1
58	ANS='N'
	IF(NEW(1).EQ.'?') GOTO 360
	WRITE(5,52) CHAR2,NEW
	READ(5,17,END=1000) ANS
	IF(ANS.EQ.'@'.OR.ANS.EQ.'#') GOTO 6000
360	I1=IA1
	I2=IA1
	M=MAXANS+1
	IF(IMULTI.GT.0) M=IMULTI  !  ENTRY ALREADY EXISTS
	IF(M.GT.MAXANS) MAXANS=M
	IF(ANS.EQ.'N'.OR.ANS.EQ.'n') GOTO 156
	IF(ANS.NE.'Y'.AND.ANS.NE.'y')GOTO 58
	I1=M
	GOTO 155
156	I2=M
	IQA=IA1
	IF(ISUB.EQ.2) IQA=IANS
155	IF(IMULTI.GT.0) GOTO 141
	IF(NEW(1).EQ.'?') GOTO 145
	GOTO 157
145	IF(LASTM.NE.0) GOTO 146
	WRITE(5,147)
147	FORMAT(/' you MUST have entered at least one alternate answer'/
     C' before a null answer can be used: Please enter an answer]'/)
	GOTO 50
146	I2=LASTM
C	"NEW" IS NULL OR DUPLICATE ENTRY:
141	WRITE(1,357) IANS,IQ2,(QUEST(I),I=1,61),SLASH,I1,I2
357	FORMAT('*',2I4,61A1,A1,2I4/'-        end of data file')
	GOTO 362
157	WRITE(1,57) IANS,IQ2,(QUEST(I),I=1,61),SLASH,I1,I2,M,IA2,NEW
57	FORMAT('*',2I4,61A1,A1,2I4/'|',2I4,70A1/
     C'-        end of data file')
362	IF(ISUB.NE.2) GOTO 27
	BACKSPACE 1
	WRITE(1,363) IA1,IA2,SAVE
363	FORMAT('|',2I4,70A1/'-        end of data file')
	GOTO 27
2000	CONTINUE  !  TEST ROUTINES....
	REWIND 1
2002	READ(1,2004) STUFF
2004	FORMAT(79A1)
	WRITE(5,2003) STUFF
2003	FORMAT(X,79A1)
	IF(STUFF(1).EQ.'-') GOTO 5
	GOTO 2002
1000	CALL CLOSE(1)
	CALL CLOSE(5)
	GOTO 1
C
C	SECTION TO JUMP:
6000	WRITE(5,6001)
	A=ANS
6001	FORMAT(' Jump where ? ',$)
	READ(5,48,END=1000) TEMP
	GOTO 6020
C	6005 FOR NEW, 6007 FOR QUEST(1-61), 6009 FOR ANIMAL
6005	DO 6006 I=1,69
	TEMP(I)=NEW(I+1)
6006	CONTINUE
	ICO=69
	A=NEW(1)
	GOTO 6020
6007	DO 6008 I=1,60
	TEMP(I)=QUEST(I+1)
6008	CONTINUE
	ICO=60
	A=QUEST(1)
	GOTO 6020
6009	DO 6010 I=1,69
	TEMP(I)=ANIMAL(I+1)
6010	CONTINUE
	ICO=69
	A=ANIMAL(1)
	GOTO 6020
6020	WRITE(5,6011)
6011	FORMAT(' <jump>')
	IF(TEMP(1).EQ.' '.AND.TEMP(2).EQ.' ') GOTO 27
	REWIND 1
6012	READ(1,11,END=1000) TYPE,IQA,IQB,ANIMAL
	IF(TYPE.EQ.'-') GOTO 27
	IF(TYPE.NE.'|') GOTO 6012
	DO 6013 I=1,ICO
	IF(TEMP(I).NE.ANIMAL(I)) GOTO 6012
6013	CONTINUE
	IF(A.EQ.'@') GOTO 6019
C
C	HAVE OBJECT, NOW WE NEED TO FIND LAST QUESTION RELATED TO IT.
C	USE ISTOP AS FLAG (=1 IF #JUMP, ELSE 0) AND GO BACK TO
C	QUESTION ANSWER SEARCH IN PROGRAM.
	IANS=IQ1  ! # OF ANSWER, NEEDED IN 118 LOOP
	GOTO 119
C
C	NEED TO FIND FIRST QUESTION REFERRING TO ANSWER IQ1
C	BECAUSE OF DATABASE STRUCTURE, QUESTIONS MUST APPEAR NO EARLIER
C	THAN 2 LINES BEFORE ANSWER.
6019	BACKSPACE 1
	BACKSPACE 1
	BACKSPACE 1
6014	READ(1,6015) TYPE,IQ1,IQ2,(QUEST(I),I=1,61),I1,I2
6015	FORMAT(A1,2I4,61A1,X,2I4)
	IF(TYPE.EQ.'-') GOTO 27
	IF(TYPE.NE.'*') GOTO 6014
	IF(I1.EQ.IQA.OR.I2.EQ.IQA) GOTO 6016 ! FOUND RIGHT QUESTION
	GOTO 6014
6016	BACKSPACE 1
	READ(1,11,END=1000) TYPE,IQ1,IQ2,ANIMAL
	GOTO 12
9999	STOP '-- Animal has died'
	END
C
C
C
	SUBROUTINE LIST
	LOGICAL*1 STUFF(79)
	REWIND 1
	I=0
1	READ(1,2) STUFF
2	FORMAT(79A1)
	IF(STUFF(1).EQ.'-') RETURN
	IF(STUFF(1).NE.'|') GOTO 1
	IF(STUFF(10).EQ.'/') GOTO 1
	I=I+1
	IF(I.EQ.1) WRITE(5,3)
3	FORMAT(//' In my world, I know only of the following:'//)
	WRITE(5,4) (STUFF(J),J=10,79)
4	FORMAT('   - ',70A1)
	GOTO 1
	END
	SUBROUTINE AZTO09(VAL,RET)
	LOGICAL*1 VAL,C
	DIMENSION VAL(4)
	MM=-1
	IPWR=-2
	X=0.
	ISGN=1
	DO 4 I=1,4
	IF(VAL(I).LE."40)GOTO 4 !  IGNORE BLANKS AND CONTROL CHARACTERS
	IF(VAL(I).EQ."55)GOTO 3
	IF(VAL(I).EQ."56)GOTO 2
	IF(VAL(I).LT."60.OR.VAL(I).GT."71) RETURN
	C="57
	MM=MM+1
	DO 1 K=1,10
	C=C+"1
	IF(VAL(I).EQ.C) X=X+(K-1)*10.**(-MM)
1	CONTINUE
	GOTO 4
2	IPWR=MM
	GOTO 4
3	ISGN=-ISGN
4	CONTINUE
	IF(IPWR.EQ.-2) IPWR=MM
	RET=ISGN*X*10.**IPWR
	RETURN
	END
