File SCONST.FT (FORTRAN source file)

Directory of image this file is from
This file as a plain text file

	SUBROUTINE SCONST
	COMMON NERR,IERRS,LC,CC,DIN,FIN
	COMMON SYM,IDENT,INUM,RNUM,SLENG,CH,STRING
	COMMON STACK,BOTTOM,TOP,KITUM,KZEIGER,NIDEK,NZEIGER
	COMMON IC0,RC0,SC0,P0,I0,T0,GPUNKT
	COMMON ICZEIGER,RCZEIGER,PZEIGER,IZEIGER,TZEIGER,SCZEIGER
	COMMON ICTAB,RCTAB,SCTAB,SCZ,PTAB,PZ,ITAB,IZ,TTAB,TZ
	INTEGER PUNKT,GPUNKT,NPUNKT,INKITUM,INKI,INKI0,INKI1
	INTEGER NERR,IERRS(61,3),LC,CC
	INTEGER SYM,IDENT,INUM,SLENG,CH,STRING(80)
	INTEGER STACK(200),BOTTOM(10),TOP(10),KITUM(200,4)
	INTEGER NIDEK(100,2),NZEIGER,IC0,RC0,SC0,P0,I0,T0
	INTEGER ICZEIGER,RCZEIGER,PZEIGER,IZEIGER,TZEIGER,SCZEIGER
	INTEGER ICTAB(200),SCTAB(200),SCZ(50),PTAB(100),PZ(50)
	INTEGER ITAB(100),IZ(50),TTAB(400),TZ(50)
	REAL RNUM,RCTAB(50)
	LOGICAL LEER,DD,B
	IF(SYM.EQ.65)		@'NIL'
	  CALL GETSYM
	  CALL EINKELLERN(0,5)		@TAU
	  CALL EINKELLERN(0,4)		@THETA
	  RETURN
	ENDIF
	IF(SYM>5)CALL FATAL(182)	@NO CONST
	I=NZEIGER
	GOTO (101,102,103,104,105), SYM
101	INKI=INKITUM(IDENT)
	IF (INKI.EQ.0) CALL FATAL(104)
	B=KITUM(INKI,2).EQ.2
	IF (.NOT.B) CALL FATAL(103)
	CALL EINKELLERN(KITUM(INKI,3),5)	@TAU
	CALL EINKELLERN(KITUM(INKI,4),4)	@THETA
	CALL GETSYM
	RETURN
102	I=I-1
112	B=I.NE.0
	IF (B)
	  B=NIDEK(I,1).NE.2.OR.ICTAB(NIDEK(I,2)).NE.INUM
	  IF (B)
	    I=I-1
	    GOTO 112
	  ENDIF
	ENDIF
C$	WRITE(1,1)I
C$1	FORMAT('NIDEK-INDEX BEI FUND = ',I6)
C$	CALL NTEST
	IF (I.EQ.0)
	  I=NZEIGER
	  NIDEK(NZEIGER,1)=2
	  NIDEK(NZEIGER,2)=IC0
	  ICTAB(IC0)=INUM
	  IC0=IC0+1
	  NZEIGER=NZEIGER+1
	  IF(IC0>200)CALL FATAL(524)	@ICMAX
	  IF(NZEIGER>100)CALL FATAL(521)	@NMAX
	ENDIF
	GOTO 199
103	RCTAB(RC0)=RNUM
	RC0=RC0+1
	IF (RC0>50)CALL FATAL(525)		@RCMAX
	NIDEK(NZEIGER,1)=3
	NIDEK(NZEIGER,2)=RC0-1
	NZEIGER=NZEIGER+1
	IF (NZEIGER>100) CALL FATAL(521)	@NMAX
	GOTO 199
104	SCZEIGER=SCZ(SC0)
	SCTAB(SCZEIGER)=CH
	NIDEK(NZEIGER,1)=4
	NIDEK(NZEIGER,2)=SC0
	NZEIGER=NZEIGER+1
	IF (NZEIGER>100) CALL FATAL(521)	@NMAX
	SC0=SC0+1
	IF (SC0>50) CALL FATAL(527)	@SCZMAX
	SCZ(SC0)=SCZEIGER+1
	IF (SCZEIGER>199) CALL FATAL(526)	@SCMAX
	GOTO 199
105	IF (NZEIGER>100) CALL FATAL(521)	@NMAX
	IF (SC0>49) CALL FATAL(527)	@SCZMAX
	B=SCZ(SC0)+SLENG>200	@SCMAX
	IF (B) CALL FATAL(526)
	SCZEIGER=SCZ(SC0)
	SC0=SC0+1
	SCZ(SC0)=SCZEIGER+SLENG
	SCZEIGER=SCZEIGER-1
	DO 555 J=1,SLENG
555	SCTAB(SCZEIGER+J)=STRING(J)
	NIDEK(NZEIGER,1)=T0
	NIDEK(NZEIGER,2)=SC0-1
	NZEIGER=NZEIGER+1
	TZEIGER=TZ(T0)
	IF (T0>49) CALL FATAL(523)	@TZMAX
	B=TZEIGER+5>200	@TMAX
	IF (B) CALL FATAL(522)
	T0=T0+1
	TZ(T0)=TZEIGER+5
	TTAB(TZEIGER)=5	@ARRAY
	TTAB(TZEIGER+1)=SLENG
	TTAB(TZEIGER+2)=4	@CHAR
	TTAB(TZEIGER+3)=2
	TTAB(TZEIGER+4)=1
199	CALL EINKELLERN(NIDEK(I,1),5)	@TAU
	CALL EINKELLERN(NIDEK(I,2),4)	@THETA
	CALL GETSYM
	RETURN
	END



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