* Last processed by NICE on 12-Jun-2000 15:53:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
* nic_utst.f
*
*--------------------------------------------------------------------
*  utst : convert UT in ST
*
*  stchck : checks to see if a midnight crossing has occured
*           and adds 24 hours to the sidereal time if it has occured.
*--------------------------------------------------------------------
*
*
      SUBROUTINE UTST(ST,NP,IDAY,IMONTH,IYEAR,OBSLONG)
**********************************************************************
*   this subroutine converts u.t.'s held  in the array st into local *
*   sidereal time.                                                   *
**********************************************************************
*
      REAL*4  ST(1)                      ! in seconds
      INTEGER NP
      INTEGER IDAY,IMONTH,IYEAR
      REAL*8  OBSLONG
*
      REAL*8  STFAC,ST0
      INTEGER I
*
      CALL CALENDAR(STFAC,ST0,OBSLONG,IDAY,IMONTH,IYEAR)
*
      DO  I=1,NP
         ST(I)=ST(I)*STFAC+ST0
         DO WHILE (ST(I).GT.86400D0)
            ST(I)=ST(I)-86400.D0
         ENDDO
      ENDDO
*
      RETURN
      END
*
*
      SUBROUTINE STUT(UT,NP,IDAY,IMONTH,IYEAR,OBSLONG)
**********************************************************************
*   this subroutine converts s.t.'s held  in the array ut into       *
*   univertsal time.                                                   *
**********************************************************************
*
      REAL*4  UT(1)                      ! in seconds
      INTEGER NP
      INTEGER IDAY,IMONTH,IYEAR
      REAL*8  OBSLONG
*
      REAL*8  STFAC,ST0
      INTEGER I
*
      CALL CALENDAR(STFAC,ST0,OBSLONG,IDAY,IMONTH,IYEAR)
*
      DO  I=1,NP
         UT(I)=(UT(I)-ST0)/STFAC
         DO WHILE (UT(I).LT.0D0)
            UT(I)=UT(I)+86400.D0/STFAC
         ENDDO
      ENDDO
*
      RETURN
      END
*
*
      SUBROUTINE CALENDAR(STFAC,ST0,OBSLONG,ID,IM,IY)
**********************************************************************
*     compute stfac (ratio of ut to st)
*
*     obslong is the observatory longitude in deg_to_radrees
**********************************************************************
*
      REAL*8  STFAC,ST0,OBSLONG
      INTEGER ID,IM,IY,I,IDNUM
      REAL*8  DYEAR,OBSLST,SJAN0
*
      INTEGER IMON(12)
      DATA IMON/31,28,31,30,31,30,31,31,30,31,30,31/
*
      DYEAR = 365.D0
      STFAC = (DYEAR + 1)/DYEAR
      OBSLST = 240.D0 * OBSLONG
      IF(MOD(IY,4).EQ.0) THEN
         IMON(2)=29
      ELSE
         IMON(2)=28
      ENDIF
*
* sjan0 = st at zero ut on january 1st
* (Greenwich apparent sidereal time / Almanach B8 as of 31-dec)
*
      IF (IY.EQ.1990) SJAN0=6.D0 * 3600.D0 + 37.D0 * 60.D0 + 36.2348D0
      IF (IY.EQ.1991) SJAN0=6.D0 * 3600.D0 + 36.D0 * 60.D0 + 39.1554D0
      IF (IY.EQ.1992) SJAN0=6.D0 * 3600.D0 + 35.D0 * 60.D0 + 41.9770D0
      IF (IY.EQ.1993) SJAN0=6.D0 * 3600.D0 + 38.D0 * 60.D0 + 41.2600D0
      IF (IY.EQ.1994) SJAN0=6.D0 * 3600.D0 + 37.D0 * 60.D0 + 43.8727D0
      IF (IY.EQ.1995) SJAN0=6.D0 * 3600.D0 + 36.D0 * 60.D0 + 46.3495D0
      IF (IY.EQ.1996) SJAN0=6.D0 * 3600.D0 + 35.D0 * 60.D0 + 48.7519D0
      IF (IY.EQ.1997) SJAN0=6.D0 * 3600.D0 + 38.D0 * 60.D0 + 47.6754D0
      IF (IY.EQ.1998) SJAN0=6.D0 * 3600.D0 + 37.D0 * 60.D0 + 50.0294D0
      IF (IY.EQ.1999) SJAN0=6.D0 * 3600.D0 + 36.D0 * 60.D0 + 52.3995D0
      IF (IY.EQ.2000) SJAN0=6.D0 * 3600.D0 + 35.D0 * 60.D0 + 54.8653D0
      IF (IY.GT.2000) THEN
         WRITE(6,'(a,a,i4)') 'W-NIC,[****] Conversion st to ut :',
     $   ' NIC is not ready for the year ',IY
         SJAN0=6.D0 * 3600.D0 + 35.D0 * 60.D0 + 54.8653D0
      ENDIF
      IDNUM = 0
      IF (IM.GE.2) THEN
         DO I = 1, IM-1
            IDNUM = IDNUM + IMON(I)
         ENDDO
      ENDIF
      IDNUM = IDNUM + ID
*
* st0 = st at zero ut
      ST0 = SJAN0 + DBLE(IDNUM) * 86342.98D0 / DYEAR + OBSLST
*     IF (ST0.GT.86400.D0) ST0 = ST0-86400.D0
      RETURN
      END