Trailing-Edge
-
PDP-10 Archives
-
LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86
-
tools/dsconv1/dsconv.for
There are 5 other files named dsconv.for in the archive. Click here to see a list.
*
*
*
* D S C O N V
*
*
* This is a program to produce 1032 DMD (Data Definition) files
* from 1022 datasets. It optionally also dumps ASCII data record files.
*
* AUTHOR: Coleman P. Harrison
* DATE WRITTEN: June 28, 1983
* DATE MODIFIED: April 18, 1984
*
*
*
* C O P Y R I G H T
*
* (C) 1983, 1984
* Copyright Software House
*
*
*
* N O T I C E S
*
* This program is in no way intended as a piece of production
* software. As such, neither the author nor Software House assumes any
* responsibility for its functioning. Absolutely no support is intended
* or implied.
*
* This program (in part or total) may be freely copied for any
* non-profit purposes. All copies must include the above copyright and
* these notices. Any reproduction (in part or total) of this software
* for profit or any reproduction which excludes the above copyright and
* these notices will be considered grounds for punitive legal action.
*
* Users are encouraged to mail their name and address to:
*
* Coleman P. Harrison
* Software House
* 1105 Massachusetts Avenue
* Cambridge, Massachusetts 02138
*
* If and when new versions are produced we will consider notifying
* all users so identified. We are, of course, also interested in
* hearing about any enhancement. We assume no responsibility for
* supporting this program.
*
*
*
* D E S C R I P T I O N
*
* The purpose of the program is to provide an automated method to
* convert System 1022 datasets to System 1032. It runs with 1022 on a
* DECSystem-10 or -20. It asks for a filespec, obtains information on
* the dataset(s) in it by means of calls on DBINFO, and produces a 1032
* DMD which can be used to CREATE analogous 1032 dataset(s) on a VAX.
* Optionally, it will also dump each dataset's data to a DMI file.
*
*
* Attribute names, abbreviations, key status, and ranges are
* copied.
*
* 1022 single integer attributes have the default range of -2**35
* to +2**35-1 unless the user defined a range. Double integers,
* available starting with Version 116 of 1022, can range as high as
* 2**71. This program translates such integers to 1032 double integers
* whose range is up to 2**63. However, if the 1022 data exceeds 2**63,
* this will produce conversion errors during the load to 1032. To
* retain more than 63 bits (18.9 decimal digits) of precision, the 1032
* Decimal datatype must be used; the required syntax is noted in a
* comment in any datasets in which this problem could arise so that the
* user could then edit his/her DMD file.
*
* In most cases, one can't improve on the 1032 default formats
* without knowing what the data looks like; usually, the default
* results will be closer to what 1022 displays than any other choice,
* although the results are usually not exactly the same as the output
* from 1022. One main difference is that 1022 chooses the width of each
* occurrence of each attribute according to its individual value, but
* 1032 does so for the attribute itself based only on its range and
* precision. The A format with no width is available in 1032 beginning
* with V2.00; it is the default in 1022, and the user may want to
* specify it for text attributes if the space-filling behavior is
* desired.
*
* The program does assign a format for real attributes, since in
* that case, while there is no single 1032 format that replicates 1022's
* behavior in all cases, the E+10.4 choice comes closer than the
* default. Formats are also included in the RD's for dates; this is
* necessary so that the output of 1022's DUMP command will be readable
* by 1032. RD_Missing items are included so that blank text attributes
* will not become MISSING in 1032.
*
* Prompts are generated by replacing underscores with spaces and
* capitalizing the first letter of each word. Titles are the same as
* prompts except that lines are broken where appropriate.
*
* Dataset and database names are truncated to 9 characters (after
* eliminating any underscores). This is not strictly necessary, but it
* is advisable because the user has to be more knowledgeable to handle
* those with longer names. (Filenames (such as DMI, DMO, DMD, and DME)
* would have to be specified each time one is needed, or else RMS would
* choke on the name 1032 generates.) DMI file names are truncated to 6
* characters for compatibility with old TOPS-10. Unique names are
* generated if these truncations result in several datasets or DMI files
* having the same name.
*
*
*
* M O D I F I C A T I O N S
*
* 1. Double length 1022 integers (available starting with Version 116)
* are now supported (but see the above discussion).
*
*
* 2. Single length integers whose value is greater than 2**31, i.e.
* which are in the double integer category for 1032, now load
* correctly.
*
* 3. Integer of identification, date of entry, and date of change are
* now supported (available in 1032 starting with Version 2).
*
* 4. Dates dumped with a length of 6 or 7 are now read correctly by
* 1032.
*
* 5. The program can now be run with Version 114 of 1022; however, if
* there is more than one dataset stored in a file, Version 114
* cannot retrieve the dataset names, so the program uses DS1, DS2,
* etc.
*
*
*
*
* I N S T A L L A T I O N
*
* The tape is labeled ____________. It was written on
* ____________ on our DECSystem-20 at 1600 b.p.i. using DUMPER under
* TOPS-20 version 4.1. It contains two copies of the following files:
*
* DSCONV.REL
* DSCONV.EXE
* DSCONV.MEM
*
* If you are using version 116A of 1022 on TOPS-20, you can run
* DSCONV.EXE. Otherwise you should reload DSCONV with your system's
* version of 1022 by means of:
*
* LOAD DSCONV, SYS:HR1022/LIB
* SAVE
*
* If you have any questions, please feel free to call me at (617)
* 661-9440.
*
PROGRAM DSCONV
IMPLICIT INTEGER (A-Z)
PARAMETER NENDWD=5, TWOE31=2147483648
DIMENSION INFO(25), DSSPEC(5), DSLGNM(5), TYPES(2,5),
1 TYPER(15), WORK(10), ENDWDS(5), DUMPER(5)
DIMENSION CLAUSE(15), ATTNAM(5), PROMPT(5), TITLE(5)
COMMON /A/ CLAUSE, ATTNAM, PROMPT, TITLE
DOUBLE PRECISION DBNAME, DSNAME(25), DMDFIL, DMIFIL(25)
COMMON /B/ DBNAME, DSNAME, DMDFIL, DMIFIL, PRE115
DATA DMIEXT /'.DMI'/, ((TYPES(I,J),I=1,2),J=1,5)
1 /'Integer Real Text Date Integer '/,
2 (TYPER(I),I=1,15) /1,2,3,0,4,1,2,4,3,1,2,4,5,5,5/,
3 (ENDWDS(I),I=1,5) /0, ' ','END','EXIT','QUIT'/,
4 BLANK /' '/, ASTRSK /'*'/
1 TYPE 2
2 FORMAT (' DSCONV')
CALL DBFOR
* CALL DBDBUG ('MCHK','ON')
3 TYPE 4
4 FORMAT (/' Enter dataset name or filespec: ',$)
ACCEPT 5, DSSPEC
5 FORMAT (5A5)
DO 6 I = 1,NENDWD
6 IF (DSSPEC(1) .EQ. ENDWDS(I)) GO TO 300
7 TYPE 8
8 FORMAT (/' Dump data? ',$)
ACCEPT 9, DUMP
9 FORMAT (A1)
IF (DUMP .GE. 'a' .AND. DUMP .LE. 'z')
1 DUMP = DUMP .and. "577777777777
IF (DUMP .EQ. 'Y' .OR. DUMP .EQ. 'N') GO TO 12
TYPE 10
10 FORMAT (/' Answer Y or N')
GO TO 7
12 CALL DBERR ($3)
CALL DBOPEN (DSSPEC)
CALL DBERR (0)
CALL DBNSET (NSET)
IF (NSET.LE.25) GO TO 15
TYPE 13
13 FORMAT (' System 1032 allows only 25 datasets per database.'/
1 ' Only the first 25 sets will be converted.')
NSET = 25
15 CALL GETNAM (NSET, DSSPEC)
16 OPEN (UNIT=21, FILE=DMDFIL, ACCESS='SEQOUT', MODE='ASCII')
CALL PUTCL(3)
IF (NSET .EQ. 1) GO TO 20
ENCODE (18,17,CLAUSE) DBNAME
17 FORMAT ('Database ',A9)
CALL PUTCL(0)
CALL PUTCL(1)
CALL PUTCL(4)
20 DO 200 SETNO = 1,NSET
SN1=SETNO
CALL DBSET(SN1)
CALL DBNATT (NATT)
ENCODE (17,21,CLAUSE) DSNAME(SETNO)
21 FORMAT ('Dataset ',A9)
CALL PUTCL(0)
IF (PRE115 .EQ. 0) GO TO 23
ENCODE (39,22,CLAUSE)
22 FORMAT ('Comment "Original dataset name was lost')
CALL PUTCL(5)
GO TO 25
23 CALL DBSYSV('SYSDSNAME',0,DSLGNM)
IF ((DSLGNM(2).AND."376) .EQ. "100) GO TO 25
ENCODE (56,24,CLAUSE) DSLGNM
24 FORMAT ('Comment "Full dataset name was ',5A5)
CALL PUTCL(5)
25 CALL PUTCL(1)
CALL PUTCL(4)
DO 100 ANO1 = 1,NATT
ANO = ANO1
CALL DBINFO (ANO,INFO)
IF (INFO(1) .EQ. 0) GO TO 110
DO 27 I=1,5
27 ATTNAM(I) = INFO(I)
ENCODE (35,28,CLAUSE) ATTNAM
28 FORMAT ('Attribute ',5A5)
CALL PUTCL(0)
IF (INFO(6) .EQ. 0) GO TO 30
ENCODE (8,29,CLAUSE) INFO(6)
29 FORMAT ('Or ',A5)
CALL PUTCL(0)
30 TNO = TYPER(INFO(8)+1)
ENCODE (10,31,CLAUSE)(TYPES(J,TNO),J=1,2)
31 FORMAT (2A5)
CALL PUTCL(0)
GO TO (40,32,34,36), INFO(18)+1
32 ENCODE (8,33,CLAUSE)
33 FORMAT ('of Entry')
GO TO 38
34 ENCODE (9,35,CLAUSE)
35 FORMAT ('of Change')
GO TO 38
36 ENCODE (17,37,CLAUSE)
37 FORMAT ('of Identification')
38 CALL PUTCL(0)
40 IF (TNO .NE. 5) GO TO 42
ENCODE (17,41,CLAUSE)
41 FORMAT ('Double Format N18')
CALL PUTCL(0)
42 IF (TNO .NE. 2) GO TO 44
ENCODE (13,43,CLAUSE)
43 FORMAT ('Format E+10.4')
CALL PUTCL(0)
44 IF (TNO .NE. 3) GO TO 50
ENCODE (15,46,CLAUSE) INFO(9)
46 FORMAT (I15)
CALL PUTCL(0)
50 IF (INFO(10)) 52,60,52
52 ENCODE (14,54,CLAUSE)
54 FORMAT ('Keyed')
CALL PUTCL(0)
IF (TNO .NE. 3) GO TO 60
56 ENCODE (8,58,CLAUSE)
58 FORMAT ('Use_Case')
CALL PUTCL(0)
60 IF (TNO .NE. 1) GO TO 80
CLAUSE(1) = 'Range'
CALL PUTCL(0)
ENCODE (15,46,CLAUSE) INFO(14)
CALL PUTCL(0)
CLAUSE(1) = ':'
CALL PUTCL(0)
ENCODE (15,46,CLAUSE) INFO(15)
CALL PUTCL(0)
80 GO TO (81,82,83,82), TNO
81 R1 = INFO(14)
IF (R1 .EQ. 0) R1=1
R2 = INFO(15)
IF (R2. EQ. 0) R2=1
L1 = ALOG10(ABS(FLOAT(R1)))
L2 = ALOG10(ABS(FLOAT(R2)))
LEN = MAX0(L1,L2) + 2
GO TO 84
82 LEN = 10
GO TO 84
83 LEN = INFO(17) - INFO(16) + 1
84 CALL PRMTTL (LEN)
IF (INFO(18) .NE. 0) GO TO 87
ENCODE (33,86,CLAUSE) PROMPT
86 FORMAT ('Prompt "',5A5)
CALL PUTCL(5)
87 ENCODE (32,88,CLAUSE) TITLE
88 FORMAT ('Title "',5A5)
CALL PUTCL(5)
90 IF (TNO .NE. 5) GO TO 98
ENCODE (51,92,CLAUSE)
92 FORMAT ('!* Alternate definition: Decimal 22.0 Format N22 *!')
CALL PUTCL(0)
98 CALL PUTCL(1)
100 CONTINUE
110 CALL PUTCL(4)
ENCODE (12,112,CLAUSE) DSNAME(SETNO)
112 FORMAT ('RD ',A9)
CALL PUTCL(0)
CALL PUTCL(2)
DO 140 ANO1 = 1,NATT
ANO = ANO1
CALL DBINFO (ANO,INFO)
TNO = TYPER (INFO(8)+1)
ENCODE (31,116,CLAUSE) INFO
116 FORMAT ('Field ',5A5)
CALL PUTCL(0)
ENCODE (10,31,CLAUSE) (TYPES(J,TNO),J=1,2)
CALL PUTCL(0)
IF (TNO .NE. 5 .AND. TNO .NE. 1) GO TO 118
FLDLEN = INFO(17) - INFO(16) + 1
IF (TNO.EQ. 1 .AND. (FLDLEN.LE. 9 .OR.
1 (INFO(14).GE.-TWOE31.AND.INFO(15).LT.TWOE31))) GO TO 118
ENCODE (6,117,CLAUSE)
117 FORMAT ('Double')
CALL PUTCL(0)
118 IF (TNO .NE. 4) GO TO 125
LC = INFO(17) - INFO(16) + 1
FMTNO = 5
IF (LC .GE. 8) FMTNO = 6
ENCODE (8,120,CLAUSE) FMTNO
120 FORMAT ('Format ',I1)
CALL PUTCL(0)
125 IF (TNO .NE. 3) GO TO 135
ENCODE (10,126,CLAUSE)
126 FORMAT ('RD_Missing')
CALL PUTCL(0)
LC = INFO(17) - INFO(16) + 1
IF (LC .GT. 20) LC=20
ENCODE (22,128,CLAUSE) (ASTRSK,I=1,LC),(BLANK,I=LC+1,21)
128 FORMAT ('"',21A1)
CALL PUTCL(5)
135 ENCODE (6,136,CLAUSE)
136 FORMAT ('Column')
CALL PUTCL(0)
ENCODE (15,46,CLAUSE) INFO(16)
CALL PUTCL(0)
ENCODE (15,46,CLAUSE) INFO(17)
CALL PUTCL(0)
CALL PUTCL(2)
140 CONTINUE
ENCODE (6,152,CLAUSE)
152 FORMAT ('End_RD')
CALL PUTCL(0)
CALL PUTCL(1)
CALL PUTCL(4)
ENCODE (13,162,CLAUSE)
162 FORMAT ('Load_Defaults')
CALL PUTCL(0)
ENCODE (21,164,CLAUSE) DMIFIL(SETNO)
164 FORMAT ('Data_Input ',A10)
CALL PUTCL(0)
ENCODE (12,168,CLAUSE) DSNAME(SETNO)
168 FORMAT ('RD ',A9)
CALL PUTCL(0)
CALL PUTCL(1)
CALL PUTCL(4)
ENCODE (11,172,CLAUSE)
172 FORMAT ('End_Dataset')
CALL PUTCL(0)
CALL PUTCL(1)
IF (NSET .NE. 1) CALL PUTCL(4)
IF (DUMP .EQ. 'N') GO TO 200
ENCODE (20,187,DUMPER) DMIFIL(SETNO)
187 FORMAT ('DUMP DATA ',A10)
DUMPER(5) = 0
CALL DBFIND ('ALL')
CALL DBNREC (NREC)
IF (NREC .NE. 0) GO TO 192
TYPE 190, DSLGNM
190 FORMAT (/' Dataset ',5A5,' no records to dump')
GO TO 200
192 CALL DBEXEC (DUMPER)
TYPE 194, DSLGNM, DMIFIL(SETNO)
194 FORMAT (/' Dataset ',5A5,' records are in file ',A10)
200 CONTINUE
IF (NSET .EQ. 1) GO TO 210
ENCODE (12,202,CLAUSE)
202 FORMAT ('End_Database')
CALL PUTCL(0)
CALL PUTCL(1)
210 TYPE 212, DMDFIL
212 FORMAT (/' Data definitions are in file ',A10)
CLOSE (UNIT=21)
CALL DBCLOS
GO TO 3
300 CALL DBEND
END
SUBROUTINE PUTCL (FLAG)
* IF FLAG = 0, PUTCL TRANSFERS A CLAUSE TO THE OUTPUT BUFFER. IF THERE IS
* NO MORE ROOM ON THE LINE, IT WRITES THAT LINE AND BEGINS A NEW BUFFER.
* IF FLAG = 1, NO CLAUSE IS TRANSFERRED, BUT THE BUFFER IS WRITTEN OUT
* WITH A SEMICOLON.
* IF FLAG = 2, NO CLAUSE IS TRANSFERRED, AND THE BUFFER IS WRITTEN OUT
* WITH A HYPHEN.
* IF FLAG = 3, THE BUFFER IS INITIALIZED.
* IF FLAG = 4, A COMMENT LINE IS WRITTEN.
* IF FLAG = 5, THE BEHAVIOR IS THE SAME AS FOR FLAG = 0, EXCEPT
* THAT A DOUBLE QUOTE IS APPENDED TO THE CLAUSE.
IMPLICIT INTEGER (A-Z)
PARAMETER LINLEN=80, CLWD=15, CLLEN=75
DIMENSION XYZ1(5), LINE(80), XYZ2(5), CLS(75), TERM(3), NEWPOS(4)
DIMENSION CLAUSE(15), ATTNAM(5), PROMPT(5), TITLE(5)
COMMON /A/ CLAUSE, ATTNAM, PROMPT, TITLE
DATA (TERM(I),I=1,3) /';','-','"'/, (NEWPOS(I),I=1,4) /1,5,1,0/,
1 BLANK /' '/
10 GO TO (100,105,110,130,11), FLAG
11 DECODE (CLLEN,12,CLAUSE) CLS
12 FORMAT (80A1)
DO 15 IC=1,CLLEN
FC = IC
IF (CLS(IC) .NE. BLANK) GO TO 18
15 CONTINUE
18 DO 20 IC= CLLEN,FC,-1
LC = IC
IF (CLS(IC) .NE. BLANK) GO TO 30
20 CONTINUE
30 IF (FLAG .EQ. 0) GO TO 35
LC=LC+1
CLS(LC) = TERM(3)
35 NC = LC - FC + 1
IF (POS+NC+2 .LT. LINLEN) GO TO 50
LINE (POS) = TERM(2)
P5 = ((POS+1)/5)*5+3
WRITE (21,12) (LINE(I),I=1,P5)
DO 40 I=1,LINLEN
40 LINE(I) = BLANK
POS = NEWPOS(2)
50 DO 60 I=FC,LC
60 LINE (POS+I-FC) = CLS(I)
POS = POS+NC+1
GO TO 124
100 POS = POS-1
105 LINE(POS) = TERM(FLAG)
P5 = ((POS+1)/5)*5+3
WRITE (21,12) (LINE(I),I=1,P5)
110 POS = NEWPOS(FLAG)
DO 120 I=1,LINLEN
120 LINE(I) = BLANK
124 DO 125 I=1,CLWD
125 CLAUSE(I) = BLANK
RETURN
130 WRITE (21,132)
132 FORMAT ('! ')
RETURN
END
SUBROUTINE PRMTTL (LEN)
* GENERATE A PROMPT AND A TITLE FOR AN ATTRIBUTE NAME
* FOR THE PROMPT, REPLACE ALL UNDERSCORES BY SPACES AND
* CAPITALIZE ONLY THE FIRST LETTER OF EACH WORD
* FOR THE TITLE, PUT IN SLASHES AFTER EACH TIME THE NUMBER OF
* CHARACTERS IS LESS THAN THE DATA ITEM LENGTH
IMPLICIT INTEGER (A-Z)
PARAMETER WL=25
DIMENSION W(35), WDB(14)
DIMENSION CLAUSE(15), ATTNAM(5), PROMPT(5), TITLE(5)
COMMON /A/ CLAUSE, ATTNAM, PROMPT, TITLE
DATA BLANK/' '/, ULINE /'_'/, SLASH/'/'/
WDE(K) = WDB(K+1) - 2
DECODE (25,20,ATTNAM) W
20 FORMAT (25A1)
DO 30 I=1,WL
FC=I
IF (W(I).NE.BLANK) GO TO 40
30 CONTINUE
40 DO 50 I=WL,FC,-1
LC=I
IF (W(I).NE. BLANK) GO TO 60
50 CONTINUE
60 NWD=1
WDB(NWD)=FC
DO 80 I=FC+1,LC
IF (W(I) .NE. ULINE) GO TO 80
W(I) = BLANK
IF (W(I+1) .EQ. ULINE) GO TO 80
NWD=NWD+1
WDB(NWD)=I+1
80 CONTINUE
WDB(NWD+1)=LC+2
DO 90 I=1,NWD
IF (W(WDB(I)) .LT. 'a' .OR. W(WDB(I)) .GT. 'z') GO TO 90
W(WDB(I)) = W(WDB(I)) .AND. "577777777777
90 CONTINUE
DO 110 I=1,NWD
DO 110 J=WDB(I)+1,WDB(I+1)-2
IF (W(J) .LT. 'A' .OR. W(J) .GT. 'Z') GO TO 110
W(J) = W(J) .OR. "200000000000
110 CONTINUE
ENCODE(25,20,PROMPT) (W(I),I=FC,LC)
200 FC1 = FC
WN=1
210 IF (FC1+LEN-1 .GE. LC) GO TO 300
NWE=0
DO 220 I=WN,NWD
I2=I
WE = WDE(I2)
IF (FC1 .LE. WE .AND. FC1+LEN-1 .GE. WE) NWE=NWE+1
220 CONTINUE
IF (NWE .GT. 0) GO TO 240
W(WDB(WN+1)-1) = SLASH
FC1 = WDB(WN+1)
WN = WN+1
GO TO 210
240 W(WDB(WN+NWE)-1) = SLASH
FC1 = WDB(WN+NWE)
WN = WN+NWE
GO TO 210
300 ENCODE (25,20,TITLE) (W(I), I=FC,LC)
RETURN
END
SUBROUTINE GETNAM (NSET, DSSPEC)
* GETNAM GETS THE DATASET NAMES AND TRUNCATES THEM TO 9 CHARACTERS
* FOR 1032. IF THERE IS MORE THAN ONE DATASET IN THE FILE, IT ALSO GETS
* A DATABASE NAME BY EXTRACTING THE "FILENAME" PORTION
* OF THE FILESPEC. THEN IT MAKES SURE ALL THESE NAMES ARE UNIQUE,
* AND GENERATES UNIQUE ONES IF NOT. FINALLY, IT GENERATES
* FILNAMES FOR THE DMD AND DMI FILES AND ALSO ENSURES ALL THESE ARE UNIQUE.
IMPLICIT INTEGER (A-Z)
PARAMETER WL=25, DSNL=9, FNL=6, EL=4
DIMENSION DSSPEC(5), WORK(35), DELIM(7), DSLC(10), DSNMF(5),
1 DSN(25,25), DBN(9)
LOGICAL MATCH(25)
DOUBLE PRECISION DBNAME, DSNAME(25), DMDFIL, DMIFIL(25)
COMMON /B/ DBNAME, DSNAME, DMDFIL, DMIFIL, PRE115
DATA (DELIM(I),I=1,7) /':',';','<','>','[',']','.'/,
1 DMDEXT /'.DMD'/, DMIEXT /'.DMI'/, BLANK/' '/, ULINE/'_'/
* FIRST, EXTRACT THE DATABASE NAME FROM THE FILESPEC
DECODE (25,12,DSSPEC) WORK
12 FORMAT (25A1)
DO 10 I=1,WL
FC=I
IF (WORK(I).NE.BLANK) GO TO 20
10 CONTINUE
20 DO 25 I=WL,FC,-1
LC=I
IF (WORK(I).NE. BLANK) GO TO 30
25 CONTINUE
30 DO 40 I=FC,LC
IF (WORK(I).NE. DELIM(1)) GOTO 40
FC=I+1
GO TO 50
40 CONTINUE
50 DO 60 I=FC,LC
IF (WORK(I).NE. DELIM(2)) GO TO 60
LC=I-1
GO TO 70
60 CONTINUE
70 DO 80 I=FC,LC
IF (WORK(I).NE. DELIM(3)) GO TO 80
DO 75 J=I+1,LC
IF (WORK(J).NE. DELIM(4)) GO TO 75
OFF = J-I+1
DO 72 K=J+1,LC
72 WORK(K-OFF) = WORK(K)
LC = LC-OFF
GO TO 90
75 CONTINUE
GO TO 900
80 CONTINUE
90 DO 100 I=FC,LC
IF (WORK(I).NE. DELIM(5)) GO TO 100
DO 95 J=I+1,LC
IF (WORK(J).NE. DELIM(6)) GO TO 95
OFF = J-I+1
DO 92 K=J+1,LC
92 WORK(K-OFF) = WORK(K)
LC = LC-OFF
GO TO 110
95 CONTINUE
GO TO 900
100 CONTINUE
110 DO 120 I=FC,LC
I2=I
IF (WORK(I).EQ. DELIM(7)) GO TO 130
120 CONTINUE
GO TO 135
130 LC = I2-1
135 IF (FC+8 .LE. LC) GO TO 140
DO 136 I=LC+1,FC+DSNL-1
136 WORK(I) = BLANK
DO 140 I=1,DSNL
140 DBN(I) = WORK(FC+I-1)
DBLC = LC-FC+1
* USE THE NAME FROM THE FILESPEC TO MAKE A DMD FILENAME
IF (LC-FC .GT. 5) LC=FC+5
DECODE (4,150,DMDEXT) (WORK(I),I=LC+1,LC+4)
150 FORMAT (4A1)
DO 155 I=LC+5, LC+8
155 WORK(I) = BLANK
DO 158 I=1,FNL
I2=FC+I-1
IF (WORK(I2).GE.'a'.AND.WORK(I2).LE.'z')
1 WORK(I2)=WORK(I2).AND."577777777777
158 CONTINUE
ENCODE (FNL+EL,162,DMDFIL) (WORK(FC+I-1),I=1,FNL+EL)
162 FORMAT (10A1)
DO 170 I=1,5
170 DSSPEC(I) = BLANK
* NOW, GET THE DATASET NAMES FROM 1022
200 DO 220 SN = 1,NSET
SN1 = SN
CALL DBSET (SN1)
PRE115 = 0
CALL DBERR ($202,IERT,IERC,0)
CALL DBSYSV ('SYSDSNAME',0,DSNMF)
CALL DBERR (0)
GO TO 208
* THIS BRANCH IF RUNNING A PRE-115 VERSION OF 1022 - SYSDSNAME NOT THERE
202 CALL DBERR (0)
PRE115 = 1
IF (NSET .EQ. 1) GO TO 206
IF (SN .LT. 10) ENCODE (WL,204,DSNMF) SN
IF (SN .GE. 10) ENCODE (WL,205,DSNMF) SN
204 FORMAT ('DS',I1,22X)
205 FORMAT ('DS',I2,21X)
GO TO 208
206 ENCODE (WL,207,DSNMF) DBN
207 FORMAT (9A1,16X)
GO TO 208
208 DECODE (WL,12,DSNMF) (DSN(I,SN),I=1,DSNL)
* ELIMINATE UNDERSCORES (VMS WON'T LIKE THEM IN FILENAMES)
210 DO 214 P=1,DSNL
IF (DSN(P,SN).NE.ULINE) GO TO 214
DO 212 I=P+1,WL
212 DSN(I-1,SN)=DSN(I,SN)
DSN(W,SNL)=BLANK
214 CONTINUE
DO 216 I=DSNL,1,-1
DSLC(SN) = I
IF (DSN(I,SN).NE.BLANK) GO TO 220
216 CONTINUE
220 CONTINUE
* IF DATABASE NAME IS SAME AS A DATASET NAME, GENERATE A NEW DB NAME
* SKIP THIS STEP IF ONLY ONE DS, SINCE DB NAME WON'T BE USED
IF (NSET .EQ. 1) GO TO 240
DO 230 SN = 1,NSET
DO 225 I=1,DSNL
IF (DBN(I) .NE. DSN(I,SN)) GO TO 230
225 CONTINUE
IF (DBLC .GT. 7) DBLC=7
DBN(DBLC+1) = 'D'
DBN(DBLC+2) = 'B'
GO TO 240
230 CONTINUE
* LOOK FOR DATASETS WITH THE SAME NAME
240 DO 280 SN=1,NSET-1
MATCH(SN) = .TRUE.
NM=0
DO 260 SET = SN+1,NSET
MATCH(SET)=.TRUE.
DO 250 I=1,DSNL
IF (DSN(I,SN).EQ.DSN(I,SET)) GO TO 250
MATCH(SET) = .FALSE.
GO TO 260
250 CONTINUE
NM = NM+1
260 CONTINUE
* GENERATE UNIQUE NAMES FOR EACH OF THEM
IF (NM .EQ. 0) GO TO 280
MNO = 0
DO 270 SET = SN,NSET
IF (.NOT.MATCH(SET)) GO TO 270
MNO = MNO+1
IF (DSLC(SET).EQ. DSNL) DSLC(SET)=DSNL-1
ENCODE (1,262,DSN(DSLC(SET)+1,SET)) MNO
262 FORMAT (I1)
DSLC(SET) = DSLC(SET)+1
270 CONTINUE
280 CONTINUE
* STORE DBNAME AND DSNAMES FOR USE BY MAIN PROGRAM
ENCODE (DSNL,282,DBNAME) DBN
282 FORMAT (9A1)
DO 290 SN=1,NSET
290 ENCODE (DSNL,282,DSNAME(SN)) (DSN(I,SN),I=1,DSNL)
* TRUNCATE DS NAMES TO 6 CHARACTERS FOR DMI FILENAMES
* SEE IF THESE ARE UNIQUE
DO 330 I=1,NSET
IF (DSLC(I).GT.FNL) DSLC(I)=FNL
330 CONTINUE
333 FORMAT (6A1)
340 DO 380 SN=1,NSET-1
MATCH(SN) = .TRUE.
NM=0
DO 360 SET = SN+1,NSET
MATCH(SET)=.TRUE.
DO 350 I=1,FNL
IF (DSN(I,SN).EQ.DSN(I,SET)) GO TO 350
MATCH(SET) = .FALSE.
GO TO 360
350 CONTINUE
NM = NM+1
360 CONTINUE
* GENERATE UNIQUE DMI FILENAMES
IF (NM .EQ. 0) GO TO 380
MNO = 0
DO 370 SET = SN,NSET
IF (.NOT.MATCH(SET)) GO TO 370
MNO = MNO+1
IF (DSLC(SET).EQ. FNL) DSLC(SET)=FNL-1
ENCODE (1,363,DSN(DSLC(SET)+1,SET)) MNO
363 FORMAT (I1)
DSLC(SET) = DSLC(SET)+1
370 CONTINUE
380 CONTINUE
DO 390 SN=1,NSET
DECODE (EL,382,DMIEXT) (DSN(DSLC(SN)+I,SN), I=1,EL)
382 FORMAT (4A1)
L1 = DSLC(SN)+EL
DMIFIL(SN) = BLANK
390 ENCODE (L1,162,DMIFIL(SN)) (DSN(I,SN),I=1,L1)
RETURN
900 TYPE 902, FC,LC
902 FORMAT (' Internal error ',3I3)
STOP
END