C @(#)horform.for	19.1 (ES0-DMD) 02/25/03 13:29:08
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
         PROGRAM HORFRM
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT (c)
C.IDENT         horform.for
C.MODULE
C.AUTHOR        Andrew T. Young
C.KEYWORD
C.LANGUAGE      FORTRAN 77
C.PURPOSE       generate horizon-table forms
C.COMMENTS
C.VERSION       0.0
C.RETURNS
C.ENVIRONMENT   requires esotel.tbl in local directory
C.
C-----------------------------------------------------------------------------
C
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C
C  BEGIN Declarations:
C
        DOUBLE PRECISION DNULL
        COMMON /NULLS/ INULL, RNULL, DNULL
C
        LOGICAL NULL
        INTEGER NOUT,NFILE
        CHARACTER*80 TOP,LINE2,LINE3,LINE4,LINE5,LINE6,GAP,FOOT
        CHARACTER*80 SPACER
        CHARACTER*84 FMT2,FMT3
        CHARACTER*64 GERMAN(2)
        CHARACTER*8 TELNAMES(100),TELESCOP,FMT1, MOUNTING
        REAL PHIS(100),PHI,DELTA(0:50)
C
C  Set up MIDAS declarations:
C
        INTEGER MADRID(1)
C
        COMMON /VMR/ MADRID
C
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'
C
C  END Declarations.
C
C
C  BEGIN DATA statements:
C
        INCLUDE 'MID_INCLUDE:ST_DAT.INC'
C
        DATA FMT1/'(4X,A76)'/
        DATA NFILE/7/
C
C  END DATA statements.
C
C
C  ********************  PROLOGUE  ********************
C
        CALL STSPRO ('HORFRM')
        OPEN(NFILE,FILE='FORM',STATUS='UNKNOWN')
        REWIND NFILE
C
C  Real program begins here:            (use RUN HORFORM to test in MIDAS)
C
        CALL TBTOPN('esotel.tbl',0,ITBL,ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL STTPUT('esotel.tbl not found',NOUT)
                CALL STETER(1, 'Error while opening esotel.tbl')
        END IF
C TBLSER        search for table column with given label; get number
        CALL TBLSER (ITBL, 'TELESCOP',  NCTEL, ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL STTPUT('Failed to find TELESCOP column',NOUT)
                CALL STETER(2, 'Error while reading esotel.tbl')
        END IF
         CALL TBLSER (ITBL, 'LAT',  NCLAT, ISTAT)
        IF (ISTAT.NE.0) THEN
                CALL STTPUT('Failed to find LAT column',NOUT)
                CALL STETER(3, 'Error while reading esotel.tbl')
        END IF
C
C  find number of rows:
        CALL TBIGET(ITBL, NCOLS, NROWS, NSORTC, NWPRAL, NROWSAL, ISTAT)
C  loop over rows:
        DO 5 NROW=1,NROWS
C        read telnames(nrow):
        CALL TBERDC(ITBL,NROW,NCTEL,TELNAMES(NROW),NULL,ISTAT)
C        read phis(nrow)=LAT:
        CALL TBERDR(ITBL,NROW,NCLAT,PHIS(NROW),NULL,ISTAT)
    5   CONTINUE
C
C       display menu:
C
    6   CALL MENU1('Please choose a telescope:',TELNAMES,NROWS,NOUT)
C STKPRC        prompt user for character-valued keyword data at terminal
        CALL STKPRC ('Please enter your selection:','INPUTC', 1, 1, 8,
     1               NACTEL, TELESCOP, IUNIT, NULLS, ISTAT)
C       convert to caps:
        IDIFF=ICHAR('A')-ICHAR('a')
        DO 8 I=1,8
        IF(ICHAR(TELESCOP(I:I)).GE.ICHAR('a'))
     1     TELESCOP(I:I)=CHAR(ICHAR(TELESCOP(I:I))+IDIFF)
    8   CONTINUE
        DO 10 NROW=1,NROWS
        IF (TELNAMES(NROW) .EQ. TELESCOP) GOTO 20
   10   CONTINUE
C       no match, so assume number was entered:
        READ(TELESCOP,'(I3)',ERR=6) NROW
        IF (NROW.GT.NROWS) GO TO 6
        TELESCOP=TELNAMES(NROW)
   20   PHI=PHIS(NROW)
C
C       Begin converted awk script:
C
        DEGRAD=180./3.1415926535
        ABSPHI=ABS(PHI)
        COSPHI=COS(PHI/DEGRAD)

        MOUNTING=' '
   25   CALL STKPRC ('Is its mounting FORK, GERMAN, or ALTAZ?',
     1               'INPUTC', 1, 1, 6,
     2               NACTEL, MOUNTING, IUNIT, NULLS, ISTAT)
C       convert to caps:
        IDIFF=ICHAR('A')-ICHAR('a')
        DO 28 I=1,6
        IF(ICHAR(MOUNTING(I:I)).GE.ICHAR('a'))
     1     MOUNTING(I:I)=CHAR(ICHAR(MOUNTING(I:I))+IDIFF)
   28   CONTINUE
        IF (MOUNTING.EQ.'FORK') THEN
            TOP(1:)    = '           '//
     +          '__________________________________________________'
            LINE2(1:)  = '           |'//
     +          '        |   Looking  EAST   |   Looking  WEST   |'
            LINE3(1:)  = '           |'//
     +          '        |===================|===================|'
            LINE4(1:)  = '           |'//
     +          '        |   ALL   |  LAST   |   ALL   |  LAST   |'
            LINE5(1:)  = '           |'//
     +          '  DEC.  |  CLEAR  |   SKY   |  CLEAR  |   SKY   |'
            LINE6(1:)  = '           |'//
     +          '        |  (OBSE) | (MOONE) |  (OBSW) | (MOONW) |'
            SPACER(1:) = '           |'//
     +          '--------+---------+---------+---------+---------|'
            GAP(1:)    = '           |'//
     +          '        |         |         |         |         |'
            FOOT(1:)   = '           '//
     +          '=================================================='
            FMT2(1:)   = '(''               |  '',
     + F4.0,''  |         |         |         |         |'')'
            FMT3       = FMT2
            FMT3(65:68)= 'omit'
            FMT3(45:48)= 'omit'
            GERMAN(1)  = ' '
            LOOPS      = 1
C
         ELSE IF (MOUNTING.EQ.'GERMAN') THEN
            TOP(1:)    = '           '//
     +          '__________________________________________________'
            LINE2(1:)  = '           |'//
     +          '        |   Looking  EAST   |   Looking  WEST   |'
            LINE3(1:)  = '           |'//
     +          '        |===================|===================|'
            LINE4(1:)  = '           |'//
     +          '        |   ALL   |  LAST   |   ALL   |  LAST   |'
            LINE5(1:)  = '           |'//
     +          '  DEC.  |  CLEAR  |   SKY   |  CLEAR  |   SKY   |'
            LINE6(1:)  = '           |'//
     +          '        | (TEOBSE)|(TEMOONE)| (TEOBSW)|(TEMOONW)|'
            SPACER(1:) = '           |'//
     +          '--------+---------+---------+---------+---------|'
            GAP(1:)    = '           |'//
     +          '        |         |         |         |         |'
            FOOT(1:)   = '           '//
     +          '=================================================='
            FMT2(1:)   = '(''               |  '',
     + F4.0,''  |         |         |         |         |'')'
            FMT3       = FMT2
            FMT3(65:68)= 'omit'
            FMT3(45:48)= 'omit'
            GERMAN(1)='  T e l e s c o p e   E A S T   o f   p i e r'
            GERMAN(2)='  T e l e s c o p e   W E S T   o f   p i e r'
            LOOPS=2
C
        ELSE IF (MOUNTING.EQ.'ALTAZ') THEN
            TOP(1:)   = '           '//
     +          ' _____________________________________________'
            LINE4(1:) = '            '//
     +          '|             |      ALL     |     LAST     |'
            LINE5(1:) = '            '//
     +          '|   AZIMUTH   |     CLEAR    |      SKY     |'
            LINE6(1:) = '            '//
     +          '|    (AZI)    |   (OBSALT)   |   (MOONALT)  |'
            SPACER(1:)= '            '//
     +          '|-------------+--------------+--------------|'
            GAP(1:)   = '            '//
     +          '|             |              |              |'
            FOOT(1:)  = '           '//
     +          '=============================================='
                DO 36, J=0,35
                        IF (MOD(J,12).EQ.0 ) THEN
                                IF (J.GT.0) THEN        ! BREAK PAGE
                                        WRITE(NFILE,FMT1)FOOT
                                        WRITE(NFILE,'(1H1)')
                                END IF
                                WRITE(NFILE,'(A57,A8)')
     1 ' L I M I T I N G   A L T I T U D E S   f o r  ',TELESCOP
                                WRITE(NFILE,FMT1)
                                WRITE(NFILE,FMT1)TOP
                                WRITE(NFILE,FMT1)GAP
                                WRITE(NFILE,FMT1)LINE4
                                WRITE(NFILE,FMT1)LINE5
                                WRITE(NFILE,FMT1)GAP
                                WRITE(NFILE,FMT1)LINE6
                        END IF
                        WRITE(NFILE,FMT1)SPACER
                        WRITE(NFILE,FMT1)GAP
                        WRITE(NFILE,'(''                |     '',I3,
     +           ''     |              |             |'')')J*10
                        WRITE(NFILE,FMT1)GAP
   36           CONTINUE
                WRITE(NFILE,FMT1)FOOT
                I=0
                CALL STTPUT('Done!',NOUT)
                CALL STTPUT(' ',NOUT)
                CALL STTPUT(' --> Don''t forget to print the file FORM',
     1                      NOUT)
                CALL STTPUT(' ',NOUT)
                CALL STSEPI
        ELSE
                CALL STTPUT('Please reply FORK or GERMAN or ALTAZ only.'
     1                     ,NOUT)
                I=0
                GOTO 25
        END IF

        DELTA(0)=0.
        DCRIT=0.
        DO 50 I=1,49
                DEL=DELTA((I-1))/DEGRAD         ! RADIANS
                COSDEL=COS(DEL)
                RAT=SIN(DEL) / COSPHI
                IF (RAT.GE.1) THEN      ! LAST ONE WAS CIRCUMPOLAR
C                         last deg.of dec. that meets horizon:
                        IF (DELTA((I-2)) .NE. 89-INT(ABSPHI) ) THEN
                                DELTA(I-1)= 89-INT(ABSPHI)
                        ELSE
                                DELTA(I-1)= 90-INT(ABSPHI)
                        END IF
                        DO 45 J=I,I+5
                                DELTA(J)=DELTA((J-1))+1
   45                   CONTINUE
                        K=I+5
                        GOTO 100
                END IF
C        place intersections with horizon no more than 0.2 rad apart:
                DD=0.2*(COSPHI/COSDEL)*SQRT(1.-RAT*RAT)
                IF (DD .LT. 1./DEGRAD) DD=1.005/DEGRAD
                DELTA(I)=DELTA((I-1))+INT(DD*DEGRAD)
C                       Moon only reaches 30 deg...
                IF (DCRIT.EQ.0. .AND. DELTA(I).GT.30.) DCRIT=DELTA(I)
   50   CONTINUE
        K=49
C
  100   LINE=3
        I=K
        IF (I.EQ.0) CALL STSEPI
        I=I-1
        DO 150 LOOP=1,LOOPS
                LINE=0
                DO 110 J=I,0,-1
                        IF (MOD(LINE,10) .EQ.0) THEN
                                IF (LINE.GT.0) THEN     ! BREAK PAGE
                                        WRITE(NFILE,FMT1)FOOT
                                        WRITE(NFILE,'(1H1)')
                                END IF
                                WRITE(NFILE,'(A58,A8)')
     1  ' H O U R   A N G L E   L I M I T S   f o r  ',
     2                             TELESCOP
                                WRITE(NFILE,FMT1)
                                IF (MOUNTING.EQ.'GERMAN')
     1                               WRITE(NFILE,FMT1)GERMAN(LOOP)
                                WRITE(NFILE,FMT1)
                                WRITE(NFILE,FMT1)TOP
                                WRITE(NFILE,FMT1)LINE2
                                WRITE(NFILE,FMT1)LINE3
                                WRITE(NFILE,FMT1)LINE4
                                WRITE(NFILE,FMT1)LINE5
                                WRITE(NFILE,FMT1)GAP
                                WRITE(NFILE,FMT1)LINE6
                        END IF
                        LINE=LINE+1
                        WRITE(NFILE,FMT1)SPACER
                        WRITE(NFILE,FMT1)GAP
                         IF (DELTA(J).LE.DCRIT) THEN
                                WRITE(NFILE, FMT2) DELTA(J)
                        ELSE
                                WRITE(NFILE, FMT3) DELTA(J)
                        END IF
                        WRITE(NFILE,FMT1)GAP
  110           CONTINUE
                DO 120 J=1,I
                        IF (MOD(LINE,10) .EQ.0) THEN
                                IF (LINE.GT.0) THEN     ! BREAK PAGE
                                        WRITE(NFILE,FMT1)FOOT
                                        WRITE(NFILE,'(1H1)')
                                END IF
                                WRITE(NFILE,'(A58,A8)')
     1 ' H O U R   A N G L E   L I M I T S   f o r  ',
     2                             TELESCOP
                                WRITE(NFILE,FMT1)
                                IF (MOUNTING.EQ.'GERMAN')
     1                               WRITE(NFILE,FMT1)GERMAN(LOOP)
                                WRITE(NFILE,FMT1)
                                WRITE(NFILE,FMT1)TOP
                                WRITE(NFILE,FMT1)LINE2
                                WRITE(NFILE,FMT1)LINE3
                                WRITE(NFILE,FMT1)LINE4
                                WRITE(NFILE,FMT1)LINE5
                                WRITE(NFILE,FMT1)GAP
                                WRITE(NFILE,FMT1)LINE6
                        END IF
                        LINE=LINE+1
                        WRITE(NFILE,FMT1)SPACER
                        WRITE(NFILE,FMT1)GAP
                        IF (DELTA(J).LE.DCRIT) THEN
                                WRITE(NFILE, FMT2) -DELTA(J)
                        ELSE
                                WRITE(NFILE, FMT3) -DELTA(J)
                        END IF
                        WRITE(NFILE,FMT1)GAP
  120           CONTINUE
                WRITE(NFILE,FMT1)FOOT
                IF (LOOPS.EQ.2) THEN
                        LINE6=
     1'       |        | (TWOBSE) | (TWMOONE) | (TWOBSW) | (TWMOONW) |'
                        IF (LOOP.EQ.1) WRITE(NFILE,'(1H1)')
                END IF
  150   CONTINUE
        CLOSE(NFILE)
C
        CALL STTPUT('Done!',NOUT)
        CALL STTPUT(' ',NOUT)
        CALL STTPUT('--> Don''t forget to print the file FORM',NOUT)
        CALL STTPUT(' ',NOUT)
C
C       End MIDAS:
C
        CALL STSEPI
C
C
C
        END
        SUBROUTINE MENU1(PROMPT,WORDS,NITEMS,NOUT)
C
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C
        CHARACTER*(*) PROMPT,WORDS(NITEMS)
        CHARACTER*80 CARD
        CHARACTER B24(2)*24, B16(4)*16, B8(8)*8, B64*64
        EQUIVALENCE (B64,B24(1),B16(1),B8(1))
C
C       *****  Begin  *****
C
        CALL STTPUT(PROMPT,NOUT)
        IF (NITEMS.LT.9)THEN
                DO 10 I=1,NITEMS
                B64=WORDS(I)
                WRITE(CARD,5) I,B64
    5           FORMAT(20X,I2,':',2X,A50)
                CALL STTPUT(' ',NOUT)
                CALL STTPUT(CARD,NOUT)
   10           CONTINUE
        ELSE IF (NITEMS.LT.17) THEN
                INC=NITEMS/2
                DO 20 I=1,(NITEMS+1)/2
                K=1
                DO 12 J=I,NITEMS,INC
                B24(K)=WORDS(J)
   12           K=K+1
                WRITE(CARD,15) (I+(KK-1)*INC,B24(KK),KK=1,K)
   15           FORMAT(10X,I2,':',2X,A24,8X,I2,':',A24)
                CALL STTPUT(' ',NOUT)
                CALL STTPUT(CARD,NOUT)
   20           CONTINUE
        ELSE IF (NITEMS.LT.65) THEN
                INC=NITEMS/4
                DO 30 I=1,(NITEMS+3)/4
                K=1
                DO 22 J=I,NITEMS,INC
                B16(K)=WORDS(J)
   22           K=K+1
                WRITE(CARD,25) (B16(KK),KK=1,K)
   25           FORMAT(6X,4(2X,A16))
                IF (NITEMS.LT.33) CALL STTPUT(' ',NOUT)
                CALL STTPUT(CARD,NOUT)
   30           CONTINUE
        ELSE
                INC=NITEMS/8
                DO 40 I=1,(NITEMS+7)/8
                K=1
                DO 32 J=I,NITEMS,INC
                B8(K)=WORDS(J)
   32           K=K+1
                WRITE(CARD,35) (B8(KK),KK=1,K)
   35           FORMAT(4X,8(1X,A8))
                CALL STTPUT(CARD,NOUT)
   40           CONTINUE
        END IF
        CALL STTPUT(' ',NOUT)
        RETURN
        END
