C+ C NAME: C HOSInquire C PURPOSE: C Determine record length for a Helios file C CATEGORY: C Kludge C CALLING SEQUENCE: subroutine HOSInquire(cFile,iRecl) C INPUTS: C cFile character*(*) file name C OUTPUTS: C iRecl integer record length in 4-byte words (usually 37 or 6) C = 0 if not succesful C INCLUDE: include 'dirspec.h' C CALLS: C bGetLun, iFreeLun, CvSwap, Say C RESTRICTIONS: C It is assumed that the record length is an integer number of C longwords (4-byte words). C PROCEDURE: C > This kludge is necessary for DOS, Unix and Linux. Helios files are opened as C direct access files. It is necessary to explicitly use the recl C keyword to provide the record length in bytes (in VMS this is not necessary). C > The resulting record length can be used directly in an open statement: C open (iU, file=cFile, status='OLD',access='DIRECT', recl=iRecl) C This should work both under DOS, VMS and Linux. Unix has not been tried yet. C > First an inquire by name is tried. C VMS returns the record length in bytes; this is converted to longword. C DOS returns a zero-record length. C The record length is determined from the file content by C looking for photometer/color combinations. C MODIFICATION HISTORY: C JUN-1998, Paul Hick (UCSD/CASS) C JAN-2003, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C Photometer values are now tested for values 1,2,3. If the first photometer C value read from file is not one of these, then bytes are swapped and the C same test is done again. If swapping bytes changes the photometer value to C 1,2 or 3 then byte swapping is applied to all integers read from file. C This should allow the routine to work when Helios files created on VMS, Windows C or Linux are opened on a Unix machine and v.v. (iHOSRead uses the same trick) C- character cFile*(*) integer iRecl integer PhotCol(9) /65537,131073,196609, !'10001'X,'20001'X,'30001'X, & 65538,131074,196610, !'10002'X,'20002'X,'30002'X, & 65539,131075,196611/ !'10003'X,'20003'X,'30003'X integer Normal /6553600/ !'640000'X, Color offset for unnormalized data integer iCntMax / 10/ ! # confirmations of record length logical bGetLun logical bBlock character cSay*10 /'HOSInquire'/ integer ib(128) integer i4 integer*2 i2(2) equivalence (i4,i2) logical bSwapBytes logical bWrongArch bWrongArch(i) = i .lt. 1 .or. i .gt. 3 !------- ! VMS returns the record length in bytes. Don't know what Unix will do. ! DOS will return iRecl=0. iRecl = 0 inquire (file=cFile, recl=iRecl) iRecl = iRecl/4 ! iRecl should be non-zero recl in longwords bBlock = iRecl .eq. 128 if (cOpSys .ne. OS__VMS .or. bBlock) then iRecl = 0 !------- ! From here on it's DOS, Unix or Linux ! or (VMS only) it is a block file (with record length of 512 bytes) if (.not. bGetLun(iU,cFile)) call Say(cSay,'E','bGetLun', 'unable to determine unit number') if (bBlock) then open (iU, file=cFile, status='OLD',access='SEQUENTIAL',form='UNFORMATTED') else open (iU, file=cFile, status='OLD',access='DIRECT', recl=4) end if iR0 = 2 if (bBlock) then read (iU) ib i4 = ib(iR0) else read (iU,rec=iR0) i4 ! Read 2nd int*4 in i4 end if !------- ! The first 2 bytes in i4 (=1st element of i2) should be a photometer with value of ! 1,2 or 3). If it's not then maybe the file was written on a different architecture. ! Try swapping bytes and test the photometer value again. ! If the value is not 1,2 or 3 after swapping then stop. If it is then keep swapping ! bytes (bSwapBytes=.TRUE.). iP = i2(1) bSwapBytes = bWrongArch(iP) if (bSwapBytes) then ! Bad photometer value call CvSwap(1,2,2,i2) ! Swap bytes in phot/color; stop if still bad iP = i2(1) if (bWrongArch(iP)) call Say(cSay,'E','Invalid','photometer; probably not a Helios file') end if iP = 1 ! 2nd int*4 must be phot/col combi do while (iP .le. 9 .and. (i4 .ne. PhotCol(iP) .and. i4 .ne. Normal+PhotCol(iP))) iP = iP+1 end do if (iP .eq. 10) then ! Not a phot/col combination iU = iFreeLun(iU) call Say(cSay,'W',cFile,'probably not a Helios file') return end if if (i4 .eq. PhotCol(iP)) Normal = 0 ! Normalized data iCnt = 0 iErr = 0 iR = iR0 do while (iErr .eq. 0 .and. iCnt .le. iCntMax) iR = iR+1 if (bBlock) then iErr = 0 i128 = mod(iR-1,128)+1 if (i128 .eq. 1) read (iU, iostat=iErr) ib i4 = ib(i128) else read (iU,rec=iR, iostat=iErr) i4 end if if (bSwapBytes) call CvSwap(1,2,2,i2) if (iErr .eq. 0) then iP = 1 ! Check for photom/color combi do while (iP .le. 9 .and. i4 .ne. Normal+PhotCol(iP)) iP = iP+1 end do if (iP .le. 9) then ! Record length in 4-byte words if (iRecl .eq. 0) iRecl = iR-iR0 if (iR-iR0 .ne. iRecl) then iU = iFreeLun(iU) call Say(cSay,'E','NoRecl','unable to determine record length') end if iCnt = iCnt+1 iR0 = iR end if end if end do iU = iFreeLun(iU) end if if (iRecl .lt. 6 .or. iRecl .gt. 37) call Say(cSay,'E',cFile,'has invalid record length') return end