C @(#)showopto.for	19.1 (ES0-DMD) 02/25/03 14:27:55
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
C @(#)showopto.for	19.1 (ESO-IPG) 14:27:55 02/25/03
      PROGRAM SHOW_OPTO
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFICATION: program SHOW_OPTO
C.PURPOSE: to show the current values of global keywords initialized in the
C.         OPTOPUS context.
C.AUTHOR: A. Gemmo             Padova Department of Astronomy
C.VERSION: 910521 A. Gemmo     Creation
C.VERSION: 910827 AG Modified
C-------------------------------------------------------------------------------
      IMPLICIT NONE
C
C ***
C
      INTEGER      MADRID(1)
      INTEGER      KUN,KNUL,ISTAT,IAV
      INTEGER      SHH1,SHH2,SMM1,SMM2
      INTEGER      HH,MM,DD,PP
      INTEGER      IND1,IND2,IND,CSIGN
C
C *** 
C
      REAL         RVAL(10)
C
C ***
C
      DOUBLE PRECISION       CRA(3),CDEC(3),CDEC1(3)
      DOUBLE PRECISION       ETIME
      DOUBLE PRECISION       LAM1,LAM2
      DOUBLE PRECISION       ST1,ST2
      DOUBLE PRECISION       ST
      DOUBLE PRECISION       SS,AA
      DOUBLE PRECISION       EQUI1,EQUI2
      DOUBLE PRECISION       YEAR,MONTH,DAY,EPP
C 
C *** 
C
      CHARACTER*80    STRING(20)
      CHARACTER*50    INFIL,OUTFIL
      CHARACTER*40    LBL
      CHARACTER*1     FLAG1,FLAG2,FLAG3,FLAG4
      CHARACTER*80    CVAL,DECCHA(3)
      CHARACTER*1     SIGN
C
C ***
C
      INCLUDE      'MID_INCLUDE:ST_DEF.INC'
      COMMON       /VMR/MADRID
      INCLUDE      'MID_INCLUDE:ST_DAT.INC'
C
C ***
C
      DATA         CSIGN/0/
      DATA         SIGN/'+'/
C
C *** start the code
C
      CALL STSPRO('SHOW_OPTO')
C
C *** do the work
C
C
C *** read input and output file
C
      CALL STKRDC('INPUTFI',1,1,50,IAV,INFIL,KUN,KNUL,ISTAT)
      CALL STKRDC('OUTPUTF',1,1,50,IAV,OUTFIL,KUN,KNUL,ISTAT)
C
C *** read coordinates of the center of the plate
C
      CALL STKRDD('PLATECEN',1,1,IAV,CRA(1),KUN,KNUL,ISTAT)
      CALL STKRDD('PLATECEN',2,1,IAV,CRA(2),KUN,KNUL,ISTAT)
      CALL STKRDD('PLATECEN',3,1,IAV,CRA(3),KUN,KNUL,ISTAT)
      CALL STKRDD('PLATECEN',4,1,IAV,CDEC(1),KUN,KNUL,ISTAT)
      CALL STKRDD('PLATECEN',5,1,IAV,CDEC(2),KUN,KNUL,ISTAT)
      CALL STKRDD('PLATECEN',6,1,IAV,CDEC(3),KUN,KNUL,ISTAT)
      CALL STKRDC('PLATECHA',1,1,80,IAV,CVAL,KUN,KNUL,ISTAT)
C
      IF(CVAL(1:8).EQ.'0.,0.,0.')THEN
        IF(CDEC(1).LT.0..OR.CDEC(2).LT.0..OR.CDEC(3).LT.0.)THEN
          CSIGN = 1
        ENDIF
        GOTO 616
      ENDIF
C
C *** decode character CVAL to real array
C
      IND1 = INDEX(CVAL,',')
      IND2 = INDEX(CVAL(IND1+1:80),',') + IND1
      DECCHA(1) = CVAL(1:IND1-1)
      DECCHA(2) = CVAL(IND1+1:IND2-1)
      DECCHA(3) = CVAL(IND2+1:80)
C
      CALL USRINP(RVAL(1),80,'R',DECCHA(1))
      CALL USRINP(RVAL(2),80,'R',DECCHA(2))
      CALL USRINP(RVAL(3),80,'R',DECCHA(3))
C
      CDEC(1) = DBLE(RVAL(1))
      CDEC(2) = DBLE(RVAL(2))
      CDEC(3) = DBLE(RVAL(3))
C
      IND = INDEX(CVAL,'-')
      IF(IND.NE.0)CSIGN = 1 
C
C *** convert to hhmmss and ddmmss if in decimal format
C
616   CDEC1(1) = DABS(CDEC(1))
      CDEC1(2) = DABS(CDEC(2))
      CDEC1(3) = DABS(CDEC(3))
C
      IF(CRA(2).EQ.0..AND.CRA(3).EQ.0.)THEN
        HH = INT(CRA(1))
        MM = INT((CRA(1)-HH)*60.)
        SS = ((CRA(1)-HH)*60.-MM)*60.
      ENDIF
C
      IF(CDEC(2).EQ.0..AND.CDEC(3).EQ.0.)THEN
        DD = INT(CDEC1(1))
        PP = INT((CDEC1(1)-DD)*60.)
        AA = ((CDEC1(1)-DD)*60.-PP)*60.
       IF(CSIGN.EQ.1)SIGN = '-'
      ENDIF
C
      IF(CRA(2).NE.0..OR.CRA(3).NE.0.)THEN
          HH = INT(CRA(1))
          MM = INT(CRA(2))
          SS = CRA(3)
      ENDIF
C
      IF(CDEC(2).NE.0..OR.CDEC(3).NE.0.)THEN
          DD = INT(CDEC1(1))
          PP = INT(CDEC1(2))
          AA = CDEC1(3)
          IF(CSIGN.EQ.1)SIGN='-'
      ENDIF
C
C *** read original and new equinox
C
      CALL STKRDD('EQUINOX',1,1,IAV,EQUI1,KUN,KNUL,ISTAT)
      CALL STKRDD('EQUINOX',2,1,IAV,EQUI2,KUN,KNUL,ISTAT)
C
C *** read plate label
C
      CALL STKRDC('LABEL',1,1,40,IAV,LBL,KUN,KNUL,ISTAT)
C
C *** read date of the observation, allowing for decimal date (i.e. YYYY.yyyyy) 
C
      CALL STKRDD('DATE',1,1,IAV,YEAR,KUN,KNUL,ISTAT)
      CALL STKRDD('DATE',2,1,IAV,MONTH,KUN,KNUL,ISTAT)
      CALL STKRDD('DATE',3,1,IAV,DAY,KUN,KNUL,ISTAT)
C
C *** read epoch 
C
      CALL STKRDD('EPOCH',1,1,IAV,EPP,KUN,KNUL,ISTAT)
C
C *** read exposure time
C
      CALL STKRDD('EXPTIME',1,1,IAV,ETIME,KUN,KNUL,ISTAT) 
C
C *** read wavelength range 
C
      CALL STKRDD('LAMBDA',1,1,IAV,LAM1,KUN,KNUL,ISTAT)
      CALL STKRDD('LAMBDA',2,1,IAV,LAM2,KUN,KNUL,ISTAT)
C
C *** read observation time slot (ST) 
C
      CALL STKRDD('STSLOT',1,1,IAV,ST1,KUN,KNUL,ISTAT)
      CALL STKRDD('STSLOT',2,1,IAV,ST2,KUN,KNUL,ISTAT)
C
C *** convert to hhmmss format
C
      SHH1 = INT(ST1)
      SMM1 = INT((ST1-SHH1)*60.)
C
      SHH2 = INT(ST2)
      SMM2 = INT((ST2-SHH2)*60.)
C
C *** read sidereal time of the observation
C
      CALL STKRDD('SIDTIME',1,1,IAV,ST,KUN,KNUL,ISTAT)
C
C *** read the value of automatic center (AC) calculation flag
C
      CALL STKRDC('ACFLAG',1,1,1,IAV,FLAG1,KUN,KNUL,ISTAT)
C
C *** read the value of automatic precession of the center flag
C
      CALL STKRDC('PFLAG',1,1,1,IAV,FLAG4,KUN,KNUL,ISTAT)
C
C *** read the value of automatic optimal ST calculation flag
C
      CALL STKRDC('ASTFLAG',1,1,1,IAV,FLAG2,KUN,KNUL,ISTAT)
C
C *** read value of E-W flip flag
C
      CALL STKRDC('EWFLAG',1,1,1,IAV,FLAG3,KUN,KNUL,ISTAT)
C
C *** start printing out values
C
      WRITE(STRING(13),110)
110   FORMAT(1X,'   ')
      CALL STTPUT(STRING(13),ISTAT)
      WRITE(STRING(14),1111)INFIL
1111  FORMAT(1X,'Input file:             ',A50)
      CALL STTPUT(STRING(14),ISTAT)
      WRITE(STRING(14),1112)OUTFIL
1112  FORMAT(1X,'Output file:            ',A50)
      CALL STTPUT(STRING(14),ISTAT)
      WRITE(STRING(1),111)LBL
111   FORMAT(1X,'Plate label:            ',A40)
      CALL STTPUT(STRING(1),ISTAT)
      WRITE(STRING(2),112)HH,MM,SS,SIGN,DD,PP,AA
112   FORMAT(1X,'Plate center:           R.A.: ',I2,'h ',I2,'m ',F6.3,
     1          's ',' DEC.: ',A1,I2,'d ',I2,'` ',F5.2,'"')
      CALL STTPUT(STRING(2),ISTAT)
      WRITE(STRING(3),222)EQUI1,EQUI2
222   FORMAT(1X,'Equinoxes:              Old:  ',F10.5,' New: ',F10.5)
      CALL STTPUT(STRING(3),ISTAT)
      WRITE(STRING(4),333)YEAR,MONTH,DAY,EPP
333   FORMAT(1X,'Date:                   Year: ',F10.5,' Month: ',F3.0,
     1          ' Day: ',F3.0,' Epoch: ',F10.5)
      CALL STTPUT(STRING(4),ISTAT)
      WRITE(STRING(5),444)ETIME
444   FORMAT(1X,'Exposure time:          ',F6.2,' m')
      CALL STTPUT(STRING(5),ISTAT)
      WRITE(STRING(6),555)LAM1,LAM2
555   FORMAT(1X,'Wavelength range:       from: ',F5.0,
     1          ' Angstrom',' to:',F5.0,' Angstrom')
      CALL STTPUT(STRING(6),ISTAT)
      WRITE(STRING(7),666)SHH1,SMM1,SHH2,SMM2
666   FORMAT(1X,'Optimal sid. time slot: from: ',I2,'h ',I2,'m ',
     1          'to: ',I2,'h ',I2,'m')
      CALL STTPUT(STRING(7),ISTAT)
      WRITE(STRING(9),888)ST
888   FORMAT(1X,'Optimal sid. time:      ',F6.2,' h')
      CALL STTPUT(STRING(9),ISTAT)
      WRITE(STRING(11),1009)FLAG1
1009  FORMAT(1X,'ACFLAG:                 ',A1)
      CALL STTPUT(STRING(11),ISTAT)
      WRITE(STRING(11),1010)FLAG4
1010  FORMAT(1X,'PFLAG:                  ',A1)
      CALL STTPUT(STRING(11),ISTAT)
      WRITE(STRING(11),1011)FLAG2
1011  FORMAT(1X,'ASTFLAG:                ',A1)
      CALL STTPUT(STRING(11),ISTAT)
      WRITE(STRING(11),1012)FLAG3
1012  FORMAT(1X,'EWFLAG:                 ',A1)
      CALL STTPUT(STRING(11),ISTAT)
C
C *** over and out
C
      CALL STSEPI
      END







