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