	Options /Extend_Source
C**********************************************************************		
C       PROGRAM TO READ THE HAWKEYE MASTER SCIENCE FILE
C**********************************************************************
	character*80 filename,finter
        INTEGER*4 ID,IRAW
	integer*2 dummy
	REAL*8 epoch,epoch0,tod
	real*4 xsunang(16),sunang(16)
C**********************************************************************
        REAL*8 TRJ,CD,EW,WORD24,WORD25,Z,ZZ,XI,YY,YI,Y1,Y2,Y3,EM,EI
C**********************************************************************
        DIMENSION ID(324),IRAW(64),TRJ(77),CD(21),EW(2),WORD24(16)
        DIMENSION WORD25(32),BX(3,32),BY(3,32),BZ(3,32),BCD(9,32)
        DIMENSION V(10),SA1(8,16),SA2(8,16),SFR(8,32),VD(6,64),IV(7)
        DIMENSION GM(32,2),FP(32,2),FE(32,2),ST(32,2),PP(8),RAMP(16)
        DIMENSION IW24(16),IW25(32),EL(16,2),BB(3,32)
        DIMENSION SFF(8),SAF1(8),SAF2(8),AN(32,2),ANE(16,16),ANP(16,16)
        DIMENSION RPEN(16),RPEW(16),RPGF(16),ENLP(32),EWLP(32),ENPL(16)
        DIMENSION REEN(16),REEW(16),REGF(16),GFP(32),GFE(32),SFFBW(8)
        DIMENSION SA1BW(8),SA2BW(8),SA1C(8),SA2C(8),ANR(16),EM(9),EI(9)
C**********************************************************************
        EQUIVALENCE (ID(34),IRAW(1)),(ID(104),EW(1)),(ID(130),CD(1))
        EQUIVALENCE (ID(180),TRJ(1)),(ID(242),EM(1)),(ID(260),EI(1))
C************************************************************************
C************************************************************************
C       LEPEDEA STEP DATA
        DATA ENLP/66.9,76.5,86.,99.4,119.,143.,170.,206.,252.,310.,375.,
     1  465.,579.,721.,881.,1101.,1415.,1774.,2179.,2734.,3441.,4321.,53
     2  15.,6691.,8450.,10630.,13115.,16499.,20647.,26192.,32501.,40721.
     3  /
        DATA EWLP/12.2,13.8,15.3,17.5,20.5,24.3,28.3,33.7,40.3,49.2,80.5
     1  ,158.,241.,356.,485.,687.,956.,1298.,1719.,2144.,2684.,3350.,410
     2  0.,5133.,6445.,8060.,9900.,12380.,15000.,17700.,20600.,24100./
        DATA GFP/18.,20.,21.,23.,25.,28.,31.,35.,39.,43.,48.,50.,52.,52.
     1  ,52.,51.,47.,43.,37.,31.,26.,22.,18.,16.,13.,11.,8.7,7.0,5.6,4.6
     2  ,3.8,3.2/
        DATA GFE/5.0E04,3.6E04,2.7E04,1.9E04,1.2E04,7.5E03,4.9E03,3.0E03
     1  ,1.6E03,784.,467.,260.,145.,96.,66.,48.,37.,29.,24.,20.,16.5,14.
     2  ,12.2,10.5,9.1,7.8,6.8,5.9,5.1,4.4,3.8,3.3/
C************************************************************************
C       LEPEDEA RAMP DATA 
        DATA RPEN/116.,134.,159.,188.,224.,260.,309.,358.,450.,670.,1120
     1  .,2200.,4900.,10500.,22400.,44800./   !PROTON ENERGY
        DATA REEN/0.,115.,136.,160.,191.,222.,264.,306.,380.,570.,960.,
     1  1900.,4200.,8900.,19100.,38200./      !ELECTRON ENERGY
        DATA RPEW/17.4,21.3,26.9,32.3,36.1,42.1,49.2,68.8,148.,317.,703.
     1  ,1710.,3890.,8160.,16300.,26200./     !PROTON ENERGY WIDTH
        DATA REEW/0.0,20.2,22.5,27.3,31.1,36.2,42.1,56.8,124.,274.,611.,
     1  1470.,3290.,6920.,14000.,22400./      !ELECTRON ENERGY WIDTH
        DATA RPGF/25.,27.,29.,40.,40.,60.,40.,40.,40.,40.,40.,37.,20.,11
     1  .,5.2,2.9/                            !PROTON GEOMETRIC FACTOR
        DATA REGF/0.0,13000.,8500.,5700.,3700.,2500.,1500.,820.,440.,150
     1  .,56.,27.,14.,9.0,5.3,3.4/            !ELECTRON GEOMETRIC FACTOR
        DATA IN_UNIT,in_unit2,out_unit1,out_unit2 /20,19,21,22/         ! INPUT UNIT NUMBER
        iskip = 0
        ipro = 0
  345   FORMAT(3X,1PE9.2,1PE9.2,1PE9.2,1PE9.2,1PE9.2,1PE9.2,1PE9.2,
     1  1PE9.2)
	print *,' type in 0 for counts/s or 1 for flux in /cm^2/sr/eV'
	read(*,*)ical
	print *,' type in 0 for no print out'
	read(*,*)iprint

	finter='data.req'
        print*,'Opening file data.req...'

 1110   if(finter .eq. ' ' .or. finter .eq. 'q') go to 9999
	open(in_unit2,file=finter,status='old',
     &		form='formatted',err=1111)
        go to  1112
 1111   print*,' '
        print*,'The file does not exist!'
 	print*,'Input another file containing the time intervals?'
        print*,' (usually data.req created after running request.exe)'
        read(*,'(a)') finter
        go to 1110
 
 1112   continue

c        OPEN(UNIT=22,STATUS='NEW',RECORDTYPE='VARIABLE',
c     1  FORM='UNFORMATTED',file='scratch:[schen]rampel.dat')
c        OPEN(UNIT=21,STATUS='NEW',RECORDTYPE='VARIABLE',
c     1  FORM='UNFORMATTED',file='scratch:[schen]ramppr.dat')
c   1    CONTINUE
	irec = 0
C
        ICOUNT=0
c	write(21)ical
c	write(22)ical
c	write(21)rpen
c	write(22)reen
c	write(21)rpew
c	write(22)reew
        idtime = 576*(33 + 7)
C
500	JREC=0
	icount = 0
	call openfile(in_unit,istat,in_unit2)
	if( istat .eq. -1)goto 1000
	call openoutfile(out_unit1,istat)
	call openoutfile(out_unit2,istat)
	write(21)ical
	write(22)ical
	write(21)rpen
	write(22)reen
	write(21)rpew
	write(22)reew
	

    8   FORMAT (3X)
   10   CONTINUE
C
C       READ IN ONE TELEMETRY FRAME
C
        READ(IN_UNIT,END=500) dummy,ID
	if( cd(10) .le. 0.)then
	    iskip = iskip + 1
	    print *,' cd(10)=',cd(10),' skip record'
	    goto 10
	endif
	tod = (id(5)*60.d0 + id(6))*60.d0 + id(7)/100.d0
	epoch = epoch0(id(3),id(4),tod)
        ipro = ipro + 1
C
        JREC=JREC+1
C
C************************************************************************
C       LEPEDEA DATA RAMP AND DIGITAL, TEMPERATURE, MODE, STEP ETC.
C************************************************************************
C
 400    CONTINUE
        IF (ICOUNT.GT. 0) GO TO 403
        ILEP=(ID(12) .AND. 2**14 )/2**14        !ON/OFF
        IF (ILEP.EQ. 0) then
	    inoff = inoff +1
	    GO TO 10                !LEPEDEA NOT ON
	endif
        IMODE=(ID(12) .AND. 2**6 )/2**6         !MODE
        LJ=MOD(ID(100),32)
        NJ=1
        MJ=1
        FJ=1.0
  403   CONTINUE
	if( mod(jrec,200) .eq. 0)print *,'jrec=',jrec
C
C       CALCULATE PITCH ANGLES FOR THE LEPEDEA DATA
C
        Z=360.D0/CD(10) !spin rate degrees/s
c cd(12) spin index defined as the angle between projected sun
c direction in the s/c spin plane and
        Y1=CD(1)+CD(12)+1.62D0*Z
        Y1=DMOD(Y1,360.D0)
        Y2=CD(4)+CD(12)+3.51D0*Z
        Y2=DMOD(Y2,360.D0)
        Y3=CD(7)+CD(12)+5.40D0*Z
        Y3=DMOD(Y3,360.D0)
        YI=(Y1+Y2+Y3)/3.D0
        ZZ=(CD(2)+CD(5)+CD(8))/3.D0
        blong = yi !degrees
        bcolat = zz
        bave = (cd(3)+cd(6)+cd(9))/3.
c        print *,'cd(11)=',cd(11)
        ZZ=ZZ/57.29578D0
        ZZ=DSIN(ZZ)
c lepedea detector points at a -43. angle from the x-axis s/c coor in
c in the spin plane
        Y1=CD(12)+0.405D0*Z-43.D0 
        Y2=CD(12)+1.755D0*Z-43.D0
        Y1=(Y1-YI)/57.29578D0
        Y1=DCOS(Y1)*ZZ
        Y1=DACOS(Y1)*57.29578D0
        Y2=(Y2-YI)/57.29578D0
        Y2=DCOS(Y2)*ZZ
        Y2=DACOS(Y2)*57.29578D0
        Y3=CD(12)+3.780D0*Z-43.D0 !detetor angle from x axis s/c coor.
        Y3=DMOD(Y3,360.D0)
	sunz = sin( cd(11)/57.29578) !sine of angle between Z-axis and Sun
	do i = 1,16
           ii = 17-i
	   xsunang(ii) = y3 +i*.09D0*z
	   xsunang(ii) = mod(xsunang(ii),360.)
           sunang(ii) = acos( cos(xsunang(ii)/57.29578)*sunz )*57.29578
	enddo
        DO 405 I=1,16 !from highest to lowest energy, highest sampled first
        II= 17-I
        Y3=Y3+0.09D0*Z   !detector angle from x axis s/c coor. during sample
        Y3=DMOD(Y3,360.D0)
c add 180 to shift from detector direction to particle direction
        YY=(Y3-YI+180)/57.29578D0
        YY=DCOS(YY)*ZZ
c        ANR(I)=DACOS(YY)*57.29578D0  !Correction?
        ANR(II)=DACOS(YY)*57.29578D0
  405   CONTINUE
C
C       END PITCH ANGLE CALCULATION
C
        J=MOD(ID(100),32)+1
        ICOUNT=ICOUNT+1
        K=MOD(ID(100),16)
        N=K+1
c moved from below line 410
C
C       PERFORMANCE PARAMETERS  CONVERTED TO VOLTS
C
        XIR=MOD(IRAW(59),256)
        IF (K.EQ. 9) TEMP=EW(1)
        IF (K.EQ. 0)  PP(1)=XIR*0.0196+0.005+0.04
        IF (K.EQ. 2)  PP(2)=XIR*0.0196+0.005+0.04
        IF (K.EQ. 4)  PP(3)=9.05*(XIR*0.0196+0.005+0.04)
c        IF (K.EQ. 6)  PP(4)=4.02*(XIR*0.0196+0.005+0.05)
        IF (K.EQ. 6)  PP(4)=4.02*(XIR*0.0196+0.005+0.04) ! correct?
        IF (K.EQ. 8)  PP(5)=2.0*(XIR*0.0196+0.005+0.04)
        IF (K.EQ. 10) PP(6)=-3.60*(XIR*0.0196+0.005+0.04)
        IF (K.EQ. 12) PP(7)=XIR*0.0196+0.005
        IF (K.EQ. 14) PP(8)=XIR*0.0196+0.005
C
C                       RAMP DATA 
C
C       PROTONS AND ELECTRONS ARE SAMPLED IN ALTERNATE FRAMES
C
        IF (MOD(ID(100),2).EQ. 1) GO TO 420
C
C       RAMP ELECTRONS
C
        DO 410 I=1,16
        II=17-I
        JJ=43+I
c iraw(44) -> lep ramp-15, highest energy sample, sampled first in s/c frame
c iraw(59)  -> lep ramp-0, lowest energy sample, sampled last in s/c frame
        XIW=MOD(IRAW(JJ),256)
        RAMP(II)=XIW*1.96+0.5               !CONVERT TO CENTAVOLTS
        IF (I.EQ. 16) GO TO 410
        X=RAMP(II)
        CALL COUNTS(X,Y)                        !CONVERT TO COUNTS
	if( ical .eq. 1)then
        RAMP(II)=Y*REGF(II)/REEW(II)        !ELE/CM*CM*SR*EV
	else
	ramp(ii) = y
	endif
  410   CONTINUE
	write(22) epoch,anr,ramp,xsunang,sunang,real(cd(10))
	1,bave,blong,bcolat!time,pitch angle,diff. flux or counts/s
C
        GO TO 440
C
C       RAMP PROTONS
C
  420   CONTINUE
C
        DO 430 I=1,16
        II=17-I
        JJ=43+I
c iraw(44) -> lep ramp 15 highest energy sample, sampled first in s/c frame
c iraw(59)  -> lep ramp  0 lowest energy sample, sampled last in s/c frame
        XIW=MOD(IRAW(JJ),256)
        RAMP(II)=XIW*1.96+0.5               !CONVERT TO CENTAVOLTS
        X=RAMP(II)
        CALL COUNTS(X,Y)                        !CONVERT TO COUNTS
	if( ical .eq. 1)then
        RAMP(II)=Y*RPGF(II)/RPEW(II)        !PRO/CM*CM*SR*EV
	else
	ramp(ii)=y
	endif
  430   CONTINUE
	write(21) epoch,anr,ramp,xsunang,sunang,real(cd(10))
	1,bave,blong,bcolat!time,pitch angle,diff. flux or counts/s
  440   CONTINUE
C
	go to 10
C
 1000   CONTINUE
	print *,' records process: ',ipro
	print *,' records skipped: ',iskip
	print *,' instru  off    : ',inoff
 9999   STOP
        END
C******************************************************************
        SUBROUTINE COUNTS(X,Y)
C******************************************************************
C       PROGRAM TO CONVERT THE LEPEDEA RAMP VOLTAGE TO COUNTS/SEC
C******************************************************************
        DATA A,B,T/1.44514E-02,1.75075E-02,1.82263E-05/
C
        IV=X
        V=X
        IF (IV.GT. 20) GO TO 1
        R=IV/2
        GO TO 8
 1      IF (IV.GT. 50) GO TO 2
        X=0.319789+0.120312*V-1.05861E-03*V*V
        GO TO 7
 2      IF (IV.GT. 120) GO TO 3
        X=2.96631+A*V
        GO TO 7
 3      IF (IV.GT. 206) GO TO 4
        X=2.59958+B*V
        GO TO 7
 4      IF (IV.GT. 300) GO TO 5
        X=3.22967+A*V
        GO TO 7
 5      IF (IV.GT. 421) GO TO 6
        X=2.31286+B*V
        GO TO 7
 6      X=3.59943+A*V
 7      R=EXP(X)
 8      RR=R
        IF (R.LT. 1.E+02) GO TO 9
        RR=R/(1.-T*R)
 9      Y=RR
        RETURN
        END

	subroutine average(x,y,nx,ny) !average over pitch angles
	dimension x(nx,ny),y(nx)
	do i = 1,nx
	   ic = 0
	   y(i) = 0.
	do j = 1,ny
	   if( x(i,j) .ne. -1. )then
	       ic = ic + 1
	       y(i) = y(i) + x(i,j)
	   endif
	enddo
	if( ic .ne. 0)then
	    y(i) = y(i)/ic
	else
	    y(i) = -1
	endif
	enddo
	return
	end

	subroutine openfile(in_unit,istat,in_unit2)
C************************************************************************
C
C       OPEN THE HAWKEYE INPUT FILE             !/* VMS BLUE CODE */
C
C************************************************************************
	integer*4 idate
	character*100 filename
	common /openfile/ idate

	istat = 1
500     continue
c	type *, 'Input filename''s yrdayhr'
c	read (*,*)idate
	read(in_unit2,*,end=1000) idate
	if( idate .lt. 0)goto 1000
	write(filename,666)idate
666	format('ndads::anon_dir:[data_dist.hawkeye]hk_',i7)
	print *,' opening ',filename
        OPEN(UNIT=IN_UNIT,READONLY,STATUS='OLD',RECORDTYPE='VARIABLE',
     1  FORM='UNFORMATTED',file=filename//'.despun',err=4990)
	return
4990	continue
        OPEN(UNIT=IN_UNIT,READONLY,STATUS='OLD',RECORDTYPE='VARIABLE',
     1  FORM='UNFORMATTED',file=filename//'.nondespun',err=499)
	return
C************************************************************************
499     continue
	print *,' file not found ',filename//'.nondespun'
	goto 500
1000	istat=-1
	return
	end

	subroutine openoutfile(out_unit,istat)
C************************************************************************
C
C       OPEN THE HAWKEYE INPUT FILE             !/* VMS BLUE CODE */
C
C************************************************************************
	integer*4 idate
	character*80 filename
	common /openfile/ idate
	istat = 1
500     continue
c	type *, 'Input filename''s yrdayhr'
c	read (*,*)idate
	if( idate .lt. 0)goto 1000

	if(out_unit .eq. 22) then
	    write(filename,666)idate
666	    format('hk_rampel_',i7)
	    print *,' opening ',filename
c            OPEN(UNIT=out_UNIT,READONLY,STATUS='new',
            OPEN(UNIT=out_UNIT,STATUS='new',
     1	    RECORDTYPE='VARIABLE',
     1      FORM='UNFORMATTED',file=filename//'.dat',err=4990)
	endif
	if(out_unit .eq. 21) then
	    write(filename,667)idate
667	    format('hk_ramppr_',i7)
	    print *,' opening ',filename
c            OPEN(UNIT=out_UNIT,READONLY,STATUS='new',
            OPEN(UNIT=out_UNIT,STATUS='new',
     1	    RECORDTYPE='VARIABLE',
     1      FORM='UNFORMATTED',file=filename//'.dat',err=4990)
	endif

	return
4990	continue
c        OPEN(UNIT=out_UNIT,READONLY,STATUS='OLD',RECORDTYPE='VARIABLE',
c     1  FORM='UNFORMATTED',file=filename//'.nondespun',err=499)
c	return
C************************************************************************
499     continue
c	print *,' file not found ',filename//'.nondespun'
	goto 500
1000	istat=-1
	return
	end
