Trailing-Edge
-
PDP-10 Archives
-
decuslib10-13
-
reusr3.for
There are 6 other files named reusr3.for in the archive. Click here to see a list.
SUBROUTINE REUSER
C RENBR(REUSR3/DIALOG OF FILE NAMES 1 PER LINE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS VERSION OF THE USER COMMAND DIALOG PROCESSOR
C FOR RENBR ASKS THE USER TO SUPPLY THE NAMES OF ONE OR
C BOTH OUTPUT FILES AND THE NAMES ONE OR MORE INPUT
C FILES. RENUMBERING IS PERFORMED IF, AND ONLY IF, THE
C USER SUPPLIES A NAME FOR THE RENUMBERED OUTPUT FILE.
C LISTING IS PERFORMED IF, AND ONLY IF, THE USER
C SUPPLIES A NAME FOR THE LISTING FILE. A SINGLE INPUT
C FILE CAN CONTAIN MANY PROGRAMS AND/OR ROUTINES, OR
C MERELY A PORTION OF A PROGRAM OR ROUTINE. ALL INPUT
C FILES ARE COPIED INTO EACH OF THE OUTPUT FILES.
C THE LIST OF INPUT FILES IS TERMINATED BY TYPING A
C BLANK INPUT FILE NAME. AFTER TYPING A BLANK INPUT
C FILE NAME, A NEW SET OF OUTPUT AND INPUT FILES CAN BE
C ESTABLISHED. PROCESSING IS TERMINATED BY TYPING
C BLANK NAMES FOR BOTH POSSIBLE OUTPUT FILES.
C
COMMON/RNBONE/I ,IALPHA,IBASE ,IBR ,IBREAK,
1IEND ,IENTER,IEOF ,IERR ,IFILL ,IFORM ,IFREAR,
2IHIHDO,IIN ,ILEVEL,ILPT ,INCR ,INCSAV,INDENT,
3INDSAV,ININAM,INIOPR,INIPRT,INITOC,INRCPY,INRFND,
4IOUT ,IPAGE ,IPASS ,IPOINT,ISPACE,ISPLIT,ISPR ,
5ISTART,ISTN ,ITAB ,ITBL ,ITITLE,ITRACE,ITTY ,
6J ,JBGN ,JBREAK,JEND ,JEOF ,JFORM ,JIN ,
7JIN1 ,JLEVEL,JMPBGN,JMPEND,JOBNUM,JOUT ,JPASS ,
8JPOINT,JSPLIT,JSTN ,JTAB ,JTBL ,JTTY ,K ,
9KBGN ,KEND ,KLEVEL,KMDMAX,KMDMIN,KNDGRP,KNT
C
COMMON/RNBTWO/KNTONE,KNTPNT,KNTSPL,KNTTOC,KNTTWO,
1KOMENT,KOMKNT,KOMNUM,KONTRL,KOUNT ,KPAGE ,KPASS ,
2KPOINT,KPYEND,KSTN ,KTAB ,KUTNUM,KUTPAG,KUTPNT,
3KUTSPL,L ,LCLNUM,LCLPNT,LCLSPL,LEFT ,LEND ,
4LIKE ,LMTTOC,LNGCOM,LNGNAM,LNGNXT,LOWDO ,LOWER ,
5LOWSHO,LOWTOC,LOW1 ,LOW2 ,LPOINT,LPTTTY,LRGNUM,
6LRGPNT,LRGSPL,LRGTOC,LSTKNT,LSTN ,LSTSTN,LTAB ,
7M ,MANY ,MASTER,MAXCOM,MAXEND,MAXLIN,MAXPNT,
8MAXPRT,MAXSPL,MAXTOC,MID ,MODBAS,MODINC,MODMAX,
9MODMIN,MODNEW,MODOLD,MOST ,MOVE ,MSTN ,MTAB
C
COMMON/RNBTHR/N ,NCD ,NEED ,NEWNUM,NEWSTN,
1NONFOR,NOWTOC,NSTN ,NTAB ,NUM ,NXTEND,NXTLST
C
COMMON/RNBFOU/INRSTR(21) ,JPNT(10) ,LINREF(9) ,
1 MCHOPR(51) ,NNEW(1000) ,NOLD(1000) ,NOTOPR(51) ,
2 NUMPNT(5000),NUMPRS(655) ,NUMTOC(112) ,NUMTYP(7)
C
COMMON/RNBFIV/LTRCLN,LTRDDD,LTRDOT,LTREEE,LTREQL,
1LTREXC,LTRHHH,LTRLFT,LTRMNS,LTRNOW,LTRPLS,LTRQOT,
2LTRREF,LTRRIT,LTRSEM,LTRSLA,LTRSPC,LTRTAB,LTR1ST,
3LTR2ND,LWRDDD,LWREEE,LWRHHH
C
COMMON/RNBSIX/LTRABC(26) ,LTRBGN(5) ,LTRBIG(2211),
1 LTRCOM(6) ,LTRDGT(10) ,LTREND(3) ,LTRFLG(8) ,
2 LTRKEY(5) ,LTRNAM(10) ,LTROPR(51) ,LTRPRS(331) ,
3 LTRSPL(2000),LTRSRT(26) ,LTRTOC(168) ,LTRTOP(117) ,
4 LTRTTL(5) ,LTRTYP(55) ,LTRUSE(6) ,LTR120(120) ,
5 LWRABC(26) ,LWRBGN(5) ,LWREND(3) ,LWRFLG(8) ,
6 LWRKEY(5) ,LWRPRS(331) ,LWRSRT(26) ,LWRTTL(5)
DOUBLE PRECISION FILSRC,FILRNB,FILLPT,FILSPC
DATA FILSPC/' '/
C
C DETERMINE IF THIS IS FIRST TIME THIS ROUTINE CALLED
JPASS=1
IF(MASTER.GT.1)GO TO 10
IPAGE=0
INCR=0
IF(MASTER.EQ.1)WRITE(ITTY,1)
1 FORMAT(14H RENBR (03/85)/1X)
IF(MASTER.EQ.1)WRITE(ITTY,2)
2 FORMAT(
140H SPECIFY A LISTING FILE TO GET A LISTING/
245H SPECIFY A RENUMBERED FILE TO GET RENUMBERING)
IF(MASTER.NE.1)WRITE(ITTY,3)
3 FORMAT(
146H DON'T SPECIFY EITHER FILE IF YOU WANT TO EXIT)
C
C OPEN LISTING FILE
4 WRITE(ITTY,5)
5 FORMAT(' OUTPUT LISTING FILE: ',$)
READ(JTTY,13)FILLPT
IF(FILLPT.EQ.FILSPC)GO TO 6
IPAGE=1
OPEN(UNIT=ILPT,FILE=FILLPT,ACCESS='SEQOUT',
1DEVICE='LPT')
C
C OPEN RENUMBERED OUTPUT FILE
6 WRITE(ITTY,7)
7 FORMAT(' OUTPUT RENUMBERED FILE: ',$)
READ(JTTY,13)FILRNB
IF(FILRNB.EQ.FILSPC)GO TO 8
INCR=1
OPEN(UNIT=IOUT,FILE=FILRNB,ACCESS='SEQOUT')
GO TO 11
8 IF(IPAGE.NE.0)GO TO 11
IF(MASTER.NE.1)GO TO 18
WRITE(ITTY,9)
9 FORMAT(' AT LEAST 1 OUTPUT FILE MUST BE SPECIFIED')
GO TO 4
C
C OPEN INPUT FILE
10 CLOSE(UNIT=IIN)
11 WRITE(ITTY,12)
12 FORMAT(' INPUT SOURCE FILE: ',$)
READ(JTTY,13)FILSRC
13 FORMAT(1A10)
IF(FILSRC.EQ.FILSPC)GO TO 16
OPEN(UNIT=IIN,FILE=FILSRC,ACCESS='SEQIN',ERR=14)
GO TO 19
14 WRITE(ITTY,15)
15 FORMAT(' FILE CAN NOT BE READ')
GO TO 11
16 IF(MASTER.NE.1)GO TO 18
WRITE(ITTY,17)
17 FORMAT(' FIRST INPUT FILE MUST BE SPECIFIED')
GO TO 11
C
C RETURN TO CALLING PROGRAM
18 JPASS=0
19 RETURN
END