C PROGRAM TO READ/WRITE DIF FILES FROM .PCC FILES c c Compilation: c FORTRAN/NOCHECK/NODEBUG DIFRW c Link: c LINK/NOMAP DIFRW c c Reads DIF files into AnalytiCalc save format files c or reads AnalytiCalc save files into DIF files. c Note that the version of AnalytiCalc must be the c new one that saves across rows rather than down c columns for the latter ability to work. c c c ADD SPECIAL "D" OPTION TO WRITE random access database files C for databases that can use them. Write files as sequential C fixed length record files, no keys used in access, but able C to be sorted etc. because key fields will be there. C C D AND P OPTIONS write out database files and ask for an c auxiliary key which can then be used in DTR retrievals c for file access where multiple sheet files are stored c in the same DTR domain. c C Also includes options to extract PCC files from the c database files as desired, with potential reorganization c according to user wishes. C c Copyright (c) Glenn C. Everhart 1985 c Noncommercial use permitted, but for-profit c distribution prohibited. c CHARACTER*1 FORM,FVLD INTEGER*4 VNLT CHARACTER*1 LET1,LET2,FORM2(128),NMSH(80) CHARACTER*1 DIFHDR(10) COMMON/NMSH/NMSH INTEGER*2 IOLVL DIMENSION FORM(128),FVLD(1,1) CHARACTER*1 FVWRK,FVWRK2 C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S C SO INITIALLY IGNORE. C FVLD=2 = CONST NUMERIC ONLY, COMPUTED. =3, CONST, NEEDS CALC. C C ROUTINE IN2AS COMPUTES ASCII CHARACTER NAMES OF SUBSCRIPTS IN1,IN2 C SO DISPLAY CAN HAVE THEM. IT MUST BE THE INVERSE OF VARSCN. CHARACTER*1 LETA CHARACTER*127 CFORM,CFORM2 EQUIVALENCE(CFORM,FORM(1)) EQUIVALENCE(CFORM2,FORM2(1)) LOGICAL*1 LFN(80) INTEGER*4 IDREC,ICW,IRW integer*2 nrows,ncols character*9 DFMT character*8 auxkey,AK2 integer*4 idbase C ENCODE ICREF, IRREF AND CWIDS PAST TITLE IN FIRST LINE C (THAT WAY, NOTHING BREAKS IN OTHER PGMS THAT USE THIS) C C PUT NUMBERS OUT TO FILE C USES RELATIVE FORMS TO CURRENT POS. C PD = PUT OURT DISPLAY SHEET. PP = PUT OUT PHYSICAL SHEET. C ONLY WRITES PHYSICALLY PRESENT DATA. C P/D RRR,CCC,FORMULA,VALID,FORMAT C N IN 3RD CHR (PPN/PDN) SAVES NUMBERS, ELSE FORMULAS. IOLVL=5 OPEN(UNIT=5,FILE='SYS$INPUT:',STATUS='OLD') OPEN(UNIT=6,FILE='SYS$OUTPUT:',STATUS='NEW') WRITE(6,101) 101 FORMAT(' Read DIF file to PCC or Write DIF file from' 1 ,' PCC or Read DIF to DB', 2 /,'$or Read PCC to DB or extract PCC ' 3 'from DB [R/W/D/P/X]:') READ(5,7953)FORM2 MODIF=ICHAR(FORM2(2)) INDIF=1 IF(FORM2(1).EQ.'R'.OR.FORM2(1).EQ.'r')INDIF=0 IF(FORM2(1).EQ.'X'.OR.FORM2(1).EQ.'x')GOTO 7000 INDB=0 IF(FORM2(1).EQ.'D'.OR.FORM2(1).EQ.'d')INDB=1 IF(FORM2(1).EQ.'P'.OR.FORM2(1).EQ.'p')INDB=2 C IF READING PCC FILE TO DTR TYPE FILE JUST FAKE THAT WE'RE C READING PCC FILES. IF READING DIF FILE TO DTR FILE SAY C WE'RE READING DIF FILES. IF(INDB.EQ.1)INDIF=0 IF(INDB.EQ.2)INDIF=1 IF(INDB.EQ.0)GOTO 165 C GET HOLD OF AUXILIARY KEY (FOR USE WHEN CROSS REFERENCING C MULTIPLE DATABASE FILES) AND OF ID BASE IF NOT 0 WRITE(6,173) 173 FORMAT(' Customization Section - allows you to diff' 1 'erentiate this DB section from others',/, 2 ' within the file:') Write(6,166) 166 FORMAT('$ Enter auxiliary key, up to 8 chars>') Read(5,167)auxkey 167 format(a8) Write(6,168) 168 Format('$Enter desired cell ID base or 0>') Read(5,169)idbase 169 format(i8) if(iabs(idbase).gt.65536)goto 165 IF(IDBASE.EQ.0)GOTO 165 write(6,170) 170 format(' Warning - ID base may conflict with cell IDs') Write(6,171) 171 format('$Are you sure you want to use it? [Y/N]:') Read(5,172)leta 172 format(1a1) if(leta.ne.'y'.and.leta.ne.'Y')stop 'OK. Rerun.' 165 CONTINUE C DON'T BOTHER WITH DIF FILE UNLESS NEEDED. IF(INDB.EQ.2)GOTO 155 WRITE(6,102) 102 FORMAT('$ Enter DIF filename>') III=IOLVL READ(III,7953,END=510,ERR=510)FORM2 7953 FORMAT(128A1) DO 6940 II=1,128 ILN=129-II IF(ICHAR(FORM2(ILN)).GT.32)GOTO 6941 FORM2(ILN)=CHAR(0) 6940 CONTINUE 6941 CONTINUE C ILN IS LENGTH OFLINE NOW. ILN=MIN0(ILN,127) FORM2(ILN+1)=CHAR(0) IF(INDIF.EQ.0)CALL RASSIG(3,FORM2) IF(INDIF.NE.0)CALL WASSIG(4,FORM2) GOTO 157 155 CONTINUE C LEAVE DUMMY DIF OUTPUT OPEN SO WRITES DON'T ALL HAVE TO C BE TESTED... OPEN(UNIT=4,FILE='NLA0:',STATUS='NEW', 1 RECL=512) 157 CONTINUE C LUN 3 IS INPUT, LUN 4 IS OUTPUT C NOW GET PCC FILENAME IF(INDB.EQ.0.OR.INDB.EQ.2)WRITE(6,103) IF(INDB.EQ.1)WRITE(6,140) 103 FORMAT('$ Enter PCC filename>') 140 FORMAT('$ Enter Database Data File name>') READ(IOLVL,7953)FORM2 DO 6340 II=1,128 ILN=129-II IF(ICHAR(FORM2(ILN)).GT.32)GOTO 6341 FORM2(ILN)=CHAR(0) 6340 CONTINUE 6341 CONTINUE C ILN IS LENGTH OFLINE NOW. ILN=MIN0(ILN,127) FORM2(ILN+1)=CHAR(0) IF(INDIF.ne.0)CALL RASSIG(3,FORM2) IF(INDB.EQ.0.AND.INDIF.eq.0)CALL WASSIG(4,FORM2) C IF WE'RE READING PCC FILES, PCC FILE ALREADY OPEN C BUT IF WRITING DB FILES FROM DIF FILES, NEED TO DUMMY C THE PCC FILE OPEN HERE. DO SO. IF(INDB.EQ.1)OPEN(UNIT=4,FILE='NLA0:',STATUS='NEW', 1 RECL=512) C IF INDB USED, FORGET OUTPUT TO .PCC FILE. C FIRST GET THE FILENAME IF INDB=2 IF(INDB.NE.2)GOTO 156 WRITE(6,140) C GET THE FILENAME HERE AND MAKE SURE IT'S NULL TERMINATED C (DON'T USE Q FORMAT TO MAKE THIS PROGRAM EASIER TO MOVE C TO COMPILERS THAT DON'T HAVE IT.) READ(IOLVL,7953,END=510,ERR=510)FORM2 C JUST ZOT OUT TRAILING WHITESPACE BY NULLING BEYOND IT. DO 5340 II=1,128 ILN=129-II C STOP ON FIRST CHARACTER THAT CAN'T BE WHITESPACE. C NOTE THAT THIS GIVES UNIFORM RESULTS EVEN IN WEIRD C OTSs THAT PASS THE C.R. OR EVEN THE CRLF. IF(ICHAR(FORM2(ILN)).GT.32)GOTO 5341 FORM2(ILN)=CHAR(0) 5340 CONTINUE 5341 CONTINUE C ILN IS LENGTH OFLINE NOW. ILN=MIN0(ILN,127) FORM2(ILN+1)=CHAR(0) 156 CONTINUE c c provide option to open file in 'unknown' status (i.e. c allow adding to existing ones) if desired. IF(INDB.EQ.0)GOTO 3214 WRITE(6,141) 141 FORMAT('$ Enter N for New file, O for Old file>') Read(5,7953)leta DO 3216 IV=1,80 LFN(IV)=ICHAR(FORM2(IV)) 3216 CONTINUE 3217 CONTINUE if(leta.NE.'n'.and.leta.ne.'N')goto 3215 c he says it's new file; open it that way (i.e., create a c new version if one already exists.) IF(MODIF.EQ.ICHAR('V'))GOTO 3315 OPEN(UNIT=7,FILE=LFN,STATUS='NEW', 1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='FIXED', 2 RECL=143,FORM='FORMATTED') goto 3214 3315 CONTINUE OPEN(UNIT=7,FILE=LFN,STATUS='NEW', 1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='VARIABLE', 2 RECL=143,FORM='FORMATTED') GOTO 3214 3215 continue C USE STATUS UNKNOWN SO THAT A NEW FILE WILL BE CREATED IF C NONE EXISTS. C ALLOW, ON CV (WHERE C IS X OR D OR P) COMMANDS, TO BUILD A C VARIABLE RECORD SIZED RECORD. IF(MODIF.EQ.ICHAR('V'))GOTO 3314 OPEN(UNIT=7,FILE=LFN,STATUS='UNKNOWN', 1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='FIXED', 1 ACCESS='APPEND', 2 RECL=143,FORM='FORMATTED') GOTO 3214 3314 CONTINUE OPEN(UNIT=7,FILE=LFN,STATUS='UNKNOWN', 1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='VARIABLE', 1 ACCESS='APPEND', 2 RECL=143,FORM='FORMATTED') 3214 CONTINUE C WRITE ROW#,COL#,FVLD,TYPE,FORMAT,FORMULA,IJUNK c Now both files are opened and all set, and INDIF flag tells c whether the DIF file is the input or the output (0=input) c c Now since DIF files don't have a valid format, if we're reading c DIF and writing PCC files, ask for a display format. IF (Indif.ne.0)goto 105 Write(6,106) 106 Format('$ Enter display format, no ().>') Read(5,107)DFMT c may need to change format... 107 Format(A9) GOTO 1000 105 Continue WRITE(6,900) 900 FORMAT('$ Emit Values or Formulas [V/F]:') Read(5,7953)let2 IF(LET2.EQ.'v')LET2='V' c LET2 tells us whether to emit Values or "Labels" in the DIF c file... C AT 1000 HANDLE READING DIF FILES TO PCC FILES C NEXT HANDLE READING PCC FILES TO DIF FILES. C C PCC IN, DIF OUT C C FIRST PASS: READ IN PCC FILE TO SEE HOW MANY ROWS AND COLS C ARE THERE SINCE THAT'S NEEDED FOR DIF. NCOLS=0 NROWS=0 READ(3,6951,END=9990,ERR=9990)NMSH,FORM 6951 FORMAT(100A1,100A1,100A1) 1107 CONTINUE C7955 FORMAT('P',I5,',',I5,',',128A1) C READ THE DATA AND KEEP MAXIMA FOR ROW, COL UNTIL EOF READ (3,108,END=109,ERR=109)LETR,ICOL,IROW,FORM NCOL=ICOL NROW=IROW 108 FORMAT(1A1,I5,1X,I5,1X,128A1) C7956 FORMAT(I3,',',9A1,',',I5) 7956 FORMAT(I3,1X,9A1,1X,I5) C NOTE SOME FORTRANS NEED TO USE 1X IN READ FORMAT, NOT C JUST USE SAME AS WRITE FORMAT HERE. READ(3,7956,END=109,ERR=109)IVLD,(FORM2(IV),IV=120, 1 128),ITYPE IF(LETR.EQ.'M')GOTO 109 C DON'T BOTHER WITH MAPPING RECORDS WHICH ARE AT END... IF(LETR.NE.'P')GOTO 1107 IF(NCOL.GT.NCOLS)NCOLS=NCOL IF(NROW.GT.NROWS)NROWS=NROW GOTO 1107 109 CONTINUE C NOW HAVE DIMENSIONS... REWIND 3 WRITE(6,5000)NCOLS,NROWS 5000 FORMAT(' NUMBER OF COLS FOUND=',I6,';NUMBER OF ROWS=' 1 ,I6) IF(NCOLS.LE.0.OR.NCOLS.GT.999)STOP 'COLS ERR' IF(NROWS.LE.0.OR.NROWS.GT.999)STOP 'ROWS ERR' C PASS THROUGH THE FILE ONCE TO BE SURE ROWS AND COLUMNS C WILL FIT... READ(3,6951,END=9990,ERR=9990)NMSH,FORM C NOW EMIT TABLE RECORD USING TITLE OF SHEET AS STRING WRITE(4,110) 110 FORMAT('TABLE',/,'0,1') WRITE(4,111)(NMSH(IV),IV=1,75) 111 FORMAT('"',75A1,'"') C VECTORS IS DIF SLANG FOR COLUMNS. EMIT NUMBER OF VECTORS. WRITE(4,112)NCOLS 112 FORMAT('VECTORS',/,'0,',I3,/,'""') C NEXT WRITE TUPLES RECORD WHICH IS BASICALLY NUMBER OF ROWS WRITE(4,113)NROWS 113 FORMAT('TUPLES',/,'0,',I3,/,'""') WRITE(4,114) 114 FORMAT('DATA',/,'0,0',/,'""') C WE ASKED EARLIER FOR LET2 TO BE V FOR VALUES OR F FOR FORMULAS C TO TELL WHICH TO EMIT. C NOW GO THROUGH AND HANDLE THE STUFF... ICOLI=0 IROWI=1 ICOLS=NCOLS IROWX=1 ICOLX=1 IROWS=NROWS WRITE(4,121) 121 FORMAT('-1,0',/,'BOT') 118 CONTINUE READ (3,108,END=119,ERR=119)LETR,ICOL,IROW,FORM NCOL=ICOL NROW=IROW READ(3,7956,END=119,ERR=119)IVLD,(FORM2(IV),IV=120, 1 128),ITYPE C ONLY ACCEPT P OR p TYPE RECORDS (ONLY ONE, DEPENDING ON LET1) IF(LETR.NE.'P'.AND.LET2.NE.'V')GOTO 118 IF(LETR.NE.'p'.AND.LET2.EQ.'V')GOTO 118 C HERE WE KNOW WE'RE LEGAL C SINCE THE NEW VERSIONS OF ANALYTICALC GENERATE DATA ACROSS COLUMNS C FIRST (I.E., ALONG TUPLES), JUST KEEP TRACK OF LAST ONE C READ AND FILL IN NULLS IF WE MUST. C ICOLX=ICOLX+1 C IF(ICOLX.LE.ICOLS)GOTO 120 C ICOLX=1 C IROWX=IROWX+1 C120 CONTINUE C ICOLX AND IROWX ARE NEXT COL AND ROW EXPECTED IF WE READ A TOTALLY C FILLED TABLE AREA'S SAVED FILE. 122 CONTINUE IF(ICOL.LE.ICOLX.AND.IROW.LE.IROWX)GOTO 123 C NEED TO FILL IN EMPTIES... WRITE(4,125) 125 FORMAT('0,0',/,'NA') ICOLX=ICOLX+1 IF(ICOLX.LE.ICOLS)GOTO 124 ICOLX=1 IROWX=IROWX+1 C WRITE ANOTHER BOT RECORD AS NEEDED HERE (IN CASE WHOLE ROW IS C EMPTY) C ONLY EMIT RECORD IF WE DIDN'T JUST FINISH THE LAST ROW THOUGH... IF(IROWX.LE.IROWS)WRITE(4,121) 124 CONTINUE GOTO 122 123 CONTINUE C OK, NOW HAVE THIS FILLED IN... IF(LET2.NE.'V')GOTO 128 C MUST ENSURE THAT THE EXPONENT IS NN.NNNEXX RATHER THAN NN.NNNNDXX C I.E., D EXPONENTS AREN'T UNDERSTOOD. THEREFORE WRITE OUT E INSTEAD C OF D. DO 200 IV=1,50 IF(FORM(IV).EQ.'D')FORM(IV)='E' 200 CONTINUE 128 CONTINUE IF(LET2.EQ.'V')WRITE(4,126)(FORM(IV),IV=1,50) 126 FORMAT('0,',50A1,/,'V') IF(LET2.NE.'V')WRITE(4,127)(FORM(IV),IV=1,109) 127 FORMAT('1,0',/,109A1) C C EMIT DATABASE FILE IF CALLED FOR C THIS IS HERE TO MAKE PCC AND DIF FILES BE ON AN EQUAL C FOOTING. NOTE THAT ESSENTIALLY ALL INFO ON THE PCC FILE C IS SAVED IN THE DATABASE FILE EXCEPT TITLES AND MAPPING. C *** IFT=32+(ITYPE*4)+IVLD C ADD UNIQUE CELL ID INDEX HERE. USE A FIXED CODE SINCE WE'RE C NOT STORING IT CONTIGUOUSLY ANYHOW. ICW=ICOL IRW=IROW IDREC=(IRW-1)*1024+ICW+IDBASE IF(INDB.NE.0)WRITE(7,5219)IDREC,ICOL,IROW,AUXKEY, 1 (FORM(IV),IV=1,109), 1 (FORM2(IV),IV=120,128),IFT 5219 FORMAT(I8.8,2I4.4,A8,109A1,9A1,A1) C C *** C GO BACK AND READ SOME MORE NOW ICOLI=ICOL IROWI=IROW ICOLI=ICOLI+1 IF(ICOLI.LE.ICOLS)GOTO 2120 ICOLI=1 IROWI=IROWI+1 WRITE(4,121) 2120 CONTINUE ICOLX=ICOLI IROWX=IROWI GOTO 118 C 119 CONTINUE C ALL DONE, SO MARK END DATA AND GO HOME. C MUST BE SURE WE FILL OUT THE LAST TUPLE (ROW) SO C WRITE "NA" RECORDS IF IT'S OK TO DO SO. IF(IROWX.GT.IROWS.OR.ICOLX.GT.ICOLS)GOTO 9191 DO 9192 N=ICOLX,ICOLS WRITE(4,125) C WRITE 'NA' RECORDS TO FILL OUT COLUMNS 9192 CONTINUE 9191 CONTINUE WRITE(4,129) 129 FORMAT('-1,0'/,'EOD') CLOSE(UNIT=4) CLOSE(UNIT=3) GOTO 9990 1000 CONTINUE C C DIF IN, PCC OUT C C ASSUME DIF FILE STARTS WITH TABLE, VECTORS, TUPLES RECORDS READ(3,1001)DIFHDR 1001 FORMAT(10A1) READ(3,1002)N1,N2 1002 FORMAT(I1,1X,I5) READ(3,7953)FORM2 C FORM2 GETS STRING OUT OF DIF RECORD C C GET RID OF " CHARACTERS 3211 CONTINUE N1=INDEX(CFORM2,'"') IF(N1.LE.0.OR.N1.GT.127)GOTO 3212 FORM2(N1)=' ' GOTO 3211 3212 CONTINUE IF(DIFHDR(1).EQ.'T'.AND.DIFHDR(2).EQ.'A'.AND.DIFHDR(3) 1 .EQ.'B')WRITE(4,1003)(FORM2(IV),IV=2,81) 1003 FORMAT(80A1) IF(DIFHDR(1).EQ.'T'.AND.DIFHDR(2).EQ.'U'.AND. 1 DIFHDR(3).EQ.'P')NROWS=N2 IF(DIFHDR(1).EQ.'V'.AND.DIFHDR(2).EQ.'E'.AND. 1 DIFHDR(3).EQ.'C')NCOLS=N2 IF(DIFHDR(1).NE.'D'.OR.DIFHDR(2).NE.'A')GOTO 1000 C FALL THROUGH AFTER READING DATA RECORD C HOPEFULLY WE NOW HAVE NUMBER OF ROWS AND COLUMNS EXPECTED C ALL STORED IN NROWS AND NCOLS. IROW=0 ICOL=0 1010 CONTINUE READ(3,7953,END=9900)FORM N1=0 IX=INDEX(CFORM,',')-1 IF(IX.LE.0)GOTO 8092 READ(CFORM,8090)N1 8090 FORMAT(I3) DO 8091 N=1,123 8091 FORM(N)=FORM(N+IX+1) 8092 CONTINUE C READ NUMBER VALUE IN A STRING SO WE CAN DECODE IT AS C NEEDED. READ(3,7961,END=9900)FORM2 7961 FORMAT(100A1,100A1) C READ A RECORD C N1 = -1 FLAGS SPECIAL RECORDS IF(N1.GE.0)GOTO 1020 IF(FORM2(1).EQ.'B'.AND.FORM2(2).EQ.'O' 1 .AND.FORM2(3).EQ.'T')GOTO 1019 IF(FORM2(1).EQ.'E'.AND.FORM2(2).EQ.'O')GOTO 9900 GOTO 1010 1019 CONTINUE C AT START OF TUPLE RESET COL TO 1 AND ROW BUMPS... IROW=IROW+1 ICOL=0 GOTO 1010 C SKIP OVER NONDATA RECORDS 1020 CONTINUE C NOW HAVE TO EMIT A DATA RECORD. IVLD=-1 IF(N1.EQ.0)IVLD=1 ICOL=ICOL+1 IF(IVLD.EQ.1.AND.FORM2(1).EQ.'N'.AND.FORM2(2).EQ. 1 'A') GOTO 1010 C SKIP 'NA' INVALID NUMBERS AND DON'T BOTHER WRITING THEM. IF(IVLD.EQ.1)WRITE(4,1030)ICOL,IROW,(FORM(IV),IV=1,110) IF(IVLD.LT.1)WRITE(4,1030)ICOL,IROW,(FORM2(IV),IV=1,110) 1030 FORMAT('P',I5,',',I5,',',128A1) ITYPE=2 C FIGURE OUT TYPE BASED ON PRESENCE OR ABSENCE OF DOT. IF(IVLD.GT.1.AND.INDEX(CFORM,'.').EQ.0)ITYPE=4 WRITE(4,1031)IVLD,DFMT,ITYPE 1031 FORMAT(I3,',',A9,',',I5) IF(INDB.LE.0)GOTO 1010 IFT=32+(ITYPE*4)+IVLD C WRITE OUT THE DIRECT ACCESS FILE FROM THE DIF FILE C DIRECT ACCESS FILE OUGHT TO BE SUITABLE FOR DATATRIEVE C C RECORD FORMAT IS: C 8 DIGITS - ID C 4 DIGITS - COL C 4 DIGITS - ROW C 8 CHARACTERS - USER'S AUXILIARY KEY C 109 CHARS - FORMULA C 9 CHARS - FORMAT C 1 CHAR - ENCODED FVLD AND TYPE C C NOTE DTR CANNOT HANDLE BINARY DATA. IT NEEDS ALL CHARACTER C DATA. SO OUTPUT THE STUFF HERE AS CHARACTERS SO DTR CAN C ACCESS IT. C C ADD UNIQUE CELL ID INDEX HERE. USE A FIXED CODE SINCE WE'RE C NOT STORING IT CONTIGUOUSLY ANYHOW. ICW=ICOL IRW=IROW IDREC=(IRW-1)*1024+ICW+IDBASE IF(IVLD.EQ.1)GOTO 8544 WRITE(7,3219)IDREC,ICOL,IROW,AUXKEY, 1 (FORM2(IV),IV=1,109),DFMT,IFT C ENSURE NUMERIC FIELDS ARE ALL FILLED IN WITH 0'S. 3219 FORMAT(I8.8,2I4.4,A8,109A1,A9,A1) GOTO 1010 8544 CONTINUE WRITE(7,3219)IDREC,ICOL,IROW,AUXKEY, 1 (FORM(IV),IV=1,109),DFMT,IFT GOTO 1010 9900 CONTINUE CLOSE(UNIT=4) CLOSE(UNIT=3) 510 CONTINUE 9990 stop 'End DIFDB' 7000 CONTINUE C HERE READ DB FILE AND WRITE A PCC FILE WRITE(6,103) READ(IOLVL,7953)FORM2 DO 8340 II=1,128 ILN=129-II IF(ICHAR(FORM2(ILN)).GT.32)GOTO 8341 FORM2(ILN)=CHAR(0) 8340 CONTINUE 8341 CONTINUE C ILN IS LENGTH OFLINE NOW. ILN=MIN0(ILN,127) FORM2(ILN+1)=CHAR(0) CALL WASSIG(4,FORM2) WRITE(6,140) READ(IOLVL,7953)FORM2 DO 8640 II=1,128 ILN=129-II IF(ICHAR(FORM2(ILN)).GT.32)GOTO 8641 FORM2(ILN)=CHAR(0) 8640 CONTINUE 8641 CONTINUE C ILN IS LENGTH OFLINE NOW. ILN=MIN0(ILN,127) FORM2(ILN+1)=CHAR(0) DO 1326 IV=1,80 LFN(IV)=ICHAR(FORM2(IV)) 1326 CONTINUE 1327 CONTINUE C FILE MUST PRE EXIST HERE. IF(MODIF.EQ.ICHAR('V'))GOTO 3317 OPEN(UNIT=7,FILE=LFN,STATUS='OLD', 1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='FIXED', 2 RECL=143,FORM='FORMATTED') GOTO 3316 3317 CONTINUE OPEN(UNIT=7,FILE=LFN,STATUS='OLD', 1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='VARIABLE', 2 RECL=143,FORM='FORMATTED') 3316 CONTINUE C NOW HAVE FILES OPEN. GET USER TO GIVE US THE TITLE C ASK FOR AUXILIARY KEY. * MEANS ALL. Write(6,166) Read(5,167)AK2 IRESET=0 ICOLAC=0 IROWAC=1 C THE FOLLOWING CODE AND THE CODE AROUND 7116 C IS DESIGNED TO ALLOW SAVED SHEETS TO BE RE-ORDERED IN C A PCC FILE. THE USER PLACES WHAT DATA HE LIKES IN A C DATABASE FILE, AND THEN GIVES THE SPECIAL KEYWORD C % IN THE AUXILIARY KEY. IF HE USES %*, THEN THE C AUX KEY IS TREATED AS CONTAINING *; OTHERWISE IT IS C ASKED FOR AGAIN. C ONCE THE KEY IS OBTAINED, THE PROGRAM ASKS FOR THE C NUMBER OF ROWS AND COLUMNS IN THE REGION BEING SET UP C AND WHEN THE PCC FILE IS BEING CREATED, RECORDS READ C OFF THE DATABASE FILE ARE JUST READ SEQUENTIALLY IN THE C ORDER OF THE PRIMARRY KEY (CELL ID) AND PLACED IN THE PCC C FILE AS THOUGH THEY DENSELY FILLED THE UPPER LEFT REGION C OF A SPREADSHEET, GOING ACROSS COLUMNS FIRST, THEN DOWN C ROWS (SO THE COLUMN INDEX VARIES MOST QUICKLY). C THIS ALLOWS SPREADSHEETS IN WHICH, SAY, 20 OR 30 NUMBERS C ARE SAVED FROM ALL OVER THE PLACE TO BE REARRANGED INTO C A DIFFERENT SUMMARY SHEET THAT IS, SAY, 30 COLUMNS WIDE C WITH EVERY SHEET SAVED AS A ROW OF THE SUMMARY. THE ONLY C PREREQUISITE IS THAT THE ID BASE THAT GETS ADDED TO CELL ID C NEEDS TO BE BIG ENOUGH FOR ALL SHEETS AFTER THE FIRST SO C THAT ALL SHEET 1 ID'S ARE FIRST, ALL SHEET 2 ID'S NEXT, ALL C SHEET 3 ID'S NEXT, AND SO ON. IF(AK2(1:1).NE.'%')GOTO 7111 IF(AK2(2:2).EQ.'*')AK2(1:1)='*' C % IS PART SYNONYM FOR * IF(AK2(2:2).NE.'*')WRITE(6,166) IF(AK2(2:2).NE.'*')READ(5,167)AK2 C IF WE GET %* IT MEANS TAKE ALL AND ASK QUESTIONS C IF WE GET JUST % WE ASK FOR NEW KEY C AGAIN AND THEN ASK FOR RESETTING LIMITS C IRESET=1 WRITE(6,7112) 7112 FORMAT('$Enter No. Cols in region to build>') Read(5,7113)irstc 7113 format(I6) Write(6,7114) 7114 Format('$Enter No. Rows in region to build>') Read(5,7113)irstr c irstc and irstr are region that we pretend was saved. if(irstc.le.0)stop 'wrong colnos' if(irstr.le.0)stop 'wrong rownos' 7111 CONTINUE WRITE(6,7003) 7003 FORMAT('$TITLE:') READ(5,7004)NMSH 7004 FORMAT(80A1) WRITE(4,7004)NMSH C NOW ALL SET FOR THE DATA ITSELF. GO GET IT. IRCT=0 7200 CONTINUE C FOR SEQUENTIAL FILE, FORGET ABOUT DIFFERENCES FROM INITIAL C KEYED READ AND REMAINDER SEQUENTIAL; JUST DO THE WHOLE C THING SEQUENTIALLY. NEVERTHELESS, THE RECORD FORMAT C ALLOWS OTHER PROGRAMS TO ACCESS IT EASILY. READ(7,7219,END=7501)IDREC,ICOL,IROW,AUXKEY, 1 (FORM(IV),IV=1,109),(FORM(IV),IV=120,128), 2 LETA IRCT=1 IFT=ICHAR(LETA)-29 ITYPE=2*(IFT/8) IFT=IFT-4*ITYPE IVLD=IFT-3 7219 FORMAT(I8,2I4,A8,109A1,9A1,A1) IF((AUXKEY.NE.AK2).AND.(AK2(1:1).NE.'*'))GOTO 7200 C ALLOW * TO READ FILE REGARDLESS OF AUX KEYS C WRITE THE STUFF OUT NOW IF(IRESET.NE.0)GOTO 7116 WRITE(4,1030)ICOL,IROW,(FORM(IV),IV=1,110) WRITE(4,7031)IVLD,(FORM(IV),IV=120,128),ITYPE 7031 FORMAT(I3,',',9A1,',',I5) GOTO 7200 7116 CONTINUE ICOLAC=ICOLAC+1 IF(ICOLAC.LE.IRSTC)GOTO 7117 IROWAC=IROWAC+1 ICOLAC=1 7117 CONTINUE IF(IROWAC.GT.IRSTR)GOTO 7200 C SKIP SAVE IF REGION IS TOO FAR DOWN FOR OUR USE. WRITE(4,1030)ICOLAC,IROWAC,(FORM(IV),IV=1,110) WRITE(4,7031)IVLD,(FORM(IV),IV=120,128),ITYPE GOTO 7200 7501 CONTINUE CLOSE(UNIT=4) CLOSE(UNIT=7) STOP END SUBROUTINE WASSIG(IUNIT,FNAME) CHARACTER*1 FNAME(80) LOGICAL*1 FN(80) CHARACTER*1 CFN(80) EQUIVALENCE(CFN(1),FN(1)) DO 1 N1=1,80 1 CFN(N1)=FNAME(N1) OPEN(UNIT=IUNIT,FILE=FN,STATUS='NEW', 1 RECL=512,ACCESS='SEQUENTIAL', 1 CARRIAGECONTROL='LIST') RETURN END SUBROUTINE RASSIG(IUNIT,FNAME) CHARACTER*1 FNAME(80) LOGICAL*1 FN(80) CHARACTER*1 CFN(80) EQUIVALENCE(CFN(1),FN(1)) DO 1 N1=1,80 1 CFN(N1)=FNAME(N1) OPEN(UNIT=IUNIT,FILE=FN,STATUS='OLD', 1 RECL=512,ACCESS='SEQUENTIAL') RETURN END