Reading SUN binary data files on a VMS DEC alpha

As Simon is based at Rutherford Appleton Laboratory, I have replied
direct to him. I am confident that the DEC extension keyword
CONVERT="LITTLE_ENDIAN" works in both OSF and VMS, so his problem may
be the FTP transfer.

Jonathan Wheeler
Systems and User Support Group
Department for Computation and Information
Rutherford Appleton Laboratory

| | | | | | | | |
The problem is that the VMS system doesn't understand the typical UNIX
Fortran unformatted file format where records are preceded and followed by
a byte count. This is needed on UNIX systems since they have no concept of
record attributes.

But not to worry - I've got a program that will convert the record format
for you. Use this, and then you can read the file with FORM='UNFORMATTED',
CONVERT='BIG_ENDIAN'. The program I'll supply here converts to the
OpenVMS Fortran 'SEGMENTED' recordtype (not a true VMS recordtype, but the
one you get by default with Fortran unformatted files.) If you want one
that converts to 'VARIABLE', I have that too - just send me mail.

My apologies for the crude user interface for the program - I did this as
a demo of the conversion technique and didn't spiff it up. Also, I haven't
tested this on a file with big-endian record lengths, though the program I
adapted it from (which accepts little-endian record lengths) works fine.
Let me know if it doesn't (or does!) work or if you have any questions
about it.

PROGRAM BIGEND_TO_SEGMENTED

C+
C
C ABSTRACT:
C
C Converts big-endian UNIXunformatted files to OpenVMS Fortran 'SEGMENTED'
C
C FUNCTIONAL DESCRIPTION:
C
C Input file is specified by the logical name FOR001, FOR001.DAT is used
C if not defined. This must be a file written a big-endian UNIX system
C as an UNFORMATTED file with the default recordtype that has the data
C preceded and followed by a 32-bit record length (in bytes). The file
C should be copied to the OpenVMS system using FTP BINARY GET or DECnet
C COPY. The OpenVMS record format of this file may be FIX or STM_LF -
C it should not be VAR.
C
C This program does not do any conversion of the actual data - it just
C converts the record format. Use CONVERT='BIG_ENDIAN' in an OPEN
C statement to do data conversion.
C
C Output file is specified by the logical name FOR002, FOR002.DAT is used
C if not defined. The input file is converted to an OpenVMS Fortran
C 'SEGMENTED' unformatted file.
C
C AUTHOR(S):
C
C Steven B. Lionel
C
C CREATION DATE:
C
C 30-Sep-1996 (from little-endian version of 2-May-1996)
C
C DESIGN:
C
C The program assumes the input file is of the correct record format.
C A command line interface might be a nice extension.
C It's possible that a very large input file might require process
C quotas to be raised. An implementation using block I/O is feasible
C but much more complicated
C
C
C MODIFICATION HISTORY:
C
C Date | Name | Description
C ++­---
C 30-SEP-1996 | SBL | V1-1 Original
C ++­---
C [change_entry]
C-
IMPLICIT NONE

INCLUDE '($SYSSRVNAM)'
INCLUDE '($SECDEF)'

INTEGER CHANNEL, BYTES_IN_BUFFER
COMMON CHANNEL, BYTES_IN_BUFFER
EXTERNAL UFO_OPEN
INTEGER STATUS
INTEGER*2 FLAGS
INTEGER*4 UNIX_RECLEN,UNIX_RECLEN_END
PARAMETER FIRST_SEGMENT = 1
PARAMETER LAST_SEGMENT = 2
PARAMETER MAX_SEGMENT_SIZE = 1024
BYTE UNIX_REC(MAX_SEGMENT_SIZE), LAST_BYTE
POINTER (UNIX_REC_P, UNIX_REC)
POINTER (UNIX_RECLEN_P, UNIX_RECLEN)
POINTER (UNIX_RECLEN_P, LAST_BYTE)
POINTER (UNIX_RECLEN_END_P, UNIX_RECLEN_END)
INTEGER RECLEN_TO_GO
INTEGER*4 I, UFO_OPEN
INTEGER*4 RETADR(2)
INTEGER*4 INADR(2) /0,0/

! Open input file and get channel/size (in COMMON)
!
OPEN (UNIT=1,STATUS='OLD',READONLY,
1 USEROPEN=UFO_OPEN,FORM='UNFORMATTED')
CLOSE (UNIT=1)

! Map input file as private section
!
STATUS = SYS$CRMPSC (
1 INADR,
1 RETADR,
1 %VAL(0), ! acmode
1 %VAL(SEC$M_EXPREG),
1 %VAL(0), ! gsdnam
1 %VAL(0), ! ident
1 %VAL(0), ! relpag
1 %VAL(CHANNEL), ! chan
1 %VAL(0), ! pagcnt
1 %VAL(0), ! vbn
1 %VAL(0), ! prot
1 %VAL(4)) ! pfc
IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))

! Open output file - this is going to be a 'SEGMENTED' file but we'll
! handle the segmentation ourselves
!
OPEN (UNIT=2,STATUS='NEW',RECORDTYPE='VARIABLE',
1 FORM='UNFORMATTED',RECL=2048)

! Set up the buffer pointers
!
UNIX_RECLEN_P = RETADR(1)
UNIX_REC_P = UNIX_RECLEN_P + 4

! Copy the file
!
DO WHILE (BYTES_IN_BUFFER .GE. 8)

! Consistency checking
CALL SWAP_RECLEN(UNIX_RECLEN)
IF ((UNIX_RECLEN + 8) .GT. BYTES_IN_BUFFER) GOTO 810
UNIX_RECLEN_END_P = UNIX_RECLEN_P + UNIX_RECLEN + 4
CALL SWAP_RECLEN(UNIX_RECLEN_END)
IF (UNIX_RECLEN_END .NE. UNIX_RECLEN) GOTO 820
FLAGS = FIRST_SEGMENT
RECLEN_TO_GO = UNIX_RECLEN
! Write intermediate segments, if any
DO WHILE (RECLEN_TO_GO .GT. MAX_SEGMENT_SIZE)
WRITE (2) FLAGS,UNIX_REC
FLAGS = 0
RECLEN_TO_GO = RECLEN_TO_GO - MAX_SEGMENT_SIZE
UNIX_REC_P = UNIX_REC_P + MAX_SEGMENT_SIZE
END DO
! Write last record
!
FLAGS = FLAGS .OR. LAST_SEGMENT
WRITE (2) FLAGS,(UNIX_REC(I),I=1,RECLEN_TO_GO)
BYTES_IN_BUFFER = BYTES_IN_BUFFER - (UNIX_RECLEN + 8)
UNIX_RECLEN_P = UNIX_REC_P + RECLEN_TO_GO + 4
UNIX_REC_P = UNIX_RECLEN_P + 4
END DO
! Should be done - do some last checks
!
IF (BYTES_IN_BUFFER .NE. 0) THEN
IF ((BYTES_IN_BUFFER .NE. 1) .OR.
1 (LAST_BYTE .NE. 10)) GOTO 830
END IF
GOTO 900

810 WRITE (*,*) 'Error - too few bytes remaining in input file'
GOTO 900
820 WRITE (*,*) 'Error - start and end record lengths do not match'
GOTO 900
830 WRITE (*,*) 'Error - data remaining at end of file'
900 CONTINUE
! Close up
CLOSE (UNIT=2)
END

! USEROPEN routine to open file for memory mapping
INTEGER*4 FUNCTION UFO_OPEN (FAB)
IMPLICIT NONE

INCLUDE '($SYSSRVNAM)'
INCLUDE '($FABDEF)'
INCLUDE '($XABDEF)'
INCLUDE '($XABFHCDEF)'
RECORD /FABDEF/ FAB
INTEGER*4 CHANNEL, BYTES_IN_BUFFER
COMMON CHANNEL,BYTES_IN_BUFFER
STRUCTURE /XAB_STR/
UNION
MAP
RECORD /XABDEF/ XAB_HDR
END MAP
MAP
RECORD /XABFHCDEF/ XAB_FHC
END MAP
END UNION
END STRUCTURE
RECORD /XAB_STR/ OUR_XAB
POINTER (XAB_P, OUR_XAB)

! Set up for user file open
!
FAB.FAB$L_FOP = IBSET(FAB.FAB$L_FOP,FAB$V_UFO)

! Open the file
!
UFO_OPEN = SYS$OPEN (FAB)
IF (.NOT. UFO_OPEN) RETURN

CHANNEL = FAB.FAB$L_STV

! Find the XABFHC and calculate the number of bytes in the file
!
XAB_P = FAB.FAB$L_XAB
DO WHILE (OUR_XAB.XAB_HDR.XAB$B_COD .NE. XAB$C_FHC)
XAB_P = OUR_XAB.XAB_HDR.XAB$L_NXT
IF (XAB_P .EQ. 0) THEN
WRITE (*,*) 'Error - no XABFHC!'
STOP
END IF
END DO
BYTES_IN_BUFFER = ((OUR_XAB.XAB_FHC.XAB$L_EBK * 512) +
1 OUR_XAB.XAB_FHC.XAB$W_FFB) - 512
RETURN
END

! Routine to "switch ends" on a 4-byte integer value
SUBROUTINE SWAP_RECLEN(VALUE)
INTEGER*4 VALUE
VALUE = (ISHFT(VALUE, 24).AND.X'FF000000') .OR.
1 (ISHFT(VALUE, 8).AND.X'00FF0000') .OR.
2 (ISHFT(VALUE, -8).AND.X'0000FF00') .OR.
3 (ISHFT(VALUE,-24).AND.X'000000FF')
RETURN
END

--

Steve Lionel mailto:
Fortran Development #
Digital Equipment Corporation
110 Spit Brook Road, ZKO2-3/N30
Nashua, NH 03062-2698 "Free advice is worth every cent"

For information on Digital Fortran, see #