SUBROUTINE TYPENDEKLARATION 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 INKI0=KZEIGER-1 CALL EINKELLERN(1,1) CALL EINKELLERN(2,1) WHILE(GPUNKT.NE.0) WRITE(1,333)GPUNKT 333 FORMAT('TYPEN GPUNKT=',I6) GOTO (101,102,103,104,105,106),GPUNKT 101 CONTINUE @EINTRAG,RETURN GOTO 999 102 CONTINUE @TYP ALLGEMEIN IF (SYM.EQ.1) @IDENT INKI=INKITUM(IDENT) IF (INKI.EQ.0) CALL FATAL(104) B=KITUM(INKI,2).NE.3 IF (B) CALL FATAL(103) CALL EINKELLERN(KITUM(INKI,3),5) @TAU CALL EINKELLERN(KITUM(INKI,4),4) @THETA CALL AUSKELLERN(1) CALL GETSYM GOTO 199 ENDIF IF (SYM .EQ. 72) @RECORD CALL ERSETZEN(6,1) CALL EINKELLERN(5,1) CALL EINKELLERN(0,6) CALL GETSYM GOTO 199 ENDIF IF (SYM.NE.52) CALL FATAL(6) @ILLEGAL SYMBOL @ARRAY EXP. CALL ERSETZEN(3,1) 103 CALL FEHL(1052) 104 CALL FATAL(1052) 105 CONTINUE @ BEGIN OF RECORD C BEARB VON ( V ; ... : T CALL EINKELLERN(0,6) @ZETA IF (SYM.NE.1)CALL FATAL(2) @IDENT WHILE (SYM .EQ. 1) B=DD(IDENT) IF (B) CALL FATAL(101) KITUM(KZEIGER,1)=IDENT KITUM(KZEIGER,2)=4 CALL EINKELLERN(KZEIGER,3) @EPSILON CALL AUFADDIEREN(1,6) @ZETA KZEIGER=KZEIGER+1 IF(KZEIGER.GE.200) CALL FATAL(520) @KMAX CALL GETSYM IF(SYM.EQ.7) @"," CALL GETSYM IF (SYM.NE.1) CALL FATAL(2) @IDENT ELSE IF(SYM.NE.24) CALL FATAL(5) @":" ENDIF ENDWHILE CALL GETSYM @FUER ":" CALL ERSETZEN(2,1) @TYP ALLGEMEIN GOTO 199 106 CONTINUE @END OF RECORD C TYPEN DER TEILBEREICHE EINTRAGEN I=PUNKT(6) J=PUNKT(5) K=PUNKT(4) CALL AUSKELLERN(6) CALL AUFADDIEREN(I,6) CALL AUSKELLERN(5) CALL AUSKELLERN(4) WHILE (I>0) INKI=NPUNKT(I,3) I=I-1 KITUM(INKI,3)=J KITUM(INKI,4)=K ENDWHILE CALL TKIT CALL TSTACK C TEST AUF CONTINUATION IF (SYM.EQ.23) @";" CALL GETSYM CALL EINKELLERN(5,1) GOTO 199 ENDIF IF (SYM.NE.60) @END CALL FEHL(14) CALL EINKELLERN(5,1) GOTO 199 ENDIF C ELSE:"END";EINTRAG CALL GETSYM CALL EINKELLERN(0,4) @THETA CALL EINKELLERN(T0,5) @TAU I=PUNKT(6) @ZETA CALL AUSKELLERN(6) B=TZ(T0)+I+2.GE.200 IF (B) CALL FATAL(526) @TMAX TZEIGER=TZ(T0) T0=T0+1 IF (T0.GE.50) CALL FATAL(520) @KZMAX TZ(T0)=TZEIGER+I+2 TTAB(TZEIGER)=6 @RECORD TTAB(TZEIGER+1)=I @ANZAHL DER KOMPONENTEN TZEIGER=TZEIGER+2 WHILE (I>0) TTAB(TZEIGER)=PUNKT(3) CALL AUSKELLERN(3) @EPSILON I=I-1 ENDWHILE 199 CONTINUE ENDWHILE 999 CONTINUE @END OF ROUTINE EINTRAG IN QUELLE KITUM(INKI0,3)=PUNKT(5) @TAU KITUM(INKI0,4)=PUNKT(4) @THETA RETURN END