Directory of image this file is from
This file as a plain text file
C PASCAL - S TV 81 02 06 COMMON NERR,IERRS,LC,ICC,DIN,FIN,ICH,LL,LINE COMMON ISYM,LEN,IWORD,IPOINT,ID,IAL COMMON NAME,IRZEIG,LZEIG,MAX,IL,ISTAB COMMON MAXE,MINE,KMAX,NMAX,ISX,LLENG,ISLENG,ISMAX DIMENSION LINE(80),LZEIG(200),IRZEIG(200),NAME(200,10) DIMENSION IWORD(29,10),IPOINT(26,2),ID(10),LEN(29) DIMENSION IERRS(61,3),ISTAB(600),IZEIL(40) INTEGER Q(20),DIN(2),FIN(4),I,J,K,CPOS,PPOS LOGICAL B ISY=0 IRZEIG(1)=-1 LZEIG(1)=-1 MAX=0 NERR=0 LLENG=72 ISMAX=600 MAXE=99 MINE=-99 KMAX=4 NMAX=2046 C EINLESEN DER SCHLUESSELWOERTER IAL=10 CALL IOPEN('SYS@','WORD@@DA') DO 5 I=1,29 READ(4,6)(IWORD(I,J),J=1,10) 6 FORMAT(10A1) C LAENGE DER SCHLUESSELWOERTER BESTIMMEN IL=IAL 45 IF(IWORD(I,IL)+2016)47,46,47 46 IL=IL-1 GOTO 45 47 LEN(I)=IL 5 CONTINUE READ(4,11)(IPOINT(I,1),I=1,26) READ(4,11)(IPOINT(I,2),I=1,26) 11 FORMAT(26I2) DO 20 I=1,31 READ(4,21)(ID(J),J=1,10) 21 FORMAT(10A1) CALL NAMLI 20 CONTINUE 10 READ(1,110)(Q(I),I=1,20) 110 FORMAT('*',20A1) CPOS = 0 PPOS = 0 DO 111 I=1,2 DIN(I)=0 111 FIN(I)=0 FIN(3)=0 DO 222 I=1,20 Q(I)=Q(I)/64 K=Q(I) IF (K<0) Q(I)=Q(I)+63 K=Q(I) ENDIF IF (K.EQ.32) Q(I)=0 @BLANK = 40 OCT => "@" IF (K.EQ.58) CPOS = I @":" = 72 OCT IF (K.EQ.46) PPOS = I @"." = 56 OCT 222 CONTINUE IF (CPOS>5 .OR. PPOS>18 .OR. CPOS>PPOS) 115 WRITE(1,30) 30 FORMAT ('ILLEGALE SYNTAX') GOTO 10 ENDIF IF (CPOS .EQ. 0) DIN(1) = 'DS' DIN(2) = 'K@' ELSE Q(CPOS) = 0 @'@' I=1 J=1 WHILE (I<CPOS) DIN(J) = Q(I)*64 + Q(I+1) J=J+1 I=I+2 ENDWHILE ENDIF IF (PPOS.EQ.0) PPOS = 20 FIN(4) = 'PS' ELSE Q(PPOS) = 0 @"@" FIN(4) = Q(PPOS+1)*64 + Q(PPOS+2) ENDIF I=CPOS+1 J=1 WHILE (J<4 .AND. I<PPOS) FIN(J)=Q(I)*64 + Q(I+1) J=J+1 I=I+2 ENDWHILE WRITE(1,39)I, 39 FORMAT(/'PASCAL - S BERGNEUSTADT TV810206 ',I0) WRITE(1,40)(DIN(I),I=1,2),(FIN(I),I=1,4),I, 40 FORMAT(2A2,':',3A2,'.',A2,10X,I0) CALL DATUM CALL IOPEN(DIN,FIN) CALL OOPEN('SYS@','PSFT@@DA') LC=0 LINE(80)=-2016 ICC=80 LL=80 ICH=-2016 120 IVSYM=ISYM ISX=1 CALL GETSYM IF(ISYM-1)123,122,123 122 WRITE(4,211)ISYM CALL NAMLI 123 IF(ISX)212,200,212 212 WRITE(4,211)ISYM 200 CONTINUE 211 FORMAT(I4,' ') IF(ISYM-21)120,130,120 130 IF(IVSYM-60)120,135,120 135 CALL OCLOSE IF (NERR) 1000,1000,1200 1000 WRITE(1,1) 1 FORMAT('PHASE 0 OHNE FEHLER') CALL CHAIN('PHASE1SV') 1200 CALL CHAIN('ERRORMSV') END