C+
C NAME:
C iHOSRead
C PURPOSE:
C Read record from Helios data file
C CATEGORY:
C I/O
C CALLING SEQUENCE:
C I = iHOSRead(iD,iU,iRecl,iR,T,P,C,F,R,L,N,Z)
C INPUTS:
C iD integer iD=-1 : read record iR
C iD>= 0: read next record (starting at iR+1) meeting input
C restrictions on photometer, color and filter
C Counting digits from the right (least-significant first)
C 1st digit = 0 : include all photometers
C = 1 : only 16 deg photometer
C = 2 : only 31 deg photometer
C = 3 : only 90 deg photometer
C = 4 : include 16 and 31 deg photometers
C = 5 : include 31 and 90 deg photometers
C = 6 : include 16 and 90 deg photometers
C 2nd digit = 0 : include all color filters
C = 1 : only color UV
C = 2 : only color Blue
C = 3 : only color Visual
C = 4 : include UV and Blue
C = 5 : include Blue and Visual
C = 6 : include UV and Visual
C 3rd digit = 0 : include all polarization filters
C = 1 : only color filter 1
C = 2 : only color filter 2
C = 3 : only color filter 3
C = 4 : only color filter 4 (clear filter)
C = 5 : only color 'filter' 5 (pB)
C = 6 : include filters 4 and 5 (clear and pB)
C 4th digit = 1 : negate photometer/color/filter selection
C iU integer logical unit number for data file
C iRecl integer record length in (4-byte) long words
C iR integer record number to be read
C N integer # sectors to be returned in Z
C MUST BE EVEN. UNEVEN VALUES WILL BE ROUNDED DOWN TO AN EVEN VALUE
C Sectors 1..N/2 will be put in Z(1)..Z(N/2)
C Sectors 33-N/2..32 will be put in Z(N/2+1)..Z(N)
C OUTPUTS:
C iR integer (negative iD only)
C On read error (or EOF), iR will be the record number of the last
C successfully read record. For iD=-1 this would be the same as the input
C value.
C If read was OK, then iR will be the number of the record read
C successfully. For iD=-1 this will be iR+1 (i.e. record counter is
C incremented by 1).
C T real time (doy)
C P integer photometer (1/2/3)
C C integer color (1/2/3)
C F integer filter (1..5) (if P=3 then F=4)(4=Clear,5=pB)
C R real heliocentric distance (AU)
C L real topocentric ecliptic longitude (deg) of the Sun
C Z(N) real intensities
C IP=3: Z(1) = intensity, Z(2) = pB
C FUNCTIONS/SUBROUTINES:
C Signal, ArrR4NARN, cInt2Str, CvR4
C EXTERNAL:
C INCLUDE:
C COMMON BLOCKS:
C SIDE EFFECTS:
C RESTRICTIONS:
C PROCEDURE:
C MODIFICATION HISTORY:
C SEP-1998, Paul Hick (UCSD; pphick@ucsd.edu)
C-
function iHOSRead(iD,iU,iRecl,iR,T,PP,CC,FF,R,L,NN,ZZ)
integer PP,CC,FF
integer*2 P, C, F, B ! Used to read/write file
parameter (nS=32)
real ZZ(*), Z(nS), L
character cStr*100, cInt2Str*14
real BadHOS /-1E7/
integer*2 POld /3/
save POld
integer k2(0:6) /4*0,3,1,2/
logical bAlign,
& bFirst /.TRUE./
character cAlign
save bFirst, bAlign
logical bRead, bWrongType, bNegate, bNative
bNative(T,R,L) = 0.25 .lt. R .and. R .lt. 1.05
if (bFirst) then
bAlign = iGetSymbol('HOS_ALIGN',cAlign) .ne. 0
if (bAlign) bAlign = cAlign .eq. '1'
bFirst = .FALSE.
end if
N = NN/2*2 ! Round down to even number
Bad = BadR4()
if (iRecl .eq. 6) POld = 3 ! Force reading of phot 3 record (iS=0)
iS = (iRecl-4.5)/2 ! Half # Sectors in phot 1 or 2 record
kP = max(-1,iD)
! Auto-Increment record counter
if (kP .ge. 0) then ! No 16/31 deg records on 90 deg file
bNegate = kP .gt. 1000
kF = mod(kP,1000)/100 ! Filter selection
kC = mod(kP, 100)/ 10 ! Color selection
kP = mod(kP, 10)/ 1 ! Photometer selection
if (kP .eq. 3) kF = 6 ! Clear+pB
if ((kP .eq. 1 .or. kP .eq. 2 .or. kP .eq. 4) .and. iRecl .eq. 6) then
iHOSRead = -1 ! Simulate read error (note that iR is not incremented)
return
end if
! Make sure to read proper record type
C if (1 .le. kP .and. kP .le. 3) POld = kP
C if (kP .eq. 4) POld = 1
iR = iR+1 ! Increment counter
end if
bRead = .TRUE.
do while (bRead)
if (POld .eq. 3) then
read (iU,rec=iR,iostat=iHOSRead) T,P,C, R,L,(Z(I),I=1,2)
else if (bAlign) then
read (iU,rec=iR,iostat=iHOSRead) T,P,C,F,B,R,L,(Z(I),I=1,iS),(Z(I),I=nS+1-iS,nS)
else
read (iU,rec=iR,iostat=iHOSRead) T,P,C,F, R,L,(Z(I),I=1,iS),(Z(I),I=nS+1-iS,nS)
end if
if (iHOSRead .ne. 0) then ! Read error
if (iR .eq. 1) then
cStr = 'error '//cInt2Str(iHOSRead)//' on record '//cInt2Str(iR)//' of'
I = iwhitespace(cStr)
inquire(iU,name=cStr(I+2:))
if (itrim(cStr(I+2:)) .gt. 0) call Signal('iHOSRead','W','Read',cStr)
end if
! If error is EOF then IR becomes # records on file
if (kP .ge. 0) iR = iR-1 ! Decrement record counter
return
end if
bWrongType = (POld .eq. 3 .and. P .ne. 3) .or. (POld .ne. 3 .and. P .eq. 3)
if (kP .eq. -1) then ! Read single record and return
bRead = bWrongType
if (bRead) POld = P ! Read same record if wrong type
else ! Use selection criteria
C-------
C Check whether the record just read passes the selection criteria on filter, color and photometer
C If it doesn't, set bRead = .TRUE.
C Note that if the record was read with the wrong type the filter F may not be available. In that
C case it is possible to positively reject the record if it doesn't fit the color and photometer
C selection, but it is not possible to determine whether it completely fits the selection.
bRead = (1 .le. kP .and. kP .le. 3 .and. kP .ne. P) .or.
& (4 .le. kP .and. kP .le. 6 .and. k2(kP) .eq. P)
if (.not. bRead) bRead = ! Unnormalized data have C=101,102,103
& (1 .le. kC .and. kC .le. 3 .and. kC .ne. mod(C,100)) .or.
& (4 .le. kC .and. kC .le. 6 .and. k2(kC) .eq. mod(C,100))
! F is not available if wrong record type was read
if (.not. bRead .and. .not. bWrongType) bRead =
& (P .ne. 3 .and. 1 .le. kF .and. kF .le. 5 .and. kF .ne. F) .or.
& (P .ne. 3 .and. kF .eq. 6 .and. F .ne. 4 .and. F .ne. 5) .or.
& (P .eq. 3 .and. 1 .le. kF .and. kF .le. 3)
if (bRead) then ! Record did not fit selection criteria
if (bNegate) then ! If negating ..
bRead = bWrongType ! .. accept, or read same record again
if (bRead) POld = P
else ! If regular selection ..
iR = iR+1 ! .. reject record and read next one
end if
else if (bWrongType) then ! Record was read with wrong type, so read again
bRead = .TRUE.
POld = P ! This time with proper photometer setting
else if (bNegate) then ! Record fit the selection criteria
bRead = .TRUE.
iR = iR+1 ! If negating reject record and read next one
end if
end if
end do
if (.not. bNative(T,R,L)) then ! Real*4 conversion needed
call CvR4(1,1,T)
call CvR4(1,1,R)
call CvR4(1,1,L)
if (P .eq. 3) then
call CvR4(1, 2,Z)
else
call CvR4(1,iS,Z)
call CvR4(1,iS,Z(nS+1-iS))
end if
end if
if (P .eq. 3) then
F = 4
call ArrR4Mask( -2,Z,BadHOS,Bad,0.,0.,1.,Z) ! Flag -1E7 (old Helios files)
call ArrR4Copy(2,Z,ZZ) ! Copy into output array
call ArrR4NARN(N-2,ZZ(3)) ! Flag unused elements in output array
else
call ArrR4NARN(nS-2*iS,Z(iS+1)) ! Flag sectors which are not in file
call ArrR4Mask(-nS,Z,BadHOS,Bad,0.,0.,1.,Z) ! Flag -1E7 (old Helios files)
iS = N/2
call ArrR4Copy(iS,Z,ZZ) ! Copy sectors 1..iS
call ArrR4Copy(iS,Z(nS+1-iS),ZZ(N+1-iS)) ! Copy sectors 33-iS..32
end if
PP = P ! Integer*4 output
CC = C
FF = F
return
entry iHOSWrite(iD,iU,iRecl,iR,T,PP,CC,FF,R,L,NN,ZZ)
if (bFirst) then
bAlign = iGetSymbol('HOS_ALIGN',cAlign) .ne. 0
if (bAlign) bAlign = cAlign .eq. '1'
bFirst = .FALSE.
end if
N = NN/2*2 ! Round down to even number
P = PP ! Integer*4 input
C = CC
F = FF
if (P .eq. 3) then
call ArrR4Copy(2,ZZ,Z) ! Copy into output array
else
iS = N/2
call ArrR4Copy(iS,ZZ,Z) ! Copy sectors 1..iS
call ArrR4Copy(iS,ZZ(N+1-iS),Z(nS+1-iS)) ! Copy sectors 33-iS..32
call ArrR4NARN(nS-2*iS,Z(iS+1)) ! Flag sectors which are not present
end if
iS = (iRecl-4.5)/2 ! Half # Sectors in phot 1 or 2 record
if (iD .ge. 0) iR = iR+1 ! Increment record counter
if (P .eq. 3) then
write (iU,rec=iR,iostat=iHOSWrite) T,P,C, R,L,(Z(I),I=1,2)
else if (bAlign) then
write (iU,rec=iR,iostat=iHOSWrite) T,P,C,F,B,R,L,(Z(I),I=1,iS),(Z(I),I=nS+1-iS,nS)
else
write (iU,rec=iR,iostat=iHOSWrite) T,P,C,F, R,L,(Z(I),I=1,iS),(Z(I),I=nS+1-iS,nS)
end if
if (iHOSWrite .ne. 0) then ! Write error
cStr = 'error '//cInt2Str(iHOSWrite)//' on record '//cInt2Str(iR)//' of'
I = iwhitespace(cStr)
inquire(iU,name=cStr(I+2:))
call Signal('iHOSWrite','W','Write',cStr)
if (iD .ge. 0) iR = iR-1 ! Decrement record counter
end if
return
end