C @(#)getut.for	17.1.1.1 (ES0-DMD) 01/25/02 17:17:32
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
         SUBROUTINE GETUT (NLINE, UT)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT (c)
C.IDENT         getut.for
C.MODULE
C.AUTHOR        Andrew T. Young
C.KEYWORD
C.LANGUAGE      FORTRAN 77
C.PURPOSE       gets U.T. from a comment line LINE(NLINE), or returns -1
C.COMMENTS
C.VERSION       5.2
C.RETURNS
C.ENVIRONMENT
C.
C-----------------------------------------------------------------------------
C
C  BEGIN Declarations:
C
        IMPLICIT NONE
C
        INTEGER MXLINE
        PARAMETER(MXLINE=100)
        CHARACTER*80 LINE(MXLINE)
        COMMON /LINES/LINE
C
        INTEGER I, J, K,KMAX,KMIN,LASTCOL
        INTEGER MCOL
        INTEGER NCOL,NCOLON,NLINE,NOFF,NTIMES,NUTS,NLSTS
        REAL TIMES(5)
        REAL UT
        CHARACTER*4 TYPES(5), TSTRING*12
C
        PARAMETER (NUTS=9, NLSTS=9)
        CHARACTER*8 UTS(NUTS), LSTS(NLSTS), CARD*81, CHAR*1
        CHARACTER*12 FMT, DUM*80
C
C
        LOGICAL MATCH
        INTEGER LWORD
        REAL TIMER
C
C
C
C  END Declarations.
C
C
C  BEGIN DATA statements:
C
        DATA UTS/' UT=', ' UT =', ' U.T.=', ' U.T. =',
     1          'UT:', 'U.T.:', 'U.T.', 'UT', ' U T'/
        DATA LSTS/' LST=', ' LST =', ' L.S.T.=', 'L.S.T. =',
     1          'LST:', 'L.S.T.:', 'L.S.T.', 'LST', '.ST:'/
C
C  END DATA statements.
C
C *****************************************************************
C
C  Program begins here:
C
        CARD=' '//LINE(NLINE)
        DO 1 LASTCOL=81,2,-1
        IF (CARD(LASTCOL:LASTCOL).NE.' ') GO TO 2
    1   CONTINUE
C               empty card; quit.
        UT=-1.
        RETURN
C
    2   NTIMES=0
        TSTRING=' '
        NCOL=INDEX(CARD,' IS ')
        IF (NCOL.GT.0) CARD(NCOL:NCOL+3)='='
        DO 20 I=1,NUTS
        NCOL=INDEX(CARD,UTS(I)(:LWORD(UTS(I))))
        NOFF=1
    3   IF (NCOL.NE.0) THEN
C       key found. Look for time string:
                NCOL=NCOL+NOFF-1
C               start in col. AFTER key:
                MCOL=NCOL+LWORD(UTS(I))
                DO 8 J=MCOL,LASTCOL-3
                    CHAR=CARD(J:J)
C                   skip blanks:
                    IF (CHAR.EQ.' ') GO TO 8
                    IF (CHAR.GE.'0' .AND. CHAR.LE.'9') THEN
C                        digit found;
C                        look for reasonable string after key:
                        KMAX=MIN(J+12, LASTCOL)
                        DO 4 K=J+1,KMAX
                            CHAR=CARD(K:K)
                            IF((CHAR.GE.'0'.AND.CHAR.LE.'9') .OR.
     1                         CHAR.EQ.'H' .OR. CHAR.EQ.'M' .OR.
     2                         CHAR.EQ.'S' .OR. CHAR.EQ.':' .OR.
     3                         CHAR.EQ.' ' .OR. CHAR.EQ.'.') GO TO 4
C                           quit if unacceptable char:
                            GO TO 5
    4                   CONTINUE
                        K=KMAX+1
    5                   K=K-1
                        TSTRING=CARD(J:K)
                        NTIMES=NTIMES+1
                        TIMES(NTIMES)=TIMER(TSTRING)
                        IF (TIMES(NTIMES).EQ.-1.) THEN
                                NTIMES=NTIMES-1
                                GO TO 10
                        ELSE
                                TYPES(NTIMES)='UT'
                                GO TO 30
                        END IF
                    ELSE
C                       try next key.
                        IF (INDEX(UTS(I),'=').NE.0) GO TO 19
                        IF (INDEX(UTS(I),':').NE.0) GO TO 19
C                       digit not found; look BEFORE key if no "=" or ":".
                        GO TO 10
                    END IF
    8           CONTINUE
C
C               scan cols. BEFORE key:
   10           DO 18 J=NCOL-1,1,-1
                    CHAR=CARD(J:J)
C                   skip blanks:
                    IF (CHAR.EQ.' ') GO TO 18
C                       look for reasonable string before key:
                        KMIN=MAX(J-12, 1)
                        DO 14 K=J,KMIN,-1
                            CHAR=CARD(K:K)
                            IF((CHAR.GE.'0'.AND.CHAR.LE.'9') .OR.
     1                         CHAR.EQ.'H' .OR. CHAR.EQ.'M' .OR.
     2                         CHAR.EQ.'S' .OR. CHAR.EQ.':' .OR.
     3                         CHAR.EQ.' ' .OR. CHAR.EQ.'.') GO TO 14
C                       quit if unacceptable char:
                        GO TO 15
   14                   CONTINUE
                        K=KMIN-1
   15                   K=K+1
C                       trim leading blanks:
                        DO 16 K=K,J
                        IF (CARD(K:K).NE.' ') GO TO 17
   16                   CONTINUE
   17                   TSTRING=CARD(K:J)
                        NTIMES=NTIMES+1
                        TIMES(NTIMES)=TIMER(TSTRING)
                        IF (TIMES(NTIMES).EQ.-1.) THEN
                                NTIMES=NTIMES-1
                                GO TO 19
                        ELSE
                                TYPES(NTIMES)='UT'
                                GO TO 30
                        END IF
   18           CONTINUE
C
C               Not found; so see if key appears later:
C
   19           NOFF=NCOL+1
                NCOL=INDEX(CARD(NOFF:),UTS(I)(:LWORD(UTS(I))))
                IF (NCOL.NE.0) THEN
                        GO TO 3
                ELSE
                END IF
        END IF
   20   CONTINUE
C
C       Nothing found.  Try without keys:
C
        NCOLON=INDEX(CARD,':')
        NOFF=1
   22   IF (NCOLON.GT.0) THEN
                NCOLON=NCOLON+NOFF-1
                IF (CARD(NCOLON-1:NCOLON-1).GE.'0' .AND.
     1              CARD(NCOLON-1:NCOLON-1).LE.'9' .AND.
     2              CARD(NCOLON+2:NCOLON+2).GE.'0' .AND.
     3              CARD(NCOLON+2:NCOLON+2).LE.'9') THEN
C                       found a colon flanked by digits.
                        TSTRING=CARD(NCOLON-2:NCOLON+5)
                        NTIMES=NTIMES+1
                        TIMES(NTIMES)=TIMER(TSTRING)
C
                        IF (TIMES(NTIMES).EQ.-1.) THEN
                                NTIMES=NTIMES-1
                                GO TO 30
                        ELSE
   25                           CALL TV(LINE(NLINE))
                                WRITE(FMT,'(''('',I2,''X,A5)'')')
     1                               NCOLON-4
                                WRITE(DUM,FMT) '^^^^^'
                                CALL TVN(DUM)
                                CALL ASK('Is this UT?',CHAR)
                                IF (MATCH (CHAR,'Y')) THEN
                                        TYPES(NTIMES)='UT'
                                        GO TO 30
                                ELSE IF (CHAR.EQ.'N') THEN
                                        NTIMES=NTIMES-1
C                                       Look for another colon:
                                        NOFF=NCOLON+4
                                        NCOLON=INDEX(CARD(NOFF:),':')
                                        IF (NCOLON.NE.0) GO TO 22
                                ELSE
                                        CALL TV('Please reply Y or N.')
                                        GO TO 25
                                END IF
                        END IF
                ELSE
C                       Look for another colon:
                        NOFF=NCOLON+1
                        NCOLON=INDEX(CARD(NOFF:),':')
                        IF (NCOLON.NE.0) GO TO 22
                END IF
        END IF
   30   CONTINUE
C
C       Assess results:
C
        IF (NTIMES.EQ.1) THEN
                UT=TIMES(1)
        ELSE IF (NTIMES.EQ.0) THEN
                UT=-1.
        ELSE
C               compare times:
                UT=TIMES(1)
        END IF
C
C
C
C
        RETURN
        END
        REAL FUNCTION TIMER(TSTRING)
C
C       extracts time (hours) from tstring.
C
        IMPLICIT NONE
C
        CHARACTER TSTRING*12, FMT*9, SUBSTRING*8, FSEP*1, STR2*12
C
        INTEGER NH,NCOLON, NM,NS
C
        REAL HOURS, TMIN,SECS
C
        INTEGER LWORD
C
C
        IF (TSTRING(:1).EQ.'S' .OR. TSTRING(:1).EQ.':') THEN
C               trim leading junk:
                STR2=TSTRING(2:)
                IF (STR2(:1).EQ.' ') THEN
                        TSTRING=STR2(2:)
                ELSE
                        TSTRING=STR2
                END IF
        END IF
C       Trim trailing nulls:
        NM=INDEX(TSTRING,CHAR(0))
        IF (NM.NE.0) TSTRING(NM:)=' '
        NH=INDEX(TSTRING,'H')
        NCOLON=INDEX(TSTRING,':')
C
        IF (NCOLON.NE.0) THEN
                FSEP=':'
        ELSE
                FSEP=' '
        END IF
C
        IF (NH.EQ.0) THEN
C               delimited string (colons or blanks)
                NH=INDEX(TSTRING,FSEP)
                WRITE (FMT,'(''(BN,F'',I1,''.0)'')') NH-1
                READ (TSTRING(1:NH-1),FMT, ERR=99) HOURS
                IF (HOURS.GT.24.) GO TO 99
                IF (TSTRING(NH+1:NH+1).EQ.' ') NH=NH+1
                SUBSTRING=TSTRING(NH+1:)
                NM=INDEX(SUBSTRING,FSEP)
                IF (NM.EQ.0) NM=LWORD(SUBSTRING)+1
                WRITE (FMT,'(''(BN,F'',I1,''.0)'')') NM-1
                READ (SUBSTRING(1:NM-1),FMT, ERR=99) TMIN
                FMT=SUBSTRING(NM+1:)
                SUBSTRING=FMT
                NS=LWORD(SUBSTRING)
                IF (NS.NE.0) THEN
C                       seconds are present.
                        WRITE (FMT,'(''(BN,F'',I1,''.0)'')') NS
                        READ (SUBSTRING(1:NS),FMT, ERR=99) SECS
                ELSE
                        SECS=0.
                END IF
                TIMER=HOURS+(TMIN+SECS/60.)/60.
                RETURN
        ELSE
C               NOT a field-separator-delimited string; look for H M S
                NM=INDEX(TSTRING,'M')
                NS=INDEX(TSTRING,'S')
C               assume H M S separators
                WRITE (FMT,'(''(BN,F'',I1,''.0)'')') NH-1
                READ (TSTRING(1:NH-1),FMT, ERR=99) HOURS
                WRITE (FMT,'(''(BN,F'',I1,''.0)'')') NM-NH-1
                READ (TSTRING(NH+1:NM-1),FMT, ERR=99) TMIN
                IF (NS.NE.0) THEN
C                       seconds are present.
                        WRITE (FMT,'(''(BN,F'',I1,''.0)'')') NS-NM-1
                        READ (TSTRING(NM+1:NS-1),FMT, ERR=99) SECS
                ELSE
                        SECS=0.
                END IF
                TIMER=HOURS+(TMIN+SECS/60.)/60.
                RETURN
        END IF
C
C       Error:
C
   99   TIMER=-1.
        RETURN
        END
      SUBROUTINE GETJDC(NLINE,DJ)
C
C  GETS DP JULIAN DAY FROM EXTERNAL COMMON BLOCK
C
C       Copyright (C) Andrew T. Young, 1990
C       Copyright (C) European Southern Observatory, 1992
C
C
      IMPLICIT NONE
C
      INTEGER NLINE
      DOUBLE PRECISION DJ
C
        INTEGER MXLINE
        PARAMETER (MXLINE=100)
        CHARACTER*80 LINE(MXLINE)
        COMMON /LINES/ LINE
C
      INTEGER IDCOL,I,M,MCOL,MXBACK,NCOL,K,MEND
      REAL DDAY,Y
C
      INTEGER MON2M
      LOGICAL MATCH
C
      CHARACTER*3 MON, MONTHS(12), LMONTH(12)
      CHARACTER*20 DATSTR, CH*1
C
        DATA LMONTH/'Jan','Feb','Mar','Apr','May','Jun','Jul',
     1              'Aug','Sep','Oct','Nov','Dec'/
        DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL',
     1              'AUG','SEP','OCT','NOV','DEC'/
C
C
C    MON is 1st 3 letters of month,  M is integer.
C    YEAR is full year,  Y is internal.
C
C
      DATSTR=' '
      IDCOL=INDEX(LINE(NLINE),'DATE')
      IF (IDCOL.EQ.0) IDCOL=INDEX(LINE(NLINE),'Date')
      IF (IDCOL.NE.0) THEN
           DO 1 I=IDCOL+4,80
C               skip over delimiters:
                IF (LINE(NLINE)(I:I).EQ.' ' .OR.
     1              LINE(NLINE)(I:I).EQ.'=' .OR.
     2              LINE(NLINE)(I:I).EQ.':') THEN
                        GO TO 1
                ELSE
C                       Date begins.
                        DATSTR=LINE(NLINE)(I:)
                        GO TO 2
                END IF
    1      CONTINUE
    2      CONTINUE
      ELSE
C       Look for month name:
        DO 5 M=1,12
                MCOL=INDEX(LINE(NLINE),MONTHS(M))
                IF (MCOL.EQ.0) MCOL=INDEX(LINE(NLINE),LMONTH(M))
                IF (MCOL.NE.0)THEN
                        NCOL=MCOL
                        MXBACK=MIN(6,MCOL-1)
C                       see if numbers precede month...
    4                   DATSTR=LINE(NLINE)(NCOL-MXBACK:)
                        IF (DATSTR(:1).GE.'0'.AND.DATSTR(:1).LE.'9')THEN
                                GO TO 6
                        ELSE
                                NCOL=NCOL+1
                                IF (NCOL-MXBACK.LE.MCOL) GO TO 4
                        END IF
                        GO TO 6
                END IF
    5   CONTINUE
C       month not found, either;quit.
        RETURN
C
    6   CONTINUE
C       Find end of month name:
        DO 8 K=6-NCOL+MCOL+4,20
        CH=DATSTR(K:K)
        IF ( (CH.GE.'A' .AND. CH.LE.'Z') .OR.
     1       (CH.GE.'a' .AND. CH.LE.'z') ) THEN
C               still in month...
                GO TO 8
        ELSE
                MEND=K
                GO TO 9
        END IF
    8   CONTINUE
        MEND=20+1
    9   CONTINUE
C       Now try to trim superfluous junk from end of string:
        IF (DATSTR(:1).GE.'0'.AND. DATSTR(:1).LE.'9') THEN
C               date string starts with digits; allow only 1 numerical field
                IF (CH.EQ.' ' .OR. CH.EQ.'.') MEND=MEND+1
                DO 10 K=MEND,20
                CH=DATSTR(K:K)
                IF ((CH.GE.'0'.AND.CH.LE.'9')) GO TO 10
                DATSTR(K:)=' '
                GO TO 11
   10           CONTINUE
        ELSE
C               date string starts with month; allow 2 fields
                IF (INDEX(DATSTR(MEND+1:),',').EQ.0) THEN
C                       no commas in date
                        MEND=INDEX(DATSTR(MEND+7:),' ')
                        IF (MEND.GT.0) DATSTR(MEND:)=' '
                ELSE
C                        commas in date
                        MEND=INDEX(DATSTR(MEND+8:),' ')
                        IF (MEND.GT.0) DATSTR(MEND:)=' '
                END IF
        END IF
   11   CONTINUE
      END IF
C
      IF(DATSTR.NE.' ')THEN
C         analyse date string to get date fields.
   17     CALL MDYC(DATSTR,MON,DDAY,Y)
C         (returns XXX in MON if it can't identify month)
          IF (MON.EQ.'XXX' .OR. DDAY.GT.32. .OR. DDAY.LT.0. .OR.
     1        Y.LT.0. .OR.
     2        (Y.LT.1800. .AND. Y.GT.99.) .OR. Y.GT.2100.) THEN
                IF (IDCOL.EQ.0) RETURN
                CALL TV ('Ambiguous date string found:')
   18           CALL TV(DATSTR)
                CALL ASK ('Does this contain a date?',MON)
                IF (MATCH(MON,'Y'))THEN
                        CALL TV ('Please enter it more clearly,')
                        CALL ASKN ('spelling month correctly:',DATSTR)
                        GO TO 17
                ELSE IF (MATCH(MON,'N'))THEN
                        RETURN
                ELSE
                        CALL TV('Please reply "y" or "n".')
                        GO TO 18
                END IF
          END IF
      ELSE
C         nothing found, so do nothing.
          RETURN
C
      END IF
C
C     Convert month name to integer:
      M=MON2M(MON)
C
C    CHECK YEAR.
      IF(Y.LT.100.) THEN
C           ...about 2048 AD you can remove the first branch, or else
C          nudge the "50" along every decade or so...
           IF (Y.GT.50.)THEN
C               assume no data before 1950:
                Y=Y+1900.
           ELSE
                Y=Y+2000.
           END IF
      END IF
C  J.D.: see SKY & TEL.61,312 (1981).
      IF(M.GT.2)GO TO 416
      M=M+12
      Y=Y-1
  416 DJ=AINT(365.25*Y) + AINT(30.6001*(M+1)) + DDAY + 1720981.5D0
C
      RETURN
      END
      SUBROUTINE MDYC(CDIN,MONTH,DAY,YEAR)
C
C       Copyright (C) Andrew T. Young, 1990
C       Copyright (C) European Southern Observatory, 1992
C
C  EXTRACTS 3-CHAR.MONTH, FLOATING DAY & YEAR FROM STRING CDIN.   3 JAN.87
C
C  (modified to handle ESO data cards, May 1992)
C
      IMPLICIT NONE
C
      CHARACTER*(*) CDIN
      CHARACTER CARD*80, MONTH*3, FIELD*5, CHAR
      INTEGER NEXT,LAST,LENCD,I,I1,J
      REAL DAY,YEAR
C
      INTEGER LWORD
C
    1 FORMAT(A4)
C    SET ILLEGAL VALUES TO FLAG ERROR RETURNS.
      MONTH='XXX'
      DAY=99.
      YEAR=-1.
      CARD=CDIN
      LENCD=LWORD(CARD)
C       skip leading blanks...
      DO 2 I=1,LENCD
      IF(CARD(I:I).NE.' ') GO TO 5
    2 CONTINUE
      RETURN
C
    4 FORMAT(BN,F4.0)
C
C  FIRST NON-BLANK...
    5 ASSIGN 25 TO NEXT
      ASSIGN 21 TO LAST
      IF(CARD(I:I).GT.'9' .OR. CARD(I:I).LT.'0') GO TO 14
C   FIRST FIELD NUMERIC, SO MONTH SECOND.
      I1=I
      DO 6 I=I,LENCD
      CHAR=CARD(I:I)
      IF(CHAR.GT.'9' .OR. CHAR.LT.'0') GO TO 10
    6 CONTINUE
      RETURN
C
C   FIRST FIELD ENDS AT (I-1), I NON-NUM.
   10 WRITE(FIELD,1) CARD(I1:I-1)
      IF(I-I1-3) 11,24,20
C    1ST FIELD IS DAY.
   11 READ(FIELD,4)DAY
      ASSIGN 18 TO LAST
C     MONTH STARTS W.LETTER.
   12 DO 13 I=I,LENCD
      CHAR=CARD(I:I)
      IF(CHAR.GE.'A' .AND. CHAR.LE.'Z') GO TO 14
   13 CONTINUE
      RETURN
C
C      GET MONTH.
   14 MONTH=CARD(I:I+2)
      I=I+3
C     FIND LAST NUMERIC FIELD.
   15 DO 16 I=I,LENCD
      CHAR=CARD(I:I)
      IF(CHAR.GE.'0' .AND. CHAR.LE.'9') GO TO LAST,(18,21)
   16 CONTINUE
      RETURN
C    YEAR LAST.
   18 J=I+3
      IF(CARD(I+2:J).EQ.'  ')J=I+1
      WRITE(FIELD,1) CARD(I:J)
      READ(FIELD,4,ERR=19)YEAR
   19 RETURN
C
C    YEAR FIRST.
   20 READ(FIELD,4,ERR=24)YEAR
      ASSIGN 24 TO NEXT
      GO TO 12
C     (TO DO MONTH.)
C
C    DAY LAST. ENDS AT NON-NUM.I1.
   21 DO 22 I1=I+1,LENCD
      CHAR=CARD(I1:I1)
      IF(CHAR.GT.'9' .OR. CHAR.LT.'0') GO TO 23
   22 CONTINUE
      RETURN
C
   23 WRITE(FIELD,1) CARD(I:I1-1)
      READ(FIELD,4,ERR=24) DAY
C     Ridiculous statement needed to fool idiot MIDAS preprocessor:
      IF(.TRUE.)GO TO NEXT,(24,25)
   24 RETURN
C
C     SKIP 2ND PART OF DOUBLE DATE.
   25 I=I1+1
      ASSIGN 18 TO LAST
      IF(CARD(I1:I1).NE.'/' .AND. CARD(I1:I1).NE.'-') GO TO 15
C     DOUBLE DATE.  SKIP TO SEPARATOR.
      I=INDEX(CARD(I1:I1+3),',')
      IF(I.EQ.0) I=INDEX(CARD(I1:I1+3),' ')
      IF(I.EQ.0) GO TO 24
      I=I+I1
      GO TO 15
      END
      REAL FUNCTION STUTZROT(DJ)
C
C  Sets STUTZ in fractional days for given Julian Date.
C
      IMPLICIT NONE
C
      DOUBLE PRECISION DJ, DSTUTZ
C
      REAL T,STUTZ
C
C
      T=(DJ-2451545.0D0)/36525.D0
      DSTUTZ=(24110.54841D0+T*(8640184.812866D0+T*(.093104-T*6.21E-6)))
     1 /86400.
      STUTZ=DSTUTZ-DINT(DSTUTZ)
      IF(STUTZ.LT.0.)STUTZ=STUTZ+1.
      STUTZROT=STUTZ
      RETURN
      END