C+
C NAME:
C	Pandora
C PURPOSE:
C	Mostly tools for manipulating Helios photometer data; also:
C	time transformatios, celestial coordinates transformations, heliocentric
C	positions of Earth, Helios 1 and Helios2, binary interpretations as
C	integer*2, integer*4, real*4 and real*8
C CATEGORY:
C	Good stuff
C CALLING SEQUENCE:
	program PANDORA
C INPUTS:
C OUTPUTS:
C CALLS:
C	Say, iHOSInfo, iHOSRead, iHOSWrite, bOpenFile, iFreeLun
C	itrim, icompress, iwhitespace, iSearch, bHOSName, AskWhat, AskR4
C	AskI2, AskI4, AskYN ,AskChar, iGetSymbol, cFlt2Str, cInt2Str
C	ArrR4Bad, ArrI1Zero, iArrR4Compare, iArrI4ValuePresent, iUniqueName
C	iOSRenameFile, IndexR4, SortI4, HOSOrbID, HOSOrbit, SunNewcomb, Julian
C	DATE_DOY, PRECESSION_APPROX, ECLIPTIC_HELIOGRAPHIC, ECLIPTIC_EQUATOR
C	N_CARRINGTON, Bit2to4, Bit4to2, Bit32, Bit16, FileInfo
C INCLUDE:
	include		'dirspec.h'
	include		'openfile.h'
	include		'hos_e9.h'
C PROCEDURE:
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS)
C	OCT-2002, Paul Hick (UCSD/CASS; pphick@ucsd.edu)
C		Completed ascii-binary and binary-ascii conversion for Helios
C		photometer files.
C-
	parameter	(MXC = 7000)
	parameter	(nS=32)
	real		Z1(nS)
	real		Z2(nS)
	real		T(MXC)

	integer		IREC(MXC)
	integer		Lst(3,11)

	character	cFile*80	/' '/
	character	cFile1*80
	character	cFile2*80
	character	cSearch*40
	character	cMon*3		/'JAN'/
	character	cStr*512
	character	cFmt*100
	character	cSay*7		/'pandora'/

	real*8		JD
	real*8		JEpoch
	real*8		rLng8
	real*8		rLat8
	real*8		rDis8

	parameter	(nVec = 1+3+2+32)
	real		rVec(nVec)

	integer		I4
	equivalence	(I4,RR4)
	integer*1	OBIT16(16)
	integer*1	OBIT32(32)
	character	C32*32

	integer		PP
	integer		CC
	integer		FF
	integer		iYr		/1976/
	real		Day		/1./
	real		Doy		/1./
	logical		bAns
	logical		bNext
	logical		bOK1
	logical		bOK2

	logical		bOpenFile
	logical		bHOSName
	logical		Pandora_Records
	integer		Pandora_Menu
	character	cInt2Str*14
	character	cFlt2Str*14

	integer		PickPP(0:3)	/HOS__P_ALL,HOS__P_1,HOS__P_2,HOS__P_3/
	integer		PickCC(0:3)	/HOS__C_ALL,HOS__C_1,HOS__C_2,HOS__C_3/
	integer		PickFF(0:6)	/HOS__F_ALL,HOS__F_1,HOS__F_2,HOS__F_3,HOS__F_4,HOS__F_5,HOS__F_CLRPB/

	integer*2	II2

	Tiny = TinyR4()

	iAns = 1
 111	iAns = Pandora_Menu(iAns,cOpSys .eq. OS__VMS)

	if (iAns .eq. 1) then		! Find recl, number of recs and time range

	    iR = iHOSInfo(0,cFile,iRecl,iSc,iYr,TBeg,TEnd,kPCF,Lst)

	else if (iAns .eq. 2) then	! Scan file: print records on screen

	    if (iHOSInfo(0,cFile,iRecl,iSc,iYr,TBeg,TEnd,kPCF,Lst) .gt. 0) then
		bAns = bHOSName(cFile,iSc,iYr,IC,IF)

		IP = 3
		if (iRecl .ne. 6 .and. .not. (bAns .and. IF .eq. 9))
     &				call AskWhat('Photometer: All,1,2,3$0$0',IP)
		if (.not. bAns) call AskWhat('Color: All,U,B,V$0$0',IC)

		if (IP .ne. 3) then
		    if (.not. bAns) call AskWhat('Filter: All,1,2,3,Clr,pB,Clr+pB$0$0',IF)
		    JSTART = 1
		    call AskI4('First sector',JSTART)
		    JEND = JSTART
		    call AskI4('Last sector',JEND)
		    if (JEND .lt. JSTART) JEND = JEND+nS
		else
		    IF = 5
		end if

		TMin = TBeg
		TMax = TEnd
		call AskR4('Start time$'//cFlt2Str(TBeg*(1-Tiny),3)//'$'//cFlt2Str(TEnd*(1+Tiny),3),TMin)
		call AskR4('End time  $'//cFlt2Str(TMin,3)//'$'//cFlt2Str(TEnd*(1+Tiny),3),TMax)

		if (bOpenFile(OPN__HOS+OPN__REOPEN+OPN__READONLY,iU,cFile,iRecl)) then
		    kPCF = kPCF-iand(kPCF,HOS__PCF_ALL)+PickPP(IP)+PickCC(IC)+PickFF(IF)

		    iW = 0
		    iR = 0
		    do while (iHOSRead(kPCF,iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0)
			if (TMin .le. TT .and. TT .le. TMax) then
			    iW = iW+1
			    if (PP .eq. 3) then
				write (*,'(I5,A,F7.3,A,I2,A,I2,A,F5.3,A,F6.2,2(A,G13.6))')
     &				    mod(iR,10000),' T=',TT,'  P=',PP,'  C=',CC,
     &				    '  R=',DIS,'  L=',POS,'  I=',Z1(1),'  PB=',Z1(2)
			    else
				write (*,'(I5,A,F7.3,3(A,I2),A,F5.3,A,F6.2,A,I2,A,G13.6)')
     &				    mod(iR,10000),' T=',TT,'  P=',PP,'  C=',CC,'  F=',
     &				    FF,'  R=',DIS,'  L=',POS,'   SEC=',JSTART,'  I=',Z1(JSTART)
				I = (JEND-JSTART)/3
				do JS=JSTART,JSTART+(I-1)*3,3
				    write (*,'(6X,3(A,I2,A,G13.6))') (' SEC=',
     &					1+mod(J-1,nS),'  I=',Z1(1+mod(J-1,nS)), J=JS+1,JS+3)
				end do
				JS = JSTART+I*3+1
				if (JS .le. JEND) write (*,'(6X,3(A,I2,A,G13.6))')(' SEC='
     &				    ,1+mod(J-1,nS),'  I=',Z1(1+mod(J-1,nS)), J=JS,JEND)
			    end if
			end if
		    end do
		    iU = iFreeLun(iU)

		    cStr = 'displayed: '//cInt2Str(iW)//' out of '//cInt2Str(iR)
		    I = iwhitespace(cStr)
		    call Say(cSay,'I','# Recs',cStr)
		end if
	    end if

	else if (iAns .eq. 3 .or. iAns .eq. 4) then	! Select/remove data for specified phot/color/filt

	    if (iHOSInfo(0,cFile,iRecl,iSc,iYr,TBeg,TEnd,kPCF,Lst) .gt. 0) then
		bAns = bHOSName(cFile,iSc,iYr,IC,IF)
		IP = 3
		if (iRecl .ne. 6 .and. .not. (bAns .and. IF .eq. 9))
     &				call AskWhat('Photometer: All,1,2,3$0$0',IP)
		if (.not. bAns) call AskWhat('Color: All,U,B,V$0$0',IC)
		if (IP .ne. 3) then
		   if (.not. bAns) call AskWhat('Filter: All,1,2,3,Clr,pB,Clr+pB$0$0',IF)
		else
		    IF = 5
		end if

		if (bOpenFile(OPN__HOS+OPN__REOPEN+OPN__READONLY,iU,cFile ,iRecl) .and.
     &		    bOpenFile(OPN__HOS+OPN__NEW		     ,iO,cFile1,iRecl)) then

		    kPCF = kPCF-iand(kPCF,HOS__PCF_ALL)+PickPP(IP)+PickCC(IC)+PickFF(IF)
		    if (iAns .eq. 4) kPCF = kPCF+HOS__NOT	! Negate selection

		    iW = 0
		    iR = 0
		    do while (iHOSRead (kPCF,iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0)
			I =   iHOSWrite(kPCF,iO,iRecl,iW,TT,PP,CC,FF,DIS,POS,nS,Z1)
		    end do

		    cStr = cInt2Str(iW)//' out of '//cInt2Str(iR)//' records to '//cFile1
		    I = iwhitespace(cStr)
		    call Say(cSay,'I','Moved',cStr)
 		end if

	 	iU = iFreeLun(iU)
		iO = iFreeLun(iO)

	        I = iHOSInfo(OPN__REOPEN,cFile1,iRecl,iSc,iYr,TBeg,TEnd,kPCF,Lst)
	    end if

	else if (iAns .eq. 5) then			! Extract data in specified time range

	    if (iHOSInfo(0,cFile,iRecl,iSc,iYr,TBeg,TEnd,kPCF,Lst) .ne. 0) then
		TMin = TBeg
		TMax = TEnd
		call AskR4('Start time$'//cFlt2Str(TBeg*(1-Tiny),3)//'$'//cFlt2Str(TEnd*(1+Tiny),3),TMin)
		call AskR4('End time  $'//cFlt2Str(TMin,3)//'$'//cFlt2Str(TEnd*(1+Tiny),3),TMax)

		if (bOpenFile(OPN__HOS+OPN__REOPEN,iU,cFile ,iRecl) .and.
     &		    bOpenFile(OPN__HOS+OPN__NEW   ,iO,cFile1,iRecl)) then
		    iR = 0
		    iW = 0
		    do while (iHOSRead(kPCF,iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0)
			if (TMin .le. TT .and. TT .le. TMax)
     &			    I = iHOSWrite(kPCF,iO,iRecl,iW,TT,PP,CC,FF,DIS,POS,nS,Z1)
		    end do
		    cStr = cInt2Str(iW)//' out of '//cInt2Str(iR)//' records to '//cFile1
		    I = iwhitespace(cStr)
		    call Say(cSay,'I','Moved',cStr)
		end if

		iU = iFreeLun(iU)
		iO = iFreeLun(iO)

	        I = iHOSInfo(OPN__REOPEN,cFile1,iRecl,iSc,iYr,TBeg,TEnd,kPCF,Lst)
	    end if

	else if (iAns .eq. 6) then			! Remove section of time series

	    if (iHOSInfo(0,cFile,iRecl,iSc,iYr,TBeg,TEnd,kPCF,Lst) .gt. 0) then
		TMin = TBeg
		TMax = TEnd

		bAns = bHOSName(cFile,iSc,iYr,IC,IF)
		if (.not. bAns) then
		    IC = 3
		    IF = 4
		end if
		IS1 = 0

		IP = 3
		if (iRecl .ne. 6) call AskWhat('Photometer: STOP,1,2,3$0',IP)
		do while (IP .ne. 0)

		    if (.not. bAns) call AskWhat('Color: U,B,V',IC)
		    if (IP .eq. 3) then
			call AskWhat('Filter: Clr,pB$4',IF)
			IS1 = IF-3
			IS2 = IS1
		    else
			call AskWhat('Filter: 1,2,3,Clr,pB',IF)

			IS1 = 1+mod(IS1,nS)
			call AskI4('Sector: 0=All,1-32$0$32$',IS1)
			IS2 = IS1
			if (IS1 .eq. 0) then
			    IS1 = 1
			    IS2 = nS
			end if
		    end if

		    call AskR4('Start time$'//cFlt2Str(TBeg*(1-Tiny),3)//'$'//cFlt2Str(TEnd*(1+Tiny),3),TMin)
		    call AskR4('End time  $'//cFlt2Str(TMin,3)//'$'//cFlt2Str(TEnd*(1+Tiny),3),TMax)

		    if (bOpenFile(OPN__HOS+OPN__REOPEN,iU,cFile,iRecl)) then
		    	kPCF = kPCF-iand(kPCF,HOS__PCF_ALL)+PickPP(IP)+PickCC(IC)+PickFF(IF)

			iR = 0
			iW = 0
			do while (iHOSRead(kPCF,iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0)
			    if (TMin .le. TT .and. TT .le. TMax) then
				call ArrR4Bad(IS2-IS1+1,Z1(IS1))
				if (iHOSWrite(iand(kPCF,HOS__NONORM),iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0) iW = iW+1
			    end if
			end do
			iU = iFreeLun(iU)

			cStr = cInt2Str(iW)//' out of '//cInt2Str(iR)//' records'
			I = iwhitespace(cStr)
			call Say(cSay,'I','Modified',cStr)
		    end if

		    if (iRecl .ne. 6) call AskWhat('Photometer: STOP,1,2,3$0',IP)
		end do
	    end if

	else if (iAns .eq. 7) then			! Change record length to 6 or 37

	    call Say(cSay,'W','!!!!!','INPUT FILE WILL BE DELETED')
	    if (bOpenFile(OPN__HOS+OPN__READONLY,iU,cFile,iRecl)) then
		bAns = .TRUE.
		if (iRecl .ne. 6) then
		    iR = 0
		    kPCF = HOS__PCF_ALL
		    do while (bAns .and. iHOSRead(kPCF,iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0)
			bAns = PP .eq. 3
		    end do
		end if
		iU = iFreeLun(iU)

		if (bAns) then
		    iReclO = 37
		    if (iRecl .ne. 6) iReclO = 6

		    cStr = 'record length from '//cInt2Str(iRecl)//' to '//cInt2Str(iReclO)
		    J = iwhitespace(cStr)
		    call Say(cSay,'I','Change',cStr)

		    I = iUniqueName(cFile,cFile1)	! Make unique name based on cFile

		    if (bOpenFile(OPN__HOS+OPN__REOPEN+OPN__NEW,iO,cFile1,iReclO) .and.
     &			bOpenFile(OPN__HOS+OPN__REOPEN	    ,iU,cFile ,iRecl )) then
			iR = 0
			kPCF = HOS__PCF_ALL
			do while (iHOSRead(kPCF,iU,iRecl ,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0)
			    I = iand(kPCF,HOS__NONORM)
			    I = iHOSWrite(iand(kPCF,HOS__NONORM),iO,iReclO,iR,TT,PP,CC,FF,DIS,POS,nS,Z1)
			end do
			iO = iFreeLun( iO)		! Close new file
			iU = iFreeLun(-iU)		! Close and delete

			I = iOSRenameFile(cFile1,cFile)	! Rename new file to old file name
			call Say(cSay,'I','Output','file: '//cFile)
		    end if
		    iU = iFreeLun(iU)
		    iO = iFreeLun(iO)
		else
		    call Say(cSay,'I','16/31 file','cannot be reduced to RECL=6')
		end if
	    end if

	else if (iAns .eq. 8) then			! Sort times

	    call Say(cSay,'W','!!!!!','INPUT FILE WILL BE DELETED')
	    if (bOpenFile(OPN__HOS+OPN__READONLY,iU,cFile,iRecl)) then
		iR = 1
		read (iU,rec=iR,iostat=I) TT
		do while (I .eq. 0 .and. iR .le. MXC)
		    T(iR) = TT
		    iR = iR+1
		    read (iU,rec=iR,iostat=I) TT
		end do
		iU = iFreeLun(iU)

		if (iR .eq. 1 .or. iR .gt. MXC) then
		    call Say(cSay,'W','Problem','Not all records read or empty file')
		else
		    iR = iR-1
		    call IndexR4(1,iR,1,MXC,T,IREC)
		    I = 1
		    do while (I .le. iR .and. I .eq. IREC(I))
			I = I+1
		    end do
		    if (I .gt. iR) then
			call Say(cSay,'I','File','is already sorted')
		    else
			I = iUniqueName(cFile,cFile1)

			if (bOpenFile(OPN__HOS+OPN__REOPEN+OPN__NEW,iO,cFile1,iRecl) .and.	! Open new file
     &			    bOpenFile(OPN__HOS+OPN__REOPEN        ,iU,cFile ,iRecl)) then	! Open old file
     			    kPCF = 0				! Disables autoincrement in iHOSRead
			    do I=1,iR
				J = iHOSRead (kPCF,iU,iRecl,IREC(I),TT,PP,CC,FF,DIS,POS,nS,Z1)
				J = iHOSWrite(kPCF,iO,iRecl,I ,TT,PP,CC,FF,DIS,POS,nS,Z1)
			    end do
			    iU = iFreeLun(-iU)			! Close and delete
			    iO = iFreeLun( iO)			! Close new file

			    I = iOSRenameFile(cFile1,cFile)	! Rename new file to old file name
			    call Say(cSay,'I','Output','file: '//cFile)
			end if
			iU = iFreeLun(iU)
			iO = iFreeLun(iO)
		    end if
		end if
	    end if

	else if (iAns .eq. 9) then	! Identify spacecraft and year for data file

	    kPCF = HOS__NULL
	    if (bOpenFile(OPN__HOS+OPN__READONLY,iU,cFile,iRecl) .and.
     &		    iHOSRead(kPCF,iU,iRecl,1,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0) then
		call HOSOrbID(-TT,DIS,POS+180.,iSc,iYr,dRMin)

		if (bHOSName(cFile,jSc,jYr,CC,FF) .and. (iSc .ne. jSc .or. jYr .ne. iYr)) then
		    if (iSc .ne. jSc) call Say(cSay,'W','Wrong','S/C ID in '//cFile)
		    if (iYr .ne. jYr) call Say(cSay,'W','Wrong','YEAR ID in '//cFile)
		end if
	    end if
	    iU  = iFreeLun(iU)

	else if (iAns .eq. 10) then			! Add 366 days to time for each record

	    kPCF = HOS__NULL
	    if (bOpenFile(OPN__HOS,iU,cFile,iRecl) .and.
     &			iHOSRead(kPCF,iU,iRecl,1,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0) then
		call HOSOrbID(TT,DIS,POS+180.,iSc,iYr,dRMin)

		iDays = 365
		if (iYr/4*4 .eq. iYr) iDays = 366	!It's a leap year

		if (TT .ge. iDays+1) then
		    iDays = -iDays
		else
		    iYr = iYr-1
		    iDays = 365
		    if (iYr/4*4 .eq. iYr) iDays = 366	!It's a leap year
		end if

		kPCF = kPCF+HOS__PCF_ALL
		iR = 0
		do while (iHOSRead (kPCF,iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0)
		    I = iHOSWrite(iand(kPCF,HOS__NONORM),iU,iRecl,iR,iDays+TT,PP,CC,FF,DIS,POS,nS,Z1)
		end do

		call Say(cSay,'I','Days','added: '//cInt2Str(iDays))
	    end if
	    iU = iFreeLun(iU)

	else if (iAns .eq. 11) then			! Compare files record by record

	    call Say(cSay,'I','2Files','Enter two file names')
	    if (bOpenFile(OPN__HOS+OPN__READONLY,iU,cFile1,iRecl1) .and.
     &		bOpenFile(OPN__HOS+OPN__READONLY,iO,cFile2,iRecl2)) then
		call AskYN('Exclude intensities$no',bAns)

		kPCF1 = HOS__PCF_ALL
		kPCF2 = HOS__PCF_ALL

		iR1 = 0
		iR2 = 0
		bNext = .TRUE.
		do while (bNext)
		    bOK1 = iHOSRead(kPCF1,iU,iRecl1,iR1,T1,IP1,IC1,IF1,DIS1,POS1,nS,Z1) .eq. 0
    		    bOK2 = iHOSRead(kPCF2,iO,iRecl2,iR2,T2,IP2,IC2,IF2,DIS2,POS2,nS,Z2) .eq. 0

		    bNext = bOK1 .and. bOK2

		    if (bNext) then
		        cStr = 'Rec '//cInt2Str(iR1)

			if (T1 .ne. T2) then
			    write (*,*) T1, T2, T1-T2
			    call Say(cSay,'I',cStr,'Times are not equal')
			    bNext = .FALSE.
			else if (IP1 .ne. IP2) then
			    write (*,*) IP1, IP2
			    call Say(cSay,'I',cStr,'Not the same photometers')
			    bNext = .FALSE.
			else if (IC1 .ne. IC2) then
			    write (*,*) IC1,IC2
			    call Say(cSay,'I',cStr,'Not the same colors')
			    bNext = .FALSE.
			else if (IP1 .ne. 3 .and. IF1 .ne. IF2) then
			    write (*,*) IF1, IF2
			    call Say(cSay,'I',cStr,'Not the same filter')
			    bNext = .FALSE.
			else if (DIS1 .ne. DIS2) then
			    write (*,*) DIS1, DIS2, DIS1-DIS2
			    call Say(cSay,'I',cStr,'Spacecraft distances are not equal')
			    bNext = .FALSE.
			else if (POS1 .ne. POS2) then
			    write (*,*) POS1, POS2, POS1-POS2
			    call Say(cSay,'I',cStr,'Spacecraft longitudes are not equal')
			    bNext = .FALSE.
			else if (.not. bAns) then
			    bNext = iArrR4Compare(nS,Z1,Z2) .eq. 0
			    if (.not. bNext) call Say(cSay,'I',cStr,'Intensities are not equal')
			end if
		    end if

		end do

		if (bOK1 .and. bOK2) then

		    if (IP1 .eq. 3) then
			write (*,'(I5,A,F7.3,A,I2,A,I2,A,F5.3,A,F6.2,2(A,G13.6))')
     &			    mod(iR1,10000),' T=',T1,'  P=',IP1,'  C=',IC1,
     &			    '  R=',DIS1,'  L=',POS1,'  I=',Z1(1),'  PB=',Z1(2)
		    else
			write (*,'(I5,A,F7.3,3(A,I2),A,F5.3,A,F6.2,A,I2,A,G13.6)')
     &			    mod(iR1,10000),' T=',T1,'  P=',IP1,'  C=',IC1,'  F=',
     &			    IF1,'  R=',DIS1,'  L=',POS1,'   SEC=',1,'  I=',Z1(1)
		    end if

		    if (IP2 .eq. 3) then
			write (*,'(I5,A,F7.3,A,I2,A,I2,A,F5.3,A,F6.2,2(A,G13.6))')
     &			    mod(iR2,10000),' T=',T2,'  P=',IP2,'  C=',IC2,
     &			    '  R=',DIS2,'  L=',POS2,'  I=',Z2(1),'  PB=',Z2(2)
		    else
			write (*,'(I5,A,F7.3,3(A,I2),A,F5.3,A,F6.2,A,I2,A,G13.6)')
     &			    mod(iR1,10000),' T=',T2,'  P=',IP2,'  C=',IC2,'  F=',
     &			    IF2,'  R=',DIS2,'  L=',POS2,'   SEC=',1,'  I=',Z2(1)
		    end if

		else if (bOK1) then
		    call Say(cSay,'I','NEQ',cFile1(:itrim(cFile1))//' has more recs than '//cFile2)
		else if (bOK2) then
		    call Say(cSay,'I','NEQ',cFile2(:itrim(cFile2))//' has more recs than '//cFile1)
		else
		    cStr = 'Files are identical'
		    if (bAns) cStr(itrim(cStr)+1:) = ' (intensities excluded)'
		    call Say(cSay,'I','EQ',cStr)
		end if

	    end if
	    iU = iFreeLun(iU)
	    iO = iFreeLun(iO)

	else if (iAns .eq. 12) then			! Search for identical records

	    if (iGetSymbol('DEF_FILE',cSearch) .eq. 0) cSearch = '*.dat'
	    call AskChar('File spec (wildcards permitted)',cSearch)

	    bNext = iSearch(1,cSearch,cFile) .eq. 1
	    if (bNext) bNext = bOpenFile(OPN__HOS+OPN__REOPEN+OPN__READONLY,iU,cFile,iRecl)

	    do while (bNext)
		call Say(cSay,'I','File',cFile)

		kPCF1 = HOS__NULL
		kPCF2 = HOS__PCF_ALL

		nB = 0				! Counts identical records
		JS = 0				! Counts identical times
		iR = 0				! Make sure the 1st rec can be read
		if (iHOSRead(kPCF2,iU,iRecl,iR,T1,IP1,IC1,IF1,DIS1,POS1,nS,Z1) .eq. 0) then
		    do while (bNext .and.		! Read rec again, then read next rec
     &			iHOSRead(kPCF1,iU,iRecl,iR,T1,IP1,IC1,IF1,DIS1,POS1,nS,Z1) .eq. 0 .and.
     &			iHOSRead(kPCF2,iU,iRecl,iR,T2,IP2,IC2,IF2,DIS2,POS2,nS,Z2) .eq. 0)
			bNext = T2 .ge. T1	! Break 'do while' loop if not sorted

			if (T2 .eq. T1) then	! Identical times
			    JS = JS+1
			    cStr = cInt2Str(iR-1)//' and '//cInt2Str(iR)
			    I = iwhitespace(cStr)
			    if (IP1 .eq. IP2 .and. IC1 .eq. IC2 .and. IF1 .eq. IF2 .and.
     &				    DIS1 .eq. DIS2 .and. POS1 .eq. POS2 .and.
     &				    iArrR4Compare(nS,Z1,Z2) .eq. 0) then
				call Say(cSay,'I','Recs',cStr(:I)//' are identical')
				nB = nB+1
				IREC(nB) = iR
			    else
				call Say(cSay,'I','Recs',cStr(:I)//' have identical times')
			    end if
			end if
		    end do
		end if
		iU = iFreeLun(iU)		! Close input file again

		if (iR .eq. 0) then		! Read error on 1st record
		    continue
		else if (.not. bNext) then	! File not sorted
		    call Say(cSay,'W','NoSort','Times on input file are not sorted')
		    bNext = .TRUE.		! Needed to search for next file
		else
		    cStr = 'times: '//cInt2Str(JS)//' out of '//cInt2Str(iR)//'#'//
     &			   'recs : '//cInt2Str(nB)//' out of '//cInt2Str(iR)
     		    I = iwhitespace(cStr)
     		    call Say(cSay,'I','Identical',cStr)
		    if (nB .gt. 0) bNext = Pandora_Records(cFile,iR,nB,IREC,Z1) ! Remove identical records
		end if

		if (bNext) then
		    bNext = iSearch(0,cSearch,cFile) .eq. 1
		    if (bNext) bNext = bOpenFile(OPN__HOS+OPN__REOPEN+OPN__READONLY,iU,cFile,iRecl)
		end if

	    end do

	else if (iAns .eq. 13) then		! Delete record

	    call Say(cSay,'W','!!!!!','INPUT FILE WILL BE DELETED')
	    iR = iHOSInfo(0,cFile,iRecl,iSc,iYr,TMin,TMax,kPCF,Lst)
	    if (iR .gt. 0) then			! iR is number of records
		iB = 0
		nB = 0				! Counts # recs to be deleted
		call AskI4('Record nr to be deleted (0=STOP)',iB)
		do while (1 .le. iB .and. iB .le. iR)
		    if (iArrI4ValuePresent(nB,IREC,iB) .eq. 0) then
			nB = nB+1
			IREC(nB) = iB
		    end if
		    iB = iB+1
		    call AskI4('Record nr to be deleted (0=STOP)',iB)
		end do

		if (nB .gt. 0) then
		    call SortI4(1,nB,1,nB,IREC)
		    write (*,'(A,I4,A)') ' Selected records (total of ',nB,' ):'
		    write (*,'(1X,10I7)') (IREC(I),I=1,nB)
		    call AskYN('Delete records$no',bAns)
		    if (bAns) bAns = Pandora_Records(cFile,iR,nB,IREC,Z1)
		end if
	    end if

	else if (iAns .eq. 14) then		! Clean file

	    if (bOpenFile(OPN__HOS+OPN__READONLY,iU,cFile,iRecl)) then
		kPCF = HOS__PCF_ALL

		nB = 0
		iR = 0
		do while (iHOSRead(kPCF,iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0)
		    if ((PP  .lt. 1   .or. PP  .gt. 3 ) .or.
     &			(CC  .lt. 1   .or. CC  .gt. 3 ) .or.
     &			(FF  .lt. 1   .or. FF  .gt. 5 ) .or.
     &			(DIS .lt. .28 .or. DIS .gt. 1.)) then

			nB = nB+1
			IREC(nB) = iR
			if (nB .eq. 1) write (*,'(A,/)') ' SUSPECTED BAD RECORDS ARE:'
			write (*,'(I5,4X,A,F7.3,3(4X,A,I6),4X,A,F6.3,4X,A,F6.1)')
     &				mod(iR,10000),'T=',TT,'P=',PP,'C=',mod(CC,100),'F=',FF,'R=',DIS,'L=',POS
		    end if
		end do
		iU = iFreeLun(iU)

		cStr = 'Number of bad records: '//cInt2Str(nB)//' out of '//cInt2Str(iR)
		I = iwhitespace(cStr)
		call Say(cSay,'W','Bad',cStr)
	 	if (nB .gt. 0) then
		    call AskYN('Remove bad records$no',bAns)
		    if (bAns) bAns = Pandora_Records(cFile,iR,nB,IREC,Z1) ! Remove identical records
		end if
	    end if

	else if (iAns .eq. 15) then			! Create binary to ASCII file

	    if (bOpenFile(OPN__HOS+OPN__READONLY,iU,cFile,iRecl)) then
		kPCF = HOS__NULL			! Disables record auto increment

		iS = max(2,int(iRecl-4.5))		! # Sectors
		iR = (8+3*4+2*10+iS*13)/4		! Needed for new text file on VMS

		if (bOpenFile(OPN__NEW+OPN__TEXT,iO,cFile,iR) .and.
     &			iHOSRead(kPCF,iU,iRecl,1,TT,PP,CC,FF,DIS,POS,iS,Z1) .eq. 0) then

		    cFmt = '(F8.3,3I4,2F10.5,'//cInt2Str(iS)//'E13.5)'
		    I = icompress(cFmt,cFmt)
		    kPCF = HOS__PCF_ALL			! Enables record auto increment

		    iR = 0
		    do while (iHOSRead(kPCF,iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,iS,Z1) .eq. 0)
			write (iO,cFmt) TT,PP,CC,FF,DIS,POS,(Z1(J),J=1,iS)
		    end do

		    call Say(cSay,'I','Output','file: '//cFile)
		end if

	    end if

	    iO = iFreeLun(iO)
	    iU = iFreeLun(iU)

	else if (iAns .eq. 16) then			! Create ASCII to binary file

	    iR = 0					!(8+3*4+2*10+iS*13)/4

	    if (bOpenFile(OPN__TEXT+OPN__READONLY,iU,cFile,iR)) then

		read (iU,'(A)') cStr			! First record may be ascii header
		if (cStr(:1) .eq. ';') read (iU,'(A)') cStr

		iS = nVec
		call Str2Flt_Exp(.TRUE.)
		call Str2Flt(cStr,iS,rVec)
		call Str2Flt_Format(cFmt)

		! A txt file created on DOS read on Linux may put a trailing A1 in the format
		! for the CR in the CR//LF record terminator. Check and remove, if present.

		I = LocFirst(',A1)',cFmt)
		if (I .ne. 0) cFmt = cFmt(:I-1)//')' 

		iS = iS-6				! # Sectors
		iRecl = 1+2+2+iS			! # 4-byte longwords per binary record

		if (bOpenFile(OPN__NEW+OPN__HOS,iO,cFile,iRecl)) then

		    kPCF = HOS__PCF_ALL			! Forces autoincrement of record counter in iHOSWrite
		    iR = 0				! Initialize record counter

		    read (cStr,cFmt,iostat=I) TT,PP,CC,FF,DIS,POS,(Z1(J),J=1,iS)

		    do while (I .eq. 0)
			I = iHOSWrite(kPCF,iO,iRecl,iR,TT,PP,CC,FF,DIS,POS,iS,Z1)
			if (I .eq. 0) read (iU,cFmt,iostat=I) TT,PP,CC,FF,DIS,POS,(Z1(J),J=1,iS)
		    end do

		    call Say(cSay,'I','Output','file: '//cFile)

		end if

	    end if

	    iO = iFreeLun(iO)
	    iU = iFreeLun(iU)


	else if (iAns .eq. 17) then			! Difference in calculated and real position

	    if (iHOSInfo(0,cFile,iRecl,iSc,iYr,TBeg,TEnd,kPCF,Lst) .gt. 0) then
		TMin = TBeg
		TMax = TEnd
		call AskR4('Start time$'//cFlt2Str(TBeg*(1-Tiny),3)//'$'//cFlt2Str(TEnd*(1+Tiny),3),TMin)
		call AskR4('End time  $'//cFlt2Str(TMin,3)//'$'//cFlt2Str(TEnd*(1+Tiny),3),TMax)

		if (bOpenFile(OPN__HOS+OPN__REOPEN+OPN__READONLY,iU,cFile,iRecl)) then
		    iR = 0
		    iW = 0
		    do while (iHOSRead(kPCF,iU,iRecl,iR,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0)
		        if (TMin .le. TT .and. TT .le. TMax) then
			    POS = amod(POS+180.,360.)
			    call HOSOrbit(iSc,iYr,TT,DIS1,POS1,VR,VT)
			    POS2 = POS1-POS
			    DIS2 = DIS1-DIS
			    Test = .0174533*DIS*POS2
			    Test = sqrt(Test*Test+DIS2*DIS2)

			    if (iW/20*20 .eq. iW) write (*,
     &					'(/,8X,2(A,12X),2X,A,9X,A,/,17X,2(3X,A,3X),A,3X,2(2X,A,2X),A,3X,A/)')
     &					'Time','Longitude (deg)','Distance (AU)','d(AU)',
     &					'obs ','calc','100*diff','obs ','calc','1E4*diff','1E4*'
			    iW = iW+1
			    write (*,	'(I5,F9.3,2H |,F9.3,F10.3,F9.3,2H |,F8.4,F9.4,F8.3,2H |,F7.3)')
     &					iR,TT,POS,POS1,100*POS2,DIS,DIS1,1E4*DIS2, 1E4*Test
			end if
		    end do
		    iU = iFreeLun(iU)
		end if
	    end if

	else if (iAns .eq. 18) then

	    cFile1 = '*.*'
	    call AskChar('File name wildcard',cFile1)
	    iR = 1
	    do while (iSearch(iR,cFile1,cFile) .eq. 1)
		iR = 0
		if (bOpenFile(OPN__HOS+OPN__REOPEN+OPN__READONLY,iU,cFile,iRecl)) then
		    kPCF = HOS__NULL
		    if (iHOSRead(kPCF,iU,iRecl,1,TT,PP,CC,FF,DIS,POS,nS,Z1) .eq. 0) then
			call HOSOrbID(TT,DIS,POS+180.,iSc,iYr,dRMin)
			cStr = 'Helios '//cInt2Str(iSc)//' in year '//cInt2Str(iYr)
			I = iwhitespace(cStr)
			if (bHOSName(cFile,jSc,jYr,CC,FF) .and.
     &				(iSc .ne. jSc .or. jYr .ne. iYr)) cStr(25:) = ' !!! WRONG !!!'
			call Say(cSay,'I','Check',cFile(:40)//cStr)
		    end if
		    iU = iFreeLun(iU)
		end if
	    end do

	else if (iAns .eq. 19) then			! Earth, Helios 1 and 2 coordinates

	    call AskI4('Year',iYr)
	    if (iYr .lt. 1900) iYr = iYr+1900
	    call AskR4('Day of year',Doy)

	    call HOSOrbit(1,iYr,Doy,DIS1,PHI1,VR,VT)
	    RLAT1 = 0
	    call HOSOrbit(2,iYr,Doy,DIS2,PHI2,VR,VT)
	    RLAT2 = 0
	    call SunNewcomb(0,iYr,Doy,rLng8,rLat8,rDis8)
	    PHI3 = rLng8
	    PHI3 = mod(180+PHI3,360.)
	    RLAT3 = 0
	    call Julian(0,iYr,Doy,JD,JEpoch)
	    call PRECESSION_APPROX(JEpoch,1974.99932d0,PHI3,RLAT3)

	    write (*,'(10X,3(14X,A),/,32X,2(12X,A,F5.3,A),/,12X,6(7X,A),/,1X,A,6F11.3)')
     &		'Earth','  Helios A','Helios B','(',DIS1,' AU)','(',DIS2,' AU)',
     &		'Lng ',' Lat','Lng ',' Lat','Lng ',' Lat','Ecliptic    ',PHI3,RLAT3,PHI1,RLAT1,PHI2,RLAT2

	    call ECLIPTIC_HELIOGRAPHIC(0,iYr,Doy,PHI1,RLAT1)
	    call ECLIPTIC_HELIOGRAPHIC(0,iYr,Doy,PHI2,RLAT2)
	    call ECLIPTIC_HELIOGRAPHIC(0,iYr,Doy,PHI3,RLAT3)

	    write (*,'(1X,A,6F11.3)') 'Heliographic',PHI3,RLAT3,PHI1,RLAT1,PHI2,RLAT2

	    jYr = iYr
	    RR4 = Doy
	    write (*,'(1X,A,9X,I6,6X,A,F10.3)')
     &			'Rotation',N_CARRINGTON(jYr,RR4),'PA Sun',PA_POLE(2,iYr,Doy,sngl(rLng8))

	else if (iAns .eq. 20) then		! Time transformations

	    jAns = 1
	    do while (jAns .ne. 0)
		call AskWhat('STOP, Date, Yr-Doy, Julian day$0',jAns)

		if (jAns .eq. 1) then
		    call AskI4('Year',iYr)
		    call AskChar('Month (3 chars or 1-12)',cMon)
		    read (cMon(:itrim(cMon)),'(I)',iostat=I) iMon
		    if (I .ne. 0) iMon = 0
		    call AskR4('Day of month$1$32',Day)

		    iDay = Day
		    FRAC = Day-iDay
		    call DATE_DOY(0,iYr,cMon,iMon,iDay,iDoy)
		    Doy = iDoy+FRAC
		    call Julian(0,iYr,Doy,JD,JEpoch)

		else if (jAns .eq. 2) then
		    call AskI4('Year',iYr)
		    call AskR4('Day of year$1$367',Doy)

		    iDoy = Doy
		    FRAC = Doy-iDoy
		    call DATE_DOY(1,iYr,cMon,iMon,iDay,iDoy)
		    Day = iDay+FRAC
		    call Julian(0,iYr,Doy,JD,JEpoch)

		else if (jAns .eq. 3) then
		    call AskR8('Julian day',JD)

		    call Julian(1,iYr,Doy,JD,JEpoch)
		    iDoy = Doy
		    FRAC = Doy-iDoy
		    call DATE_DOY(1,iYr,cMon,iMon,iDay,iDoy)
		    Day = iDay+FRAC

		end if

		if (jAns .ne. 0) then
		    cStr = '(/,1X,F7.4,1X,2A,I2,A,I6,A,F8.4,A,F13.4,A,F11.5)'
		    write (*,cStr) Day,cMon,'(',iMon,')',iYr,' = DOY ',Doy,' = JD ',JD,' = EPOCH ',JEpoch
		end if
	    end do

	else if (iAns .eq. 21) then	! Celestial coordinate transformations

	    iYr = 2000.
	    Doy = 1.
	    call Say(cSay,'I','Set','equinox (default is 2000.0)')
	    call AskI4('Year',iYr)
	    call AskR4('Day of year',Doy)

	    jAns = 1
	    do while (jAns .ne. 0)
		call AskWhat('STOP, Ecliptic, Heliographic, Equatorial$0',jAns)

		if (jAns .eq. 1) then
		    call AskR4('Ecliptic longitude$0$360',PHI1)
		    call AskR4('Ecliptic latitude$-90$90',RLAT1)

		    PHI2 = PHI1
		    RLAT2 = RLAT1
		    call ECLIPTIC_EQUATOR(0,iYr,Doy,PHI2,RLAT2)

		    PHI3 = PHI1
		    RLAT3 = RLAT1
		    call ECLIPTIC_HELIOGRAPHIC(0,iYr,Doy,PHI3,RLAT3)

		else if (jAns .eq. 2) then
		    call AskR4('Carrington longitude$0$360',PHI3)
		    call AskR4('Carrington latitude$-90$90',RLAT3)

		    PHI1 = PHI3
		    RLAT1 = RLAT3
		    call ECLIPTIC_HELIOGRAPHIC(1,iYr,Doy,PHI1,RLAT1)

		    PHI2 = PHI1
		    RLAT2 = RLAT1
		    call ECLIPTIC_EQUATOR(0,iYr,Doy,PHI2,RLAT2)

		else if (jAns .eq. 3) then
		    call AskR4('Right ascension$0$360',PHI2)
		    call AskR4('Declination$-90$90',RLAT2)

		    PHI1 = PHI2
		    RLAT1 = RLAT2
		    call ECLIPTIC_EQUATOR(1,iYr,Doy,PHI1,RLAT1)

		    PHI3 = PHI1
		    RLAT3 = RLAT1
		    call ECLIPTIC_HELIOGRAPHIC(0,iYr,Doy,PHI3,RLAT3)

		end if

		if (jAns .ne. 0) then
		    cStr = '(/,1X,6(A,F6.2),A)'
		    write (*,cStr) 'ECLIPTIC (',PHI1,',',RLAT1,
     &			') * EQUATOR (',PHI2,',',RLAT2,') * HELIOGRAPH (',PHI3,',',RLAT3,')'
		end if
	    end do

	else if (iAns .eq. 22) then

	    jAns = 1
	    do while (jAns .ne. 0)
		call AskWhat('STOP, I2, I4, R4, Binary, Hex$0',jAns)

		if (jAns .eq. 1) then
		    call AskI2('Integer*2 value',II2)
		    call Bit2to4(II2,I4)
		else if (jAns .eq. 2) then
		    call AskI4('Integer*4 value',I4)
		else if (jAns .eq. 3) then
		    call AskR4('Real*4 value',RR4)
		else if (jAns .eq. 4) then
		    C32 = ' '
		    call AskChar('Binary value (max len=32)',C32)
		    call ArrI1Zero(32,OBIT32)
		    J = itrim(C32)
		    do I=1,J
			if (C32(I:I) .eq. '1') OBIT32(32-J+I) = 1
		    end do
		    call Bit32(1,I4,OBIT32)
		else if (jAns .eq. 5) then
		    write (C32,'(Z8)') I4
		    call AskChar('Hex value (max. len=8)',C32)
		    read (C32(:itrim(C32)),'(Z)') I4
		end if

		if (jAns .ne. 0) then
		    call Bit32(0,I4,OBIT32)
		    call Bit4to2(I4,II2)
		    call Bit16(0,II2,OBIT16)
		    cStr = '(/,1X,I11,1X,A,8(1X,4I1),A,Z8,A,G,'//'/,1X,I11,1X,A,20X,4(1X,4I1),A,Z8)'
		    write (*,cStr) I4,'=',OBIT32,' = ',I4,'=',RR4,II2,'=',OBIT16,' = ',II2
		end if
	    end do

	else if (iAns .eq. 23) then	! Display file info

	    call AskChar('File name$file',cFile)
	    iU = iFreeLun(0)
	    call FileInfo(iU,cFile)

	end if

	go to 111

	end
C+
C NAME:
C	Pandora_Menu
C PURPOSE:
C	Internal use by Pandora
C CALLING SEQUENCE:
	integer function Pandora_Menu(iAns,bOS)
C CALLS:
C	Say, AskI4
C MODIFICATION HISTORY:
C-
	logical		bOS
	character	ESC	/27/

 1	Pandora_Menu = iAns

	write (*,'(8X,61(1H*))')
	call AskI4('Option (-1 = Menu, 0 = Stop)$-1$22',Pandora_Menu)
	if (Pandora_Menu .eq.  0) call Say('Menu','I','StopPlay','Exit')
	write (*,'(8X,61(1H*))')

	if (Pandora_Menu .eq. -1) then
	    if (bOS) write (*,'(1X,A)') ESC//'[?3l'
	    write (*,'(8X,A)')
     & '    1)  Find recl, number of recs and time range        (1',
     & '    2)  Scan file: print records on screen              (2',
     & '    3)  Select data for specified phot/color/filt       (3',
     & '    4)  Delete data for specified phot/color/filt       (4',
     & '    5)  Extract data in specified time range            (5',
     & '    6)  Remove section of time series                   (6',
     & '    7)  Change record length to 6 or 37                 (7',
     & '    8)  Sort times                                      (8',
     & '    9)  Identify spacecraft and year for data file      (9',
     & '   10)  Add/subtract 365/366 days for each record      (10',
     & '   11)  Compare files record by record                 (11',
     & '   12)  Search for identical records                   (12',
     & '   13)  Delete records                                 (13',
     & '   14)  Clean file                                     (14',
     & '   15)  Convert binary file to ASCII                   (15',
     & '   16)  Convert ASCII file to binary                   (16',
     & '   17)  Compare calculated and real s/c positions      (17',
     & '   18)  Check file name against content                (18',
     & '   19)  Earth and spacecraft positions                 (19',
     & '   20)  Time transformations                           (20',
     & '   21)  Celestial coordinate transformations           (21',
     & '   22)  Binary translations                            (22',
     & '   23)  File inquire                                   (23'
	    go to 1
	end if

	return
	end
C+
C NAME:
C	Pandora_Records
C PURPOSE:
C	(Internal use by Pandora only)
C CALLING SEQUENCE:
	logical function Pandora_Records(cFile,iR,nB,IREC,Z)
C CALLS:
C	Say, bTempFile, bOpenFile, iHOSRead, iHOSWrite, iFreeLun
C INCLUDE:
	include		'openfile.h'
	include		'hos_e9.h'
C MODIFICATION HISTORY:
C-
	character	cFile*(*)
	character	cFile2*80
	integer		IREC(*)
	integer		P
	integer		C
	integer		F
	real		L
	real		Z(*)
	logical		bTempFile
	logical		bOpenFile

	call Say('Records','I','Deleting','records')

	Pandora_Records = bTempFile(cFile,cFile2) 				.and.	! Make temp file
     &		bOpenFile(OPN__HOS+OPN__REOPEN	    ,iU,cFile2,iRecl)	.and.	! Open temp file
     &		bOpenFile(OPN__HOS+OPN__REOPEN+OPN__NEW,iO,cFile ,iRecl)	! Open new file

	if (Pandora_Records) then
	    kPCF = HOS__NULL

	    iW = 0
	    iB = 1
	    do I=1,iR
		if (iB .le. nB .and. I .eq. IREC(iB)) then
		    iB = iB+1
		else
		    J = iHOSRead (kPCF,iU,iRecl, I,T,P,C,F,R,L,32,Z)
		    J = iand(kPCF,HOS__NONORM)+HOS__PCF_ALL	! HOS__PCF_ALL needed for autoincrement of iW
		    J = iHOSWrite(J   ,iO,iRecl,iW,T,P,C,F,R,L,32,Z)
		end if
	    end do
	    iU = iFreeLun(-iU)		! Close and delete
	end if

	iU = iFreeLun(iU)
	iO = iFreeLun(iO)
	
	return
	end
