C===========================================================================
C Copyright (C) 1995-2010 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 Massachusetts Ave, Cambridge, 
C MA 02139, USA.
C
C Correspondence 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
         PROGRAM ESODCON
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENT         esodcon.for
C.MODULE
C.AUTHOR        Andrew T. Young
C.KEYWORD
C.LANGUAGE      FORTRAN 77
C.PURPOSE       convert La Silla photometric data files to uniform ascii
C.COMMENTS
C.VERSION       5.2
C 
C 100621	last modif
C-----------------------------------------------------------------------------
C*****************************************************************************
C
C       This program reads data recorded in intermixed formats and combines
C       them into a uniform format, in the file 'data.dat' that is converted
C       into a MIDAS table-format file, using the *.fmt file ''.
C
C       The version you see here is designed to convert data from the ESO
C       1-meter telescope, as described in "The Optical Photometer on the
C       ESO 1m Telescope" by H. Lindgren & F. Gutierrez W. (ESO Operating
C       Manual No. 14, Version No.1, August 1991).  These data come in
C       several different card-image formats, flagged by a digit in col.1.
C       These codes are read and decoded at statements 110-190 in the main
C       program.
C
C       The basic method is to load the data as they are read from different
C       types of cards into the COMMON blocks /OUTR/ and /OUTC/, which hold
C       real and character variables, respectively.  (Some compilers want you
C       to keep such blocks separate.)  When enough card images have been read
C       to make a complete observation, the contents of /OUT*/ are written to
C       the uniform-format file 'data.dat'; then the common blocks are cleared,
C       to the appropriate "null" values.  (Blanks are used to clear character
C       strings.)
C
C       The MIDAS command CREATE/TABLE can then be used, with the *.fmt file
C       supplied, to convert the uniform 'data.dat' file to MIDAS table format.
C       This is done in the command CONVERT/PHOT.
C
C       The only tricky things in this data reformatting are:
C
C            1. The ESO Data contain retroactive cancellation codes.
C               This requires a look-ahead/look-back feature, which is
C               handled by storing the incoming data lines in a circular
C               buffer, LINE(nline).  The READER subroutine does the
C               looking back, to delete cancelled data.  This involves
C               some tricky indexing; be sure you understand what is going
C               on here before you change anything!
C
C            2. As long as we have the line buffer available, we use it to
C               assign times to COMMENT cards.  Times are simply interpolated
C               between the actual times of observations.  When a COMMENT is
C               longer than 32 characters, the pieces are ordered by assigning
C               times successively 0.1 second later to the second and third
C               32-byte parts.  Comments need times, because the MIDAS table
C               can be rearranged (e.g., by sorting on some column), and only
C               sorting on the MJD_OBS column will restore everything to the
C               proper order.
C
C*****************************************************************************
C
C
C  BEGIN Declarations:
C
        DOUBLE PRECISION DJD, DJZ, DJZ1, OLDMJD
C
        INTEGER INULL
        REAL RNULL
        DOUBLE PRECISION DNULL
        COMMON /NULLS/ INULL, RNULL, DNULL
C
        LOGICAL MATCH
        LOGICAL EFLAG, UTWRAP, SIDTIM, TIMSEL
        INTEGER NDATA, NOUTP
C
        INTEGER MXLINE
        PARAMETER(MXLINE=100)
        CHARACTER*80 LINE(MXLINE), DATFIL
        COMMON /LINES/LINE
        SAVE /LINES/
        COMMON /BUF/LENBUF, NOW
C 
        CHARACTER*32  CTEST
C
        CHARACTER A*1
        CHARACTER*10 RASTR, DESTR,UTSTR, TIME
        CHARACTER*32 COM1,COM2,COM3, OBJNAM
        CHARACTER*3 MON
        DOUBLE PRECISION DJ
C
C       Filter conversion table:
C
        CHARACTER*8 FILTCD(20),BNDNAM(20)
        COMMON /FILTBC/ FILTCD,BNDNAM
C
C
C       Declarations for the output (must be in WRITER too!):
C
        DOUBLE PRECISION MJDOBS
        COMMON /OUTR/ SIGNAL,EXPTIME,MJDOBS, GENEVAQ,GENEVAR,GENEVAG
        CHARACTER OBJECT*32,STARSKY*4,BAND*8,COMMENT*32
        COMMON /OUTC/ OBJECT,STARSKY,BAND,COMMENT
C
C
        INTEGER LENBUF, NOW, ITBL, ISTAT, NCOLS, NROWS, NSORTC, NWPRAL, 
     1   NROWSAL, NCOL, NCDIAM, NROW, NLINE, I, I1, I2, M, MON2M, NTYPE, 
     2         ID, NFILT, NSTSK, K, K2
        REAL SIGNAL, EXPTIME, GENEVAQ, GENEVAR, GENEVAG, DIAM, 
     1     ELONG, PHI, OLDUT, UT1, UT2, UT, TIMER, DAY, YEAR, STUTZH, 
     2     STUTZROT, TINT, SIGIN, FNINTS, STDDEV, GENQ, GENR, GENG, FLST
C
C  Set up MIDAS declarations:
C
        INTEGER MADRID(1)
C
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'
C
        COMMON /VMR/ MADRID
C
        INTEGER NACTEL, IUNIT, NULLS
        CHARACTER CARD*80
C
C  END Declarations.
C
C
C  BEGIN DATA statements:
C
        INCLUDE 'MID_INCLUDE:ST_DAT.INC'
C
        DATA NDATA/7/, NOUTP/8/
C
C  END DATA statements.
C
C
C  ********************  PROLOGUE  ********************
C
        CALL STSPRO ('ESODCON')
C
C       Because the Sun library barfs on -Inf (which is used as NULL
C       by MIDAS), I define my own "NULL" values here as 3.e33:
C
        RNULL=3.E33
        DNULL=3.D33
C
C  Real program begins here:            (use RUN ESODCON to test in MIDAS)
C
C
        INQUIRE(FILE='data.dat',EXIST=EFLAG)
        IF (EFLAG) THEN
                CALL TV('File "data.dat" already exists!')
    1           CALL ASK ('Do you want to write over it?? ',A)
                IF (MATCH(A,'Y')) THEN
                        OPEN(NOUTP,FILE='data.dat',STATUS='UNKNOWN')
                        REWIND NOUTP
                        CLOSE (NOUTP,STATUS='DELETE')
                ELSE IF (MATCH(A,'N')) THEN
                        CALL STETER(1,
     1                  'Please move "data.dat" to a new name.')
                ELSE
                        CALL TV('Please reply "yes" or "no".')
                        GO TO 1
                END IF
         END IF
C               Open the uniform-format ascii file:
        OPEN(NOUTP,FILE='data.dat',STATUS='UNKNOWN')
        REWIND NOUTP
C
C       Find telescope coordinates:
C
        INQUIRE (FILE='esotel.tbl', EXIST=EFLAG)
        IF (EFLAG) THEN
                CALL TBTOPN ('esotel.tbl', 0,  ITBL, ISTAT)
                IF (ISTAT.NE.0) THEN
                        CALL TV('Problem opening "esotel.tbl".')
                        CALL STETER(2,'Do you have read permission?')
                END IF
                CALL TBIGET (ITBL,
     1                    NCOLS, NROWS, NSORTC, NWPRAL, NROWSAL, ISTAT)
                CALL TBLSER (ITBL, 'TELESCOP',  NCOL, ISTAT)
                CALL TBLSER (ITBL, 'DIAM',  NCDIAM, ISTAT)
                CALL TV(' ')
                CALL TV ('Which telescope did you use?')
                DO 2 NROW=1,NROWS
                CALL TBERDC (ITBL, NROW, NCOL,  CTEST, EFLAG, ISTAT)
                IF (EFLAG.OR. ISTAT.NE.0) GOTO 2
                CALL FT_EOS (CTEST,32,COM2,ISTAT)
                CALL TBERDR (ITBL, NROW, NCDIAM,  DIAM, EFLAG, ISTAT)
                IF (EFLAG.OR. ISTAT.NE.0) GOTO 2
                WRITE (COM1,'(8X,I2,'':  '',A8,F6.2,'' m'')')
     1                              NROW,COM2,DIAM
                CALL TV (COM1)
    2           CONTINUE
                WRITE(COM1,'(8X,I2,'':  (None of these)'')') NROWS+1
                CALL TV(COM1)
                CALL ASK ('Please enter the number: ',COM1)
    3           READ (COM1,'(BN,I2)', ERR=4) NROW
                IF (NROW.LE.NROWS .AND. NROW.GE.1) THEN
                        CALL TBERDC (ITBL,NROW,NCOL,CTEST,EFLAG,ISTAT)
                        CALL FT_EOS (CTEST,32,COM2,ISTAT)
                ELSE
                        COM2='"none"'
                END IF
                GO TO 6
    4           DO 5 NROW=1,NROWS
                CALL TBERDC (ITBL, NROW, NCOL, CTEST, EFLAG, ISTAT)
                CALL FT_EOS (CTEST,32,COM2,ISTAT)
                IF (COM1.EQ.COM2) THEN
                        GO TO 6
                END IF
    5           CONTINUE
                CALL ASK ('Please use the numbers at left.',COM1)
                GO TO 3
    6           WRITE(COM1,'(''   You selected '',A8)') COM2
                CALL TV (COM1)
                IF (NROW.LE.NROWS .AND. NROW.GE.1) THEN
                        CALL TBLSER (ITBL, 'LON',  NCOL, ISTAT)
                        CALL TBERDR (ITBL,NROW,NCOL, ELONG,EFLAG,ISTAT)
                        IF(EFLAG.OR. ISTAT.NE.0) THEN
                            CALL QF('Enter EAST longitude (deg):',
     1                                 ELONG)
                        END IF
                        CALL TBLSER (ITBL, 'LAT',  NCOL, ISTAT)
                        CALL TBERDR (ITBL,NROW,NCOL, PHI,EFLAG,ISTAT)
                        IF(EFLAG.OR. ISTAT.NE.0) THEN
                             CALL QF('Enter Latitude (deg):', PHI)
                        END IF
                ELSE
                        CALL QF('Enter EAST longitude (deg):', ELONG)
                        CALL QF('Enter Latitude (deg):', PHI)
                END IF
                ELONG=ELONG/15.
                CALL TBTCLO(ITBL, ISTAT)
        ELSE
                CALL TV('File "esotel.tbl" not available!')
                CALL STETER(3,'Please get a copy of "esotel.tbl"')
        END IF
C
C       Get filter conversion table:
C
        CALL FILTBL
C
C       clear data storage:
C
        OBJECT=' '
        STARSKY=' '
        BAND=' '
        COMMENT=' '
        SIGNAL=RNULL
        EXPTIME=RNULL
        GENEVAQ=RNULL
        GENEVAR=RNULL
        GENEVAG=RNULL
        MJDOBS=DNULL
C
C       *** Prepare input buffer ***
C
        CALL TV(' ')
    7   Call STKRDC ('RAWDAT',1,1,80,  NACTEL,DATFIL,IUNIT,NULLS,ISTAT)
C   7   CALL ASKFIL('What is the name of the file of observed data?',
C    1                  DATFIL)
        INQUIRE(FILE=DATFIL,EXIST=EFLAG)
        IF (.NOT.EFLAG) THEN
                CALL TV('No such file exists!')
                CALL TVN('Please try again:')
                GO TO 7
        END IF
        OPEN(NDATA,FILE=DATFIL,STATUS='UNKNOWN')
        REWIND NDATA
        NOW=0
C
C       Read data.  (READER returns negative NLINE at EOF.)
C
        CALL READER(NLINE)
C
C       Initialize times on first read:
C
        UTWRAP=.FALSE.
        SIDTIM=.FALSE.
        TIMSEL=.FALSE.
    8   DJZ=0.D0
        DJZ1=0.D0
        OLDMJD=-1.D0
        OLDUT=-1.
        UT1=0.
        UT2=0.
        UT=-1.
C
        DO 10 I=1,LENBUF
            IF (LINE(I)(:2).EQ.' 8') THEN
C               Look for first day of double date:
                IF (DJZ.EQ.0.D0) THEN
                        CALL GETJDC (I,DJZ)
                        IF (DJZ.GT.0.D0) THEN
C                               found date on card.
                                CALL TV('Date found on:')
                                CALL TVN(LINE(I))
                                DJZ1=DJZ
                        END IF
                END IF
C               Look for UT:
                CALL GETUT(I,UT)
C               Look for "Tim.Out":
                IF (LINE(I)(5:11).EQ.'Tim.Out' .AND.
     1              LINE(I)(13:14).EQ.'SI') THEN
                    CALL TV('Using Local Sidereal Time.')
                    SIDTIM=.TRUE.
                    TIMSEL=.TRUE.
                ELSE IF (LINE(I)(5:11).EQ.'Tim.Out' .AND.
     1              LINE(I)(13:14).EQ.'UT') THEN
                    CALL TV('Using Universal Time.')
                    SIDTIM=.FALSE.
                    TIMSEL=.TRUE.
                END IF
            ELSE IF (LINE(I)(:2).EQ.' 7') THEN
                UT=TIMER(LINE(I)(26:33))
C               Look for JD of 0h UT:
                IF (DJZ.EQ.0.D0) THEN
        WRITE(CARD,*)'I=',I
        CALL TV(CARD)
        CALL TVN(LINE(I)(11:19))
                    READ(LINE(I)(11:19),'(F9.1)',ERR=10) DJZ
                END IF
            END IF
            IF (UT.GE.0.) GO TO 12
   10   CONTINUE
        CALL TV('Can''t find U.T. in first 100 cards.')
C
   12   UT1=UT
        I1=I
        UT=-1.
C
        DO 20 I=I+1,LENBUF
            IF (LINE(I)(:2).EQ.' 8') THEN
C               Look for first day of double date:
                IF (DJZ.EQ.0.D0) THEN
                        CALL GETJDC (I,DJZ)
                        IF (DJZ.GT.0.D0) THEN
C                               found date on card.
                                CALL TV('Date found on:')
                                CALL TVN(LINE(I))
                                DJZ1=DJZ
                        END IF
                END IF
C               Look for UT:
                CALL GETUT(I,UT)
C               Look for "Tim.Out":
                IF (LINE(I)(5:11).EQ.'Tim.Out' .AND.
     1              LINE(I)(13:14).EQ.'SI') THEN
                    CALL TV('Using Local Sidereal Time.')
                    SIDTIM=.TRUE.
                    TIMSEL=.TRUE.
                ELSE IF (LINE(I)(5:11).EQ.'Tim.Out' .AND.
     1              LINE(I)(13:14).EQ.'UT') THEN
                    CALL TV('Using Universal Time.')
                    SIDTIM=.FALSE.
                    TIMSEL=.TRUE.
                END IF
            ELSE IF (LINE(I)(:2).EQ.' 7') THEN
                UT=TIMER(LINE(I)(26:33))
                IF (DJZ.EQ.0.D0) THEN
                        READ(LINE(I)(11:19),'(F9.1)') DJZ
                        IF (UT.LT.UT1) THEN
                                DJZ=DJZ-1.D0
                        END IF
                END IF
            END IF
            IF (UT.GE.0.) GO TO 22
   20   CONTINUE
C
   22   UT2=UT
        I2=I
C
        IF (UT2.GT.UT1) THEN
C               OK.
        ELSE IF (UT1.GT.21. .AND. UT2.LT.UT1+24.+3.) THEN
C               wrap through 0h U.T.; 3-hr. grace period.
                IF (DJZ.EQ.0.D0) UTWRAP=.TRUE.
        ELSE
                CALL TV('Times are out of order!')
                CALL TV(' ')
                IF (I2.GT.I1 .AND. I2.LT.MXLINE)THEN
                    DO 23 I=I1,I2
                        CALL TVN(LINE(I))
   23               CONTINUE
                    CALL TV(' ')
                    CALL STETER(23,'Please fix data.')
                ELSE
                    CALL STETER(23,'Please fix data.')
                END IF
        END IF
C
        IF (DJZ.EQ.0.D0) THEN
C               read on until we find a type 7 card...
                DO 26 I=I,LENBUF
                    IF (LINE(I)(:2).EQ.' 7') THEN
                        UT=TIMER(LINE(I)(26:33))
                        READ(LINE(I)(11:19),'(F9.1)') DJZ
                        IF (UT.LT.UT1) THEN
                                DJZ=DJZ-1.D0
                        END IF
                        GO TO 30
                    END IF
   26           CONTINUE
C
                IF (DJZ.EQ.0.D0) THEN
C                       still not found, so ask for help:
   28                   CALL ASK ('Please supply UT date at start:',
     1                             COM1)
                        CALL MDYC(COM1,MON,DAY,YEAR)
                        M=MON2M(MON)
                        IF (M.EQ.0 .OR. DAY.LT.0. .OR. DAY.GT.32. .OR.
     1                      YEAR.LT.0. .OR. YEAR.GT.2100. .OR.
     2                      (YEAR.GT.99. .AND. YEAR.LT.1900.)) GOTO 28
                        IF (YEAR.LT.50.) THEN
                                 YEAR=YEAR+2000.
                        ELSE
                                YEAR=YEAR+1900.
                        END IF
C                       compute JD of 0h UT:
                        IF (M.GT.2) GOTO 29
                        M=M+12
                        YEAR=YEAR-1.
   29                   DJZ=AINT(365.25*YEAR) + AINT(30.6001*(M+1)) +
     1                       DAY + 1720981.5D0
                        COM1=' '
                END IF
        ELSE
                IF (UTWRAP) DJZ=DJZ-1.D0
        END IF
   30   CONTINUE
C
        IF(.NOT.TIMSEL .AND. NLINE.LT.25) THEN
            DO 33 I=I,25
                IF (LINE(I)(5:11).EQ.'Tim.Out' .AND.
     1              LINE(I)(13:14).EQ.'SI') THEN
                    CALL TV('Using Local Sidereal Time.')
                    SIDTIM=.TRUE.
                    TIMSEL=.TRUE.
                ELSE IF (LINE(I)(5:11).EQ.'Tim.Out' .AND.
     1              LINE(I)(13:14).EQ.'UT') THEN
                    CALL TV('Using Universal Time.')
                    SIDTIM=.FALSE.
                    TIMSEL=.TRUE.
                END IF
   33       CONTINUE
        END IF
C
        IF(.NOT.TIMSEL) THEN
                CALL TV('ASSUMING Universal Time is used...')
                CALL ASK('               IS this correct???',COM1)
                IF (MATCH(COM1,'Y')) THEN
                        TIMSEL=.TRUE.
                ELSE IF (MATCH(COM1,'N'))THEN
                        CALL TV('Assuming Sidereal Time is used.')
                        TIMSEL=.TRUE.
                        SIDTIM=.TRUE.
                END IF
        END IF
C
C       Decide which date to use:
        IF (DJZ1.NE.0.D0 .AND. UT1.LT.MOD(36.-ELONG,24.))THEN
C               use 2nd day of double date:
                DJZ=DJZ+1.D0
        ELSE
C               use 1st day of double date:
        END IF
        STUTZH=STUTZROT(DJZ)*24.
C       Now fix up JD zero-point to make MJD_OBS:
        DJZ=DJZ-2400000.5D0
        GO TO 111
C
  110   CALL READER(NLINE)
  111   IF (NLINE.GT.0) THEN
                READ (LINE(NLINE)(:2),'(I2)',ERR=199) NTYPE
                IF (NTYPE.LT.0 .OR. NTYPE.GT.9) GOTO 199
                NTYPE=NTYPE+1
                GO TO (115,125,130,140,140,150,160,170,180,190) NTYPE
C                 type: 0   1   2   3   4   5   6   7   8   9
C
C                 Card Type:
C
C                       0: measurement
C
  115           CONTINUE
                READ (LINE(NLINE),116) ID,TINT,TIME,NFILT,NSTSK,SIGIN,
     1                              FNINTS,STDDEV,GENQ, GENR, GENG
  116           FORMAT(2X,I3,F5.1,2X,A10,I4,4X,I4,F10.1,F7.0,2F7.2,2F6.2
     1)
                OBJECT=OBJNAM
C               Convert mean rate to integral count.
                SIGNAL=SIGIN*FNINTS
C               Convert exposure time to total.
                EXPTIME=TINT*FNINTS
                UT=TIMER(TIME)
                IF (SIDTIM) THEN
                        FLST=UT
                        UT=MOD((UT-ELONG-STUTZH+48.D0),24.D0)/1.00273791
                        IF(FLST.LT.0.00273791*24.)THEN
C                               LST may have rolled over.
                                IF (DJZ+UT/24.D0.LT.OLDMJD) THEN
                                        UT=UT+24./1.00273791
                                ELSE
                                END IF
                        END IF
                END IF
C               Correct time of observation from middle to start of exposure.
C               Remember to convert from seconds to days:
                MJDOBS=DJZ+(UT/24.D0) - EXPTIME*0.5/86400.
                IF (MJDOBS.LT.OLDMJD) THEN
                    IF (UT.LT.3. .AND. OLDUT.GT.21.) THEN
C                       assume we just went through 0h UT.
                        CALL TV('   0h UT passed by:')
                        CALL TVN(LINE(NLINE))
                        DJZ=DJZ+1.D0
                        STUTZH=24.*STUTZROT(DJZ+2400000.5D0)
                    ELSE
  117                   IF (TIMSEL) THEN
                            CALL TV('Times out of order!')
                            CALL TV(LINE(NLINE))
                            WRITE(LINE(1),118) 'old MJD =',OLDMJD,
     1                                     '; oldut=',OLDUT
  118                       FORMAT(A9,F13.5,A8,F13.5)
                            CALL TV(LINE(1))
                            WRITE(LINE(1),118) 'MJD =',MJDOBS,
     1                                          ';    ut=',UT
                            CALL TVN(LINE(1))
                            CALL STETER(118,'Please fix data.')
                        ELSE
C                           See if we are using sidereal time:
  119                       CALL ASK('Are you using Sidereal Time?',
     1                                  COM1)
                            IF (MATCH(COM1,'Y'))THEN
                                SIDTIM=.TRUE.
                                TIMSEL=.TRUE.
                                REWIND NDATA
                                REWIND NOUTP
                                NOW=0
                                CALL READER(NLINE)
                                GO TO 8
                            ELSE IF (MATCH(COM1,'N'))THEN
                                SIDTIM=.FALSE.
                                TIMSEL=.TRUE.
                                GO TO 117
                            ELSE
                                CALL TV('Please reply "y" or "n".')
                                GO TO 119
                            END IF
                        END IF
                    END IF
                END IF
                OLDMJD=MJDOBS
                OLDUT=UT
C               Convert STAR/SKY flag to standard strings.
                IF (NSTSK.EQ.0) THEN
                        STARSKY='STAR'
                ELSE IF (NSTSK.EQ.1) THEN
                        STARSKY='SKY'
                ELSE
                        CALL TV('Unexpected value in STAR/SKY column:')
                        CALL TV(LINE(NLINE))
                        CALL STETER(119,'Fix data and try again.')
                END IF
C               Convert filter position to band name:
                BAND=BNDNAM(NFILT+1)
C               Save Geneva parameters:
                GENEVAQ=GENQ
                GENEVAR=GENR
                GENEVAG=GENG
                CALL WRITER
                GO TO 110
C
C                       1: last integration results if MAGtape,All (??)
  125           CONTINUE
                GO TO 110
C
C                       2: (unused)
  130           CONTINUE
                GO TO 110
C
C                       3 or 4: rejects (should never occur!)
  140           CONTINUE
                CALL VIEW('PROGRAM ERROR: kept bad data!',NLINE)
                GO TO 110
C
C                       5: Object identifier
  150           CONTINUE
                READ (LINE(NLINE),'(2X,A32)') OBJNAM
                GO TO 110
C
C                       6: Telescope coordinates
  160           CONTINUE
                READ (LINE(NLINE),'(5X,A10,1X,A10)') RASTR, DESTR
                GO TO 110
C
C                       7: measurement number, UT, & JD
  170           CONTINUE
                READ (LINE(NLINE),'(2X,I5,F12.1,2A10)')M,DJ,UTSTR
C               lststr is truncated to nearest minute on card 7, so useless.
                UT=TIMER(UTSTR)
                IF (DJ.EQ.DJZ+2400000.5D0) THEN
C                       OK.
                ELSE IF (DJ.EQ.DJZ+2400001.5D0) THEN
C                       probably OK.
                        IF (UT.LT.3. .AND. OLDUT.GT.21.) THEN
C                           assume we just went through 0h UT.
                            CALL TV('0h UT passed by:')
                            CALL TVN(LINE(NLINE))
                            DJZ=DJZ+1.
                            STUTZH=24.*STUTZROT(DJZ+2400000.5D0)
                        ELSE
                            CALL TV('Computed JD does not match data:')
                            CALL TV(LINE(NLINE))
                            CALL STETER(176,'Please fix data.')
                        END IF
                ELSE
C                       problem:
                        CALL TV('Computed JD does not match data:')
                        CALL TV(LINE(NLINE))
                        WRITE(COMMENT,*) 'Computed was ',DJZ+2400000.5D0
                        CALL TV(COMMENT)
                        CALL STETER(178,'Please fix data.')
                END IF
                OLDUT=UT
                GO TO 110
C
C                       8: Heading or comment
  180           CONTINUE
                CALL GETUT(NLINE,UT)
                IF (UT.GE.0.)THEN
C                       time found on card
                        DJD=DJZ+(UT/24.D0)
                        IF (DJD.LT.OLDMJD) THEN
                            IF (UT.LT.3. .AND. OLDUT.GT.21.) THEN
C                               assume we just went through 0h UT.
                                DJZ=DJZ+1.D0
                                DJD=DJD+1.D0
                                STUTZH=24.*STUTZROT(DJZ+2400000.5D0)
                                CALL TV('0h UT passed by:')
                                CALL TVN(LINE(NLINE))
                            ELSE
  183                           IF (TIMSEL) THEN
                                    CALL TV('Times out of order!')
                                    CALL TV(LINE(NLINE))
                                    CALL STETER(183,'Please fix data.')
                                ELSE
                                    CALL TV('Times seem out of order.')
  184                               CALL ASK('Are you using UT or LST?',
     1                                         COM1)
                                    IF (MATCH(COM1,'U')) THEN
                                        SIDTIM=.FALSE.
                                        TIMSEL=.TRUE.
                                        GO TO 183
                                     ELSE IF (MATCH(COM1,'LST') .OR.
     1                                        MATCH(COM1,'SID')) THEN
                                        CALL TV('Starting over....')
                                        CALL TV(' ')
                                        SIDTIM=.TRUE.
                                        TIMSEL=.TRUE.
                                        REWIND NDATA
                                        REWIND NOUTP
                                        NOW=0
                                        CALL READER(NLINE)
                                        GO TO 8
                                    ELSE
                                        CALL TV('Please reply "LST"')
                                        CALL TVN('         or "UT".')
                                        GO TO 184
                                    END IF
                                END IF
                            END IF
                        END IF
                        OLDMJD=DJD
                        OLDUT=UT
                ELSE
C                       time not found on card
                        IF (OLDMJD.EQ.-1.D0) THEN
                                DJD=DJZ+(UT1/24.)-1.E-5*(I1-NLINE)
                        ELSE
                                DJD=OLDMJD+1.E-5
                        END IF
                END IF
                MJDOBS=DJD
C               Split up comment card cleanly if possible:
                DO 186 K=34,14,-1
                IF (LINE(NLINE)(K:K).EQ.' ') GO TO 187
  186           CONTINUE
  187           DO 188 K2=K+32,K+12,-1
                IF (LINE(NLINE)(K2:K2).EQ.' ') GO TO 189
  188           CONTINUE
  189           IF (LINE(NLINE)(K2+32:).EQ.' ') THEN
                        COM1=LINE(NLINE)(3:K)
                        COM2=LINE(NLINE)(K+1:K2)
                        COM3=LINE(NLINE)(K2+1:)
                ELSE
                        READ (LINE(NLINE),'(2X,2A32,A14)')COM1,COM2,COM3
                END IF
                COMMENT=COM1
                CALL WRITER
                MJDOBS=DJD+1.D-6
                COMMENT=COM2
                IF (COM2.NE.' ') CALL WRITER
                MJDOBS=DJD+2.D-6
                COMMENT=COM3
                IF (COM3.NE.' ') CALL WRITER
                GO TO 110
C
C                       9: End of object
  190           CONTINUE
                OBJNAM=' '
                GO TO 110
C
C                       other: Illegal card.
  199           CONTINUE
                CALL TV('This card is not in standard format:')
                CALL TV(LINE(NLINE))
                CALL TV('Please fix data and try again.')
                CALL STETER(199,'Data not in std. ESO format')
        END IF
C
C       *** fall through at EOF ***
C
        CLOSE(NOUTP)
C
C       Now make format file:
C
        OPEN (NOUTP,FILE='data.fmt',STATUS='UNKNOWN')
        WRITE(NOUTP,'(A26)')'! Format file for ESO Data'
  200   FORMAT(A39)
        WRITE(NOUTP,200)'DEFINE/FIELD   1  10 R  F10.1 :SIGNAL  '
        WRITE(NOUTP,200)'DEFINE/FIELD  11  42 C  A32   :OBJECT  '
        WRITE(NOUTP,200)'DEFINE/FIELD  43  46 C  A7    :STARSKY '
        WRITE(NOUTP,200)'DEFINE/FIELD  48  55 C  A8    :BAND    '
        WRITE(NOUTP,200)'DEFINE/FIELD  56  67 D  F12.6 :MJD_OBS '
        WRITE(NOUTP,200)'DEFINE/FIELD  68  75 R  F8.3  :EXPTIME '
        WRITE(NOUTP,200)'DEFINE/FIELD  76 107 C  A32   :COMMENT '
        WRITE(NOUTP,200)'DEFINE/FIELD 108 113 R  F8.2  :GENEVA_Q'
        WRITE(NOUTP,200)'DEFINE/FIELD 114 119 R  F8.2  :GENEVA_R'
        WRITE(NOUTP,200)'DEFINE/FIELD 120 125 R  F8.2  :GENEVA_G'
        WRITE(NOUTP,'(A3)')'END'
        CLOSE(NOUTP)
C
        CALL TV('DCON is finished')
C
C
C       End MIDAS:
C
        CALL STSEPI
        END
        SUBROUTINE WRITER
C
C       writes output to uniform ascii file 'data.dat'
C
        INTEGER INULL
        REAL RNULL
        DOUBLE PRECISION DNULL
        COMMON /NULLS/ INULL, RNULL, DNULL
C
        REAL SIGNAL, EXPTIME, GENEVAQ, GENEVAR, GENEVAG
        DOUBLE PRECISION MJDOBS
        COMMON /OUTR/ SIGNAL,EXPTIME,MJDOBS, GENEVAQ,GENEVAR,GENEVAG
        CHARACTER OBJECT*32,STARSKY*4,BAND*8,COMMENT*32, C*125
        COMMON /OUTC/ OBJECT,STARSKY,BAND,COMMENT
C
C
        WRITE(C,5) SIGNAL, OBJECT,STARSKY,BAND,MJDOBS,EXPTIME,COMMENT,
     1                                        GENEVAQ,GENEVAR,GENEVAG
    5   FORMAT(F10.1,A32,A4,1X,A8,F12.6,F8.3,A32,3F6.2)
C
C       Fix up NULL fields:
C
        IF (SIGNAL.EQ.RNULL) C(1:10)=' '
        IF (MJDOBS.EQ.DNULL) C(56:67)=' '
        IF (EXPTIME.EQ.RNULL) C(68:75)=' '
        IF (GENEVAQ.EQ.RNULL) C(108:113)=' '
        IF (GENEVAR.EQ.RNULL) C(114:119)=' '
        IF (GENEVAG.EQ.RNULL) C(120:125)=' '
C
        WRITE(8,'(A125)') C
C
C       clear data arrays:
C
        OBJECT=' '
        STARSKY=' '
        BAND=' '
        COMMENT=' '
        SIGNAL=RNULL
        EXPTIME=RNULL
        GENEVAQ=RNULL
        GENEVAR=RNULL
        GENEVAG=RNULL
        MJDOBS=DNULL
C
        RETURN
        END
        SUBROUTINE READER(NLINE)
C
C       Reads data lines, and returns ptr. to one in buffer each time.
C
C *****************************************************************************
C
C       This subroutine uses a circular buffer to read the data, because the
C       ESO data contain codes for "cancel last star" and "cancel last datum".
C
C       The circular buffer is also used here to look ahead, and interpolate
C       times to assign to comments that lack time information.
C
C *****************************************************************************
C
        INTEGER MXLINE
        PARAMETER (MXLINE=100)
C
        INTEGER NLINE, LENBUF, NOW, NEOF, LAST
        CHARACTER*80 LINE(MXLINE)
        COMMON /LINES/LINE
        SAVE /LINES/
        COMMON /BUF/LENBUF, NOW
C
        SAVE NEOF
C
        DATA NEOF/0/
C
C
        IF (NOW.EQ.0) THEN
C
C       *****   initial entry:  *****
C
                NOW=1
    1           READ (7,'(A80)', END=9) LINE(NOW)
C                       Test for backup (bad data):
                IF (LINE(NOW)(:2).EQ.' 4') THEN
C                       Back up over object:
                        DO 4 NOW=NOW-1,1,-1
                        IF (LINE(NOW)(:2).EQ.' 5') GO TO 6
    4                   CONTINUE
                        NOW=0
                ELSE IF (LINE(NOW)(:2).EQ.' 3') THEN
C                       Back up over last filter:
                        IF (LINE(NOW-1)(:2).EQ.' 0') THEN
                                NOW=NOW-2
                        ELSE IF (LINE(NOW-2)(:2).EQ.' 0') THEN
                                NOW=NOW-3
                        ELSE
                                CALL TV('Did not find bad datum:')
                                DO 5 LAST=MAX(1,NOW-3),NOW
    5                           CALL TVN(LINE(LAST))
                        END IF
                END IF
C
                NOW=NOW+1
C
C               *** test for full buffer ***
C
    6           IF(NOW.GT.MXLINE) THEN
                        LENBUF=MXLINE
                ELSE
                        GO TO 1
                END IF
C
C               *** return from initial entry ***
C
    8           NOW=1
                NLINE=1
                RETURN
C
C               *** EOF found on initial entry ***
C
    9           LENBUF=NOW
                NEOF=LENBUF
                GOTO 8
C
        ELSE
C
C       *****  normal entry (NOW > 0):  *****
C
                LAST=NOW
   10           IF (NEOF.EQ.0) THEN
C                       overwrite last output line:
                        READ (7, '(A80)',END=99) LINE(NOW)
C
C                       Test for backup (bad data):
                        IF (LINE(NOW)(:2).EQ.' 4') THEN
C                               back up over object:
                                DO 14 NOW=NOW-1,1,-1
                                IF (LINE(NOW)(:2).EQ.' 5') GOTO 10
   14                           CONTINUE
                                DO 15 NOW=LENBUF,LAST+1,-1
                                IF (LINE(NOW)(:2).EQ.' 5') GOTO 10
   15                           CONTINUE
                                CALL TV('Backed up over entire buffer!')
                                CALL STETER(15,
     1                          'Increase MXLINE and recompile')
C
                        ELSE IF (LINE(NOW)(:2).EQ.' 3') THEN
C                               back up over filter:
                                DO 17 NOW=NOW-1,1,-1
                                IF (LINE(NOW)(:2).EQ.' 0') GOTO 10
   17                           CONTINUE
                                DO 18 NOW=LENBUF,LAST+1,-1
                                IF (LINE(NOW)(:2).EQ.' 0') GOTO 10
   18                           CONTINUE
                                CALL TV('Backed up over entire buffer!')
                                CALL STETER(18,
     1                          'Increase MXLINE and recompile')
                        END IF
                END IF
C
   20           IF (NOW.NE.LAST) THEN
C                       Refill buffer, if needed:
                        NOW=NOW+1
                        IF (NOW.GT.LENBUF) NOW=1
                        GO TO 10
                END IF
C
C               Advance line counter:
                IF (NOW.EQ.LENBUF) THEN
                        NOW=1
                ELSE
                        NOW=NOW+1
                END IF
C
                IF (NOW.EQ.NEOF) THEN
C                       Return negative value at eof:
                        NLINE=-NOW
                        RETURN
                ELSE
                        NLINE=NOW
                END IF
C
                RETURN
C
   99           NEOF=NOW
                IF (NEOF.GT.LENBUF) NEOF=1
                GO TO 20
C
        END IF
C
        END
        SUBROUTINE VIEW(STRING,NLINE)
C
        CHARACTER*(*) STRING
C
        INTEGER MXLINE
        PARAMETER (MXLINE=100)
C
        CHARACTER*80 LINE(MXLINE)
        INTEGER NLINE, LENBUF, NOW, NM1, NP1, NP2, NP3
        COMMON /LINES/LINE
        SAVE /LINES/
        COMMON /BUF/LENBUF, NOW
C
C
        CALL TV(STRING)
        CALL TV(' ')
        NM1=NLINE-1
        IF (NM1.LE.0) THEN
                NM1=LENBUF
                IF(LENBUF.EQ.MXLINE) CALL TVN(LINE(NM1))
        ELSE
                CALL TVN(LINE(NM1))
        END IF
        CALL TVN(LINE(NLINE))
        NP1=NLINE+1
        IF (NP1.GT.LENBUF) NP1=1
        CALL TVN(LINE(NP1))
        NP2=NLINE+2
        IF (NP2.GT.LENBUF) NP2=1
        CALL TVN(LINE(NP2))
        NP3=NLINE+3
        IF (NP3.GT.LENBUF) NP3=1
        CALL TVN(LINE(NP3))
C
        RETURN
        END
        SUBROUTINE  FILTBL
C
C       Filter conversion table:
C
        CHARACTER*8 FILTCD(20),BNDNAM(20)
        COMMON /FILTBC/ FILTCD,BNDNAM
C
        LOGICAL MATCH
C
        CHARACTER ANS, ROW*40
        CHARACTER*8 ESORCD(12),ESOBCD(12),ESORED(12),ESOBLU(12)
        INTEGER I
C
        DATA ESORCD/' 0',' 1',' 2',' 3',' 4',' 5',' 6',
     1              ' 7',' 8',' 9','10','11'/
C
        DATA ESORED/'B','U','DARK','DARK','DARK','DARK','DARK',
     1              'DARK','DARK','I','R','V'/
C
        DATA ESOBCD/' 0',' 1',' 2',' 3',' 4',' 5',' 6',
     1              ' 7',' 8',' 9','10','11'/
C
        DATA ESOBLU/'BETAN','BETAW','u','v','b','y','DARK',
     1              'DARK','DARK','U','V','B'/
C
C
        CALL TV(' ')
    1   CALL TV('Did you use the "red" standard wheel (UBVRI),')
        CALL TVN('            the "blue" standard wheel (uvby, beta),')
        CALL TVN('            or some other arrangement?')
        CALL ASK('(Please reply "red", "blue", or "other"):',ANS)
    2   IF (MATCH(ANS,'R')) THEN
C               ESO Std.red wheel.
                CALL TV('The standard table for this wheel is:')
                CALL TV('      code   band')
                DO 3 I=1,12
                WRITE(ROW,'(7X,A6,A8)') ESORCD(I),ESORED(I)
                CALL TV(ROW)
                FILTCD(I)=ESORCD(I)
                BNDNAM(I)=ESORED(I)
    3           CONTINUE
                CALL ASK('Are these correct?',ANS)
                IF (MATCH(ANS,'Y'))THEN
                        RETURN
                ELSE IF (MATCH(ANS,'N')) THEN
                        GO TO 2
                ELSE
                        CALL TV('Please reply "yes" or "no".')
                        CALL TV('Let''s try this again:')
                        GO TO 1
                END IF
        ELSE IF (MATCH(ANS,'B')) THEN
C               ESO Std.red wheel.
                CALL TV('The standard table for this wheel is:')
                CALL TV('      code   band')
                DO 4 I=1,12
                WRITE(ROW,'(7X,A6,A8)') ESOBCD(I),ESOBLU(I)
                CALL TV(ROW)
                FILTCD(I)=ESOBCD(I)
                BNDNAM(I)=ESOBLU(I)
    4           CONTINUE
                CALL ASK('Are these correct?',ANS)
                IF (MATCH(ANS,'Y'))THEN
                        RETURN
                ELSE IF (MATCH(ANS,'N')) THEN
                        GO TO 2
                ELSE
                        CALL TV('Please reply "yes" or "no".')
                        CALL TV('Let''s try this again:')
                        GO TO 1
                END IF
        ELSE IF (MATCH(ANS,'O')) THEN
C               Non-std. wheel.
                CALL TV('Enter the standard filter name for each place')
                CALL TVN('in the wheel:')
                DO 5 I=1,12
                CALL ASK(ESORCD(I),BNDNAM(I))
    5    CONTINUE
        ELSE
                GO TO 1
        END IF
C
        RETURN
        END
