C @(#)showopto.for 17.1.1.1 (ES0-DMD) 01/25/02 17:55:14 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 17.1.1.1 (ESO-IPG) 17:55:14 01/25/02 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