FORTRAN Forum

This forum is archived and is Read Only.

FORTRAN Introduction Page    Resource Page   Search

# How to write efficient FORTRAN

R

http://www.nsa.gov/public_info/_files/tech_journals/writing_efficient_fortran.pdf

Posted on Nov 27, 2011, 1:57 PM

# N54 FIXED something ELSE!

R

I will try to edit this. CAN EDIT, but DEBUG ERROR

 This message has been edited by burger2227 on Jan 24, 2011 9:05 AM

Posted on Jan 24, 2011, 9:04 AM

# plz change dis forran code..only 1 change reqd

hello..this is a general newton forward difference ccode..where and what will change for newtons forward DIVIDED difference?.
.program Divided_Differences_Iterpolation dimension
x(20),y(20),d(20,20)
n=7

xx=.7
data (x(i), i=1,7) /0,.5,1,1.4,2,3.2,5.5/
data (y(i), i=1,7)/-1.25,-3.5,6,2.32,1.5,1.27,5.6/
s=y(1)
do i=1,n-1
do j=1,n-i
y(j)=(y(j+1)-y(j))/(x(j+i)-x(j))
d(i,j)=y(j)
print*,d(i,j)
enddo
enddo
do i=1,n-1
p=1
do j=1,i
p=p*(xx-x(j))
enddo
s=s+d(i,1)*p
enddo
print*,'Interpolation of(',xx,')=',s
end

Posted on Oct 1, 2010, 7:40 AM

# Parallelism in LISP and FORTRAN

Posted on Feb 10, 2010, 3:42 PM

IMPLICIT INTEGER(A-Z)
REAL RAN
COMMON RTEXT,LLINE_TEXT,LLINE_LEN,LLINE_CONT
CHARACTER*5 A,B,WD2
CHARACTER*5 ATAB(1000)
CHARACTER*1 LLINE_TEXT(1000,100)
DIMENSION IOBJ(300),ICHAIN(100),IPLACE(100),LLINE_CONT(1000)
1 ,IFIXED(100),COND(300),PROP(100),ABB(300),LLINE_LEN(1000)
2 ,LTEXT(300),STEXT(300),KEY(300),DEFAULT(300),TRAVEL(1000)
3 ,TK(25),KTAB(1000),BTEXT(200),DSEEN(10)
4 ,DLOC(10),ODLOC(10),DTRAV(20),RTEXT(100),JSPKT(100)
5 ,IPLT(100),IFIXT(100)

IF(SETUP.NE.0) GOTO 1
SETUP=1
KEYS=1
LAMP=2
GRATE=3
ROD=5
BIRD=7
NUGGET=10
SNAKE=11
FOOD=19
WATER=20
AXE=21
DATA(JSPKT(I),I=1,16)/24,29,0,31,0,31,38,38,42,42,43,46,77,71
1 ,73,75/
DATA(IPLT(I),I=1,20)/3,3,8,10,11,14,13,9,15,18,19,17,27,28,29
1 ,30,0,0,3,3/
DATA(IFIXT(I),I=1,20)/0,0,1,0,0,1,0,1,1,0,1,1,0,0,0,0,0,0,0,0/
DATA(DTRAV(I),I=1,15)/36,28,19,30,62,60,41,27,17,15,19,28,36
1 ,300,300/
DO 1001 I=1,300
STEXT(I)=0
IF(I.LE.200) BTEXT(I)=0
IF(I.LE.100)RTEXT(I)=0
1001 LTEXT(I)=0
I=1
1003 FORMAT(I7)
GOTO(1100,1004,1004,1013,1020,1004,1004)(IKIND+1)
1005 FORMAT(1I7,100A)
IF(JKIND.EQ.-1) GOTO 1002
DO 1006 K=1,100
KK=K
IF(LLINE_TEXT(I,101-K).NE.' ') GOTO 1007
1006 CONTINUE
STOP
1007 LLINE_LEN(I)=100-KK+1
LLINE_CONT(I)=0
IF(IKIND.EQ.6)GOTO 1023
IF(IKIND.EQ.5)GOTO 1011
IF(IKIND.EQ.1) GOTO 1008
IF(STEXT(JKIND).NE.0) GOTO 1009
STEXT(JKIND)=I
GOTO 1010

1008 IF(LTEXT(JKIND).NE.0) GOTO 1009
LTEXT(JKIND)=I
GOTO 1010
1009 LLINE_CONT(I-1)=I
1010 I=I+1
IF(I.NE.1000)GOTO 1004
PAUSE 'TOO MANY LINES'

1011 IF(JKIND.LT.200)GOTO 1012
IF(BTEXT(JKIND-100).NE.0)GOTO 1009
BTEXT(JKIND-100)=I
BTEXT(JKIND-200)=I
GOTO 1010
1012 IF(BTEXT(JKIND).NE.0)GOTO 1009
BTEXT(JKIND)=I
GOTO 1010

1023 IF(RTEXT(JKIND).NE.0) GOTO 1009
RTEXT(JKIND)=I
GOTO 1010

1013 I=1
1015 FORMAT(12I7)
IF(JKIND.EQ.-1) GOTO 1002
IF(KEY(JKIND).NE.0) GOTO 1016
KEY(JKIND)=I
GOTO 1017
1016 TRAVEL(I-1)=-TRAVEL(I-1)
1017 DO 1018 L=1,10
IF(TK(L).EQ.0) GOTO 1019
TRAVEL(I)=LKIND*1024+TK(L)
I=I+1
IF(I.EQ.1000) STOP
1018 CONTINUE
1019 TRAVEL(I-1)=-TRAVEL(I-1)
GOTO 1014

1020 DO 1022 IU=1,1000
1021 FORMAT(I7,A5)
IF(KTAB(IU).EQ.-1)GOTO 1002
1022 CONTINUE
PAUSE 'TOO MANY WORDS'

C TRAVEL = NEG IF LAST THIS SOURCE + DEST*1024 + KEYWORD

C COND = 1 IF LIGHT, 2 IF DON T ASK QUESTION

1100 DO 1101 I=1,100
IPLACE(I)=IPLT(I)
IFIXED(I)=IFIXT(I)
1101 ICHAIN(I)=0

DO 1102 I=1,300
COND(I)=0
ABB(I)=0
1102 IOBJ(I)=0
DO 1103 I=1,10
1103 COND(I)=1
COND(16)=2
COND(20)=2
COND(21)=2
COND(22)=2
COND(23)=2
COND(24)=2
COND(25)=2
COND(26)=2
COND(31)=2
COND(32)=2
COND(79)=2

DO 1107 I=1,100
KTEM=IPLACE(I)
IF(KTEM.EQ.0)GOTO 1107
IF(IOBJ(KTEM).NE.0) GOTO 1104
IOBJ(KTEM)=I
GO TO 1107
1104 KTEM=IOBJ(KTEM)
1105 IF(ICHAIN(KTEM).NE.0) GOTO 1106
ICHAIN(KTEM)=I
GOTO 1107
1106 KTEM=ICHAIN(KTEM)
GOTO 1105
1107 CONTINUE
IDWARF=0
IFIRST=1
IWEST=0
ILONG=1
IDETAL=0
PAUSE 'INIT DONE'

1 CALL YES(65,1,0,YEA)
L=1
LOC=1
2 DO 73 I=1,3
IF(ODLOC(I).NE.L.OR.DSEEN(I).EQ.0)GOTO 73
L=LOC
CALL SPEAK(2)
GOTO 74
73 CONTINUE
74 LOC=L

C DWARF STUFF

IF(IDWARF.NE.0) GOTO 60
IF(LOC.EQ.15) IDWARF=1
GOTO 71
60 IF(IDWARF.NE.1)GOTO 63
IF(RAN(QZ).GT.0.05) GOTO 71
IDWARF=2
DO 61 I=1,3
DLOC(I)=0
ODLOC(I)=0
61 DSEEN(I)=0
CALL SPEAK(3)
ICHAIN(AXE)=IOBJ(LOC)
IOBJ(LOC)=AXE
IPLACE(AXE)=LOC
GOTO 71

63 IDWARF=IDWARF+1
ATTACK=0
DTOT=0
STICK=0
DO 66 I=1,3
IF(2*I+IDWARF.LT.8)GOTO 66
IF(2*I+IDWARF.GT.23.AND.DSEEN(I).EQ.0)GOTO 66
ODLOC(I)=DLOC(I)
IF(DSEEN(I).NE.0.AND.LOC.GT.14)GOTO 65
DLOC(I)=DTRAV(I*2+IDWARF-8)
DSEEN(I)=0
IF(DLOC(I).NE.LOC.AND.ODLOC(I).NE.LOC) GOTO 66
65 DSEEN(I)=1
DLOC(I)=LOC
DTOT=DTOT+1
IF(ODLOC(I).NE.DLOC(I)) GOTO 66
ATTACK=ATTACK+1
IF(RAN(QZ).LT.0.1) STICK=STICK+1
66 CONTINUE
IF(DTOT.EQ.0) GOTO 71
IF(DTOT.EQ.1)GOTO 75
PRINT 67,DTOT
67 FORMAT(' THERE ARE ',I2,' THREATENING LITTLE DWARVES IN THE
1 ROOM WITH YOU.',/)
GOTO 77
75 CALL SPEAK(4)
77 IF(ATTACK.EQ.0)GOTO 71
IF(ATTACK.EQ.1)GOTO 79
PRINT 78,ATTACK
78 FORMAT(' ',I2,' OF THEM THROW KNIVES AT YOU!',/)
GOTO 81
79 CALL SPEAK(5)
CALL SPEAK(52+STICK)
GOTO(71,83)(STICK+1)

81 IF(STICK.EQ.0) GOTO 69
IF(STICK.EQ.1)GOTO 82
PRINT 68,STICK
68 FORMAT(' ',I2,' OF THEM GET YOU.',/)
GOTO 83
82 CALL SPEAK(6)
83 PAUSE 'GAMES OVER'
GOTO 71
69 CALL SPEAK(7)

C PLACE DESCRIPTOR

71 KK=STEXT(L)
IF(ABB(L).EQ.0.OR.KK.EQ.0)KK=LTEXT(L)
IF(KK.EQ.0) GOTO 7
4 PRINT 5,(LLINE_TEXT(KK,JJ),JJ=1,LLINE_LEN(KK))
5 FORMAT(100A)
KK=KK+1
IF(LLINE_CONT(KK-1).NE.0) GOTO 4
PRINT 6
6 FORMAT(/)
7 IF(COND(L).EQ.2)GOTO 8
IF(LOC.EQ.33.AND.RAN(QZ).LT.0.25)CALL SPEAK(8)
J=L
GOTO 2000

C GO GET A NEW LOCATION

8 KK=KEY(LOC)
IF(KK.EQ.0)GOTO 19
IF(K.EQ.57)GOTO 32
IF(K.EQ.67)GOTO 40
IF(K.EQ.8)GOTO 12
LOLD=L
9 LL=TRAVEL(KK)
IF(LL.LT.0) LL=-LL
IF(1.EQ.MOD(LL,1024))GOTO 10
IF(K.EQ.MOD(LL,1024))GOTO 10
IF(TRAVEL(KK).LT.0)GOTO 11
KK=KK+1
GOTO 9
12 TEMP=LOLD
LOLD=L
L=TEMP
GOTO 21
10 L=LL/1024
GOTO 21
11 JSPK=12
IF(K.GE.43.AND.K.LE.46)JSPK=9
IF(K.EQ.29.OR.K.EQ.30)JSPK=9
IF(K.EQ.7.OR.K.EQ.8.OR.K.EQ.36.OR.K.EQ.37.OR.K.EQ.68)
1 JSPK=10
IF(K.EQ.11.OR.K.EQ.19)JSPK=11
IF(JVERB.EQ.1)JSPK=59
IF(K.EQ.48)JSPK=42
IF(K.EQ.17)JSPK=80
CALL SPEAK(JSPK)
GOTO 2
19 CALL SPEAK(13)
L=LOC
IF(IFIRST.EQ.0) CALL SPEAK(14)
21 IF(L.LT.300)GOTO 2
IL=L-300+1
GOTO(22,23,24,25,26,31,27,28,29,30,33,34,36,37)IL
GOTO 2

22 L=6
IF(RAN(QZ).GT.0.5) L=5
GOTO 2
23 L=23
IF(PROP(GRATE).NE.0) L=9
GOTO 2
24 L=9
IF(PROP(GRATE).NE.0)L=8
GOTO 2
25 L=20
IF(IPLACE(NUGGET).NE.-1)L=15
GOTO 2
26 L=22
IF(IPLACE(NUGGET).NE.-1) L=14
GOTO 2
27 L=27
IF(PROP(12).EQ.0)L=31
GOTO 2
28 L=28
IF(PROP(SNAKE).EQ.0)L=32
GOTO 2
29 L=29
IF(PROP(SNAKE).EQ.0) L=32
GOTO 2
30 L=30
IF(PROP(SNAKE).EQ.0) L=32
GOTO 2
31 PAUSE 'GAME IS OVER'
GOTO 1100
32 IF(IDETAL.LT.3)CALL SPEAK(15)
IDETAL=IDETAL+1
L=LOC
ABB(L)=0
GOTO 2
33 L=8
IF(PROP(GRATE).EQ.0) L=9
GOTO 2
34 IF(RAN(QZ).GT.0.2)GOTO 35
L=68
GOTO 2
35 L=65
38 CALL SPEAK(56)
GOTO 2
36 IF(RAN(QZ).GT.0.2)GOTO 35
L=39
IF(RAN(QZ).GT.0.5)L=70
GOTO 2
37 L=66
IF(RAN(QZ).GT.0.4)GOTO 38
L=71
IF(RAN(QZ).GT.0.25)L=72
GOTO 2
39 L=66
IF(RAN(QZ).GT.0.2)GOTO 38
L=77
GOTO 2
40 IF(LOC.LT.8)CALL SPEAK(57)
IF(LOC.GE.8)CALL SPEAK(58)
L=LOC
GOTO 2

C DO NEXT INPUT

2000 LTRUBL=0
LOC=J
ABB(J)=MOD((ABB(J)+1),5)
IDARK=0
IF(MOD(COND(J),2).EQ.1) GOTO 2003
IF((IPLACE(2).NE.J).AND.(IPLACE(2).NE.-1)) GOTO 2001
IF(PROP(2).EQ.1)GOTO 2003
2001 CALL SPEAK(16)
IDARK=1

2003 I=IOBJ(J)
2004 IF(I.EQ.0) GOTO 2011
IF(((I.EQ.6).OR.(I.EQ.9)).AND.(IPLACE(10).EQ.-1))GOTO 2008
ILK=I
IF(PROP(I).NE.0) ILK=I+100
KK=BTEXT(ILK)
IF(KK.EQ.0) GOTO 2008
2005 PRINT 2006,(LLINE_TEXT(KK,JJ),JJ=1,LLINE_LEN(KK))
2006 FORMAT(100A)
KK=KK+1
IF(LLINE_CONT(KK-1).NE.0) GOTO 2005
PRINT 2007
2007 FORMAT(/)
2008 I=ICHAIN(I)
GOTO 2004

C K=1 MEANS ANY INPUT

2012 A=WD2
B=' '
TWOWDS=0
GOTO 2021

2009 K=54
2010 JSPK=K
5200 CALL SPEAK(JSPK)

2011 JVERB=0
JOBJ=0
TWOWDS=0

2020 CALL GETIN(TWOWDS,A,WD2,B)
K=70
IF(A.EQ.'ENTER'.AND.(WD2.EQ.'STREA'.OR.WD2.EQ.'WATER'))GOTO 2010
IF(A.EQ.'ENTER'.AND.TWOWDS.NE.0)GOTO 2012
2021 IF(A.NE.'WEST')GOTO 2023
IWEST=IWEST+1
IF(IWEST.NE.10)GOTO 2023
CALL SPEAK(17)
2023 DO 2024 I=1,1000
IF(KTAB(I).EQ.-1)GOTO 3000
IF(ATAB(I).EQ.A)GOTO 2025
2024 CONTINUE
PAUSE 'ERROR 6'
2025 K=MOD(KTAB(I),1000)
KQ=KTAB(I)/1000+1
GOTO (5014,5000,2026,2010)KQ
PAUSE 'NO NO'
2026 JVERB=K
JSPK=JSPKT(JVERB)
IF(TWOWDS.NE.0)GOTO 2028
IF(JOBJ.EQ.0)GOTO 2036
2027 GOTO(9000,5066,3000,5031,2009,5031,9404,9406,5081,5200,
1 5200,5300,5506,5502,5504,5505)JVERB
PAUSE 'ERROR 5'

2028 A=WD2
B=' '
TWOWDS=0
GOTO 2023

3000 JSPK=60
IF(RAN(QZ).GT.0.8)JSPK=61
IF(RAN(QZ).GT.0.8)JSPK=13
CALL SPEAK(JSPK)
LTRUBL=LTRUBL+1
IF(LTRUBL.NE.3)GOTO 2020
IF(J.NE.13.OR.IPLACE(7).NE.13.OR.IPLACE(5).NE.-1)GOTO 2032
CALL YES(18,19,54,YEA)
GOTO 2033
2032 IF(J.NE.19.OR.PROP(11).NE.0.OR.IPLACE(7).EQ.-1)GOTO 2034
CALL YES(20,21,54,YEA)
GOTO 2033
2034 IF(J.NE.8.OR.PROP(GRATE).NE.0)GOTO 2035
CALL YES(62,63,54,YEA)
2033 IF(YEA.EQ.0)GOTO 2011
GOTO 2020
2035 IF(IPLACE(5).NE.J.AND.IPLACE(5).NE.-1)GOTO 2020
IF(JOBJ.NE.5)GOTO 2020
CALL SPEAK(22)
GOTO 2020

2036 GOTO(2037,5062,5062,9403,2009,9403,9404,9406,5062,5062,
1 5200,5300,5062,5062,5062,5062)JVERB
PAUSE 'OOPS'
2037 IF((IOBJ(J).EQ.0).OR.(ICHAIN(IOBJ(J)).NE.0)) GOTO 5062
DO 5312 I=1,3
IF(DSEEN(I).NE.0)GOTO 5062
5312 CONTINUE
JOBJ=IOBJ(J)
GOTO 2027
5062 IF(B.NE.' ')GOTO 5333
PRINT 5063,A
5063 FORMAT(' ',A5,' WHAT?',/)
GOTO 2020

5333 PRINT 5334,A,B
5334 FORMAT(' ',2A5,' WHAT?',/)
GOTO 2020
5014 IF(IDARK.EQ.0) GOTO 8

IF(RAN(QZ).GT.0.25) GOTO 8
5017 CALL SPEAK(23)
PAUSE 'GAME IS OVER'
GOTO 2011

5000 JOBJ=K
IF(TWOWDS.NE.0)GOTO 2028
IF((J.EQ.IPLACE(K)).OR.(IPLACE(K).EQ.-1)) GOTO 5004
IF(K.NE.GRATE)GOTO 502
IF((J.EQ.1).OR.(J.EQ.4).OR.(J.EQ.7))GOTO 5098
IF((J.GT.9).AND.(J.LT.15))GOTO 5097
502 IF(B.NE.' ')GOTO 5316
PRINT 5005,A
5005 FORMAT(' I SEE NO ',A5,' HERE.',/)
GOTO 2011
5316 PRINT 5317,A,B
5317 FORMAT(' I SEE NO ',2A5,' HERE.'/)
GOTO 2011
5098 K=49
GOTO 5014
5097 K=50
GOTO 5014
5004 JOBJ=K
IF(JVERB.NE.0)GOTO 2027

5064 IF(B.NE.' ')GOTO 5314
PRINT 5001,A
5001 FORMAT(' WHAT DO YOU WANT TO DO WITH THE ',A5,'?',/)
GOTO 2020
5314 PRINT 5315,A,B
5315 FORMAT(' WHAT DO YOU WANT TO DO WITH THE ',2A5,'?',/)
GOTO 2020

C CARRY

9000 IF(JOBJ.EQ.18)GOTO 2009
IF(IPLACE(JOBJ).NE.J) GOTO 5200
9001 IF(IFIXED(JOBJ).EQ.0)GOTO 9002
CALL SPEAK(25)
GOTO 2011
9002 IF(JOBJ.NE.BIRD)GOTO 9004
IF(IPLACE(ROD).NE.-1)GOTO 9003
CALL SPEAK(26)
GOTO 2011
9003 IF((IPLACE(4).EQ.-1).OR.(IPLACE(4).EQ.J)) GOTO 9004
CALL SPEAK(27)
GOTO 2011
9004 IPLACE(JOBJ)=-1
9005 IF(IOBJ(J).NE.JOBJ) GOTO 9006
IOBJ(J)=ICHAIN(JOBJ)
GOTO 2009
9006 ITEMP=IOBJ(J)
9007 IF(ICHAIN(ITEMP).EQ.(JOBJ)) GOTO 9008
ITEMP=ICHAIN(ITEMP)
GOTO 9007
9008 ICHAIN(ITEMP)=ICHAIN(JOBJ)
GOTO 2009

C LOCK, UNLOCK, NO OBJECT YET

9403 IF((J.EQ.8).OR.(J.EQ.9))GOTO 5105
5032 CALL SPEAK(28)
GOTO 2011
5105 JOBJ=GRATE
GOTO 2027

5066 IF(JOBJ.EQ.18)GOTO 2009
IF(IPLACE(JOBJ).NE.-1) GOTO 5200
5012 IF((JOBJ.NE.BIRD).OR.(J.NE.19).OR.(PROP(11).EQ.1))GOTO 9401
CALL SPEAK(30)
PROP(11)=1
5160 ICHAIN(JOBJ)=IOBJ(J)
IOBJ(J)=JOBJ
IPLACE(JOBJ)=J
GOTO 2011

9401 CALL SPEAK(54)
GOTO 5160

C LOCK,UNLOCK OBJECT

5031 IF(IPLACE(KEYS).NE.-1.AND.IPLACE(KEYS).NE.J)GOTO 5200
IF(JOBJ.NE.4)GOTO 5102
CALL SPEAK(32)
GOTO 2011
5102 IF(JOBJ.NE.KEYS)GOTO 5104
CALL SPEAK(55)
GOTO 2011
5104 IF(JOBJ.EQ.GRATE)GOTO 5107
CALL SPEAK(33)
GOTO 2011
5107 IF(JVERB.EQ.4) GOTO 5033
IF(PROP(GRATE).NE.0)GOTO 5034
CALL SPEAK(34)
GOTO 2011
5034 CALL SPEAK(35)
PROP(GRATE)=0
PROP(8)=0
GOTO 2011
5033 IF(PROP(GRATE).EQ.0)GOTO 5109
CALL SPEAK(36)
GOTO 2011
5109 CALL SPEAK(37)
PROP(GRATE)=1
PROP(8)=1
GOTO 2011

C LIGHT LAMP

9404 IF((IPLACE(2).NE.J).AND.(IPLACE(2).NE.-1))GOTO 5200
PROP(2)=1
IDARK=0
CALL SPEAK(39)
GOTO 2011

C LAMP OFF

9406 IF((IPLACE(2).NE.J).AND.(IPLACE(2).NE.-1)) GOTO 5200
PROP(2)=0
CALL SPEAK(40)
GOTO 2011

C STRIKE

5081 IF(JOBJ.NE.12)GOTO 5200
PROP(12)=1
GOTO 2003

C ATTACK

5300 DO 5313 ID=1,3
IID=ID
IF(DSEEN(ID).NE.0)GOTO 5307
5313 CONTINUE
IF(JOBJ.EQ.0)GOTO 5062
IF(JOBJ.EQ.SNAKE) GOTO 5200
IF(JOBJ.EQ.BIRD) GOTO 5302
CALL SPEAK(44)
GOTO 2011
5302 CALL SPEAK(45)
IPLACE(JOBJ)=300
GOTO 9005

5307 IF(RAN(QZ).GT.0.4) GOTO 5309
DSEEN(IID)=0
ODLOC(IID)=0
DLOC(IID)=0
CALL SPEAK(47)
GOTO 5311
5309 CALL SPEAK(48)
5311 K=21
GOTO 5014

C EAT

5502 IF((IPLACE(FOOD).NE.J.AND.IPLACE(FOOD).NE.-1).OR.PROP(FOOD).NE.0
1 .OR.JOBJ.NE.FOOD)GOTO 5200
PROP(FOOD)=1
5501 JSPK=72
GOTO 5200

C DRINK

5504 IF((IPLACE(WATER).NE.J.AND.IPLACE(WATER).NE.-1)
1 .OR.PROP(WATER).NE.0.OR.JOBJ.NE.WATER) GOTO 5200
PROP(WATER)=1
JSPK=74
GOTO 5200

C RUB

5505 IF(JOBJ.NE.LAMP)JSPK=76
GOTO 5200

C POUR

5506 IF(JOBJ.NE.WATER)JSPK=78
PROP(WATER)=1
GOTO 5200

END

SUBROUTINE SPEAK(IT)
IMPLICIT INTEGER(A-Z)
COMMON RTEXT,LLINE_TEXT,LLINE_LEN,LLINE_CONT
DIMENSION RTEXT(100),LLINE_CONT(1000),LLINE_LEN(1000)
CHARACTER*1 LLINE_TEXT(1000,100)

KKT=RTEXT(IT)
IF(KKT.EQ.0)RETURN
999 PRINT 998, (LLINE_TEXT(KKT,JJT),JJT=1,LLINE_LEN(KKT))
998 FORMAT(100A)
KKT=KKT+1
IF(LLINE_CONT(KKT-1).NE.0)GOTO 999
997 PRINT 996
996 FORMAT(/)
RETURN
END

SUBROUTINE YES(X,Y,Z,YEA)
IMPLICIT INTEGER(A-Z)
CHARACTER*5 IA1,IB1,JUNK2
CALL SPEAK(X)
CALL GETIN(JUNK,IA1,JUNK2,IB1)
IF(IA1.EQ.'NO'.OR.IA1.EQ.'N') GOTO 1
YEA=1
IF(Y.NE.0) CALL SPEAK(Y)
RETURN
1 YEA=0
IF(Z.NE.0)CALL SPEAK(Z)
RETURN
END

Posted on Jul 29, 2009, 7:29 AM

# Collossal cave (fixed spaces)

IMPLICIT INTEGER(A-Z)
REAL RAN
COMMON RTEXT,LLINE_TEXT,LLINE_LEN,LLINE_CONT
CHARACTER*5 A,B,WD2
CHARACTER*5 ATAB(1000)
CHARACTER*1 LLINE_TEXT(1000,100)
DIMENSION IOBJ(300),ICHAIN(100),IPLACE(100),LLINE_CONT(1000)
1 ,IFIXED(100),COND(300),PROP(100),ABB(300),LLINE_LEN(1000)
2 ,LTEXT(300),STEXT(300),KEY(300),DEFAULT(300),TRAVEL(1000)
3 ,TK(25),KTAB(1000),BTEXT(200),DSEEN(10)
4 ,DLOC(10),ODLOC(10),DTRAV(20),RTEXT(100),JSPKT(100)
5 ,IPLT(100),IFIXT(100)

IF(SETUP.NE.0) GOTO 1
SETUP=1
KEYS=1
LAMP=2
GRATE=3
ROD=5
BIRD=7
NUGGET=10
SNAKE=11
FOOD=19
WATER=20
AXE=21
DATA(JSPKT(I),I=1,16)/24,29,0,31,0,31,38,38,42,42,43,46,77,71
1 ,73,75/
DATA(IPLT(I),I=1,20)/3,3,8,10,11,14,13,9,15,18,19,17,27,28,29
1 ,30,0,0,3,3/
DATA(IFIXT(I),I=1,20)/0,0,1,0,0,1,0,1,1,0,1,1,0,0,0,0,0,0,0,0/
DATA(DTRAV(I),I=1,15)/36,28,19,30,62,60,41,27,17,15,19,28,36
1 ,300,300/
DO 1001 I=1,300
STEXT(I)=0
IF(I.LE.200) BTEXT(I)=0
IF(I.LE.100)RTEXT(I)=0
1001   LTEXT(I)=0
I=1
1003   FORMAT(I7)
GOTO(1100,1004,1004,1013,1020,1004,1004)(IKIND+1)
1005   FORMAT(1I7,100A)
IF(JKIND.EQ.-1) GOTO 1002
DO 1006 K=1,100
KK=K
IF(LLINE_TEXT(I,101-K).NE.' ') GOTO 1007
1006   CONTINUE
STOP
1007   LLINE_LEN(I)=100-KK+1
LLINE_CONT(I)=0
IF(IKIND.EQ.6)GOTO 1023
IF(IKIND.EQ.5)GOTO 1011
IF(IKIND.EQ.1) GOTO 1008
IF(STEXT(JKIND).NE.0) GOTO 1009
STEXT(JKIND)=I
GOTO 1010

1008   IF(LTEXT(JKIND).NE.0) GOTO 1009
LTEXT(JKIND)=I
GOTO 1010
1009   LLINE_CONT(I-1)=I
1010   I=I+1
IF(I.NE.1000)GOTO 1004
PAUSE 'TOO MANY LINES'

1011   IF(JKIND.LT.200)GOTO 1012
IF(BTEXT(JKIND-100).NE.0)GOTO 1009
BTEXT(JKIND-100)=I
BTEXT(JKIND-200)=I
GOTO 1010
1012   IF(BTEXT(JKIND).NE.0)GOTO 1009
BTEXT(JKIND)=I
GOTO 1010

1023   IF(RTEXT(JKIND).NE.0) GOTO 1009
RTEXT(JKIND)=I
GOTO 1010

1013   I=1
1015   FORMAT(12I7)
IF(JKIND.EQ.-1) GOTO 1002
IF(KEY(JKIND).NE.0) GOTO 1016
KEY(JKIND)=I
GOTO 1017
1016   TRAVEL(I-1)=-TRAVEL(I-1)
1017   DO 1018 L=1,10
IF(TK(L).EQ.0) GOTO 1019
TRAVEL(I)=LKIND*1024+TK(L)
I=I+1
IF(I.EQ.1000) STOP
1018   CONTINUE
1019   TRAVEL(I-1)=-TRAVEL(I-1)
GOTO 1014

1020   DO 1022 IU=1,1000
1021   FORMAT(I7,A5)
IF(KTAB(IU).EQ.-1)GOTO 1002
1022   CONTINUE
PAUSE 'TOO MANY WORDS'

C TRAVEL = NEG IF LAST THIS SOURCE + DEST*1024 + KEYWORD

C COND  = 1 IF LIGHT,  2 IF DON T ASK QUESTION

1100   DO 1101 I=1,100
IPLACE(I)=IPLT(I)
IFIXED(I)=IFIXT(I)
1101   ICHAIN(I)=0

DO 1102 I=1,300
COND(I)=0
ABB(I)=0
1102   IOBJ(I)=0
DO 1103 I=1,10
1103   COND(I)=1
COND(16)=2
COND(20)=2
COND(21)=2
COND(22)=2
COND(23)=2
COND(24)=2
COND(25)=2
COND(26)=2
COND(31)=2
COND(32)=2
COND(79)=2

DO 1107 I=1,100
KTEM=IPLACE(I)
IF(KTEM.EQ.0)GOTO 1107
IF(IOBJ(KTEM).NE.0) GOTO 1104
IOBJ(KTEM)=I
GO TO 1107
1104   KTEM=IOBJ(KTEM)
1105   IF(ICHAIN(KTEM).NE.0) GOTO 1106
ICHAIN(KTEM)=I
GOTO 1107
1106   KTEM=ICHAIN(KTEM)
GOTO 1105
1107   CONTINUE
IDWARF=0
IFIRST=1
IWEST=0
ILONG=1
IDETAL=0
PAUSE 'INIT DONE'

1      CALL YES(65,1,0,YEA)
L=1
LOC=1
2      DO 73 I=1,3
IF(ODLOC(I).NE.L.OR.DSEEN(I).EQ.0)GOTO 73
L=LOC
CALL SPEAK(2)
GOTO 74
73     CONTINUE
74     LOC=L

C DWARF STUFF

IF(IDWARF.NE.0) GOTO 60
IF(LOC.EQ.15) IDWARF=1
GOTO 71
60     IF(IDWARF.NE.1)GOTO 63
IF(RAN(QZ).GT.0.05) GOTO 71
IDWARF=2
DO 61 I=1,3
DLOC(I)=0
ODLOC(I)=0
61     DSEEN(I)=0
CALL SPEAK(3)
ICHAIN(AXE)=IOBJ(LOC)
IOBJ(LOC)=AXE
IPLACE(AXE)=LOC
GOTO 71

63     IDWARF=IDWARF+1
ATTACK=0
DTOT=0
STICK=0
DO 66 I=1,3
IF(2*I+IDWARF.LT.8)GOTO 66
IF(2*I+IDWARF.GT.23.AND.DSEEN(I).EQ.0)GOTO 66
ODLOC(I)=DLOC(I)
IF(DSEEN(I).NE.0.AND.LOC.GT.14)GOTO 65
DLOC(I)=DTRAV(I*2+IDWARF-8)
DSEEN(I)=0
IF(DLOC(I).NE.LOC.AND.ODLOC(I).NE.LOC) GOTO 66
65     DSEEN(I)=1
DLOC(I)=LOC
DTOT=DTOT+1
IF(ODLOC(I).NE.DLOC(I)) GOTO 66
ATTACK=ATTACK+1
IF(RAN(QZ).LT.0.1) STICK=STICK+1
66     CONTINUE
IF(DTOT.EQ.0) GOTO 71
IF(DTOT.EQ.1)GOTO 75
PRINT 67,DTOT
67     FORMAT(' THERE ARE ',I2,' THREATENING LITTLE DWARVES IN THE
1  ROOM WITH YOU.',/)
GOTO 77
75     CALL SPEAK(4)
77     IF(ATTACK.EQ.0)GOTO 71
IF(ATTACK.EQ.1)GOTO 79
PRINT 78,ATTACK
78     FORMAT(' ',I2,' OF THEM THROW KNIVES AT YOU!',/)
GOTO 81
79     CALL SPEAK(5)
CALL SPEAK(52+STICK)
GOTO(71,83)(STICK+1)

81     IF(STICK.EQ.0) GOTO 69
IF(STICK.EQ.1)GOTO 82
PRINT 68,STICK
68     FORMAT(' ',I2,' OF THEM GET YOU.',/)
GOTO 83
82     CALL SPEAK(6)
83     PAUSE 'GAMES OVER'
GOTO 71
69     CALL SPEAK(7)

C PLACE DESCRIPTOR

71     KK=STEXT(L)
IF(ABB(L).EQ.0.OR.KK.EQ.0)KK=LTEXT(L)
IF(KK.EQ.0) GOTO 7
4      PRINT 5,(LLINE_TEXT(KK,JJ),JJ=1,LLINE_LEN(KK))
5      FORMAT(100A)
KK=KK+1
IF(LLINE_CONT(KK-1).NE.0) GOTO 4
PRINT 6
6      FORMAT(/)
7      IF(COND(L).EQ.2)GOTO 8
IF(LOC.EQ.33.AND.RAN(QZ).LT.0.25)CALL SPEAK(8)
J=L
GOTO 2000

C GO GET A NEW LOCATION

8      KK=KEY(LOC)
IF(KK.EQ.0)GOTO 19
IF(K.EQ.57)GOTO 32
IF(K.EQ.67)GOTO 40
IF(K.EQ.8)GOTO 12
LOLD=L
9      LL=TRAVEL(KK)
IF(LL.LT.0) LL=-LL
IF(1.EQ.MOD(LL,1024))GOTO 10
IF(K.EQ.MOD(LL,1024))GOTO 10
IF(TRAVEL(KK).LT.0)GOTO 11
KK=KK+1
GOTO 9
12     TEMP=LOLD
LOLD=L
L=TEMP
GOTO 21
10     L=LL/1024
GOTO 21
11     JSPK=12
IF(K.GE.43.AND.K.LE.46)JSPK=9
IF(K.EQ.29.OR.K.EQ.30)JSPK=9
IF(K.EQ.7.OR.K.EQ.8.OR.K.EQ.36.OR.K.EQ.37.OR.K.EQ.68)
1 JSPK=10
IF(K.EQ.11.OR.K.EQ.19)JSPK=11
IF(JVERB.EQ.1)JSPK=59
IF(K.EQ.48)JSPK=42
IF(K.EQ.17)JSPK=80
CALL SPEAK(JSPK)
GOTO 2
19     CALL SPEAK(13)
L=LOC
IF(IFIRST.EQ.0) CALL SPEAK(14)
21     IF(L.LT.300)GOTO 2
IL=L-300+1
GOTO(22,23,24,25,26,31,27,28,29,30,33,34,36,37)IL
GOTO 2

22     L=6
IF(RAN(QZ).GT.0.5) L=5
GOTO 2
23     L=23
IF(PROP(GRATE).NE.0) L=9
GOTO 2
24     L=9
IF(PROP(GRATE).NE.0)L=8
GOTO 2
25     L=20
IF(IPLACE(NUGGET).NE.-1)L=15
GOTO 2
26     L=22
IF(IPLACE(NUGGET).NE.-1) L=14
GOTO 2
27     L=27
IF(PROP(12).EQ.0)L=31
GOTO 2
28     L=28
IF(PROP(SNAKE).EQ.0)L=32
GOTO 2
29     L=29
IF(PROP(SNAKE).EQ.0) L=32
GOTO 2
30     L=30
IF(PROP(SNAKE).EQ.0) L=32
GOTO 2
31     PAUSE 'GAME IS OVER'
GOTO 1100
32     IF(IDETAL.LT.3)CALL SPEAK(15)
IDETAL=IDETAL+1
L=LOC
ABB(L)=0
GOTO 2
33     L=8
IF(PROP(GRATE).EQ.0) L=9
GOTO 2
34     IF(RAN(QZ).GT.0.2)GOTO 35
L=68
GOTO 2
35     L=65
38     CALL SPEAK(56)
GOTO 2
36     IF(RAN(QZ).GT.0.2)GOTO 35
L=39
IF(RAN(QZ).GT.0.5)L=70
GOTO 2
37     L=66
IF(RAN(QZ).GT.0.4)GOTO 38
L=71
IF(RAN(QZ).GT.0.25)L=72
GOTO 2
39     L=66
IF(RAN(QZ).GT.0.2)GOTO 38
L=77
GOTO 2
40     IF(LOC.LT.8)CALL SPEAK(57)
IF(LOC.GE.8)CALL SPEAK(58)
L=LOC
GOTO 2

C DO NEXT INPUT

2000   LTRUBL=0
LOC=J
ABB(J)=MOD((ABB(J)+1),5)
IDARK=0
IF(MOD(COND(J),2).EQ.1) GOTO 2003
IF((IPLACE(2).NE.J).AND.(IPLACE(2).NE.-1)) GOTO 2001
IF(PROP(2).EQ.1)GOTO 2003
2001   CALL SPEAK(16)
IDARK=1

2003   I=IOBJ(J)
2004   IF(I.EQ.0) GOTO 2011
IF(((I.EQ.6).OR.(I.EQ.9)).AND.(IPLACE(10).EQ.-1))GOTO 2008
ILK=I
IF(PROP(I).NE.0) ILK=I+100
KK=BTEXT(ILK)
IF(KK.EQ.0) GOTO 2008
2005   PRINT 2006,(LLINE_TEXT(KK,JJ),JJ=1,LLINE_LEN(KK))
2006   FORMAT(100A)
KK=KK+1
IF(LLINE_CONT(KK-1).NE.0) GOTO 2005
PRINT 2007
2007   FORMAT(/)
2008   I=ICHAIN(I)
GOTO 2004

C K=1 MEANS ANY INPUT

2012   A=WD2
B=' '
TWOWDS=0
GOTO 2021

2009   K=54
2010   JSPK=K
5200   CALL SPEAK(JSPK)

2011   JVERB=0
JOBJ=0
TWOWDS=0

2020   CALL GETIN(TWOWDS,A,WD2,B)
K=70
IF(A.EQ.'ENTER'.AND.(WD2.EQ.'STREA'.OR.WD2.EQ.'WATER'))GOTO 2010
IF(A.EQ.'ENTER'.AND.TWOWDS.NE.0)GOTO 2012
2021   IF(A.NE.'WEST')GOTO 2023
IWEST=IWEST+1
IF(IWEST.NE.10)GOTO 2023
CALL SPEAK(17)
2023   DO 2024 I=1,1000
IF(KTAB(I).EQ.-1)GOTO 3000
IF(ATAB(I).EQ.A)GOTO 2025
2024   CONTINUE
PAUSE 'ERROR 6'
2025   K=MOD(KTAB(I),1000)
KQ=KTAB(I)/1000+1
GOTO (5014,5000,2026,2010)KQ
PAUSE 'NO NO'
2026   JVERB=K
JSPK=JSPKT(JVERB)
IF(TWOWDS.NE.0)GOTO 2028
IF(JOBJ.EQ.0)GOTO 2036
2027   GOTO(9000,5066,3000,5031,2009,5031,9404,9406,5081,5200,
1 5200,5300,5506,5502,5504,5505)JVERB
PAUSE 'ERROR 5'

2028   A=WD2
B=' '
TWOWDS=0
GOTO 2023

3000   JSPK=60
IF(RAN(QZ).GT.0.8)JSPK=61
IF(RAN(QZ).GT.0.8)JSPK=13
CALL SPEAK(JSPK)
LTRUBL=LTRUBL+1
IF(LTRUBL.NE.3)GOTO 2020
IF(J.NE.13.OR.IPLACE(7).NE.13.OR.IPLACE(5).NE.-1)GOTO 2032
CALL YES(18,19,54,YEA)
GOTO 2033
2032   IF(J.NE.19.OR.PROP(11).NE.0.OR.IPLACE(7).EQ.-1)GOTO 2034
CALL YES(20,21,54,YEA)
GOTO 2033
2034   IF(J.NE.8.OR.PROP(GRATE).NE.0)GOTO 2035
CALL YES(62,63,54,YEA)
2033   IF(YEA.EQ.0)GOTO 2011
GOTO 2020
2035   IF(IPLACE(5).NE.J.AND.IPLACE(5).NE.-1)GOTO 2020
IF(JOBJ.NE.5)GOTO 2020
CALL SPEAK(22)
GOTO 2020

2036   GOTO(2037,5062,5062,9403,2009,9403,9404,9406,5062,5062,
1 5200,5300,5062,5062,5062,5062)JVERB
PAUSE 'OOPS'
2037   IF((IOBJ(J).EQ.0).OR.(ICHAIN(IOBJ(J)).NE.0)) GOTO 5062
DO 5312 I=1,3
IF(DSEEN(I).NE.0)GOTO 5062
5312   CONTINUE
JOBJ=IOBJ(J)
GOTO 2027
5062   IF(B.NE.' ')GOTO 5333
PRINT 5063,A
5063   FORMAT('  ',A5,' WHAT?',/)
GOTO 2020

5333   PRINT 5334,A,B
5334   FORMAT(' ',2A5,' WHAT?',/)
GOTO 2020
5014   IF(IDARK.EQ.0) GOTO 8

IF(RAN(QZ).GT.0.25) GOTO 8
5017   CALL SPEAK(23)
PAUSE 'GAME IS OVER'
GOTO 2011

5000   JOBJ=K
IF(TWOWDS.NE.0)GOTO 2028
IF((J.EQ.IPLACE(K)).OR.(IPLACE(K).EQ.-1)) GOTO 5004
IF(K.NE.GRATE)GOTO 502
IF((J.EQ.1).OR.(J.EQ.4).OR.(J.EQ.7))GOTO 5098
IF((J.GT.9).AND.(J.LT.15))GOTO 5097
502    IF(B.NE.' ')GOTO 5316
PRINT 5005,A
5005   FORMAT(' I SEE NO ',A5,' HERE.',/)
GOTO 2011
5316   PRINT 5317,A,B
5317   FORMAT(' I SEE NO ',2A5,' HERE.'/)
GOTO 2011
5098   K=49
GOTO 5014
5097   K=50
GOTO 5014
5004   JOBJ=K
IF(JVERB.NE.0)GOTO 2027

5064   IF(B.NE.' ')GOTO 5314
PRINT 5001,A
5001   FORMAT(' WHAT DO YOU WANT TO DO WITH THE ',A5,'?',/)
GOTO 2020
5314   PRINT 5315,A,B
5315   FORMAT(' WHAT DO YOU WANT TO DO WITH THE ',2A5,'?',/)
GOTO 2020

C CARRY

9000   IF(JOBJ.EQ.18)GOTO 2009
IF(IPLACE(JOBJ).NE.J) GOTO 5200
9001   IF(IFIXED(JOBJ).EQ.0)GOTO 9002
CALL SPEAK(25)
GOTO 2011
9002   IF(JOBJ.NE.BIRD)GOTO 9004
IF(IPLACE(ROD).NE.-1)GOTO 9003
CALL SPEAK(26)
GOTO 2011
9003   IF((IPLACE(4).EQ.-1).OR.(IPLACE(4).EQ.J)) GOTO 9004
CALL SPEAK(27)
GOTO 2011
9004   IPLACE(JOBJ)=-1
9005   IF(IOBJ(J).NE.JOBJ) GOTO 9006
IOBJ(J)=ICHAIN(JOBJ)
GOTO 2009
9006   ITEMP=IOBJ(J)
9007   IF(ICHAIN(ITEMP).EQ.(JOBJ)) GOTO 9008
ITEMP=ICHAIN(ITEMP)
GOTO 9007
9008   ICHAIN(ITEMP)=ICHAIN(JOBJ)
GOTO 2009

C LOCK, UNLOCK, NO OBJECT YET

9403   IF((J.EQ.8).OR.(J.EQ.9))GOTO 5105
5032   CALL SPEAK(28)
GOTO 2011
5105   JOBJ=GRATE
GOTO 2027

5066   IF(JOBJ.EQ.18)GOTO 2009
IF(IPLACE(JOBJ).NE.-1) GOTO 5200
5012   IF((JOBJ.NE.BIRD).OR.(J.NE.19).OR.(PROP(11).EQ.1))GOTO 9401
CALL SPEAK(30)
PROP(11)=1
5160   ICHAIN(JOBJ)=IOBJ(J)
IOBJ(J)=JOBJ
IPLACE(JOBJ)=J
GOTO 2011

9401   CALL SPEAK(54)
GOTO 5160

C LOCK,UNLOCK OBJECT

5031   IF(IPLACE(KEYS).NE.-1.AND.IPLACE(KEYS).NE.J)GOTO 5200
IF(JOBJ.NE.4)GOTO 5102
CALL SPEAK(32)
GOTO 2011
5102   IF(JOBJ.NE.KEYS)GOTO 5104
CALL SPEAK(55)
GOTO 2011
5104   IF(JOBJ.EQ.GRATE)GOTO 5107
CALL SPEAK(33)
GOTO 2011
5107   IF(JVERB.EQ.4) GOTO 5033
IF(PROP(GRATE).NE.0)GOTO 5034
CALL SPEAK(34)
GOTO 2011
5034   CALL SPEAK(35)
PROP(GRATE)=0
PROP(8)=0
GOTO 2011
5033   IF(PROP(GRATE).EQ.0)GOTO 5109
CALL SPEAK(36)
GOTO 2011
5109   CALL SPEAK(37)
PROP(GRATE)=1
PROP(8)=1
GOTO 2011

C LIGHT LAMP

9404   IF((IPLACE(2).NE.J).AND.(IPLACE(2).NE.-1))GOTO 5200
PROP(2)=1
IDARK=0
CALL SPEAK(39)
GOTO 2011

C LAMP OFF

9406   IF((IPLACE(2).NE.J).AND.(IPLACE(2).NE.-1)) GOTO 5200
PROP(2)=0
CALL SPEAK(40)
GOTO 2011

C STRIKE

5081   IF(JOBJ.NE.12)GOTO 5200
PROP(12)=1
GOTO 2003

C ATTACK

5300   DO 5313 ID=1,3
IID=ID
IF(DSEEN(ID).NE.0)GOTO 5307
5313   CONTINUE
IF(JOBJ.EQ.0)GOTO 5062
IF(JOBJ.EQ.SNAKE) GOTO 5200
IF(JOBJ.EQ.BIRD) GOTO 5302
CALL SPEAK(44)
GOTO 2011
5302   CALL SPEAK(45)
IPLACE(JOBJ)=300
GOTO 9005

5307   IF(RAN(QZ).GT.0.4) GOTO 5309
DSEEN(IID)=0
ODLOC(IID)=0
DLOC(IID)=0
CALL SPEAK(47)
GOTO 5311
5309   CALL SPEAK(48)
5311   K=21
GOTO 5014

C EAT

5502   IF((IPLACE(FOOD).NE.J.AND.IPLACE(FOOD).NE.-1).OR.PROP(FOOD).NE.0
1 .OR.JOBJ.NE.FOOD)GOTO 5200
PROP(FOOD)=1
5501   JSPK=72
GOTO 5200

C DRINK

5504   IF((IPLACE(WATER).NE.J.AND.IPLACE(WATER).NE.-1)
1 .OR.PROP(WATER).NE.0.OR.JOBJ.NE.WATER) GOTO 5200
PROP(WATER)=1
JSPK=74
GOTO 5200

C RUB

5505   IF(JOBJ.NE.LAMP)JSPK=76
GOTO 5200

C POUR

5506   IF(JOBJ.NE.WATER)JSPK=78
PROP(WATER)=1
GOTO 5200

END

SUBROUTINE SPEAK(IT)
IMPLICIT INTEGER(A-Z)
COMMON RTEXT,LLINE_TEXT,LLINE_LEN,LLINE_CONT
DIMENSION RTEXT(100),LLINE_CONT(1000),LLINE_LEN(1000)
CHARACTER*1 LLINE_TEXT(1000,100)

KKT=RTEXT(IT)
IF(KKT.EQ.0)RETURN
999    PRINT 998, (LLINE_TEXT(KKT,JJT),JJT=1,LLINE_LEN(KKT))
998    FORMAT(100A)
KKT=KKT+1
IF(LLINE_CONT(KKT-1).NE.0)GOTO 999
997    PRINT 996
996    FORMAT(/)
RETURN
END

SUBROUTINE YES(X,Y,Z,YEA)
IMPLICIT INTEGER(A-Z)
CHARACTER*5 IA1,IB1,JUNK2
CALL SPEAK(X)
CALL GETIN(JUNK,IA1,JUNK2,IB1)
IF(IA1.EQ.'NO'.OR.IA1.EQ.'N') GOTO 1
YEA=1
IF(Y.NE.0) CALL SPEAK(Y)
RETURN
1      YEA=0
IF(Z.NE.0)CALL SPEAK(Z)
RETURN
END

SUBROUTINE GETIN(TWOW,B,C,D)
IMPLICIT INTEGER(A-Z)
CHARACTER*5 A(5),B,C,D
CHARACTER*1 UPCASE
1      FORMAT(4A5)
TWOW=0
S=0
DO 7 J=1,4
DO 7 K=1,5
A(J)(K:K) = UPCASE(A(J)(K:K))
7      CONTINUE
B=A(1)
DO 2 J=1,4
DO 2 K=1,5
IF (A(J)(K:K).EQ.' ') GOTO 3
IF(S.EQ.0)GOTO 2
TWOW=1
C(1:6-K) = A(J)(K:5)
IF (K.NE.1) C(6-K+1:5) = A(J+1)(1:K-1)
GOTO 4
3      IF(S.EQ.1)GOTO 2
S=1
IF (J.NE.1) GOTO 2
DO 5 L=K,5
B(L:L)=' '
5      CONTINUE
2      CONTINUE
4      D=A(2)
RETURN
END

FUNCTION RAN(I)
C     Rand is often quite poor, should replace this -- MTR
INTEGER I
RAN = Rand(0)
RETURN
END

FUNCTION UPCASE(CH)
CHARACTER*1 CH,UPCASE
INTEGER CODE
CODE=IAChar(CH)
IF (CODE.GE.97.AND.CODE.LE.122) CODE = CODE - 32
UPCASE=AChar(CODE)
RETURN
END

Posted on Jul 29, 2009, 7:31 AM

1
1       YOU ARE STANDING AT THE END OF A ROAD BEFORE A SMALL BRICK
1       BUILDING . AROUND YOU IS A FOREST. A SMALL
1       STREAM FLOWS OUT OF THE BUILDING AND DOWN A GULLY.
2       YOU HAVE WALKED UP A HILL, STILL IN THE FOREST
2       THE ROAD NOW SLOPES BACK DOWN THE OTHER SIDE OF THE HILL.
2       THERE IS A BUILDING IN THE DISTANCE.
3       YOU ARE INSIDE A BUILDING, A WELL HOUSE FOR A LARGE SPRING.
4       YOU ARE IN A VALLEY IN THE FOREST BESIDE A STREAM TUMBLING
4       ALONG A ROCKY BED.
5       YOU ARE IN OPEN FOREST, WITH A DEEP VALLEY TO ONE SIDE.
6       YOU ARE IN OPEN FOREST NEAR BOTH A VALLEY AND A ROAD.
7       AT YOUR FEET ALL THE WATER OF THE STREAM SPLASHES INTO A
7       2 INCH SLIT IN THE ROCK. DOWNSTREAM THE STREAMBED IS BARE ROCK.
8       YOU ARE IN A 20 FOOT DEPRESSION FLOORED WITH BARE DIRT. SET INTO
8       THE DIRT IS A STRONG STEEL GRATE MOUNTED IN CONCRETE. A DRY
8       STREAMBED LEADS INTO THE DEPRESSION.
9       YOU ARE IN A SMALL CHAMBER BENEATH A 3X3 STEEL GRATE TO THE
9       SURFACE. A LOW CRAWL OVER COBBLES LEADS INWARD TO THE WEST.
10      YOU ARE CRAWLING OVER COBBLES IN A LOW PASSAGE. THERE IS A
10      DIM LIGHT AT THE EAST END OF THE PASSAGE.
11      YOU ARE IN A DEBRIS ROOM, FILLED WITH STUFF WASHED IN FROM
11      THE SURFACE. A LOW WIDE PASSAGE WITH COBBLES BECOMES
11      PLUGGED WITH MUD AND DEBRIS HERE,BUT AN AWKWARD CANYON
11      A NOTE ON THE WALL SAYS 'MAGIC WORD XYZZY'.
12      YOU ARE IN AN AWKWARD SLOPING EAST/WEST CANYON.
13      YOU ARE IN A SPLENDID CHAMBER THIRTY FEET HIGH. THE WALLS
13      ARE FROZEN RIVERS OF ORANGE STONE. AN AWKWARD CANYON AND A
13      GOOD PASSAGE EXIT FROM EAST AND WEST SIDES OF THE CHAMBER.
14      AT YOUR FEET IS A SMALL PIT BREATHING TRACES OF WHITE MIST. AN
14      EAST PASSAGE ENDS HERE EXCEPT FOR A SMALL CRACK LEADING ON.
15      YOU ARE AT ONE END OF A VAST HALL STRETCHING FORWARD OUT OF
15      SIGHT TO THE WEST. THERE ARE OPENINGS TO EITHER SIDE. NEARBY, A WIDE
15      STONE STAIRCASE LEADS DOWNWARD. THE HALL IS FILLED WITH
15      WISPS OF WHITE MIST SWAYING TO AND FRO ALMOST AS IF ALIVE.
15      A COLD WIND BLOWS UP THE STAIRCASE. THERE IS A PASSAGE
15      AT THE TOP OF A DOME BEHIND YOU.
16      THE CRACK IS FAR TOO SMALL FOR YOU TO FOLLOW.
17      YOU ARE ON THE EAST BANK OF A FISSURE SLICING CLEAR ACROSS
17      THE HALL. THE MIST IS QUITE THICK HERE, AND THE FISSURE IS
17      TOO WIDE TO JUMP.
18      THIS IS A LOW ROOM WITH A CRUDE NOTE ON THE WALL.
18      IT SAYS 'YOU WON'T GET IT UP THE STEPS'.
19      YOU ARE IN THE HALL OF THE MOUNTAIN KING, WITH PASSAGES
19      OFF IN ALL DIRECTIONS.
20      YOU ARE AT THE BOTTOM OF THE PIT WITH A BROKEN NECK.
21      YOU DIDN'T MAKE IT
22      THE DOME IS UNCLIMBABLE
23      YOU CAN'T GO IN THROUGH A LOCKED STEEL GRATE!
24      YOU DON'T FIT DOWN A TWO INCH HOLE!
25      YOU CAN'T GO THROUGH A LOCKED STEEL GRATE.
27      YOU ARE ON THE WEST SIDE OF THE FISSURE IN THE HALL OF MISTS.
28      YOU ARE IN A LOW N/S PASSAGE AT A HOLE IN THE FLOOR.
28      THE HOLE GOES DOWN TO AN E/W PASSAGE.
29      YOU ARE IN THE SOUTH SIDE CHAMBER.
30      YOU ARE IN THE WEST SIDE CHAMBER OF HALL OF MT KING.
30      A PASSAGE CONTINUES WEST AND UP HERE.
31      THERE IS NO WAY ACROSS THE FISSURE.
32      YOU CAN'T GET BY THE SNAKE
33      YOU ARE IN A LARGE ROOM, WITH A PASSAGE TO THE SOUTH,
33      A PASSAGE TO THE WEST, AND A WALL OF BROKEN ROCK TO
33      THE EAST. THERE IS A LARGE 'Y2' ON A ROCK IN ROOMS CENTER.
34      YOU ARE IN A JUMBLE OF ROCK, WITH CRACKS EVERYWHERE.
35      YOU ARE AT A WINDOW ON A HUGE PIT, WHICH GOES UP AND
35      DOWN OUT OF SIGHT. A FLOOR IS INDISTINCTLY VISIBLE
35      OVER 50 FEET BELOW. DIRECTLY OPPOSITE YOU AND 25 FEET AWAY
35      THERE IS A SIMILAR WINDOW.
36      YOU ARE IN A DIRTY BROKEN PASSAGE. TO THE EAST IS A CRAWL.
36      TO THE WEST IS A LARGE PASSAGE. ABOVE YOU IS A HOLE TO
36      ANOTHER PASSAGE.
37      YOU ARE ON THE BRINK OF A SMALL CLEAN CLIMBABLE PIT.
38      YOU ARE IN THE BOTTOM OF A SMALL PIT WITH A LITTLE
38      STREAM, WHICH ENTERS AND EXITS THROUGH TINY SLITS.
39      YOU ARE IN A LARGE ROOM FULL OF DUSTY ROCKS. THERE IS A
39      BIG HOLE IN THE FLOOR. THERE ARE CRACKS EVERYWHERE, AND
40      YOU HAVE CRAWLED THROUGH A VERY LOW WIDE PASSAGE PARALLEL
40      TO AND NORTH OF THE HALL OF MISTS.
41      YOU ARE AT THE WEST END OF HALL OF MISTS. A LOW WIDE CRAWL
41      CONTINUES WEST AND ANOTHER GOES NORTH. TO THE SOUTH IS A
41      LITTLE PASSAGE 6 FEET OFF THE FLOOR.
42      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
43      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
44      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
45      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
49      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
50      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
51      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
52      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
53      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
55      YOU ARE IN A MAZE OF TWISTY LITTLE PASSAGES, ALL ALIKE.
57      YOU ARE ON THE BRINK OF A THIRTY FOOT PIT WITH A MASSIVE
57      ORANGE COLUMN DOWN ONE WALL. YOU COULD CLIMB DOWN HERE
57      BUT YOU COULD NOT GET BACK UP. THE MAZE CONTINUES AT THIS
57      LEVEL.
59      YOU HAVE CRAWLED THROUGH A VERY LOW WIDE PASSAGE PARALLEL
59      TO AND NORTH OF THE HALL OF MISTS.
60      YOU ARE AT THE EAST END OF A VERY LONG HALL APPARENTLY
60      WITHOUT SIDE CHAMBERS. TO THE EAST A LOW WIDE CRAWL SLANTS
60      UP. TO THE NORTH A ROUND TWO FOOT HOLE SLANTS DOWN.
61      YOU ARE AT THE WEST END OF A VERY LONG FEATURELESS HALL.
62      YOU ARE AT A CROSSOVER OF A HIGH N/S PASSAGE AND A LOW E/W ONE.
64      YOU ARE AT A COMPLEX JUNCTION. A LOW HANDS AND KNEES
64      PASSAGE FROM THE NORTH JOINS A HIGHER CRAWL
64      FROM THE EAST TO MAKE  A WALKING PASSAGE GOING WEST
64      THERE IS ALSO A LARGE ROOM ABOVE. THE AIR IS DAMP HERE.
64      A SIGN IN MIDAIR HERE SAYS 'CAVE UNDER CONSTRUCTION BEYOND
64      THIS POINT. PROCEED AT OWN RISK.'
65      YOU ARE IN BEDQUILT, A LONG EAST/WEST PASSAGE WITH HOLES EVERYWHERE.
65      TO EXPLORE AT RANDOM SELECT NORTH, SOUTH, UP, OR DOWN.
66      YOU ARE IN A ROOM WHOSE WALLS RESEMBLE SWISS CHEESE.
66      OBVIOUS PASSAGES GO WEST,EAST,NE, AND
66      NW. PART OF THE ROOM IS OCCUPIED BY A LARGE BEDROCK BLOCK.
67      YOU ARE IN THE TWOPIT ROOM. THE FLOOR
67      HERE IS LITTERED WITH THIN ROCK SLABS, WHICH MAKE IT
67      EASY TO DESCEND THE PITS. THERE IS A PATH HERE BYPASSING
67      THE PITS TO CONNECT PASSAGES FROM EAST AND WEST.THERE
67      ARE HOLES ALL OVER, BUT THE ONLY BIG ONE IS ON THE WALL
67      DIRECTLY OVER THE EAST PIT WHERE YOU CAN'T GET TO IT.
68      YOU ARE IN A LARGE LOW CIRCULAR CHAMBER WHOSE FLOOR IS AN
68      IMMENSE SLAB FALLEN FROM THE CEILING(SLAB ROOM). EAST AND
68      WEST THERE ONCE WERE LARGE PASSAGES, BUT THEY ARE NOW FILLED
68      WITH BOULDERS. LOW SMALL PASSAGES GO NORTH AND SOUTH, AND THE
68      SOUTH ONE QUICKLY BENDS WEST AROUND THE BOULDERS.
69      YOU ARE IN A SECRET NS CANYON ABOVE A LARGE ROOM.
70      YOU ARE IN A SECRET N/S CANYON ABOVE A SIZABLE PASSAGE.
71      YOU ARE IN SECRET CANYON AT A JUNCTION OF THREE CANYONS,
71      BEARING NORTH, SOUTH, AND SE. THE NORTH ONE IS AS TALL
71      AS THE OTHER TWO COMBINED.
72      YOU ARE IN A LARGE LOW ROOM. CRAWLS LEAD N, SE, AND SW.
74      YOU ARE IN SECRET CANYON WHICH HERE RUNS E/W. IT CROSSES OVER
74      A VERY TIGHT CANYON 15 FEET BELOW. IF YOU GO DOWN YOU MAY
74      NOT BE ABLE TO GET BACK UP
75      YOU ARE AT A WIDE PLACE IN A VERY TIGHT N/S CANYON.
76      THE CANYON HERE BECOMES TO TIGHT TO GO FURTHER SOUTH.
77      YOU ARE IN A TALL E/W CANYON. A LOW TIGHT CRAWL GOES 3 FEET
77      NORTH AND SEEMS TO OPEN UP.
78      THE CANYON RUNS INTO A MASS OF BOULDERS - DEAD END.
79      THE STREAM FLOWS OUT THROUGH A PAIR OF 1 FOOT DIAMETER SEWER
79      PIPES. IT WOULD BE ADVISABLE TO USE THE DOOR.
-1     END
2
1       YOU'RE AT END OF ROAD AGAIN.
2       YOU'RE AT HILL IN ROAD.
3       YOU'RE INSIDE BUILDING.
4       YOU'RE IN VALLEY
5       YOU'RE IN FOREST
6       YOU'RE IN FOREST
7       YOU'RE AT SLIT IN STREAMBED
8       YOU'RE OUTSIDE GRATE
9       YOU'RE BELOW THE GRATE
10      YOU'RE IN COBBLE CRAWL
11      YOU'RE IN DEBRIS ROOM.
13      YOU'RE IN BIRD CHAMBER.
14      YOU'RE AT TOP OF SMALL PIT.
15      YOU'RE IN HALL OF MISTS.
17      YOU'RE ON EAST BANK OF FISSURE.
18      YOU'RE IN NUGGET OF GOLD ROOM.
19      YOU'RE IN HALL OF MT KING.
33      YOU'RE AT Y2
35      YOU'RE AT WINDOW ON PIT
36      YOU'RE IN DIRTY PASSAGE
39      YOU'RE N DUSTY ROCK ROOM.
41      YOU'RE AT WEST END OF HALL OF MISTS.
57      YOU'RE AT BRINK OF PIT.
60      YOU'RE AT EAST END OF LONG HALL.
66      YOU'RE IN SWISS CHEESE ROOM
67      YOU'RE IN TWOPIT ROOM
68      YOU'RE IN SLAB ROOM
-1
3
1      2      2      44
1      3      3      12     19     43
1      4      4      5      13     14     46     30
1      5      6      45     43
1      8      49
2      1      8      2      12     7      43     45     30
2      5      6      45     46
3      1      3      11     32     44
3      11     48
3      33     65
3      79     5      14
4      1      4      45
4      5      6      43     44     29
4      7      5      46     30
4      8      49
5      4      9      43     30
5      300    6      7      8      45
5      5      44     46
6      1      2      45
6      4      9      43     44     30
6      5      6      46
7      1      12
7      4      4      45
7      5      6      43     44
7      8      5      15     16     46     30
7      24     47     14     30
8      5      6      43     44     46
8      1      12
8      7      4      13     45
8      301    3      5      19     30
9      302    11     12
9      10     17     18     19     44
9      14     31
9      11     51
10     9      11     20     21     43
10     11     19     22     44     51
10     14     31
11     310    49
11     10     17     18     23     24     43
11     12     25     305    19     29     44
11     3      48
11     14     31
12     310    49
12     11     30     43     51
12     13     19     29     44
12     14     31
13     310    49
13     11     51
13     12     25     305    43
13     14     23     31     44
14     310    49
14     11     51
14     13     23     43
14     303    30     31     34
14     16     33     44
15     18     36     46
15     17     7      38     44
15     19     10     30     45
15     304    29     31     34     35     23     43
15     34     55
15     62     69
16     14     1
17     15     8      38     43
17     305    7
17     306    40     41     42     44     19     39
18     15     38     11     8      45
19     15     10     29     43
19     307    45     36
19     308    46     37
19     309    44     7
19     74     66
20     26     1
21     26     1
22     15     1
23     8      1
24     7      1
25     9      1
27     17     8      11     38
27     40     45
27     41     44
28     19     38     11     46
28     33     45
28     36     30     52
29     19     38     11     45
30     19     38     11     43
30     62     44     29
31     17     1
32     19     1
33     3      65
33     28     46
33     34     43     53     54
33     35     44
34     33     30
34     15     29
35     33     43     55
36     37     43     17
36     28     29     52
36     39     44
37     36     44     17
37     38     30     31     56
38     37     56     29
39     36     43
39     64     30     52     58
39     65     70
40     41     1
41     42     46     29     23     56
41     27     43
41     59     45
41     60     44     17
42     41     44
42     43     43
42     44     46
43     42     44
43     44     46
43     45     43
44     42     45
44     43     43
44     48     30
44     50     46
45     43     45
45     46     43
45     47     46
46     45     44     11
47     45     45     11
48     44     29     11
49     50     30     43
49     51     44
50     44     43
50     49     44     29
50     52     46
51     49     44
51     52     43
51     53     46
52     50     45
52     51     44
52     53     29
52     55     43
53     51     44
53     52     45
53     54     46
54     53     43     11
55     52     44
55     56     30
55     57     43
56     55     29     11
57     55     44
57     58     46
57     13     30     56
58     57     44     11
59     27     1
60     41     43     29
60     61     44
60     62     45     30
61     60     43     11
62     60     44
62     63     45
62     30     43
62     15     46
63     62     46     11
64     39     29     56     59
64     65     44
65     64     43
65     66     44
65     68     61
65     311    46
65     312    29
66     313    45
66     65     60
66     67     44
66     77     25
66     314    46
67     66     43
67     72     60
68     66     46
68     69     29
69     68     30
69     74     46
70     71     45
71     39     29
71     65     62
71     70     46
72     67     63
72     73     45
73     72     46
74     19     43
74     69     44
74     75     30
75     76     46
75     77     45
76     75     45
77     75     43
77     78     44
77     66     45
78     77     46
79     3      1
-1
4
3      ENTER
3      DOOR
3      GATE
4      UPSTR
5      DOWNS
6      FORES
7      FORWA
7      CONTI
7      ONWAR
8      BACK
8      RETUR
8      RETRE
9      VALLE
10     STAIR
11     OUT
11     OUTSI
11     EXIT
11     LEAVE
12     BUILD
12     BLD
12     HOUSE
13     GULLY
14     STREA
15     ROCK
16     BED
17     CRAWL
18     COBBL
19     INWAR
19     INSID
19     IN
20     SURFA
21     NULL
21     NOWHE
22     DARK
23     PASSA
24     LOW
25     CANYO
26     AWKWA
29     UPWAR
29     UP
29     U
29     ABOVE
30     D
30     DOWNW
30     DOWN
31     PIT
32     OUTDO
33     CRACK
34     STEPS
35     DOME
36     LEFT
37     RIGHT
38     HALL
39     JUMP
40     MAGIC
41     OVER
42     ACROS
43     EAST
43     E
44     WEST
44     W
45     NORTH
45     N
46     SOUTH
46     S
47     SLIT
48     XYZZY
49     DEPRE
50     ENTRA
51     DEBRI
52     HOLE
53     WALL
54     BROKE
55     Y2
56     CLIMB
57     LOOK
57     EXAMI
57     TOUCH
57     LOOKA
58     FLOOR
59     ROOM
60     NE
61     SLAB
61     SLABR
62     SE
63     SW
64     NW
65     PLUGH
66     SECRE
67     CAVE
68     TURN
69     CROSS
70     BEDQU
1001   KEYS
1001   KEY
1002   LAMP
1003   GRATE
1004   CAGE
1005   ROD
1006   STEPS
1007   BIRD
1010   NUGGE
1010   GOLD
1011   SNAKE
1012   FISSU
1013   DIAMO
1014   SILVE
1014   BARS
1015   JEWEL
1016   COINS
1017   DWARV
1017   DWARF
1018   KNIFE
1018   KNIVE
1018   ROCK
1018   WEAPO
1018   BOULD
1019   FOOD
1019   RATIO
1020   WATER
1020   BOTTL
1021   AXE
1022   KNIFE
1023   CHEST
1023   BOX
1023   TREAS
2001   TAKE
2001   CARRY
2001   KEEP
2001   PICKU
2001   PICK
2001   WEAR
2001   CATCH
2001   STEAL
2001   CAPTU
2001   FIND
2001   WHERE
2001   GET
2002   RELEA
2002   FREE
2002   DISCA
2002   DROP
2002   DUMP
2003   DUMMY
2004   UNLOC
2004   OPEN
2004   LIFT
2005   NOTHI
2005   HOLD
2006   LOCK
2006   CLOSE
2007   LIGHT
2007   ON
2008   EXTIN
2008   OFF
2009   STRIK
2010   CALM
2010   WAVE
2010   SHAKE
2010   SING
2010   CLEAV
2011   WALK
2011   RUN
2011   TRAVE
2011   GO
2011   PROCE
2011   CONTI
2011   EXPLO
2011   GOTO
2011   FOLLO
2012   ATTAC
2012   KILL
2012   STAB
2012   FIGHT
2012   HIT
2013   POUR
2014   EAT
2015   DRINK
2016   RUB
3050   OPENS
3051   HELP
3051   ?
3051   WHAT
3064   TREE
3066   DIG
3066   EXCIV
3067   BLAST
3068   LOST
3069   MIST
3049   THROW
3079   FUCK
-1
5
201     THERE ARE SOME KEYS ON THE GROUND HERE.
202     THERE IS A SHINY BRASS LAMP NEARBY.
3       THE GRATE IS LOCKED
103     THE GRATE IS OPEN.
204     THERE IS A SMALL WICKER CAGE DISCARDED NEARBY.
205     A THREE FOOT BLACK ROD WITH A RUSTY STAR ON AN END LIES NEARBY
206     ROUGH STONE STEPS LEAD DOWN THE PIT.
7       A CHEERFUL LITTLE BIRD IS SITTING HERE SINGING.
107     THERE IS A LITTLE BIRD IN THE CAGE.
8       THE GRATE IS LOCKED
108     THE GRATE IS OPEN.
209     ROUGH STONE STEPS LEAD UP THE DOME.
210     THERE IS A LARGE SPARKLING NUGGET OF GOLD HERE!
11      A HUGE GREEN FIERCE SNAKE BARS THE WAY!
112     A CRYSTAL BRIDGE NOW SPANS THE FISSURE.
213     THERE ARE DIAMONDS HERE!
214     THERE ARE BARS OF SILVER HERE!
215     THERE IS PRECIOUS JEWELRY HERE!
216     THERE ARE MANY COINS HERE!
19      THERE IS FOOD HERE.
20      THERE IS A BOTTLE OF WATER HERE.
120     THERE IS AN EMPTY BOTTLE HERE.
221     THERE IS A LITTLE AXE HERE
-1
6
1       SOMEWHERE NEARBY IS COLOSSAL CAVE, WHERE OTHERS HAVE FOUND
1       FORTUNES IN TREASURE AND GOLD, THOUGH IT IS RUMORED
1       THAT SOME WHO ENTER ARE NEVER SEEN AGAIN. MAGIC IS SAID
1       TO WORK IN THE CAVE.  I WILL BE YOUR EYES AND HANDS. DIRECT
1       ME WITH COMMANDS OF 1 OR 2 WORDS.
1       (ERRORS, SUGGESTIONS, COMPLAINTS TO CROWTHER)
1       (IF STUCK TYPE HELP FOR SOME HINTS)
2       A LITTLE DWARF WITH A BIG KNIFE BLOCKS YOUR WAY.
3       A LITTLE DWARF JUST WALKED AROUND A CORNER,SAW YOU, THREW
3       A LITTLE AXE AT YOU WHICH MISSED, CURSED, AND RAN AWAY.
4       THERE IS A THREATENING LITTLE DWARF IN THE ROOM WITH YOU!
5       ONE SHARP NASTY KNIFE IS THROWN AT YOU!
6       HE GETS YOU!
7       NONE OF THEM HIT YOU!
8       A HOLLOW VOICE SAYS 'PLUGH'
9       THERE IS NO WAY TO GO THAT DIRECTION.
10      I AM UNSURE HOW YOU ARE FACING. USE COMPASS POINTS OR
10      NEARBY OBJECTS.
11      I DON'T KNOW IN FROM OUT HERE. USE COMPASS POINTS OR NAME
11      SOMETHING IN THE GENERAL DIRECTION YOU WANT TO GO.
12      I DON'T KNOW HOW TO APPLY THAT WORD HERE.
13      I DON'T UNDERSTAND THAT!
14      I ALWAYS UNDERSTAND COMPASS DIRECTIONS, OR YOU CAN NAME
14      A NEARBY THING TO HEAD THAT WAY.
15      SORRY, BUT I AM NOT ALLOWED TO GIVE MORE DETAIL. I WILL
15      REPEAT THE LONG DESCRIPTION OF YOUR LOCATION.
16      IT IS NOW PITCH BLACK. IF YOU PROCEED YOU WILL LIKELY
16      FALL INTO A PIT.
17      IF YOU PREFER, SIMPLY TYPE W RATHER THAN WEST.
18      ARE YOU TRYING TO CATCH THE BIRD?
19      THE BIRD IS FRIGHTENED RIGHT NOW AND YOU CANNOT CATCH IT
19      NO MATTER WHAT YOU TRY. PERHAPS YOU MIGHT TRY LATER.
20      ARE YOU TRYING TO ATTACK OR AVOID THE SNAKE?
21      YOU CAN'T KILL THE SNAKE, OR DRIVE IT AWAY, OR AVOID IT,
21      OR ANYTHING LIKE THAT. THERE IS A WAY TO GET BY, BUT YOU
21      DON'T HAVE THE NECESSARY RESOURCES RIGHT NOW.
22      MY WORD FOR HITTING SOMETHING WITH THE ROD IS 'STRIKE'.
23      YOU FELL INTO A PIT AND BROKE EVERY BONE IN YOUR BODY!
24      YOU ARE ALREADY CARRYING IT!
25      YOU CAN'T BE SERIOUS!
26      THE BIRD WAS UNAFRAID WHEN YOU ENTERED, BUT AS YOU APPROACH
26      IT BECOMES DISTURBED AND YOU CANNOT CATCH IT.
27      YOU CAN CATCH THE BIRD, BUT YOU CANNOT CARRY IT.
28      THERE IS NOTHING HERE WITH A LOCK!
29      YOU AREN'T CARRYING IT!
30      THE LITTLE BIRD ATTACKS THE GREEN SNAKE, AND IN AN
30      ASTOUNDING FLURRY DRIVES THE SNAKE AWAY.
31      YOU HAVE NO KEYS!
32      IT HAS NO LOCK.
33      I DON'T KNOW HOW TO LOCK OR UNLOCK SUCH A THING.
34      THE GRATE WAS ALREADY LOCKED.
35      THE GRATE IS NOW LOCKED.
36      THE GRATE WAS ALREADY UNLOCKED.
37      THE GRATE IS NOW UNLOCKED.
38      YOU HAVE NO SOURCE OF LIGHT.
39      YOUR LAMP IS NOW ON.
40      YOUR LAMP IS NOW OFF.
41      STRIKE WHAT?
42      NOTHING HAPPENS.
43      WHERE?
44      THERE IS NOTHING HERE TO ATTACK.
45      THE LITTLE BIRD IS NOW DEAD. ITS BODY DISAPPEARS.
46      ATTACKING THE SNAKE BOTH DOESN'T WORK AND IS VERY DANGEROUS.
47      YOU KILLED A LITTLE DWARF.
48      YOU ATTACK A LITTLE DWARF, BUT HE DODGES OUT OF THE WAY.
49      I HAVE TROUBLE WITH THE WORD 'THROW' BECAUSE YOU CAN THROW
49      A THING OR THROW AT A THING. PLEASE USE DROP OR ATTACK INSTEAD.
50      GOOD TRY, BUT THAT IS AN OLD WORN-OUT MAGIC WORD.
51      I KNOW OF PLACES, ACTIONS, AND THINGS. MOST OF MY VOCABULARY
51      DESCRIBES PLACES AND IS USED TO MOVE YOU THERE. TO MOVE TRY
51      WORDS LIKE FOREST, BUILDING, DOWNSTREAM, ENTER, EAST, WEST
51      NORTH, SOUTH, UP, OR DOWN.  I KNOW ABOUT A FEW SPECIAL OBJECTS,
51      LIKE A BLACK ROD HIDDEN IN THE CAVE. THESE OBJECTS CAN BE
51      MANIPULATED USING ONE OF THE ACTION WORDS THAT I KNOW. USUALLY
51      YOU WILL NEED TO GIVE BOTH THE OBJECT AND ACTION WORDS
51      (IN EITHER ORDER), BUT SOMETIMES I CAN INFER THE OBJECT FROM
51      THE VERB ALONE. THE OBJECTS HAVE SIDE EFFECTS - FOR
51      INSTANCE, THE ROD SCARES THE BIRD.
51      USUALLY PEOPLE HAVING TROUBLE MOVING JUST NEED TO TRY A FEW
51      MORE WORDS. USUALLY PEOPLE TRYING TO MANIPULATE AN
51      OBJECT ARE ATTEMPTING SOMETHING BEYOND THEIR (OR MY!)
51      CAPABILITIES AND SHOULD TRY A COMPLETELY DIFFERENT TACK.
51      TO SPEED THE GAME YOU CAN SOMETIMES MOVE LONG DISTANCES
51      WITH A SINGLE WORD. FOR EXAMPLE, 'BUILDING' USUALLY GETS
51      YOU TO THE BUILDING FROM ANYWHERE ABOVE GROUND EXCEPT WHEN
51      LOST IN THE FOREST. ALSO, NOTE THAT CAVE PASSAGES TURN A
51      LOT, AND THAT LEAVING A ROOM TO THE NORTH DOES NOT GUARANTEE
51      ENTERING THE NEXT FROM THE SOUTH. GOOD LUCK!
52      IT MISSES!
53      IT GETS YOU!
54      OK
55      YOU CAN'T UNLOCK THE KEYS.
56      YOU HAVE CRAWLED AROUND IN SOME LITTLE HOLES AND WOUND UP
56      BACK IN THE MAIN PASSAGE.
57      I DON'T KNOW WHERE THE CAVE IS, BUT HEREABOUTS NO STREAM
57      CAN RUN ON THE SURFACE FOR LONG. I WOULD TRY THE STREAM.
58      I NEED MORE DETAILED INSTRUCTIONS TO DO THAT.
59      I CAN ONLY TELL YOU WHAT YOU SEE AS YOU MOVE ABOUT
59      AND MANIPULATE THINGS. I CANNOT TELL YOU WHERE REMOTE THINGS
59      ARE.
60      I DON'T KNOW THAT WORD.
61      WHAT?
62      ARE YOU TRYING TO GET INTO THE CAVE?
63      THE GRATE IS VERY SOLID AND HAS A HARDENED STEEL LOCK. YOU
63      CANNOT ENTER WITHOUT A KEY, AND THERE ARE NO KEYS NEARBY.
63      I WOULD RECOMMEND LOOKING ELSEWHERE FOR THE KEYS.
64      THE TREES OF THE FOREST ARE LARGE HARDWOOD OAK AND MAPLE,
64      WITH AN OCCASIONAL GROVE OF PINE OR SPRUCE. THERE IS QUITE
64      A BIT OF UNDERGROWTH, LARGELY BIRCH AND ASH SAPLINGS PLUS
64      NONDESCRITPT BUSHES OF VARIOUS SORTS. THIS TIME OF YEAR
64      VISIBILITY IS QUITE RESTRICTED BY ALL THE LEAVES, BUT TRAVEL
64      IS QUITE EASY IF YOU DETOUR AROUND THE SPRUCE AND BERRY BUSHES.
65      WELCOME TO ADVENTURE!!  WOULD YOU LIKE INSTRUCTIONS?
66      DIGGING WITHOUT A SHOVEL IS QUITE IMPRACTICAL: EVEN WITH A
66      SHOVEL PROGRESS IS UNLIKELY.
67      BLASTING REQUIRES DYNAMITE.
68      I'M AS CONFUSED AS YOU ARE.
69      MIST IS A WHITE VAPOR, USUALLY WATER, SEEN FROM TIME TO TIME
69      IN CAVERNS. IT CAN BE FOUND ANYWHERE BUT IS FREQUENTLY A SIGN
69      OF A DEEP PIT LEADING DOWN TO WATER.
70      YOUR FEET ARE NOW WET.
71      THERE IS NOTHING HERE TO EAT.
72      EATEN!
73      THERE IS NO DRINKABLE WATER HERE.
74      THE BOTTLE OF WATER IS NOW EMPTY.
75      RUBBING THE ELECTRIC LAMP IS NOT PARTICULARLY REWARDING.
75      ANYWAY, NOTHING EXCITING HAPPENS.
76      PECULIAR.  NOTHING UNEXPECTED HAPPENS.
77      YOUR BOTTLE IS EMPTY AND THE GROUND IS WET.
78      YOU CAN'T POUR THAT.
79      WATCH IT!
80      WHICH WAY?
-1
0

Posted on Jul 29, 2009, 7:33 AM

# why is file output binary

I open a new output file as formatted and correctly close the unit before the end of the program. The program compiles fine and runs without error.

The only problem is that my output file is BINARY and not formatted as requested// Any ideas why ??

Chaim

Posted on Nov 30, 2008, 8:04 AM

# Which compiler are you using?

I can't reproduce it with either g77 or gfortran, which is what I have. They only have form='formatted' and form='unformatted'. Trying to use the wrong one produces a runtime error. Are you using Microsoft's compiler? If you post the code I might be able to see what is wrong more easily.

Try running this code (add spaces to the beginning if using f77):

OPEN (3, FILE='FSEQ', FORM='FORMATTED')
WRITE (3, '(A, I3)') 'Hello', 42
WRITE (3, '()')
WRITE (3, '(A)') 'Cogito ergo sum'
CLOSE (3)
END

and tell me that the contents of fseq are.

Posted on Nov 30, 2008, 5:24 PM

# File output format problem

Hello Qbguy,

Thanks for your answer. I am using the G77 compiler. I want stress the following points:

1. There are no compile or runtime error.
2. I open four output files, all formatted with the same syntax and close them properly.
3. Three of the four output formatted files and only one (UNIT=21) gives me a binary file.
4. The code is over 4 thousand lines so I will only post a fragment.

Could the syntax of my write statements cause a binary output ??

Here is the fragment:

OPEN(UNIT=18, FILE='TAMSrc.out', STATUS='NEW', FORM='FORMATTED')
OPEN(UNIT=19, FILE='Diurnal.out', STATUS='NEW', FORM='FORMATTED')
OPEN(UNIT=21, FILE='check.out', STATUS='NEW', FORM='FORMATTED')

many lines of code

WRITE(UNIT=21, FMT=1001) 'Link Number = ',LN
1001 FORMAT (A, I10)
WRITE(UNIT=21, FMT=1001) 'Location = ',AR
WRITE(UNIT=21, FMT=1002) 'Link length in km = ',LENKM
1002 FORMAT (A, F10.3)
WRITE(UNIT=21, FMT=1003) 'Car flow (7-8) = ',TCF
1003 FORMAT (A, F10.3)
WRITE(UNIT=21, FMT=1003) 'Bus flow (7-8) = ',TBF
WRITE(UNIT=21, FMT=1003) 'SPEED speed in km/hr (7-8) = ',SPEED
WRITE(UNIT=21, FMT=1003) 'TSPEED speed in km/hr (7-8) = ',TSPEED
WRITE(UNIT=21, FMT=1003) 'Final speed in km/hr = ',NSPEED
WRITE(UNIT=21, FMT=1001) 'Total number of lanes = ',TLANES
WRITE(UNIT=21, FMT=1001) 'Number of segments = ',INS
WRITE(UNIT=21, FMT=1003) 'Initial segment length in meters= ',DL
WRITE(UNIT=21, FMT=1003) 'Final Segment length in meters = ',SEG
WRITE(UNIT=21, FMT=1003) 'Sigma Z in meters = ',VSIGZI
WRITE(UNIT=21, FMT=1003) 'Sigma Y in meters = ',VSIGYI
WRITE(UNIT=21, FMT=1003) 'Lane width in meters = ',LANEW
WRITE(UNIT=21, FMT=1003) 'Base Elevation in meters = ',BELEV
WRITE(UNIT=21, FMT=1003) 'Source height in meters = ',VEFFHT
WRITE(UNIT=21, FMT=1003) 'Total emissions for link = ',TE
WRITE(UNIT=21, FMT=1003) 'Total emissions for segment = ',STE
WRITE(UNIT=21, FMT=1004) 'Coordinates = ',XA,YA,XB,YB 1004 FORMAT (A, 4(F15.3))
1005 FORMAT (A, 2(F15.3))

WRITE(UNIT=21, FMT=527) ' R10R Matrix '
527 FORMAT (A)
DO 540 J=1,24
WRITE(UNIT=21, FMT=528) (R10R(I,J),I=1,6)
540 CONTINUE

WRITE(UNIT=21, FMT=527) ' R10F Matrix '
DO 550 J=1,24
WRITE(UNIT=21, FMT=528) (R10F(I,J),I=1,6)
550 CONTINUE

CLOSE(UNIT=18)
CLOSE(UNIT=19)
CLOSE(UNIT=20)
CLOSE(UNIT=21)
END

Hope you can find a reason for the binary output.

Regards,

Chaim

Posted on Dec 1, 2008, 9:02 AM

# You reference a format statement on line 528

But there is no line with that label in your source. It might have been one of the lines you cut out. I added a line there, but when I tested it, it printed the numbers in text format.

Posted on Dec 1, 2008, 3:30 PM

# problem resolved

Hi Qbguy,

I did cut out the format statement (528). In the end I resolved the problem by removing write statements one by one (for the particular unit) until the problem went away. I did find one write statement which seemed to cause the problem. The syntax of the statement is OK and when run alone (as you did, there is not problem).

Apparently this write statement along with the logic of the program causes the binary file to be created. I did not think that this could be.

The bottom line is that the problem was resolved, but I am aware of the specific reason for its occurance.

Thanks for all of your assistance.

Regards,

Chaim

Posted on Dec 2, 2008, 8:04 AM

# Mandelbrot Set

PROGRAM MANDEL
IMPLICIT NONE
INTEGER, PARAMETER :: N=999, RESOLUTION=999
INTEGER, DIMENSION(N,N) :: COLOUR
REAL, DIMENSION(N,N) :: CR, CI, ZR, ZI, ZRS, ZIS
INTEGER I, J
DO I=1,N
CR(I,:)=(I*3.0/N) - 2.0
CI(:,I)=(I*3.0/N) - 1.5
END DO
ZR=CR; ZI=CI; ZRS=ZR*ZR; ZIS=ZI*ZI
DO I=0, RESOLUTION
WHERE (ZRS + ZIS <= 4.0)
ZRS = ZR * ZR
ZIS = ZI * ZI
ZI = 2.0 * ZR * ZI + CI
ZR = ZRS - ZIS + CR
COLOUR = I
END WHERE
END DO
OPEN(UNIT=10, FILE='mandel.pgm')
WRITE(10, FMT='(''P2'',/,i3,2x,i3,/,i3)') N, N, RESOLUTION
WRITE(10,*) colour
CLOSE(UNIT=10)
END PROGRAM MANDEL

It outputs in pgm format:
http://netpbm.sourceforge.net/doc/pgm.html
http://en.wikipedia.org/wiki/Netpbm_format
http://netpbm.sourceforge.net/

pgm is natively supported by ubuntu's image viewer, and by the GNU Image Manipulation Program (gimp).

For windows, try installing the GiMP or look at http://gnuwin32.sourceforge.net/packages/netpbm.htm

Posted on Nov 24, 2008, 1:48 PM

Posted on Jul 12, 2008, 10:37 AM

# * Actual footage of QBGuy posting QB64 on Sourceforge project site

R

 This message has been edited by burger2227 on Sep 8, 2008 10:21 AMThis message has been edited by burger2227 on Jul 13, 2008 4:35 PM

Posted on Jul 12, 2008, 1:08 PM

# What like this

R

 This message has been edited by dean.menezes on Sep 8, 2008 4:15 PM

Posted on Sep 8, 2008, 4:15 PM

# Hard to type when holding a camera eh?

R

You could have made a typing simulator LOL. But I TRULEY believe you DID do it, arrogant child.

 This message has been edited by burger2227 on Sep 10, 2008 5:14 PMThis message has been edited by burger2227 on Sep 9, 2008 11:08 AM

Posted on Sep 9, 2008, 8:41 AM

# * DOS? Oh, right... Because you would EXPECTED to use Linux... Nice!

P.S. Skateboarders have helmet-cams. Those who can't afford them wrap some strong adhesive tape (duct tape is THE only tape) a camera around their helmet. You might try that! ^_^

Posted on Nov 6, 2008, 12:11 AM

# * Well it's actually the Command Prompt in Windows XP run full screen

Posted on Nov 6, 2008, 5:39 AM

# F90 Chess

http://samanddeanus.no-ip.org/chess.f90
http://samanddeanus.no-ip.org/chess.exe

This must be compiled with Fortran 90 compiler (g95 or gfortran) , not with Fortran 77 compiler (g77).

Posted on Jul 5, 2008, 1:36 PM

# Hello, World

R

PROGRAM HELLO
WRITE (*, *) "HELLO, WORLD!"
END PROGRAM

Notes:

This is the hello world program. Single quotes may be used instead of double quotes.

Compile with:

gfortran hello.f90 -o hello

If you want to use fixed form format then you have to put six spaces before each line so it starts in the right column.

Posted on Jul 1, 2008, 5:35 PM