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 HORFRM
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.RETURNS
C.ENVIRONMENT   requires esotel.tbl in local directory
C.VERSION       0.0
C
C 100618	last modif
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,CTEST
        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)
C TBLSER        search for table column with given label; get number
        CALL TBLSER (ITBL, 'TELESCOP',  NCTEL, ISTAT)
         CALL TBLSER (ITBL, 'LAT',  NCLAT, ISTAT)
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,CTEST,NULL,ISTAT)
        CALL FT_EOS(CTEST,8,TELNAMES(NROW),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
