C*I4BITS -- Extract a bit field from a four byte integer. C+ INTEGER FUNCTION I4BITS (NUMBER, BITS, OFFSET) INTEGER BITS, NUMBER, OFFSET C C This function will extract a specified bit field from the given four C byte integer. C C Returns: C I4BITS : The (positive) value contained in the specified bit C field. A negative value is returned if the input C parameters are incorrect. C Arguments: C NUMBER (input) : The integer containing the bit field of interest. C BITS (input) : The number of bits in the field (1 - 31). C OFFSET (input) : The offset (0 relative) from the least significant C bit (0 - 31). C C This function uses the following nonstandard intrinsic functions C described in the software metadata files: C C IAND (intger, mask) C ISHFT (integer, left-shift) C C NOTE: In order for the result of this routine to be meaningful, the C following condition must hold: C C (BITS + OFFSET) < 33 C-- C Version 1.0 13-Feb-1990 Scott C. Allendorf C - Original version. C Version 1.1 18-May-1990 Scott C. Allendorf C - Clean up error checking. C----------------------------------------------------------------------- C C Assume failure. C I4BITS = -1 C C Check the input values for validity. C IF ((BITS + OFFSET) .GT. 32) RETURN IF ((BITS .LT. 1) .OR. (BITS .GT. 31)) RETURN IF ((OFFSET .LT. 0) .OR. (OFFSET .GT. 31)) RETURN C C Extract the desired bit field. If BITS is 31, we must avoid an C arithmetic underflow while calculating the mask. C IF (BITS .EQ. 31) THEN I4BITS = IAND (ISHFT (NUMBER, -OFFSET), 2147483647) ELSE I4BITS = IAND (ISHFT (NUMBER, -OFFSET), ISHFT (1, BITS) - 1) END IF C C Return to the calling routine C RETURN END C*I4FLIP -- Flip the bytes of a four byte integer. C+ INTEGER FUNCTION I4FLIP (RECORD) INTEGER RECORD(442) C C This function will look at the passed data record and see if the byte C order needs to be changed on this machine. If it does, it will swap C the order of the bytes and check the record again to see if the byte C reordering was successful. C C Returns: C I4FLIP : A status return value. A value of 1 indicates C successful completion, a value of 0 indicates C an error. C Arguments: C RECORD (in/out) : DE PWI data record read from the optical disk C C This function uses the following nonstandard intrinsic functions C described in the software metadata files: C C IAND (intger, mask) C IOR (integer1, integer2) C ISHFT (integer, left-shift) C-- C Version 1.0 25-Jan-1990 Scott C. Allendorf C - Original version. C Version 1.1 18-May-1990 Scott C. Allendorf C - Avoid redundant checks. C----------------------------------------------------------------------- INTEGER I, TEMP C C Assume a successful completion. C I4FLIP = 1 C C Use the magic cookie in the first word to determine if a byte swap is C necessary. C IF ((RECORD(1) .NE. 99) .AND. (RECORD(1) .NE. 25443)) THEN C C Loop through the entire record, interchanging the order of the bytes C in a word. C DO 10 I = 1, 442 C C Save the word into temporary storage. C TEMP = RECORD(I) C C Rewrite the word with the swapped version. C RECORD(I) = IAND (ISHFT (TEMP, -24), 255) RECORD(I) = IOR (RECORD(I), IAND (ISHFT (TEMP, -8), 65280)) RECORD(I) = IOR (RECORD(I), ISHFT (IAND (TEMP, 65280), 8)) RECORD(I) = IOR (RECORD(I), ISHFT (IAND (TEMP, 255), 24)) 10 CONTINUE C C Check to see if changing the byte order works on this machine by C looking at the magic cookie. If it is still scrambled, return an C error condition. C IF ((RECORD(1) .NE. 99) .AND. (RECORD(1) .NE. 25443)) + I4FLIP = 0 END IF C C Return to the calling routine. C RETURN END C*OPNDAT -- Open the input data file. C+ INTEGER FUNCTION OPNDAT (FILNAM) CHARACTER FILNAM*(*) C C This function will open a specified DE PWI data file and return the C FORTRAN unit number to the calling procedure. C C Returns: C OPNDAT : The FORTRAN unit number of the opened file. A C negative value is returned if the open fails. C Arguments: C FILNAM (input) : The name of the file to be opened. C C This function uses the following nonstandard keywords in the OPEN C statement (necessary for compilation under VMS FORTRAN): C C SHARED C READONLY C RECORDTYPE = 'FIXED' C C In addition, it may also be necessary to change the unit number used C in this function if it conflicts with a unit number predefined by your C FORTRAN compiler. C-- C Version 1.0 11-Jun-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- C C Define the unit number to be used for input. C OPNDAT = 11 C C Open the data file and exit if successful. C OPEN (UNIT = OPNDAT, FILE = FILNAM, STATUS = 'OLD', + ACCESS = 'DIRECT', FORM = 'UNFORMATTED', READONLY, + RECL=1768, ERR = 10) GOTO 20 C C Indicate that the file open failed. C 10 OPNDAT = -1 C C Return to the calling program. C 20 RETURN END C*OPNUSE -- Open the user output file. C+ INTEGER FUNCTION OPNUSE (FILNAM) CHARACTER FILNAM*(*) C C This function will open a user-specified output file and return the C FORTRAN unit number to the calling procedure. C C Returns: C OPNUSE : The FORTRAN unit number of the opened file. A C negative value is returned if the open fails. C Arguments: C FILNAM (input) : The name of the file to be opened. C C Note that it may be necessary to change the unit number used in this C function if it conflicts with a unit number predefined by your FORTRAN C compiler. C-- C Version 1.0 11-Jun-1990 Scott C. Allendorf C - Original version. C----------------------------------------------------------------------- C C Define the unit number to be used for output. C OPNUSE = 10 C C Open the output file and exit if successful. C OPEN (UNIT = OPNUSE, FILE = FILNAM, STATUS = 'NEW', ERR = 10) GOTO 20 C C Indicate that the file open failed. C 10 OPNUSE = -1 C C Return to the calling program. C 20 RETURN END