Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/srt/srt.for
There is 1 other file named srt.for in the archive. Click here to see a list.
C	WESTERN MICHIGAN UNIVERSITY
C	SRT.F4 (FILENAME ON LIBRARY DECTAPE)
C	SRT, 3.10.1 (CALLING NAME, SUBLST. NO.)
C	DATA FILE BREAKDOWN PROGRAM
C	PROGRAMMED BY SAM ANEMA AT WMU--LATER MODIFIED BY R.R. BARR
C	LIBRARY DECTAPE PROGS USED:  USAGE.MAC
C	APLIB PROGS. USED:  IO
C	FORWMU PROGS. USED:  DEVCHG, EXISTS, PRINTS, DEVICE
C	INTERNAL SUBR. USED:  OPEN
C	FUNCTIONS USED:  ECODE
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
C---------------INT IS USER'S INPUT, IN IS USER'S INPUT WITHOUT
C--------------- SPACES.  NBR(20) GIVES THE BREAKDOWN RANGES,
C--------------- B(16) IS USED IN FUNCTION ECODE FOR TEMPORARY STORAGE
C
      DIMENSION INT(80),IN(80),NBR(20),B(16),IFMT(16),ISH(20),KNAME(20)
      DIMENSION KNT(20),INA(160)
	TYPE 8
8	FORMAT('0WMU - CSR--DATA FILE BREAKDOWN PROGRAM',//)
C	CALL USAGE('SRT   ')
C---------------FORTRAN DEV.NO=1, MNEMONIC FOR FORTRAN DEV.NO.,
C--------------- DIALOGUE OUTPUT DEV.NO.=-1, DIALOGUE INPUT DEVICE
C--------------- NO.=-4, FIRST 0 MEANS SUPPRESS PRINTING INPUT?
C--------------- SECOND 0 MEANS JOB IS TTY.
9     CALL IO(1,IDV,-1,-4,0,0)
      DO 10 I=6,30
10    CALL DEVCHG('DSK',I)
101   K=0
102   TYPE 100
100   FORMAT(' *',$)
      ACCEPT 11,INT
11    FORMAT(80A1)
      IF=0
      IL=0
      ISW=0
      NC=1
      NREC=1
      J=0
      DO 12 I=1,80
      IN(I)=' '
      IF(INT(I).EQ.' ')GO TO 12
      K=K+1
      IN(K)=INT(I)
12    CONTINUE
      IF(IN(1).NE.'B')GO TO 201
      I=0
200   I=I+1
      IF(I.GT.80)GO TO 201
      IF(IN(I).EQ.'(')GO TO 202
      IF(IN(I).EQ.',')GO TO 203
      IF(IN(I).EQ.'-')GO TO 303
      IF(IN(I).EQ.':')GO TO 205
      IF(IN(I).EQ.')')GO TO 206
      IF(IN(I).EQ.'C')GO TO 701
      IF(IN(I).EQ.'/')GO TO 702
      GO TO 200
201   TYPE 301
C---------------CALL EXIT IF FORTRAN UNIT 5 IS NOT TELETYPE.
	CALL DEVICE(5)
301   FORMAT(' ?ILLEGAL COMMAND'/)
      GO TO 101
202	CALL ECODE(5,IN,I+1,B)
C---------------PUT INFO. BETWEEN '(' AND '-' INTO IF (SEE
C--------------- WRITE UP BOTTOM OF PAGE 2)
      DECODE(5,302,B)IF
302   FORMAT(I)
      IF(IF.GT.80.OR.IF.LT.1)GO TO 201
      GO TO 200
203   IF(ISW.EQ.0)GO TO 303
      J=J+1
	CALL ECODE(10,IN,I+1,B)
C---------------PUT INFO. BETWEEN: AND / INTO NBR(J)
      DECODE(10,302,B)NBR(J)
      GO TO 200
303   IF(ISW.EQ.1)GO TO 200
	CALL ECODE(5,IN,I+1,B)
C---------------PUT INFO BETWEEN '-' AND 'C' INTO IL
      DECODE(5,302,B)IL
      IF(IL.GT.80.OR.IL.LT.1)GO TO 201
      GO TO 200
205   ISW=1
      GO TO 203
701	CALL ECODE(5,IN,I+1,B)
C---------------PUT INFO BETWEEN C AND : INTO NC
      DECODE(5,302,B)NC
      GO TO 200
702	CALL ECODE(5,IN,I+1,B)
C---------------PUT INFO BETWEEN / AND ) INTO NREC
      DECODE(5,302,B)NREC
      GO TO 200
C---------------HERE WHEN THE USER'S B COMMAND HAS BEEN STORED
206   IF(NC.GT.NREC.OR.NC.LT.1)GO TO 201
C---------------WHEN NO OF RECORDS PER CASE >11, IT IS ILLEGAL COMMAND 
      IF(NREC.GT.11.OR.NREC.LT.1)GO TO 201
C---------------ICB, ICA, ICUT, ILAST ARE USED
C--------------- IN ST. 50, 50+1, 71+1, 72-1
      ICB=NC-1
      ICA=NREC-ICB-1
      ICUT=16*ICB
      ILAST=(ICB+ICA)*16
      I1=0
      I2=0
      I3=0
      I4=0
      I5=0
      I6=0
      K=IF-1
      IF(K.GT.5)GO TO 403
      I2=K
      GO TO 405
403   I1=K/5
      I2=K-I1*5
405   IF(IL.EQ.0)IL=IF
C---------------CALCULATE WIDTH OF KEY FIELD
      I3=IL-IF+1
      K=80-IL
      IF(K.GT.5)GO TO 410
      I5=K
      GO TO 420
410   I4=K/5
      I5=K-I4*5
C---------------BETWEEN HERE AND ST. 425 WE PUT TOGETHER A FORTRAN
C--------------- FORMAT MAKING USE OF I1, I2, I3, I4, I5
420   DO 421 I=2,6
421   IFMT(I)=' '
      KN=0
      IFMT(1)='('
      IF(I1.EQ.0)GO TO 422
      KN=KN+I1
      ENCODE(5,429,IFMT(2))I1
429   FORMAT(I2,'A5,')
422   IF(I2.EQ.0)GO TO 423
      KN=KN+1
      ENCODE(5,430,IFMT(3))I2
430   FORMAT('A',I3,',')
423   KN=KN+1
      KS=KN
      ENCODE(5,431,IFMT(4))I3
431   FORMAT('I',I3,',')
      IF(I4.EQ.0)GO TO 424
      KN=KN+I4
      ENCODE(5,432,IFMT(5))I4
432   FORMAT(I2,'A5,')
424   IF(I5.EQ.0)GO TO 425
      KN=KN+1
      ENCODE(5,433,IFMT(6))I5
433   FORMAT('A',I3,')')
      GO TO 426
425   IFMT(6)=')'
426   DO 427 I=1,20
      ISH(I)=0
      KNT(I)=0
427   CONTINUE
      TYPE 428
428   FORMAT(' FILES?(4 CHARACTERS) ',$)
      ACCEPT 449,IFN
449   FORMAT(A4)
C---------------THIS CAUSES AN A TO BE ATTACHED TO USER SPECIFIED 
C--------------- 4 CH. FOR A SUBFILE.
      IFN=IFN+66
      L=1
C---------------J=NO. OF SUBFILES (SEE ST. 203+1)
      IF(J.EQ.0)L=0
C---------------ICB=RECORD NO. OF KEY FIELD MINUS 1 (ST. 206+2)
50    IF(ICB.EQ.0)GO TO 71
C---------------ICUT (ST. 206+4), READ NREC RECORDS
      READ(1,79,END=500)(INA(I),I=1,ICUT)
79    FORMAT(16A5)
C---------------KN=NO. OF WORDS TO BE READ AS SPEC. BY IFTMT(16)
71    READ(1,IFMT,END=500)(IN(I),I=1,KN)
      IF(ICA.EQ.0)GO TO 72
      READ(1,79,END=500)(INA(I),I=ICUT+1,ILAST)
C---------------L=0 WHEN J=0.  THIS IS CASE WHERE USER OMITS RANGE
C--------------- LIMITS FOR SUBFILES.  THEN PROGRAM CREATES AN OUTPUT 
C--------------- FILE FOR EACH VALUE OF KEY.  (SEE SECTION 2.2
C--------------- OF WRITE UP)
72    IF(L.EQ.0)GO TO 51
      DO 52 JJ=1,J
C---------------COMPARE KEYFIELD WITH RANGE CRITERION FOR A
C--------------- SUBFILE.  KEYFIELD IS DETERMINED IN ST. 423+1.
      IF(IN(KS).LE.NBR(JJ))GO TO 53
52    CONTINUE
      GO TO 50
53    IF(ISH(JJ).EQ.0)CALL OPEN(JJ,IFN,KNAME,ISH)
      IDN=JJ+5
      IF(ICB.EQ.0)GO TO 81
      WRITE(IDN,79)(INA(I),I=1,ICUT)
81    WRITE(IDN,IFMT)(IN(I),I=1,KN)
      IF(ICA.EQ.0)GO TO 82
      WRITE(IDN,79)(INA(I),I=ICUT+1,ILAST)
82    KNT(JJ)=KNT(JJ)+1
      GO TO 50
500   TYPE 501
501   FORMAT(10X,'NO OF'/2X,'FILE',3X,'RECORDS',3X,'KEY'/)
C---------------KNAME(I)=FILENAME GEN. BY USER AND PROG.,
C--------------- KNT(I)=NO. OF RECORDS IN KNAME(I),
C--------------- NBR(I)=BOUNDARIES FOR GENERATED FILES
      TYPE 502,(KNAME(I),KNT(I),NBR(I),I=1,J)
502   FORMAT(1X,A5,2I8)
      TYPE 503
503   FORMAT(////)
C---------------GO TO INPUT?
      GO TO 9
51    IF(J.EQ.0)GO TO 58
      DO 59 I=1,J
      IF(IN(KS).EQ.NBR(I))GO TO 60
59    CONTINUE
58    J=J+1
      NBR(J)=IN(KS)
      JJ=J
      GO TO 53
60    JJ=I
      GO TO 53
      END
C---------------J, IFN, ISH INPUT, KNAME RETURNED, ISH MODIFIED
C--------------- SUBR. OPEN THE PROG. AND USER SPEC. FILENAME TO
C--------------- BE ASSOC. WITH IDN
      SUBROUTINE OPEN(J,IFN,KNAME,ISH)
      DIMENSION KNAME(20),ISH(20)
      IDN=J+5
      CALL OFILE(IDN,IFN)
      KNAME(J)=IFN
C---------------THIS CAUSES B,C, ETC. TO BE ATTACHED TO USER SPEC.
C--------------- 4 CH. FOR SUBFILES.
      IFN=IFN+2
      ISH(J)=1
      RETURN
      END
C---------------N, I, IN ARE INPUT.  B IS MODIFIED.  USER SPEC.
C--------------- INFO. IS PUT INTO B.
	FUNCTION ECODE(N,IN,I,B)
	DIMENSION IN(1),IX(10),IC(6),B(1)
	DATA IC/',','-',':',')','C','/'/
	K=0
	NC=6
	DO 802 L=I,80
	IF(K.GE.N)GO TO 808
	DO 800 M=1,NC
800	IF(IN(L).EQ.IC(M))GO TO 804
	K=K+1
802	IX(K)=IN(L)
804	IF(K.GE.N)GO TO 808
	DO 806 L=K+1,N
806	IX(L)=' '
808	ENCODE(N,810,B)(IX(L),L=1,N)
810	FORMAT(10A1)
812	RETURN
	END