C @(#)invset.for	19.1 (ES0-DMD) 02/25/03 13:26:21
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 ++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,
C                                         all rights reserved
C.IDENTIFICATION:  INVSET
C.PURPOSE:         Show the keywords used by inventory and set them to
C                  other different values
C.AUTHOR:          A. Kruszewski
C.LANGUAGE:        F77+ESOext
C.VERSION:         CHO 840522 Creation
C.VERSION:         RHW 871120 ESO-FORTRAN Conversion
C.VERSION:         AK  881213 Changes for the portable version
C.VERSION:         RHW 891214 Combine the SET and SHOW code
C -------------------------------------------------------
      PROGRAM SETINV
C
      IMPLICIT NONE
C
      INTEGER IAC,IST,I,ISTAT,IACT
      INTEGER ANALITER,OUPROFIL,HALFEDGE,FIELDVAR,UNITS
      INTEGER PRFLCTRL,IJBORDER(4),ITERATE(2),BRGTCTRL
      INTEGER ISOPHOTR,MARGINS,FULLPSF,UNDRSMPL
      INTEGER IA(23),IKEYVAL(4),NETHEDGE,SKYDETER
      INTEGER IVAL(44),IPOS(44),KUN,KNUL,PHYSICAL
C
      REAL TRESHOLD,CLASSPAR(3),BRGHTLMT,CUTS(2)
      REAL DISTANCE,EXPRTIME,ZEROMAGN,STMETRIC(2),SPROFIL1(5)
      REAL SPROFIL2(5),SPROFIL3(5),SPROFIL4(5),SPROFIL5(5)
      REAL CTRLMODE,CVFACTOR,SGFACTOR,PAIRSPRT,MULTDTCT
      REAL ELONGLMT,YFACTOR,DFVALLEY,BRIGHTOB
      REAL PRFLCLNG(3),NEBLIMIT,ETAFUNCT
      REAL RKEYVAL(5),A(57),XYBORDER(4)
      REAL FILTER,SKYSAMPL
C
      CHARACTER OPTION1*1,OPTION2*1,CMND*20
      CHARACTER KEYWOR(44)*8,KEYNUM(44)*8
      CHARACTER PROMP1*34,PROMP2*26,PROMP3*24,TEXT*80,STRING*80
C
      DATA KEYWOR/
     +     'OUPROFIL','HALFEDGE','FIELDVAR','PRFLCTRL','UNITS   ',
     +     'ITERATE ','ANALITER','IJBORDER','BRGTCTRL','ISOPHOTR',
     +     'LHCUTS  ','TRESHOLD','CTRLMODE','CVFACTOR','SGFACTOR',
     +     'PAIRSPRT','MULTDTCT','ELONGLMT','YFACTOR ','DFVALLEY',
     +     'BRIGHTOB','PRFLCLNG','EXPRTIME','ZEROMAGN','STMETRIC',
     +     'ETAFUNCT','SPROFIL1','SPROFIL2','BRGHTLMT','DISTANCE',
     +     'CLASSPAR','SPROFIL3','SPROFIL4','SPROFIL5','NEBLIMIT',
     +     'MARGINS ','CLASSPAR','PHYSICAL','XYBORDER','FULLPSF ',
     +     'UNDRSMPL','NETHEDGE','SKYDETER','FILTER  '/
C
      DATA KEYNUM/
     +     '18      ','1       ','16      ','15      ','17      ',
     +     '28      ','33      ','30      ','32      ','34      ',
     +     '35      ','2       ','5       ','6       ','7       ',
     +     '3       ','4       ','8       ','9       ','10      ',
     +     '19      ','20      ','13      ','11      ','12      ',
     +     '14      ','21      ','22      ','26      ','27      ',
     +     '29      ','23      ','24      ','25      ','31      ',
     +     '36      ','37      ','38      ','39      ','40      ',
     +     '41      ','42      ','43      ','44      '/
C
      DATA IVAL/
     +      1, 1, 1, 1, 1,
     +      2, 1, 4, 1, 1,
     +      2, 1, 1, 1, 1,
     +      1, 1, 1, 1, 1,
     +      1, 3, 1, 1, 2,
     +      1, 5, 5, 1, 1,
     +      3, 5, 5, 5, 1,
     +      1, 3, 1, 4, 1,
     +      1, 1, 1, 1/
C
      DATA IPOS/
     +      6, 8, 9,11,10,
     +     17, 2,12,22, 5,
     +      1, 3,39,40,41,
     +     42,43,44,45,46,
     +     47,49,10,11,12,
     +     53,14,19, 8, 9,
     +      5,24,29,34,52,
     +     19, 5, 7,54,20,
     +     21,23,16,4/
C
 9000 FORMAT('LHCUTS   (35)=',2F12.1,'          TRESHOLD ( 2)=',F8.3)
 9010 FORMAT('HALFEDGE ( 1)=',I4,'      PAIRSPRT ( 3)=',F7.2,'   MULT',   
     &       'DTCT ( 4)=',F7.2)
 9020 FORMAT('HALFEDGE ( 1)=',I4,'     PAIRSPRT ( 3)=',F7.2,'    ANAL',
     &       'ITER (33)=',I4)
 9030 FORMAT('EXPRTIME (13)=',F10.3,'    STMETRIC (12)=',2F7.2)
 9040 FORMAT('PRFLCTRL (15)=',I4,'     CLASSPAR (37)=',F7.2,'    ZERO',
     &       'MAGN (11)=',F7.2)
 9050 FORMAT('CTRLMODE ( 5)=',F7.2,'   CVFACTOR ( 6)=',F7.2,'   SGF',
     +       'ACTOR ( 7)=',F7.2)
 9060 FORMAT('ELONGLMT ( 8)=',F7.2,'   YFACTOR  ( 9)=',F7.2,'   DFV',
     +       'ALLEY (10)=',F7.2)
 9070 FORMAT('FILTER   (44)=',F7.2,'   UNITS    (17)=',I4,'      MAR',
     &       'GINS  (36)=',I4)
 9080 FORMAT('FULLPSF  (40)=',I4,'      UNDRSMPL (41)=',I4,'      OUP',
     &       'ROFIL (18)=',I4)
 9090 FORMAT('BRIGHTOB (19)=',F7.2,'   PRFLCLNG (20)=',3F7.2)
 9095 FORMAT('ISOPHOTR (34)=',I4,'      ETAFUNCT (14)=',F7.2,'   NEB',
     &       'LIMIT (31)=',F7.2)
 9100 FORMAT('SPROFIL1 (21)=',5F8.3)
 9110 FORMAT('SPROFIL2 (22)=',5F8.3)
 9120 FORMAT('SPROFIL3 (23)=',5F8.3)
 9130 FORMAT('SPROFIL4 (24)=',5F8.3)
 9140 FORMAT('SPROFIL5 (25)=',5F8.3)
 9150 FORMAT('TRESHOLD ( 2)=',F6.2,'    BRGHTLMT (26)=',F6.2,'    DIS',
     +       'TANCE (27)=',F6.2)
 9160 FORMAT('ITERATE (28)=',2I6,'    CLASSPAR (29)=',3F7.2)
 9170 FORMAT('Enter ',I1,' integer value(s): ')
 9180 FORMAT('Enter ',I2,' real value(s): ')
 9190 FORMAT('PHYSICAL (38)=',I4,'      IJBORDER (30)=',4I6)
 9200 FORMAT('XYBORDER (39)=',4F10.2)
 9210 FORMAT('BRGTCTRL (32)=',I4,'      NETHEDGE (42)=',I4,'      SKY',
     &       'DETER (43)=',I4)
 9220 FORMAT('FILTER   (44)=',F7.2,'   MARGINS  (36)=',I4,'      FIEL',
     &       'DVAR (16)=',I4)
C
C *** do the work
C
      CALL STSPRO('SETINV')
      CALL STKRDC('MID$CMND',1,1,20,IAC,CMND,KUN,KNUL,IST)
C
C *** read option1 in INPUTC/C/1/1
C
      CALL STKRDC('INPUTC',1,1,1,IAC,OPTION1,KUN,KNUL,IST)
      IF ((OPTION1.NE.'S') .AND. (OPTION1.NE.'s' ) .AND.
     &    (OPTION1 .NE. 'A') .AND. (OPTION1 .NE. 'a') .AND.
     &    (OPTION1 .NE. 'C') .AND. (OPTION1 .NE. 'c')) THEN
          CALL STTPUT(
     &          '*** FATAL: Option "S" or "A" or "C" is missing',IST)
          CALL STSEPI
      END IF

      CALL STKRDC('INPUTC',1,2,1,IAC,OPTION2,KUN,KNUL,IST)
C
C *** read keywords INV_INTG and INV_REAL
C
      CALL STKRDI('INV_INTG',1,23,IAC,IA,KUN,KNUL,IST)
      CALL STKRDR('INV_REAL',1,57,IAC,A,KUN,KNUL,IST)
C
C *** store the integer keywords of inventory
C
      ANALITER = IA(2)
      ISOPHOTR = IA(5)
      OUPROFIL = IA(6)
      PHYSICAL = IA(7)
      HALFEDGE = IA(8)
      FIELDVAR = IA(9)
      UNITS    = IA(10)
      PRFLCTRL = IA(11)
      DO 10 I = 1,4
          IJBORDER(I) = IA(11+I)
   10 CONTINUE
      SKYDETER   = IA(16)
      ITERATE(1) = IA(17)
      ITERATE(2) = IA(18)
      MARGINS    = IA(19)
      FULLPSF    = IA(20)
      UNDRSMPL   = IA(21)
      BRGTCTRL   = IA(22)
      NETHEDGE   = IA(23)
C
C *** store the real keywords of inventory
C
      CUTS(1)     = A(1)
      CUTS(2)     = A(2)
      TRESHOLD    = A(3)
      FILTER      = A(4)
      CLASSPAR(1) = A(5)
      CLASSPAR(2) = A(6)
      CLASSPAR(3) = A(7)
      BRGHTLMT    = A(8)
      DISTANCE    = A(9)
      EXPRTIME    = A(10)
      ZEROMAGN    = A(11)
      STMETRIC(1) = A(12)
      STMETRIC(2) = A(13)
      DO 20 I = 1,5
         SPROFIL1(I) = A(13+I)
         SPROFIL2(I) = A(18+I)
         SPROFIL3(I) = A(23+I)
         SPROFIL4(I) = A(28+I)
         SPROFIL5(I) = A(33+I)
   20 CONTINUE
      CTRLMODE    = A(39)
      CVFACTOR    = A(40)
      SGFACTOR    = A(41)
      PAIRSPRT    = A(42)
      MULTDTCT    = A(43)
      ELONGLMT    = A(44)
      YFACTOR     = A(45)
      DFVALLEY    = A(46)
      BRIGHTOB    = A(47)
      SKYSAMPL    = A(48)
      PRFLCLNG(1) = A(49)
      PRFLCLNG(2) = A(50)
      PRFLCLNG(3) = A(51)
      NEBLIMIT    = A(52)
      ETAFUNCT    = A(53)
      XYBORDER(1) = A(54)
      XYBORDER(2) = A(55)
      XYBORDER(3) = A(56)
      XYBORDER(4) = A(57)
C
C *** write the keyword contents according to the option
C
      IF (OPTION1.EQ.'S' .OR. OPTION1.EQ.'s' ) THEN
         WRITE (TEXT,9000) CUTS,TRESHOLD
         CALL STTPUT(TEXT,IST)
         WRITE (TEXT,9010) HALFEDGE,PAIRSPRT,MULTDTCT
         CALL STTPUT(TEXT,IST)
         WRITE ( TEXT , 9210 ) BRGTCTRL,NETHEDGE,SKYDETER
         CALL STTPUT( TEXT , IST )
         WRITE ( TEXT , 9220 ) FILTER,MARGINS, FIELDVAR
         CALL STTPUT( TEXT , IST )
         TEXT   = ' '
         CALL STTPUT(TEXT,IST)
C
         IF (OPTION2.EQ.'A' .OR. OPTION2.EQ.'a' ) THEN
            WRITE ( TEXT , 9190 ) PHYSICAL , IJBORDER
            CALL STTPUT( TEXT , IST )
            WRITE ( TEXT , 9200 ) XYBORDER
            CALL STTPUT( TEXT , IST )
            WRITE (TEXT,9050) CTRLMODE,CVFACTOR,SGFACTOR
            CALL STTPUT(TEXT,IST)
            WRITE (TEXT,9060) ELONGLMT,YFACTOR,DFVALLEY
            CALL STTPUT(TEXT,IST)
            TEXT   = ' '
            CALL STTPUT(TEXT,IST)
         END IF
C
      ELSE IF (OPTION1.EQ.'A' .OR. OPTION1.EQ.'a' ) THEN
         WRITE (TEXT,9000) CUTS,TRESHOLD
         CALL STTPUT(TEXT,IST)
         WRITE (TEXT,9020) HALFEDGE,PAIRSPRT,ANALITER
         CALL STTPUT(TEXT,IST)
         WRITE (TEXT,9040) PRFLCTRL,CLASSPAR(1),ZEROMAGN
         CALL STTPUT(TEXT,IST)
         WRITE (TEXT,9030) EXPRTIME,STMETRIC
         CALL STTPUT(TEXT,IST)
         WRITE (TEXT,9070) FILTER,UNITS,MARGINS
         CALL STTPUT( TEXT , IST )
         TEXT   = ' '
         CALL STTPUT(TEXT,IST)
C
         IF (OPTION2.EQ.'A' .OR. OPTION2.EQ.'a' ) THEN
            WRITE (TEXT,9080) FULLPSF,UNDRSMPL,OUPROFIL
            CALL STTPUT(TEXT,IST)
            WRITE ( TEXT , 9190 ) PHYSICAL , IJBORDER
            CALL STTPUT( TEXT , IST )
            WRITE ( TEXT , 9200 ) XYBORDER
            CALL STTPUT( TEXT , IST )
            WRITE (TEXT,9090) BRIGHTOB,PRFLCLNG
            CALL STTPUT(TEXT,IST)
            WRITE (TEXT,9095) ISOPHOTR,ETAFUNCT,NEBLIMIT
            CALL STTPUT(TEXT,IST)
            WRITE (TEXT,9100) SPROFIL1
            CALL STTPUT(TEXT,IST)
            WRITE (TEXT,9110) SPROFIL2
            CALL STTPUT(TEXT,IST)
            WRITE (TEXT,9120) SPROFIL3
            CALL STTPUT(TEXT,IST)
            WRITE (TEXT,9130) SPROFIL4
            CALL STTPUT(TEXT,IST)
            WRITE (TEXT,9140) SPROFIL5
            CALL STTPUT(TEXT,IST)
            TEXT   = ' '
            CALL STTPUT(TEXT,IST)
         END IF
C
      ELSE IF (OPTION1.EQ.'C' .OR. OPTION1.EQ.'c' ) THEN
         WRITE (TEXT,9150) TRESHOLD,BRGHTLMT,DISTANCE
         CALL STTPUT(TEXT,IST)
         WRITE (TEXT,9160) ITERATE,CLASSPAR
         CALL STTPUT(TEXT,IST)
         TEXT   = ' '
         CALL STTPUT(TEXT,IST)
C
      ELSE
         CALL STTPUT('*** FATAL: Unknown parameter as input',ISTAT)
         CALL STSEPI
      END IF
C
C *** if command is SET/INV read new values of inventory keyword ***
C
      IF (CMND(1:3).EQ.'SET') THEN
   30    CONTINUE
         STRING(1:) = ' '
         PROMP1 = 'Enter the keyword name or number: '
         CALL STKPRC(PROMP1,'INPUTC',1,1,20,IACT,STRING,
     2               KUN,KNUL,ISTAT)
C
         IF (STRING.EQ.' ') THEN
            CALL STSEPI
         ELSE
            DO 40 I = 1,44
               IF (STRING(1:8).EQ.KEYWOR(I) (1:8) .OR. STRING(1:8).EQ.
     +            KEYNUM(I) (1:8)) THEN
                  IF ( I .LE. 10 .OR. I .EQ. 36 .OR. I .EQ. 38
     &                        .OR. ( I .GT. 39 .AND. I .LT. 44 ) ) THEN
                     WRITE (PROMP2,9170) IVAL(I)
                     CALL STKPRI(PROMP2,'INPUTI',1,IVAL(I),IACT,
     +                           IKEYVAL,KUN,KNUL,ISTAT)
                     CALL STKWRI('INV_INTG',IKEYVAL,IPOS(I),
     +                           IVAL(I),KUN,IST)

                  ELSE
                     WRITE(PROMP3,9180) IVAL(I)
                     CALL STKPRR(PROMP3,'INPUTR',1,IVAL(I),IACT,
     +                           RKEYVAL,KUN,KNUL,ISTAT)
                     CALL STKWRR('INV_REAL',RKEYVAL,IPOS(I),
     +                           IVAL(I),KUN,IST)
                  END IF
                  GO TO 30
               END IF

   40       CONTINUE
            CALL STTPUT('*** WARNING: Illegal keyword or '//
     +                  'number; try again ...',ISTAT)
            GO TO 30
         END IF
       ENDIF
C
      CALL STSEPI
      END
