Google
 

Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - 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