C @(#)invset.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:58 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