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 Copyright (c) Glenn C. Everhart 1985 c Noncommercial use permitted, but for-profit c distribution prohibited. c CHARACTER*1 FORM,FVLD,CMDLIN(132) 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)) integer*2 nrows,ncols character*9 DFMT 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='TT:',STATUS='OLD') OPEN(UNIT=6,FILE='TT:',STATUS='NEW') WRITE(6,101) 101 FORMAT('$Read DIF file to PCC or Write DIF file from' 1 ,' PCC [R/W]:') READ(5,7953)FORM2 INDIF=1 IF(FORM2(1).EQ.'R'.or.form2(1).eq.'r')INDIF=0 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) C LUN 3 IS INPUT, LUN 4 IS OUTPUT C NOW GET PCC FILENAME WRITE(6,103) 103 FORMAT('$ Enter PCC filename>') READ(III,7953,END=510,ERR=510)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(INDIF.eq.0)CALL WASSIG(4,FORM2) 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 FORCE UPPERCASE V REPLY SINCE THAT'S WHAT WE TEST. C 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) 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' 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 BOT RECORD IF WE DIDN'T JUST FINISH THE LAST ROW... 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 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 SO C WRITE 'NA' RECORDS TO DO SO IF IT'S OK 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 THE COLUMN 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 GET RID OF " CHARACTERS... 3211 CONTINUE N1=INDEX(CFORM2,'"') IF(N1.GT.0)FORM2(N1)=' ' IF(N1.GT.0.AND.N1.LT.127)GOTO 3211 C EMIT TITLE FROM "TABLE" RECORD, SKIPPING " CHARACTERS. 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 REMOVE ALL REMAINING " CHARACTERS TOO. 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) GOTO 1010 9900 CONTINUE CLOSE(UNIT=4) CLOSE(UNIT=3) 510 CONTINUE 9990 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