PROGRAM CHR2IS C 3/06: Increased MXBBK,R from 20,1000 to 24,5000 for 292 line MLH header C Convert CEDAR DB character format to binary format; usage: C C chr2is.exe [-xX] rd1 [rd2 ...] wr.cbf C C where C chr2is.exe = the executable made from this source C -x = option to expand tabs in text fields or warn when there is insufficient room C -X = option to expand tabs in text fields or die when there is insufficient room C rdi = CEDAR DB character (or binary) format file C wr.cbf = CEDAR DB binary format file name (to be written) C C Any tabs remain in text fields unless overridden by a command option. C C Piping (read from stdin and write to stdout) is precluded because C the beginning of each input file is read twice and the output file C is written using direct access writes to avoid implicit write of C record terminators (e.g. newline) but piping is simulated by the C driver script. C C SEE ALSO: C chr2is = driver script for this executable which simulates piping (~bozo/is/bin/chr2is) C is2chr = reverse of chr2is (~bozo/is/bin/is2chr) C C INSTALLATION: C (1) Set LMWD in the main program below. C set IRLF C set MODCNV C set MXNMSG C (2) VBKOPN: Change definition of exlusive or; see Cpc. C (4) CBFOPN: Comments explain changes (find "Cbyte") for byte C reversed machines (PC, DEC, Linux) and for direct access length C units (near "Crecl") for DEC and old SGI. Byte reversed machines C (PC and DEC) also need to activate SWAP4. C (5) Include the appropriate version of GBYTES. C Cray: linked via library ncarm C Sun: gbyts.c or gathred ~bozo/is/src/gbytes.fortran C (6) Compile using make cdbrdf or activate gathr directives at end and C C gathr chr2is.f >! go.f; f77 -O -o ../bin/chr2is.exe go.f; rm go.f C C HISTORY: C 2002 May: asc2is revised for piping; i.e. w/o a job control file and C read from stdin, diagnostics to stderr; no file skipping C allowed in this version and fewer diagnostics. C 2002 Jul: Bump max binary write rec size to 10000 16-bit vals C 2004 Sep: Install new version of wrchr which optionally uses detab C and remove parcods checking. It took two tries to get this C change right (initially only 1 read file was allowed). C Miscellaneous declarations C MSGUN = Fortran unit no. for diagnostic output C MXLS = Max length of string (no. characters) PARAMETER (MSGUN=0, MXLS=200) INTEGER ACCESS CHARACTER TEXT*(MXLS) C Declarations for vbkopn (vbkrd, vbkcls, vbkwr) and rdchr C IOCKS = Checksum validation flag: 0 (off) or 1 (on) C IUNR = Fortran unit for read C IUNW = Fortran unit for write (should not be stdout, 6) C LMWD = Number of bits in a computer word (size of type INTEGER) C LWK = Length of work array needed by VBKOPN C LWKR = Extra large work array C MXBBK = Maximum no. bytes in a block C MXBBKR = Extra large MXBBK C MXLBK = Maximum packed block size (number of words length LMWD) C MXLBKR = Extra large MXLBK C MXNVAL = Maximum no. of values in a record or unpacked record size C MXNVLR = Extra large MXNVAL C MXLPR = Maximum packed record size (number of words length LMWD) C MXLPRR = Extra large MXLPR C The 'extra large' versions are reading and the regular version writing; C the read larger buffer avoids diagnostics which warn when exactly at C the design maximum (which could be a result of limiting an exceedence). PARAMETER (IOCKS = 1, + IUNR = 10, + IUNW = 11, + LMWD = 32, + MXBBK = 24000, + MXBBKR = 25000, + MXLBK = MXBBK *8/LMWD, + MXLBKR = MXBBKR*8/LMWD, + LWK = 13 + MXLBK + 20+2*512*64/LMWD, + LWKR = 13 + MXLBKR + 20+2*512*64/LMWD, + MXNVAL = MXLBK *LMWD/16 - 2, + MXNVLR = MXLBKR*LMWD/16 - 2, + MXLPR = (MXNVAL*16 + LMWD-1)/LMWD, + MXLPRR = (MXNVLR*16 + LMWD-1)/LMWD) DIMENSION LRP(MXLPRR), IWKR(LWKR), IWKW(LWK), + LRU(MXNVLR) CHARACTER RDNM*(MXLS), WRNM*(MXLS) C Get command arguments: options, first read file and write file IOPX = 0 ! expand tabs options: 0 (don't), 1 (warn when impossible) or 2 (die) NARG = IARGC() IF (NARG .LT. 2) GO TO 9000 CALL GETARG (1, TEXT) IF (TEXT(1:1).EQ.'-' .AND. (TEXT(2:2).EQ.'x' .OR. TEXT(2:2).EQ.'X' +)) THEN IF (TEXT(2:2) .EQ. 'x') THEN IOPX = 1 ELSE IF (TEXT(2:2) .EQ. 'X') THEN IOPX = 2 ELSE GO TO 9010 ENDIF IF (NARG .LT. 3) GO TO 9000 IRAB = 2 ! first read file argument index ELSE IRAB = 1 ENDIF CALL GETARG (NARG,WRNM) CALL VBKOPN (IUNW,WRNM,MSGUN,LMWD,2,IWKW,LWK,MXLBK,IOCKS) NRW = 0 ! no. records written DO 200 IRDA=IRAB,NARG-1 CALL GETARG (IRDA, RDNM) LRDN = LENNB(RDNM) IF (ACCESS (RDNM,' r') .NE. 0) THEN WRITE (MSGUN,9100) RDNM(:LRDN) GO TO 200 ENDIF C Determine the file format type OPEN (IUNR,FILE=RDNM) CALL GFTYP (IUNR,ITYP) IF (ITYP .EQ. 1) THEN ! CEDAR DB binary CLOSE (IUNR) CALL VBKOPN (IUNR,RDNM,MSGUN,LMWD,1,IWKR,LWKR,MXLBKR,IOCKS) ELSE IF (ITYP .EQ. 2) THEN ! CEDAR DB character REWIND (IUNR) MODCNV = 0 ! ASCII character set w/o translation when writing (default) IF (IOPX .EQ. 1) MODCNV = 2 ! ASCII character set and tab expansion with non-fatal message when impossible IF (IOPX .EQ. 2) MODCNV = 3 ! ASCII character set and tab expansion with fatal message when impossible MXNMSG = 10 ! warning diagnostics limit CALL RDCHRI (LMWD,MODCNV,MSGUN,MXNMSG,MXNVLR) ELSE WRITE (MSGUN,9110) RDNM(:LRDN) GO TO 200 ENDIF C Read and write a record loop NRR = 0 ! no. recs read from current file NSEOF = 0 100 IF (ITYP .EQ. 1) THEN CALL VBKRD (IUNR,IWKR,LRP,LLR,ISTR) IF (ISTR .EQ. 0) NSEOF = 0 IF (ISTR .EQ. 2) GO TO 9120 IF (ISTR .EQ. 1) THEN NSEOF = NSEOF + 1 IF (NSEOF .GT. 1) THEN ISTR = 3 ELSE CALL VBKEOF (IUNW,IWKW,ISTE) IF (ISTE .EQ. 0) GO TO 9130 GO TO 100 ENDIF ENDIF ELSE CALL RDCHR (IUNR,LRU,ISTR) IF (ISTR .EQ. 0) THEN LLR = LRU(1) CALL PAKLR (MSGUN,LRU,LRP) ELSE ISTR = 3 ENDIF ENDIF IF (ISTR .EQ. 0) THEN NRR = NRR + 1 NRW = NRW + 1 CALL VBKWR (IUNW,IWKW,LRP,LLR,ISTW) GO TO 100 ENDIF C At end of data on current read file IF (ITYP .EQ. 1) THEN CALL VBKCLS (IUNR,IWKR) WRITE (MSGUN,9200) RDNM(:LRDN) ELSE CLOSE (IUNR) ENDIF WRITE (MSGUN,9210) NRR,RDNM(:LRDN) 200 CONTINUE CALL VBKCLS (IUNW,IWKW) WRITE (MSGUN,9220) IWKW(11),IWKW(12),NRW CALL EXIT (0) C Error trap diagnostics 9000 CALL EREXIT ('CHR2IS requires at least two arguments; usage: chr2i +s.exe [-xX] rd1 [rd2 ...] wr.cbf') 9010 CALL EREXIT ('CHR2IS bad options argument; usage: chr2is.exe [-xX] + rd1 [rd2 ...] wr.cbf') 9100 FORMAT ('CHR2IS skipping file "',A,'"; not readable') 9110 FORMAT ('CHR2IS skipping file "',A,'"; unrecognized file format') 9120 CALL EREXIT ('CHR2IS: vbkrd read status 2 on file "' // RDNM(:LRDN +) // '"') 9130 CALL EREXIT ('CHR2IS: trouble with vbkeof on "' // WRNM(:LENNB(WRN +M)) // '"') 9200 FORMAT ('CHR2IS: "',A,'" already CEDAR DB binary format') 9210 FORMAT ('CHR2IS read ',I8,' recs from "',A,'"') 9220 FORMAT ('CHR2IS wrote',3I8,' (files,blks,recs)') END C gathr directives (a way to include files): C~ ~bozo/is/src/cbfopn.f C~ ~bozo/is/src/ch2a16.f C~ ~bozo/is/src/erexit.f C~ ~bozo/is/src/gbytes.fortran C~ ~bozo/is/src/gftyp.f C~ ~bozo/is/src/lennb.f C~ ~bozo/is/src/paklr.f C~ ~bozo/is/src/rdchr.f C~ ~bozo/is/src/swap4.f C~ ~bozo/is/src/vbkopn.f