C @(#)texlv.for	17.1.1.1 (ESO-DMD) 01/25/02 17:14:44
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 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 TEXLV
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENT:      program TEXLV
C.AUTHOR:     A. Lauberts
C.KEYWORDS:   MIDAS table file, select, parameters, tex file
C.PURPOSE:    prepare tex file with selected parameters from ESOLV catalogue
C.USAGE:      MIDAS applic program
C             execute as @@ TEXLV P1 P2
C.PARAMETERS: P1 = name of ESOLV catalogue on MIDAS table file (default PCAT)
C	      P2 = name of Tex include file (default TABNEW)
C Output:     Tex file on 'P1'.TEX
C.COMMENTS:   New page and header after 35 objects;
C             Remember to sort ESOLV in RA order!
C
C	     In order to execute Tex file ESOLV (def = PCAT) you need to
C	     include the macros specified in the following command lines
C	     (please consult A. Lauberts, E. Valentijn or E. Huizinga):
C
C 	     % \magnification=\magstep1
C	     \input texinp:header
C	     %\draft    % switch for own work copy with comments etc
C	     \facsimile  % switch for JOURNAL lay out
C	     %\forcopyeditor % switch for ordinary double line spacing
C	     \aaformat
C	     \ifdraft \draft \fi
C	     \input DESCRIPTORS
C	     \input PCAT
C	    \bye
C.VERSION: 890317 AL  Creation
C.VERSION: 890714 AL  ???
C.VERSION:        EAV ??? 
C.VERSION: 890425 ??? print all selected entries of whole catalogue 25/4/89
C.VERSION: 890420 ??? version without ra,dec bug
C.VERSION: 890406 ??? version that creates header and wants input in pages
C.VERSION: 890413 AL  new version with Jacek ext received from AL
C.VERSION: 890320 AL  Jacek's ext withdrawn! 20-03-89 AL
C.VERSION: ?????? ??   **** NEW VERSION 21.4 WITH CHANGED ALGORITHMS FOR 
C.                     RA AND DEC/AL *** NOTE four usual substitutes!!!
C-------------------------------------------------------------------------------
C 
        IMPLICIT     NONE
C 
        INTEGER      MADRID(1)
        INTEGER      N35
        INTEGER      IACT
        INTEGER      N1, N2
        INTEGER      NCOL, NROW, NSC, ACOL, AROW
        INTEGER      IST
        INTEGER      I, J, N
        INTEGER      ISTAT
        INTEGER      NSEQ
        INTEGER      TID,KNUL,KUN
        INTEGER      COL(256),STAT
        INTEGER      IH
        INTEGER      IHM
        INTEGER      IHMS
        INTEGER      ID
        REAL         ROW(256)
        REAL         A
        REAL         DEC
        REAL         DM 
        REAL         H
        REAL         HM
        REAL         HMS
        REAL         PI
        REAL         RA, RA1
        REAL         SBA
        LOGICAL      NULL(256),FLAG1
C
        CHARACTER*1  SORT
        CHARACTER*3  PAGE
        CHARACTER*4  MORPH,DIMEN,EXT
        CHARACTER*5  FLAG,REDSH,MAGNIT,ORIENT,DENS,SURFB,COLOUR
        CHARACTER*6  EXPGRA,PSKIP
        CHARACTER*7  IDENT
        CHARACTER*60 PCAT,TABNEW
        CHARACTER*10 POSIT
        CHARACTER*11 PAGENO
        CHARACTER*30 LHEAD
        CHARACTER*80 TEXT,TEX3,TEX4,TEX5,TEX6
        CHARACTER*150 LIN1,LIN2,TEX1,TEX2
C
        PARAMETER (PI=3.141593)
        INCLUDE       'MID_INCLUDE:ST_DEF.INC/NOLIST'
        COMMON        /VMR/MADRID
        INCLUDE       'MID_INCLUDE:ST_DAT.INC/NOLIST'
C
        DATA TEX1(1:48)/ 
     *      '&&        &&          -&&   -&&    -&& -       &'/
        DATA TEX1(49:94)/ 
     *      '    -&&    -&    -&&    -&    -&&    -&     -&'/
         DATA TEX1(95:138)/ 
     *      '    -&&    -&    -&&     -&&      -&&     -&'/
        DATA TEX2(1:48)/
     *      '&&        &&          -&&   -&&    -&& -       &'/
        DATA TEX2(49:94)/ 
     *      '    -&&    -&    -&&    -&    -&&    -&     -&'/
        DATA TEX2(95:139)/ 
     *      '    -&&    -&    -&&     -&&      -&&      &'/

        DATA TEX3/'\\noalign{\\hrule height 0.4pt}'/
        DATA TEX4/'\\noalign{\\hrule height 1pt}'/
        DATA TEX5/'\\cr'/
        DATA TEX6/'}$$'/
        DATA SORT/'N'/
        DATA PSKIP/'\\eject'/

        SBA=2.5*ALOG10(PI*25.)
        N35=35
C
        CALL STSPRO('TEXLV')
C  get keywords
        CALL STKRDC('IN_A',1,1,60,IACT,PCAT,KUN,KNUL,STAT)
        CALL STKRDC('IN_B',1,1,60,IACT,TABNEW,KUN,KNUL,STAT)
C
C  get entry limits; 1st entry no should start at 1+N*35, else
C  warning and truncation to next lower permissible integer
C
C  has been changed to page output with leaving the old structure intact
         N1  = 1
C
C  open TEX files
C
        OPEN (UNIT=10,FILE=TABNEW//'.TEX',STATUS='OLD')
        OPEN (UNIT=11,FILE=PCAT//'.TEX',STATUS='NEW')
C
C  open table file and get info
C
        CALL TBTOPN(PCAT,F_O_MODE,TID,STAT)
        CALL TBIGET(TID,NCOL,NROW,NSC,ACOL,AROW,IST)
C
        N2 = NROW
        NCOL=NCOL-1
        DO I=1,NCOL
          COL(I)=I
        ENDDO
C
C  normally PCAT should be sorted according to RA
C  if not, you will get ONE warning
C
C  write one time first page number; other page numbers handled by tex
        WRITE(PAGE,120) N1
  120   FORMAT(I3)
        PAGENO(1:8)  = '\\pageno='
        PAGENO(9:11) = PAGE
        WRITE(11,99) PAGENO
C
        RA=0.
C
C  read table file, row by row
C
        DO NSEQ=N1,N2
C
C  new page and header after 35 objects;
C  if N35 = 35 copy TABNEW.TEX to PCAT.TEX
C
          IF(N35.EQ.35) THEN
            N35=0
            IF(NSEQ.NE.1) THEN
              REWIND 10
              WRITE(11,99) PSKIP
            ENDIF
c  make the header for RA
          CALL TBRRDR(TID,NSEQ,NCOL,COL,ROW,NULL,STAT)
          RA=ROW(9)
          H=RA/15.
          IH=INT(H)
          HM=(H-IH)*60.
          IHM=INT(HM)
          HMS=(HM-IHM)*60.
          IHMS=NINT(HMS)
          IF(IHMS.EQ.60) THEN
            IHM=IHM+1
            IHMS=0
          ENDIF
          IF(IHM.EQ.60) THEN
            IH=IH+1
            IHM=0
          ENDIF
          WRITE(POSIT,101) IH,IHM,IHMS
          LIN1(16:23)=POSIT
          IF(LIN1(22:22).EQ.' ') LIN1(22:22)='0'
          IF(LIN1(19:19).EQ.' ') LIN1(19:19)='0'
          LHEAD(1:30) = '\\def \\llhead{\\bf   $^h$  $^m$}'
          LHEAD(18:19) = LIN1(16:17)
          LHEAD(24:25) = LIN1(19:20)
          WRITE(11,99) LHEAD
C continue with contents of TABNEW.TEX
10          READ(10,99,END=20) TEXT
            WRITE(11,99) TEXT
99          FORMAT(A)
            GOTO 10
          ENDIF
20        CONTINUE
          LIN1=TEX1
          LIN2=TEX2
C  read select flag
          CALL TBSGET(TID,NSEQ,FLAG1,ISTAT)
          IF (FLAG1) THEN
            CALL TBRRDR(TID,NSEQ,NCOL,COL,ROW,NULL,STAT)
            N35 = N35 +1
            ELSE
            GOTO 998
          ENDIF
C
C  IDENT
C  ESO_NO = FFF NNNC , where FFF = field no and NNNC = object no (C=0,1,2)
C  assume all identifiers = NULL are at the end of PCAT
C
          IF(NULL(1)) GOTO 999
          I=ROW(1)
          IF(I.LT.10010.OR.I.GT.6061000) GOTO 999
          WRITE(IDENT,100) I
          LIN1(3:5) =IDENT(1:3)
          LIN1(7:10)=IDENT(4:7)
100       FORMAT(I7)
C  NGC
          N=ROW(2)
          IF(.NOT.NULL(2).AND.N.GT.0) THEN
            WRITE(IDENT,100) N
            LIN2(4:10)=IDENT
            LIN2(4:6)='N\\x'
          ENDIF
C  IC
          I=ROW(3)
          IF(.NOT.NULL(3).AND.NULL(2).AND.I.GT.0) THEN
            WRITE(IDENT,100) I
            LIN2(4:10)=IDENT
            LIN2(4:6)='I\\x'
          ENDIF
C
C  POSITION
C  RA_O, DEC_O
          RA1=RA
          RA=ROW(9)
          IF(SORT.NE.'Y'.AND.RA.LT.RA1) THEN
            WRITE(6,*) 'WARNING: PCAT is NOT sorted in RA'
            WRITE(6,*) 'Answer with (capital!) Y if OK'
            READ(5,99) SORT
            IF(SORT.NE.'Y') THEN
              WRITE(6,*) 'Since you didn''t say Y, program STOPs now'
              GOTO 999
            ENDIF
          ENDIF
          DEC=ROW(10)
          H=RA/15.
          IH=INT(H)
          HM=(H-IH)*60.
          IHM=INT(HM)
          HMS=(HM-IHM)*60.
          IHMS=NINT(HMS)
          IF(IHMS.EQ.60) THEN
            IHM=IHM+1
            IHMS=0
          ENDIF
          IF(IHM.EQ.60) THEN
            IH=IH+1
            IHM=0
          ENDIF
          WRITE(POSIT,101) IH,IHM,IHMS
101       FORMAT(I2,1X,I2,1X,I2)
          LIN1(16:23)=POSIT
          IF(LIN1(22:22).EQ.' ') LIN1(22:22)='0'
          IF(LIN1(19:19).EQ.' ') LIN1(19:19)='0'
          ID=DEC
          DM=(ID-DEC)*60.
          IF(DM.GT.59.95) THEN
            DM=0.
            ID=ID-1.
          ENDIF
          WRITE(POSIT,1010) ID,DM
1010      FORMAT(I3,1X,F4.1)
          LIN2(16:23)=POSIT
          IF(LIN2(20:20).EQ.' ') LIN2(20:20)='0'
C
C  MORPH
C  T_NEW
          IF(.NOT.NULL(7)) THEN
            A=ROW(7)
            WRITE(MORPH,102) A
102         FORMAT(F4.1)
            LIN1(26:29)=MORPH
          ENDIF
C  I_FLAG
          IF(NULL(182)) THEN
            I=0
          ELSE
            I=ROW(182)
          ENDIF
C  T_FLAG
          IF(NULL(8)) THEN
            J=0
          ELSE
            J=ROW(8)
          ENDIF
C  write I and J to FLAG
          WRITE(FLAG,1020) I, J
1020      FORMAT(I1,'~~',I1)
          LIN2(26:29)=FLAG
C
C  REDSHIFT
C  CZ and CZ_ERR
          IF(.NOT.NULL(13)) THEN
            I=ROW(13)
            IF(IABS(I).LT.99999) THEN
              WRITE(REDSH,103) I
103           FORMAT(I5)
              LIN1(32:36)=REDSH
              IF(.NOT.NULL(14)) THEN
                I=ROW(14)
                WRITE(REDSH,103) I
                LIN2(32:36)=REDSH
              ENDIF
            ENDIF
          ENDIF
C
C  MAGNITUDES
C
C  flags for saturated and pg-pe replacement
C  case: B replaced,                    flag - on B_TOT
C        B and R repl, R_TOT non-exist, flag = on B_TOT
C        R replaced,   R_TOT existing,  flag - on R_TOT
C
C
C  flag  for saturated, not pg-pe replacement, not deblended
C  case: B (and R) saturated            flag #sat on B_TOT
C
C  The above scheme is motivated by the wish to use only a one char flag.
C  Furthermore, cases with pg-pe replacement need not show number of
C  saturated rings because the saturation problem is solved anyway.
C
C  The only complication is the case B saturated, not pg-pe replaced
C  together with R pg-pe replaced but no R_TOT exist. In this case
C  flag #sat is put on B_TOT, not showing the pg-pe replacement on R.
C
C  flag for resolved blends             flag 0 on B_TOT
C  note that blends are never resolved if also pg-pe repl
C
C  B_TOT
          IF(.NOT.NULL(15)) THEN
            A=ROW(15)
            IF(A.GT.5..AND.A.LT.25.) THEN
              WRITE(MAGNIT,104) A
104           FORMAT(F5.2)
              LIN1(40:44)=MAGNIT
              IF(.NOT.NULL(105)) THEN
                LIN1(39:39)='$'
                LIN1(45:47)='^-$'
                IF(NULL(16).AND..NOT.NULL(106)) LIN1(45:47)='^=$'
              ELSE IF(.NOT.NULL(112)) THEN
                LIN1(39:39)='$'
                LIN1(45:47)='^0$'
              ELSE IF(.NOT.NULL(11)) THEN
                I=ROW(11)
                IF(I.GT.0.AND.I.LT.10) THEN
                  WRITE(FLAG,1020) I
                  LIN1(39:39)='$'
                  LIN1(45:47)='^-$'
                  LIN1(46:46)=FLAG(1:1)
                ENDIF
              ENDIF
            ENDIF
          ENDIF
C  R_TOT
          IF(.NOT.NULL(16)) THEN
            A=ROW(16)
            IF(A.GT.5..AND.A.LT.25.) THEN
              WRITE(MAGNIT,104) A
              LIN2(40:44)=MAGNIT
              IF(.NOT.NULL(106)) THEN
                LIN2(39:39)='$'
                LIN2(45:47)='^-$'
              ENDIF
            ENDIF
          ENDIF
C  B_B26
          IF(.NOT.NULL(17)) THEN
            A=ROW(17)
            IF(A.GT.5..AND.A.LT.25.) THEN
              WRITE(MAGNIT,104) A
              LIN2(49:53)=MAGNIT
            ENDIF
          ENDIF
C  B_B25
          IF(.NOT.NULL(19)) THEN
            A=ROW(19)
            IF(A.GT.5..AND.A.LT.25.) THEN
              WRITE(MAGNIT,104) A
              LIN1(49:53)=MAGNIT
            ENDIF
          ENDIF
C
C  SURFB
C  BS_E
          IF(.NOT.NULL(143)) THEN
            A=ROW(143)
            IF(A.GT.10.AND.A.LT.30.) THEN
              WRITE(SURFB,113) A
113           FORMAT(F5.2)
              LIN1(56:60)=SURFB
            ENDIF
          ENDIF
C  RS_E
          IF(.NOT.NULL(144)) THEN
            A=ROW(144)
            IF(A.GT.10.AND.A.LT.30.) THEN
              WRITE(SURFB,113) A
              LIN2(56:60)=SURFB
            ENDIF
          ENDIF
C  BS_10
          IF(.NOT.NULL(21)) THEN
            A=ROW(21)+SBA
            IF(A.GT.10.AND.A.LT.30.) THEN
              WRITE(SURFB,113) A
              LIN1(62:66)=SURFB
            ENDIF
          ENDIF
C  RS_10
          IF(.NOT.NULL(34)) THEN
            A=ROW(34)+SBA
            IF(A.GT.10.AND.A.LT.30.) THEN
              WRITE(SURFB,113) A
              LIN2(62:66)=SURFB
            ENDIF
          ENDIF
C
C  B-R COLOUR
C  BR_T
          IF(.NOT.NULL(101)) THEN
            A=ROW(101)
            IF(A.GT.-9..AND.A.LT.9.) THEN
              WRITE(COLOUR,105) A
              LIN1(69:73)=COLOUR
            ENDIF
          ENDIF
C  BR_E
          IF(.NOT.NULL(99)) THEN
            A=ROW(99)
            IF(A.GT.-9..AND.A.LT.9.) THEN
              WRITE(COLOUR,105) A
105           FORMAT(F5.2)
              LIN2(69:73)=COLOUR
            ENDIF
          ENDIF
C  BR_10
          IF(.NOT.NULL(100)) THEN
            A=ROW(100)
            IF(A.GT.-9..AND.A.LT.9.) THEN
              WRITE(COLOUR,105) A
              LIN1(75:79)=COLOUR
            ENDIF
          ENDIF
C  BR_DIFF
          IF(.NOT.NULL(171)) THEN
            A=ROW(171)
            IF(A.GT.-9..AND.A.LT.9.) THEN
              WRITE(COLOUR,105) A
              LIN2(75:79)=COLOUR
            ENDIF
          ENDIF
C
C  DIMENSIONS
C  DB_E
          IF(.NOT.NULL(122)) THEN
            A=ROW(122)
            IF(A.LT.99.5) THEN
              WRITE(DIMEN,106) A
            ELSE
              I=NINT(A)
              WRITE(DIMEN,107) I
            ENDIF
            LIN1(83:86)=DIMEN
          ELSE IF (.NOT.NULL(15)) THEN
            LIN1(82:86)='$<10$'
          ENDIF
C  AB_E
          IF(.NOT.NULL(125)) THEN
            A=ROW(125)
            IF(A.LT.99.5) THEN
              WRITE(DIMEN,106) A
            ELSE
              I=NINT(A)
              WRITE(DIMEN,107) I
            ENDIF
            LIN2(83:86)=DIMEN
          ELSE IF (.NOT.NULL(15)) THEN
            LIN2(82:86)='$<10$'
          ENDIF
C  SD25
          IF(.NOT.NULL(109)) THEN
            A=ROW(109)
C           IF(A.LT.99.5) THEN
C             WRITE(DIMEN,106) A
106           FORMAT(F4.1)
C           ELSE
              I=NINT(A)
              WRITE(DIMEN,107) I
107           FORMAT(I4)
C           ENDIF
            LIN1(90:93)=DIMEN
          ENDIF
C  SD26
          IF(.NOT.NULL(110)) THEN
            A=ROW(110)
C           IF(A.LT.99.5) THEN
C             WRITE(DIMEN,106) A
C           ELSE
              I=NINT(A)
              WRITE(DIMEN,107) I
C           ENDIF
            LIN2(90:93)=DIMEN
          ENDIF
C  SD27
          IF(.NOT.NULL(111)) THEN
            A=ROW(111)
C           IF(A.LT.99.5) THEN
C             WRITE(DIMEN,106) A
C           ELSE
              I=NINT(A)
              WRITE(DIMEN,107) I
C           ENDIF
            LIN1(97:100)=DIMEN
          ENDIF
C  DB_90
          IF(.NOT.NULL(121)) THEN
            A=ROW(121)
C           IF(A.LT.99.5) THEN
C             WRITE(DIMEN,106) A
C           ELSE
              I=NINT(A)
              WRITE(DIMEN,107) I
C           ENDIF
            LIN2(97:100)=DIMEN
          ENDIF
C
C  ORIENT
C  D_R_N
          IF(.NOT.NULL(116)) THEN
            A=ROW(116)
            IF(A.LT.99.5) THEN
              WRITE(ORIENT,110) A
              LIN1(103:107)=ORIENT
            ENDIF
          ENDIF
C  PA_N
          IF(.NOT.NULL(118)) THEN
            A=ROW(118)
            IF(A.GE.0..AND.A.LE.180.) THEN
              WRITE(ORIENT,111) A
              LIN1(109:113)=ORIENT
            ENDIF
          ENDIF
C  ABEOCT
          IF(.NOT.NULL(113)) THEN
            A=ROW(113)
            IF(A.LT.99.5) THEN
              WRITE(ORIENT,110) A
110           FORMAT(F5.2)
              LIN2(103:107)=ORIENT
            ENDIF
          ENDIF
C  PAEOCT
          IF(.NOT.NULL(114)) THEN
            A=ROW(114)
            IF(A.GE.0..AND.A.LE.180.) THEN
              WRITE(ORIENT,111) A
111           FORMAT(F5.1)
              LIN2(109:113)=ORIENT
            ENDIF
          ENDIF
C
C  DENSITY
C  NG_T
          IF(.NOT.NULL(127)) THEN
            A=ROW(127)
            WRITE(DENS,112) A
112         FORMAT(F5.1)
            LIN1(126:130)=DENS
          ENDIF
C  NG_SP
          IF((.NOT.NULL(127)).AND.(.NOT.NULL(131))) THEN
            A=ROW(131)
            WRITE(DENS,112) A
            LIN2(126:130)=DENS
          ENDIF
C
C  GRADIENT
C  EXPO_B
c  changed to oct values
          IF(.NOT.NULL(150)) THEN
            A=ROW(150)
            IF(A.GT.-10..AND.A.LT.10.) THEN
              WRITE(EXPGRA,108) A
108           FORMAT(F6.2)
              LIN1(116:121)=EXPGRA
            ENDIF
          ENDIF
C  EXPO_R
          IF(.NOT.NULL(162)) THEN
            A=ROW(162)
            IF(A.GT.-10..AND.A.LT.10.) THEN
              WRITE(EXPGRA,109) A
109           FORMAT(F6.2)
              LIN2(116:121)=EXPGRA
            ENDIF
          ENDIF
C
C  EXTINCT
C  AEXT
          IF(.NOT.NULL(177)) THEN
            A=ROW(177)
            IF(A.LT.10.) THEN
              WRITE(EXT,114) A
114           FORMAT(F4.2)
              LIN1(135:138)=EXT
            ENDIF
          ENDIF
C  JEXT withdrawn !!!!
c          IF(.NOT.NULL(102)) THEN
c            A=ROW(102)
c            IF(A.LT.10.) THEN
c              WRITE(EXT,114) A
c              LIN2(135:138)=EXT
c            ENDIF
c          ENDIF
C
C  write tex file
C
          WRITE(11,99) LIN1
          WRITE(11,99) LIN2
          IF(N35.NE.35.AND.NSEQ.NE.N2) THEN
            WRITE(11,99) TEX3
          ELSE
            WRITE(11,99) TEX4
            WRITE(11,99) TEX5
            WRITE(11,99) TEX6
          ENDIF
998     CONTINUE
        ENDDO
C 
        IF(N35.NE.35.AND.NSEQ.NE.N2) THEN
          WRITE(11,99) TEX5
          WRITE(11,99) TEX6
        ENDIF
C
999     CONTINUE
        CALL STSEPI
        END