! File:  format.f90
!
! Creation Date: 12.02.2016; Time: 15:45
! Time-stamp: <2016-03-04 22:18:34 (andrzejbaran)> 
!
! Andrzej Baran
! IF UMCS, ul. Radziszewskiego 10, 20-031 Lublin, PL
! baran@kft.umcs.lublin.pl
!
program formater
  implicit none
  character*1 :: irflag, rirflag, mult, de1900, de, nvmag, uvmag, &
       ubv, uub, nri, nsptype, nparallax, urotvel, noteflag, de_
  character*2  :: adscomp, nrotvel, lrotvel
  character*4  :: nradvel, multid
  character*5  :: ads
  character*9  :: varid
  character*10 :: name
  character*11 :: dm
  character*20 :: sptype
  integer      :: HR, HD, SAO, FK5, rah1900, ram1900, ded1900, &
       dem1900, des1900, rah, ram, ded, dem, des, &
       arcmin, arcsec, radvel, rotvel, multcnt
  real :: ras, ras1900, ri, pmra, pmde, parallax, dmag, sep, glon, &
       glat, vmag, bv, ub, RAdeg, DEdeg, pi
  integer      :: bsc5, minus

  pi = 3.141592
  
  ! format file for bsc5
  bsc5=17
  open(unit=17,file="bsc5.dat",status="old")
  
1 format( &
!1 -  4 
I4, & !---     HR       [1/9110]+ Harvard Revised Number 
!                                    = Bright Star Number
!   5- 14
A10, & !---    Name     Name, generally Bayer and/or Flamsteed name
!  15- 25
A11, & !---    DM       Durchmusterung Identification (zone in
!                                    bytes 17-19)
!  26- 31
I6, & !---     HD       [1/225300]? Henry Draper Catalog Number
!  32- 37
I6, & !---     SAO      [1/258997]? SAO Catalog Number
!  38- 41
I4, & !---     FK5      ? FK5 star Number
!      42
A1, & !---     IRflag   [I] I if infrared source
!      43
A1, & !---     r_IRflag *[ ':] Coded reference for infrared source
!      44
A1, & !---     Multiple *[AWDIRS] Double or multiple-star code
!  45- 49
A5, & !---     ADS      Aitken's Double Star Catalog (ADS) designation
!  50- 51
A2, & !---     ADScomp  ADS number components
!  52- 60
A9,  & !---    VarID    Variable star identification
!  61- 62
I2, & !h       RAh1900  ?Hours RA, equinox B1900, epoch 1900.0 (1)
!  63- 64
I2, & !min     RAm1900  ?Minutes RA, equinox B1900, epoch 1900.0 (1)
!  65- 68
F4.1, & !s     RAs1900  ?Seconds RA, equinox B1900, epoch 1900.0 (1)
!      69
A1, & !---     DE-1900  ?Sign Dec, equinox B1900, epoch 1900.0 (1)
!  70- 71
I2, & !deg     DEd1900  ?Degrees Dec, equinox B1900, epoch 1900.0 (1)
!  72- 73
I2, & !arcmin  DEm1900  ?Minutes Dec, equinox B1900, epoch 1900.0 (1)
!  74- 75
I2, & !arcsec  DEs1900  ?Seconds Dec, equinox B1900, epoch 1900.0 (1)
!  76- 77
I2, & !h       RAh      ?Hours RA, equinox J2000, epoch 2000.0 (1)
!  78- 79
I2, & !min     RAm      ?Minutes RA, equinox J2000, epoch 2000.0 (1)
!  80- 83
F4.1, & !s     RAs      ?Seconds RA, equinox J2000, epoch 2000.0 (1)
!      84
A1, & !---     DE-      ?Sign Dec, equinox J2000, epoch 2000.0 (1)
!  85- 86
I2, & !deg     DEd      ?Degrees Dec, equinox J2000, epoch 2000.0 (1)
!  87- 88
I2, & !arcmin  DEm      ?Minutes Dec, equinox J2000, epoch 2000.0 (1)
!  89- 90
I2, & !arcsec  DEs      ?Seconds Dec, equinox J2000, epoch 2000.0 (1)
!  91- 96
F6.2, & !deg   GLON     ?Galactic longitude (1)
!  97-102
F6.2, & !deg   GLAT     ?Galactic latitude (1)
! 103-107
F5.2, & !mag   Vmag     ?Visual magnitude (1)
!     108
A1, & !---     n_Vmag    *[ HR] Visual magnitude code
!     109
A1, & !---     u_Vmag     [ :?] Uncertainty flag on V
! 110-114
F5.2, & !mag   B-V      ? B-V color in the UBV system
!     115
A1, & !---     u_B-V      [ :?] Uncertainty flag on B-V
! 116-120
F5.2, & !mag   U-B      ? U-B color in the UBV system
!     121
A1, & !---     u_U-B      [ :?] Uncertainty flag on U-B
! 122-126
F5.2, & !mag   R-I      ? R-I   in system specified by n_R-I
!     127
A1, & !---     n_R-I      [CE:?D] Code for R-I system (Cousin, Eggen)
! 128-147
A20, & !---    SpType   Spectral type
!     148
A1, & !---     n_SpType   [evt] Spectral type code
! 149-154
F6.3, & !arcsec/yr pmRA    *?Annual proper motion in RA J2000, FK5 system
! 155-160
F6.3, & !arcsec/yr pmDE     ?Annual proper motion in Dec J2000, FK5 system
!     161
A1, & !---     n_Parallax [D] D indicates a dynamical parallax,
!                             otherwise a trigonometric parallax
! 162-166
F5.3, & !arcsec Parallax ? Trigonometric parallax (unless n_Parallax)
! 167-170
I4, & !km/s    RadVel   ? Heliocentric Radial Velocity
! 171-174
A4, & !---     n_RadVel  *[V?SB123O ] Radial velocity comments
! 175-176
A2, & !---     l_RotVel   [<=> ] Rotational velocity limit characters
! 177-179
I3, & !km/s    RotVel   ? Rotational velocity, v sin i
!     180
A1, & !---     u_RotVel   [ :v] uncertainty and variability flag on
!                                    RotVel
! 181-184
F4.1, & !mag   Dmag     ? Magnitude difference of double,
!                                   or brightest multiple
! 185-190
F6.1, & !arcsec  Sep      ? Separation of components in Dmag
!                                    if occultation binary.
! 191-194
A4, & !---     MultID   Identifications of components in Dmag
! 195-196
I2,  & !---    MultCnt  ? Number of components assigned to a multiple
!     197
A1  & !---     NoteFlag [*] a star indicates that there is a note
!                                    (see file notes)
)

  do 
     read(bsc5,1,end=11) &
          HR, Name, Dm, Hd, SAO, FK5, IRFLAG, rIrflag, mult, ads, adscomp, &
          varid, rah1900, ram1900, ras1900, de1900, ded1900, dem1900, des1900, &
          rah, ram, ras, de_, ded, dem, des, glon, glat, vmag, nvmag, uvmag, &
          bv, ubv, ub, uub, ri, nri, sptype, nsptype, pmra, pmde, nparallax, &
          parallax, radvel, nradvel, lrotvel, rotvel, urotvel, dmag, sep, &
          multid, multcnt, noteflag
     
!!$     write(*,*) &
!!$          HR, Name, Dm, Hd, SAO, FK5, IRFLAG, Irflag, mult, ads, adscomp, &
!!$          varid, rah1900, ram1900, ras1900, de1900, ded1900, dem1900, des1900, &
!!$          rah, ram, ras, de_, ded, dem, des, glon, glat, vmag, nvmag, uvmag, &
!!$          bv, ubv, ub, uub, ri, nri, sptype, nsptype, pmra, pmde, nparallax, &
!!$          parallax, radvel, nradvel, lrotvel, rotvel, urotvel, dmag, sep, &
!!$          multid, multcnt, noteflag

     if (de_ == "-") then
        minus=-1
     else
        minus = 1
     end if
     RAdeg = (RAh/24. + RAm/1440. + RAs/86400.)*360
     DEdeg = (abs(DEd)/90. + DEm/5400. + DEs/324000.)*90. * minus
     print 10, RAdeg, DEdeg, vmag, bv, ub, sptype

  end do
10 format(5f10.4,a22)
11 continue
END program formater
