      PROGRAM TEST
      INTEGER*2 IFLAG,INUNIT,OUTUNIT,IOPEN1, IOPEN7,iall
      DIMENSION APA(5)
      CHARACTER*30 INFILE,OUTFILE
      CHARACTER*1 ANS, FPM(3)
      DATA FPM/'F','P','M'/
      print*,' This program scans an .FPM file to look for small pitch'
      print*,' angles at small B'
      iall=0
      WRITE(*,1008)
1008  FORMAT(' FLOATING-POINT MAGNETIC FIELD DATA  FILE NAME?',/,
     1 ' (MUST HAVE UT,BX,BY,BZ IN FLOATING POINT IN THAT ORDER)',/,
     2 ' SUFFIX MUST BE "FPM"',/)
      READ(*,1004)INFILE
1004  format(a)
      INUNIT=1
      OUTUNIT=7
C
      CALL SUFIX(INFILE,FPM)
      OPEN(UNIT=INUNIT,FILE=INFILE,FORM='UNFORMATTED',STATUS='OLD',
     1 ACCESS='TRANSPARENT')
C
      IOPEN1=1
      ipa=0
      CALL FIRSTPA(INUNIT,UT,APA,IFLAG)
      IF(IFLAG.EQ.1)STOP
      WRITE(*,1002)UT
1002  FORMAT(' FIRST TIME IN MAG FILE IS ',F10.3,/)
      print*,' First UT to try?   '
      read*,UT
      print*,' Last UT?   '
      read*,utlst
      print*,' Maximum B?  '
      read*,BMAX
      print*,' Maximum PA?  '
      read*,APAMAX
      DO 135 JJ=1,5000
      DO 134 I=1,200
      UT=UT+.512
      CALL GETPA(INUNIT,UT,APA,IFLAG)
      IF (IFLAG.EQ.1)GOTO140
      if(apa(4).gt.BMAX)go to 134
      if(apa(5).lt.APAMAX)ipa=1
      if(ipa.eq.0)go to 134
      WRITE(*,19)UT,APA
19    FORMAT(1X,F10.3,2X,5f10.2)
134   CONTINUE
      print*,' Working, UT=',ut,' B=',apa(4),' PA=',apa(5)
      if(utlst.lt.UT)stop
135   CONTINUE
140   IF(IOPEN1.EQ.1)CLOSE(INUNIT)
      STOP
      END
C   
      SUBROUTINE GETPA(INUNIT,UT,APA,IFLAG)
      DIMENSION ARRAY(4,33),DCS(3),BCMP(3),apa(5)
      INTEGER*2 INDX,IFLAG,NDX,inunit
      DATA DCS/146.5,78.9,3./
1     NDX=INDX

      DO 100 J=NDX,33
      IF(UT.GT.ARRAY(1,J))GO TO 100
      if(array(1,j).gt.(ut+5000.))go to 88

      TDEL=ARRAY(1,J)-ARRAY(1,J-1)
      TPART1=(UT-ARRAY(1,J-1))/TDEL
      BCMP(1)=TPART1*(ARRAY(2,J)-ARRAY(2,J-1))+ARRAY(2,J-1)
      BCMP(2)=TPART1*(ARRAY(3,J)-ARRAY(3,J-1))+ARRAY(3,J-1)
      BCMP(3)=TPART1*(ARRAY(4,J)-ARRAY(4,J-1))+ARRAY(4,J-1)
      B=SQRT(DOT(BCMP,BCMP))
      BMP=DOT(BCMP,DCS)/B
      apa(1)=bcmp(1)
      apa(2)=bcmp(2)
      apa(3)=bcmp(3)
      apa(4)=b
      IF (BMP.GT.1.)BMP=1.
      IF (BMP.LT.-1.)BMP=-1.
      APAp=57.29572*ACOS(BMP)
      IF(APAp.LT.0.)APAp=-APAp
      IF(APAp.GT.180.)APAp=360.-APAp
      apa(5)=apap
      RETURN
88    print*,' bad TIME in .fpm: ',array(1,j)
100   INDX=INDX+1
      DO 110 IJ=1,4
110   ARRAY(IJ,1)=ARRAY(IJ,33)
      CALL GETSECT(INUNIT,ARRAY(1,2),IFLAG)
      IF(IFLAG.EQ.1)THEN
         PRINT*,' MAGNETIC FIELD FILE EXHAUSTED'
         RETURN
      ENDIF
      INDX=2
      GO TO 1
      ENTRY FIRSTPA
      CALL GETSECT(INUNIT,ARRAY(1,2),IFLAG)
        IF(IFLAG.EQ.1)THEN
           PRINT*,' MAGNETIC FIELD FILE CAN NOT BE READ'
           RETURN
        ENDIF
      DO 120 IJ=1,4
120   ARRAY(IJ,1)=ARRAY(IJ,2)
      INDX=2
      UT=ARRAY(1,1)
      tmp3=cos(dcs(3)/57.29578)
      tmp1=dcs(1)/57.29578
      tmp2=dcs(2)/57.29578
      dcs(1)=tmp3*cos(tmp1)
      dcs(2)=-tmp3*cos(tmp2)
      dcs(3)=tmp3*sin(tmp1)*sin(tmp2)
      RETURN
      END


      SUBROUTINE GETSECT(INUNIT,BREC,IFLAG)
C     A subroutine to read sectors from disk.
C     IFLAG = 1 if reached end of file.
      LOGICAL*1 BREC(512)
      INTEGER*2 INUNIT,IFLAG
      IFLAG=0
      READ(UNIT=INUNIT,END=1000)BREC
      RETURN
1000  IFLAG=1
      PRINT *,' END OF DATA ON INPUT FILE'
      CLOSE (UNIT=INUNIT)
      RETURN
      END


      SUBROUTINE SUFIX(NAME,SUF)
      CHARACTER*1 NAME(51),SUF(3),SUF1
      DATA SUF1/'.'/
      DO 1 I=1,51
      IF(NAME(I).EQ.'.')GOTO4
1     IF(NAME(I).EQ.' ')GOTO3
      WRITE(*,2)NAME
2     FORMAT(' ***** ERROR ***** ERROR ***** ERROR *****',//,
     1 A,//,' exceeds the limit on file names (50 characters)')
      STOP
3     NAME(I)=SUF1
4     NAME(I+1)=SUF(1)
      NAME(I+2)=SUF(2)
      NAME(I+3)=SUF(3)
      RETURN
      END

      FUNCTION DOT(A,B)
      DIMENSION A(3),B(3)
      DOT=A(1)*B(1)+A(2)*B(2)+A(3)*B(3)
      RETURN
      END
