home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / GENERAL / SKYMAP23.ZIP / BIGSTAR.FOR < prev    next >
Text File  |  1991-06-05  |  3KB  |  83 lines
  1.       Program BigStar
  2.       Implicit None
  3.       Integer StarNum,StarIdx(22)
  4.       Integer*2 FPos,FileNum,J
  5.       Character*50 InFile,OutFile
  6.       Character*44 IdxString
  7.       Real*8 RA,Dec
  8.       Real Mag,RAMot,DecMot,RAIdx(22),MaxMag
  9.       Logical FileThere,FirstStar
  10.  
  11.       IdxString = '01020304050607080910111213141516171819202122'
  12.       Write (*,10)
  13. 10    Format (' Enter name of first 28-byte star file: ')
  14.       Read (*,20) InFile
  15. 20    Format (A)
  16.       FPos = Index(InFile,'01')
  17.       IF (FPos .EQ. 0) THEN
  18.         Write (*,30)
  19. 30      Format ('+Filename must have "01" as part of name.')
  20.         STOP
  21.       ENDIF
  22.       Write (*,40)
  23. 40    Format ('+Enter output file name (file will contain all',
  24.      &   ' stars): ')
  25.       Read (*,20) OutFile
  26.       Open (Unit=2, File = OutFile, Status = 'New', Form=
  27.      &    'Unformatted', Recl = 28, Access = 'Direct')
  28.       FileNum = 1
  29.       StarNum = 1
  30.       Write (*,45)
  31. 45    Format ('+Enter dimmest star magnitude of interest: ')
  32.       Read (*,*) MaxMag
  33.  
  34. 50    InFile(FPos:FPos+1) = IdxString(FileNum*2-1:FileNum*2)
  35.       Inquire (Exist = FileThere, File = InFile)
  36.       IF (.NOT. FileThere) THEN
  37.         Write (*,60) CHARNB(InFile)
  38. 60      Format (' Error.  File "',A,'" not found.')
  39.         Close (2)
  40.         STOP
  41.       ENDIF
  42.       Write (*,70) CHARNB(InFile)
  43. 70    Format (' Opening ',A,/)
  44.       Open (Unit=1, File = InFile, Status = 'Old', Form =
  45.      &    'Unformatted', Access = 'Transparent')
  46.       FirstStar = .True.
  47.  
  48. 100   Read (1,End=300) RA,Dec,Mag,RAMot,DecMot
  49.       IF (FirstStar) THEN
  50.         StarIdx(FileNum) = StarNum
  51.         FirstStar = .False.
  52.       ENDIF
  53.       IF (Mag .GT. MaxMag) GOTO 100
  54.       IF (StarNum/100 .EQ. Float(StarNum)/100.) Write (*,120) StarNum
  55. 120   Format ('+Star #',I6)
  56.       Write (2,Rec=StarNum) RA,Dec,Mag,RAMot,DecMot
  57.       StarNum = StarNum + 1
  58.       GOTO 100
  59.  
  60. 300   Write (*,120) StarNum-1
  61.       RAIdx(FileNum) = MIN(24.,RA + 1E-6)
  62.       Close (1)
  63.       IF (FileNum .NE. 22) THEN
  64. C       More star files to read:
  65.         FileNum = FileNum + 1
  66.         GOTO 50
  67.       ENDIF
  68.       Write (*,310) StarNum - 1
  69. 310   Format (' Total stars read in: ',I6,/)
  70.       Close (2)
  71.       Write (*,320)
  72. 320   Format (' Building index file STARS.IDX...')
  73.       Open (1, File = 'STARS.IDX', Status = 'Unknown')
  74.       Write (1,330) StarNum-1
  75. 330   Format ('22,',I6)
  76.       DO 500 J = 1,22
  77.         Write (1,340) StarIdx(J),RAIdx(J)
  78. 340     Format (I6,X,F9.6)
  79. 500   CONTINUE
  80.       Close (1)
  81.       Stop
  82.       End
  83.