File FORTRN.TM

Directory of image this file is from
This file as a plain text file
FORTR 
/      COMMON IDATA
/      DIMENSION IPA(2),ISET(9),ICODE(180),NN(12),NC(12)
/      DIMENSION DATA(12),NNS(3,5),NCS(3,5),DATS(3,5),IDATA(800)
/      DO 10 I=1,3
DCA \I
^A, INC \I
TAD \I
CIA 
TAD (3
SPC 
JMP ^B
/      DO 11 J=1,5
DCA \J
^C, INC \J
TAD \J
CIA 
TAD (5
SPC 
JMP ^D
/      NNS(I,J)=0
TAD (3
CALL 3,SUBSC
ARG \J
ARG \I
ARG \NNS
[0
DCA I [0
/      NCS(I,J)=0
TAD (3
CALL 3,SUBSC
ARG \J
ARG \I
ARG \NCS
[0
DCA I [0
/ 11   DATS(I,J)=0.
\11, TAD (3
CMA 
CALL 3,SUBSC
ARG \J
ARG \I
ARG \DATS
[0
CALL 1,FAD
ARG ]3
CALL 1,ISTO
ARG [0
JMP ^C
^D, 
/      DO 10 J=1,2
DCA \J
^E, INC \J
TAD \J
CIA 
TAD (2
SPC 
JMP ^F
/      DO 10 K=1,2
DCA \K
^G, INC \K
TAD \K
CIA 
TAD (2
SPC 
JMP ^H
/      JKI=(I-1)*4+(J-1)*2+K
IAC 
CIA 
TAD \I
CALL 1,MPY
ARG (4
DCA [A
IAC 
CIA 
TAD \J
CALL 1,MPY
ARG (2
TAD [A
TAD \K
DCA \JKI
/      NN(JKI)=0
CALL 2,SUBSC
ARG \JKI
ARG \NN
[0
DCA I [0
/      NC(JKI)=0
CALL 2,SUBSC
ARG \JKI
ARG \NC
[0
DCA I [0
/10    DATA(JKI)=0.
\10, CMA 
CALL 2,SUBSC
ARG \JKI
ARG \DATA
[0
CALL 1,FAD
ARG ]3
CALL 1,ISTO
ARG [0
JMP ^G
^H, 
JMP ^E
^F, 
JMP ^A
^B, 
/      IPA(1)=-1
CALL 2,SUBSC
ARG (1
ARG \IPA
[0
IAC 
CIA 
DCA I [0
/      IPA(2)=0
CALL 2,SUBSC
ARG (2
ARG \IPA
[0
DCA I [0
/      DO 1 I=1,9
DCA \I
^I, INC \I
TAD \I
CIA 
TAD (11
SPC 
JMP ^J
/1     ISET(I)=I
\1, CALL 2,SUBSC
ARG \I
ARG \ISET
[0
TAD \I
DCA I [0
JMP ^I
^J, 
/      DO 2 I=1,180
DCA \I
^K, INC \I
TAD \I
CIA 
TAD (264
SPC 
JMP ^L
/2     ICODE(I)=I-1
\2, CALL 2,SUBSC
ARG \I
ARG \ICODE
[0
IAC 
CIA 
TAD \I
DCA I [0
JMP ^K
^L, 
/      CALL SRAND
CALL 0,SRAND
/      READ(1,200)ITON,ITOFF,IDEL,ITOUT,IRAN
CALL 2,READ
ARG (1
ARG \200
CALL 1,IOH
ARG \ITON
CALL 1,IOH
ARG \ITOFF
CALL 1,IOH
ARG \IDEL
CALL 1,IOH
ARG \ITOUT
CALL 1,IOH
ARG \IRAN
CALL 1,IOH
ARG 0
/200   FORMAT(I5)
JMP ^M
CPAGE 3
\200, 5011
6551
0
^M, 
/      DO 3 I=1,IRAN
DCA \I
^N, INC \I
TAD \I
CIA 
TAD \IRAN
SPC 
JMP ^O
/3     J=IRAND(0)
\3, CALL 1,IRAND
ARG (0
DCA \J
JMP ^N
^O, 
/      NEXT=0
DCA \NEXT
/      DO 80 NS=1,3
DCA \NS
^P, INC \NS
TAD \NS
CIA 
TAD (3
SPC 
JMP ^Q
/      CALL SHUF1(ICODE,1,180,1)
CALL 4,SHUF1
ARG \ICODE
ARG (1
ARG (264
ARG (1
     CLA;6132;TAD (2100;6132;TAD (-144;6133
/      DO 20 N=1,180
DCA \N
^R, INC \N
TAD \N
CIA 
TAD (264
SPC 
JMP ^S
/      CALL SHUF1(ISET,1,9,1)
CALL 4,SHUF1
ARG \ISET
ARG (1
ARG (11
ARG (1
/      NO=ICODE(N)
CALL 2,SUBSC
ARG \N
ARG \ICODE
[0
TAD I [0
DCA \NO
/      I1=NO/90
TAD \NO
CALL 1,DIV
ARG (132
DCA \I1
/      NO=NO-I1*90
TAD (132
CALL 1,MPY
ARG \I1
CIA 
TAD \NO
DCA \NO
/      I2=NO/45
TAD \NO
CALL 1,DIV
ARG (55
DCA \I2
/      NO=NO-I2*45
TAD (55
CALL 1,MPY
ARG \I2
CIA 
TAD \NO
DCA \NO
/      I3=NO/15
TAD \NO
CALL 1,DIV
ARG (17
DCA \I3
/      II3=I3
TAD \I3
DCA \II3
/      I3=I3*2+1
TAD (2
CALL 1,MPY
ARG \I3
IAC 
DCA \I3
/      IF(I2)21,21,22
TAD \I2
SNA 
JMP \21
SPC 
JMP \21
/ 22   NO=NO-15*II3
\22, TAD \II3
CALL 1,MPY
ARG (17
CIA 
TAD \NO
DCA \NO
/      I4=NO/(15/I3)+1
TAD (17
CALL 1,DIV
ARG \I3
DCA [A
TAD \NO
CALL 1,DIV
ARG [A
IAC 
DCA \I4
/21    CONTINUE
\21, NOP 
/      I1=I1+1
IAC 
TAD \I1
DCA \I1
/      I2=I2+1
IAC 
TAD \I2
DCA \I2
/      GO TO(23,24),I1
TAD \I1
TAD ^T
DCA 7
TAD I 7
DCA 7
JMP I 7
CPAGE 3
^T, ^T
\23
\24
/23    ITEST=IPA(I2)
\23, CALL 2,SUBSC
ARG \I2
ARG \IPA
[0
TAD I [0
DCA \ITEST
/      GO TO 19
JMP \19
/24    ITEST=ISET(I3+1)
\24, IAC 
TAD \I3
DCA [A
CALL 2,SUBSC
ARG [A
ARG \ISET
[0
TAD I [0
DCA \ITEST
/      IF(I2-2)19,28,19
TAD (2
CIA 
TAD \I2
SNA CLA 
JMP \28
JMP \19
/28    ITEST=ISET(I4)
\28, CALL 2,SUBSC
ARG \I4
ARG \ISET
[0
TAD I [0
DCA \ITEST
/19    CONTINUE
\19, NOP 
     6141;1000;1;2;DCA SAVE1
     6135
     WW, 6135;SMA CLA;JMP WW
/      DO 1100 III=1,I3
DCA \III
^U, INC \III
TAD \III
CIA 
TAD \I3
SPC 
JMP ^V
/      J=ISET(III)
CALL 2,SUBSC
ARG \III
ARG \ISET
[0
TAD I [0
DCA \J
/      DO 1050 K=1,ITON
DCA \K
^W, INC \K
TAD \K
CIA 
TAD \ITON
SPC 
JMP ^X
     JMS SYNC;JMS SHOW
/ 1050 CONTINUE
\1050, NOP 
JMP ^W
^X, 
/      DO 1060 K=1,ITOFF
DCA \K
^Y, INC \K
TAD \K
CIA 
TAD \ITOFF
SPC 
JMP ^Z
     JMS SYNC
/ 1060 CONTINUE
\1060, NOP 
JMP ^Y
^Z, 
/ 1100 CONTINUE
\1100, NOP 
JMP ^U
^V, 
/      DO 1150 K=1,IDEL
DCA \K
^AA, INC \K
TAD \K
CIA 
TAD \IDEL
SPC 
JMP ^AB
     JMS SYNC
/ 1150 CONTINUE
\1150, NOP 
JMP ^AA
^AB, 
/      J=ITEST
TAD \ITEST
DCA \J
     6314
/      DO 1200 K=1,ITOUT
DCA \K
^AC, INC \K
TAD \K
CIA 
TAD \ITOUT
SPC 
JMP ^AD
     JMS SYNC;JMS SHOW
     6316
     SZA
     JMP RESP
/ 1200 CONTINUE
\1200, NOP 
JMP ^AC
^AD, 
/      IRESP=-1
IAC 
CIA 
DCA \IRESP
/      LAT=ITOUT
TAD \ITOUT
DCA \LAT
/      GO TO 1300
JMP \1300
     RESP, TAD (-1000
     SZA CLA;IAC;DCA \IRESP
/      LAT=K
TAD \K
DCA \LAT
/ 1300 CONTINUE
\1300, NOP 
     6141;61
     SAVE1,0
     2
/      KK=ITI-LAT
TAD \LAT
CIA 
TAD \ITI
DCA \KK
/      DO 1400 K=1,KK
DCA \K
^AE, INC \K
TAD \K
CIA 
TAD \KK
SPC 
JMP ^AF
     JMS SYNC
/ 1400 CONTINUE
\1400, NOP 
JMP ^AE
^AF, 
/      GO TO 1500
JMP \1500
     R,0
     SHOW,0
     CLA CLL;TAD \J;RAL;TAD ADPWS;TAD (-1;DCA 10
     TAD I 10;DCA PW1;TAD I 10;DCA PW2;6141;61;374
     1760
     PW1,0
     1760
     PW2,0
     2;CLA CLL;JMP I SHOW
     SYNC,0
     CLA;6135;SPA CLA;HLT
     W1,  6135
     SMA CLA;JMP W1
     JMP I SYNC
     ADPWS,PWS
     404     /"-" PWS
     404
     PWS, 1212       /"=" PWS
     1212
     2101;177        /"1"
     4523;2151
     4122;2651
     2414;477
     5172;651
     1506;4225
     4443;6050
     5126;2651
     5120;3651       /"9"
/1500  WRITE(1,100)N,I1,I2,I3,I4,IRESP,LAT
\1500, CALL 2,WRITE
ARG (1
ARG \100
CALL 1,IOH
ARG \N
CALL 1,IOH
ARG \I1
CALL 1,IOH
ARG \I2
CALL 1,IOH
ARG \I3
CALL 1,IOH
ARG \I4
CALL 1,IOH
ARG \IRESP
CALL 1,IOH
ARG \LAT
CALL 1,IOH
ARG 0
/100   FORMAT(I3,I2,3I1,I2,I5)
JMP ^AG
CPAGE 11
\100, 5011
6354
1162
5463
1161
5411
6254
1165
5100
^AG, 
/      NEXT=NEXT+1
IAC 
TAD \NEXT
DCA \NEXT
/      IDATA(NEXT)=ICODE(N)+1+1000*IRESP
CALL 2,SUBSC
ARG \NEXT
ARG \IDATA
[0
CALL 2,SUBSC
ARG \N
ARG \ICODE
[1
TAD I [1
IAC 
DCA [A
TAD \IRESP
CALL 1,MPY
ARG (1750
TAD [A
DCA I [0
/      NEXT=NEXT+1
IAC 
TAD \NEXT
DCA \NEXT
/      IDATA(NEXT)=LAT
CALL 2,SUBSC
ARG \NEXT
ARG \IDATA
[0
TAD \LAT
DCA I [0
/      IF(NS-1)30,31,30
IAC 
CIA 
TAD \NS
SNA CLA 
JMP \31
JMP \30
/ 31   IF (N-40) 20,9,20
\31, TAD (50
CIA 
TAD \N
SNA CLA 
JMP \9
JMP \20
/ 30   I3=I3/2+1
\30, TAD \I3
CALL 1,DIV
ARG (2
IAC 
DCA \I3
/      IJK=(I1-1)*4+(I2-1)*2+I3
IAC 
CIA 
TAD \I1
CALL 1,MPY
ARG (4
DCA [A
IAC 
CIA 
TAD \I2
CALL 1,MPY
ARG (2
TAD [A
TAD \I3
DCA \IJK
/      NN(IJK)=NN(IJK)+1
CALL 2,SUBSC
ARG \IJK
ARG \NN
[0
CALL 2,SUBSC
ARG \IJK
ARG \NN
[1
TAD I [1
IAC 
DCA I [0
/      IF(IRESP+1-I2)20,34,20
IAC 
TAD \IRESP
CIA 
TAD \I2
CIA 
SNA CLA 
JMP \34
JMP \20
/ 34   NC(IJK)=NC(IJK)+1
\34, CALL 2,SUBSC
ARG \IJK
ARG \NC
[0
CALL 2,SUBSC
ARG \IJK
ARG \NC
[1
TAD I [1
IAC 
DCA I [0
/      DATA(IJK)=DATA(IJK)+FLOAT(LAT)
CMA 
CALL 2,SUBSC
ARG \IJK
ARG \DATA
[0
CMA 
CALL 2,SUBSC
ARG \IJK
ARG \DATA
[1
CALL 1,FLOAT
ARG \LAT
CALL 1,STO
ARG ]A
CALL 1,IFAD
ARG [1
CALL 1,FAD
ARG ]A
CALL 1,ISTO
ARG [0
/      IF(2*I1+I2-6)20,35,20
TAD \I1
CALL 1,MPY
ARG (2
TAD \I2
CIA 
TAD (6
CIA 
SNA CLA 
JMP \35
JMP \20
/ 35   NNS(I3,I4)=NNS(I3,I4)+1
\35, TAD (3
CALL 3,SUBSC
ARG \I4
ARG \I3
ARG \NNS
[0
TAD (3
CALL 3,SUBSC
ARG \I4
ARG \I3
ARG \NNS
[1
TAD I [1
IAC 
DCA I [0
/      IF(IRESP+1-I2)20,36,20
IAC 
TAD \IRESP
CIA 
TAD \I2
CIA 
SNA CLA 
JMP \36
JMP \20
/36    NCS(I3,I4)=NCS(I3,I4)+1
\36, TAD (3
CALL 3,SUBSC
ARG \I4
ARG \I3
ARG \NCS
[0
TAD (3
CALL 3,SUBSC
ARG \I4
ARG \I3
ARG \NCS
[1
TAD I [1
IAC 
DCA I [0
/      DATS(I3,I4)=DATS(I3,I4)+FLOAT(LAT)
TAD (3
CMA 
CALL 3,SUBSC
ARG \I4
ARG \I3
ARG \DATS
[0
TAD (3
CMA 
CALL 3,SUBSC
ARG \I4
ARG \I3
ARG \DATS
[1
CALL 1,FLOAT
ARG \LAT
CALL 1,STO
ARG ]A
CALL 1,IFAD
ARG [1
CALL 1,FAD
ARG ]A
CALL 1,ISTO
ARG [0
/20    CONTINUE
\20, NOP 
JMP ^R
^S, 
/ 9    PAUSE
\9, CALL 0,CKIO
TAD (0
HLT 
CLA 
/ 80   CALL OPEN
\80, CALL 0,OPEN
JMP ^P
^Q, 
/      DO 50 I=1,2
DCA \I
^AH, INC \I
TAD \I
CIA 
TAD (2
SPC 
JMP ^AI
/      DO 50 J=1,2
DCA \J
^AJ, INC \J
TAD \J
CIA 
TAD (2
SPC 
JMP ^AK
/      DO 50 K=1,3
DCA \K
^AL, INC \K
TAD \K
CIA 
TAD (3
SPC 
JMP ^AM
/      IJK=(I-1)*4+(J-1)*2+K
IAC 
CIA 
TAD \I
CALL 1,MPY
ARG (4
DCA [A
IAC 
CIA 
TAD \J
CALL 1,MPY
ARG (2
TAD [A
TAD \K
DCA \IJK
/50    DATA(IJK)=DATA(IJK)/FLOAT(NC(IJK))
\50, CMA 
CALL 2,SUBSC
ARG \IJK
ARG \DATA
[0
CMA 
CALL 2,SUBSC
ARG \IJK
ARG \DATA
[1
CALL 2,SUBSC
ARG \IJK
ARG \NC
^AN
CALL 1,FLOAT
^AN, ARG 0
CALL 1,STO
ARG ]A
CALL 1,IFAD
ARG [1
CALL 1,FDV
ARG ]A
CALL 1,ISTO
ARG [0
JMP ^AL
^AM, 
JMP ^AJ
^AK, 
JMP ^AH
^AI, 
/      DO 51 I=1,3
DCA \I
^AO, INC \I
TAD \I
CIA 
TAD (3
SPC 
JMP ^AP
/      II=I*2-1
TAD (2
CALL 1,MPY
ARG \I
CIA 
IAC 
CIA 
DCA \II
/      DO 51 J=1,II
DCA \J
^AQ, INC \J
TAD \J
CIA 
TAD \II
SPC 
JMP ^AR
/ 51   DATS(I,J)=DATS(I,J)/FLOAT(NCS(I,J))
\51, TAD (3
CMA 
CALL 3,SUBSC
ARG \J
ARG \I
ARG \DATS
[0
TAD (3
CMA 
CALL 3,SUBSC
ARG \J
ARG \I
ARG \DATS
[1
TAD (3
CALL 3,SUBSC
ARG \J
ARG \I
ARG \NCS
^AS
CALL 1,FLOAT
^AS, ARG 0
CALL 1,STO
ARG ]A
CALL 1,IFAD
ARG [1
CALL 1,FDV
ARG ]A
CALL 1,ISTO
ARG [0
JMP ^AQ
^AR, 
JMP ^AO
^AP, 
/      WRITE(1,110)NC,DATA,((NCS(I,J),J=1,5),I=1,3)
CALL 2,WRITE
ARG (1
ARG \110
CMA 
CALL 2,IOH
ARG 14
ARG \NC
CMA 
CALL 2,IOH
ARG 4014
ARG \DATA
DCA \I
^AT, INC \I
TAD \I
CIA 
TAD (3
SPC 
JMP ^AU
DCA \J
^AV, INC \J
TAD \J
CIA 
TAD (5
SPC 
JMP ^AW
TAD (3
CALL 3,SUBSC
ARG \J
ARG \I
ARG \NCS
^AX
CALL 1,IOH
^AX, ARG 0
JMP ^AV
^AW, 
JMP ^AT
^AU, 
CALL 1,IOH
ARG 0
/      WRITE(1,113)((DATS(I,J),J=1,5),I=1,3)
CALL 2,WRITE
ARG (1
ARG \113
DCA \I
^AY, INC \I
TAD \I
CIA 
TAD (3
SPC 
JMP ^AZ
DCA \J
^BA, INC \J
TAD \J
CIA 
TAD (5
SPC 
JMP ^BB
TAD (3
CMA 
CALL 3,SUBSC
ARG \J
ARG \I
ARG \DATS
^BC
CALL 1,IOH
^BC, ARG 0
JMP ^BA
^BB, 
JMP ^AY
^AZ, 
CALL 1,IOH
ARG 0
/ 113  FORMAT(//3(5F10.0/))
JMP ^BD
CPAGE 10
\113, 5057
5763
5065
661
6056
6057
5151
0
^BD, 
/ 110  FORMAT(4(3I10/)//4(3F10.0/)///3(5I10/)//3(5F10.0/))
JMP ^BE
CPAGE 27
\110, 5064
5063
1161
6057
5157
5764
5063
661
6056
6057
5157
5757
6350
6511
6160
5751
5757
6350
6506
6160
5660
5751
5100
^BE, 
/      WRITE(1,111)
CALL 2,WRITE
ARG (1
ARG \111
CALL 1,IOH
ARG 0
/ 111  FORMAT(//'ENTER BLOCK #, UNIT 1, TO SAVE DATA')
JMP ^BF
CPAGE 25
\111, 5057
5747
516
2405
2240
214
1703
1340
4354
4025
1611
2440
6154
4024
1740
2301
2605
4004
124
147
5100
^BF, 
/      READ(1,112)IBLK
CALL 2,READ
ARG (1
ARG \112
CALL 1,IOH
ARG \IBLK
CALL 1,IOH
ARG 0
/ 112  FORMAT(I4)
JMP ^BG
CPAGE 3
\112, 5011
6451
0
^BG, 
     TAD \IBLK;TAD (4000;DCA INBLK1;TAD INBLK1;IAC;DCA INBLK2
     TAD INBLK2;IAC;DCA INBLK3;TAD INBLK3;IAC;DCA INBLK4
     6141;644
     714; INBLK1,0
     714; INBLK2,0
     714; INBLK3,0
     714; INBLK4,0
     2;CLA CLL
/      STOP
CALL 0,EXIT
/      END
CALL 0,EXIT
[0, BLOCK 2
[1, BLOCK 2
[2, BLOCK 2
END 
LAP 
\IDATA, COMMN 1440
\IPA, BLOCK 2
\ISET, BLOCK 11
\ICODE, 0
PAGE 
BLOCK 77
\NN, BLOCK 14
\NC, BLOCK 14
\DATA, BLOCK 44
\NNS, 0
PAGE 
BLOCK 12
\NCS, BLOCK 17
\DATS, BLOCK 55
\I, BLOCK 1
\J, BLOCK 1
\K, BLOCK 1
\JKI, BLOCK 1
\ITON, BLOCK 1
\ITOFF, BLOCK 1
\IDEL, BLOCK 1
\ITOUT, BLOCK 1
\IRAN, BLOCK 1
\NEXT, BLOCK 1
\NS, BLOCK 1
\N, BLOCK 1
\NO, BLOCK 1
\I1, BLOCK 1
\I2, BLOCK 1
\I3, BLOCK 1
\II3, BLOCK 1
\I4, BLOCK 1
\ITEST, BLOCK 1
\III, BLOCK 1
\IRESP, BLOCK 1
\LAT, BLOCK 1
\KK, BLOCK 1
\ITI, BLOCK 1
\IJK, BLOCK 1
\II, BLOCK 1
\IBLK, BLOCK 1
]A, BLOCK 3
[A, BLOCK 1
DUMMY [0
DUMMY [1
DUMMY [2
]3, 0
0
0
CPAGE 6
EAP 
ENTRY MAIN
MAIN, NOP 
CALL 0,OPEN
PAUSE
Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with. I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation.

PDP-8 Home Page PDP-8 Site Map PDP-8 Site Search