SUBROUTINE YFF * * Module Number: 14.7 * * Module Name: YFF * * Keyphrase: * ---------- * FOS flat field * * Description: * ------------ * This routine computes the FOS flat field response * Using a cubic spline fit through a continuum spectrum. * The ratio of the raw data and the fitted data is then * the flat field response. * * Fortran Name: yff * * Keywords of accessed files and tables: * -------------------------------------- * INPUT input input observation template * MASK1 input input mask 1 (Bad data points) * MASK2 input input mask 2 (Blemishes) * NODES input number of nodes in cubic spline * MINVAL input minimum value in INFILE allowed * for computation of FF. * NITER input number of least squares iterations * INDEX1 input First data point to process * INDEX2 input Last data point to process * DOFIT input Perform fit of spline to data? * NODEFILE inp/out Text table containing node pos'n * FLATFIELD output output flat field file * FFMASK output mask file giving locations where * a flat field value was computed * FIT output smooth curve fit to data * * Subroutines Called: * ------------------- * CDBS: * yff1 * SDAS: * uclgs* , umsput, uimcre, uhdps*, uipl1d, * uimopn, uimgid, uimclo, uhdgs* uimclo * * History: * -------- * version date Author Description * 1 3/23/87 D. Lindler Designed and coded * 2 May 88 D. Lindler Designed and coded * 3 May 92 D. Bazell Added USEAFTER keyword * 4 Jul 92 D. Bazell Add interactive graphics * with cursor readback to * add and delete nodes. Add * nodefile and make fitting * optional. * 4.1 May 94 H. Bushouse Added YBASE,YSPACE to YXPTRN *------------------------------------------------------------------------- C C FILE I/O ACCESS MODES C INTEGER RDONLY PARAMETER (RDONLY = 1) INTEGER TYREAL PARAMETER (TYREAL = 6) INTEGER TYDOUB PARAMETER (TYDOUB = 7) C C UMSPUT DESTINATIONS -- CB, DAO, 4-SEP-87 C INTEGER STDOUT PARAMETER (STDOUT = 1) INTEGER STDERR PARAMETER (STDERR = 2) INTEGER USRLOG PARAMETER (USRLOG = 4) C END IRAF77.INC C C TABLE I/O PARAMETER DEFINITIONS C INTEGER TBALLR PARAMETER (TBALLR=3) INTEGER TBWTYP PARAMETER (TBWTYP=5) INTEGER TBMXPR PARAMETER (TBMXPR=6) INTEGER TBLTXT PARAMETER (TBLTXT=13) INTEGER TBNROW PARAMETER (TBNROW=21) C C ERROR PROCESSING PARAMETERS C INTEGER STATUS,ISTATS(20),ISTAT CHARACTER*130 CONTXT C C INPUT FILE I/O C CHARACTER*64 NAME,MASK1,MASK2,NODFIL C --->FILE NAMES INTEGER IDIN,IDOUT C --->FILE IDS INTEGER NAXIS,DTYPE,DIMEN(8),NS C --->DATA DESCRIPTIONS DOUBLE PRECISION DATA(2500) C --->DATA BUFFERS DOUBLE PRECISION M1(2500),M2(2500),FFMASK(2500) C C KEYWORD PARAMETERS C CHARACTER*64 TMPLT,FITNAM,FFMSK,FLATF,USEAFT INTEGER INDEX1,INDEX2,NODES,NITER DOUBLE PRECISION MINVAL C C HEADER VALUES C CHARACTER*5 DET CHARACTER*3 FGWA,APER CHARACTER*1 POLAR CHARACTER*6 APERPS INTEGER PASSDR,FCHNL,NCHNL,XSTEPS,OVRSCN,YBASE,YSPACE C C OTHERS C CHARACTER*19 COLNMS(2), CUNIT(2) CHARACTER*7 CFMT(2) DOUBLE PRECISION FF(2500),FIT(2500),XNODE(30),DNODE(30) INTEGER I,TBDSCR,COLIDS(2),TYPE(2) LOGICAL DOFIT,NULFLG(30) DATA COLNMS /'XPOS','YPOS'/ DATA CUNIT /' ',' '/ DATA CFMT /' ',' '/ DATA TYPE /TYDOUB,TYDOUB/ C C---------------------------------------------------------------- C C GET CL PARAMETERS C CALL UCLGST('input',NAME,ISTATS(1)) CALL UCLGST('mask1',MASK1,ISTATS(2)) CALL UCLGST('mask2',MASK2,ISTATS(3)) CALL UCLGST('flatfield',FLATF,ISTATS(4)) CALL UCLGST('ffmask',FFMSK,ISTATS(5)) CALL UCLGST('fit',FITNAM,ISTATS(6)) CALL UCLGSI('nodes',NODES,ISTATS(7)) CALL UCLGSI('niter',NITER,ISTATS(8)) CALL UCLGSD('minval',MINVAL,ISTATS(9)) CALL UCLGSI('index1',INDEX1,ISTATS(10)) CALL UCLGSI('index2',INDEX2,ISTATS(11)) CALL UCLGST('template',TMPLT,ISTATS(12)) CALL UCLGST('useafter',USEAFT,ISTATS(13)) CALL UCLGSB('dofit',DOFIT,ISTATS(14)) CALL UCLGST('nodefile',NODFIL,ISTATS(15)) DO 10 I=1,15 IF(ISTATS(I).NE.0)THEN CONTXT='Error getting CL parameter' GO TO 999 ENDIF 10 CONTINUE C C READ INPUT OBSERVATION FILE ------------------------------------------------ C C OPEN INPUT FILE C CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening file '//NAME GO TO 999 ENDIF C C READ IMAGE INFO C CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C NS=DIMEN(1) IF((NAXIS.NE.1).OR.(DIMEN(1).GT.2500))THEN CONTXT='Input data must be vector with length less '// * 'than 2500 data points' GO TO 999 ENDIF C C READ DATA C CALL UIGL1D(IDIN,DATA,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C GET HEADER INFORMATION C CALL YGMODE(IDIN,DET,FGWA,APER,APERPS,POLAR,PASSDR,ISTATS(1)) CALL YXPTRN(IDIN,FCHNL,NCHNL,XSTEPS,OVRSCN,YBASE,YSPACE, * ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0))THEN CONTXT='Error; required information missing from header' GO TO 999 ENDIF C C CLOSE IMAGE C CALL UIMCLO(IDIN,ISTAT) C C READ INPUT MASK 1 ------------------------------------------------ C C OPEN INPUT FILE C IF(MASK1.EQ.' ')THEN DO 20 I=1,NS 20 M1(I)=1 ELSE CALL UIMOPN(MASK1,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening mask1 file '//MASK1 GO TO 999 ENDIF C C READ IMAGE INFO C CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading mask1 file '//MASK1 GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.NS))THEN CONTXT='Mask1 must be vector of same length as input'// * 'observation' GO TO 999 ENDIF C C READ DATA C CALL UIGL1D(IDIN,M1,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading mask1 file '//MASK1 GO TO 999 ENDIF C C CLOSE IMAGE C CALL UIMCLO(IDIN,ISTAT) ENDIF C C READ INPUT MASK 2 ------------------------------------------------ C C OPEN INPUT FILE C IF(MASK2.EQ.' ')THEN DO 30 I=1,NS 30 M2(I)=1 ELSE CALL UIMOPN(MASK2,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening mask2 file '//MASK2 GO TO 999 ENDIF C C READ IMAGE INFO C CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading mask2 file '//MASK2 GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.NS))THEN CONTXT='Mask2 must be vector of same length as input'// * 'observation' GO TO 999 ENDIF C C READ DATA C CALL UIGL1D(IDIN,M2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading mask2 file '//MASK2 GO TO 999 ENDIF C C CLOSE IMAGE C CALL UIMCLO(IDIN,ISTAT) ENDIF C C OPEN AND READ NODE LIST IF ONE EXISTS ------------------------------------- C C OPEN TABLE. SET XNODE(1) = -1 IF NODE FILE DOESN'T EXIST C CALL UTTOPN(NODFIL,RDONLY,TBDSCR,ISTAT) IF (ISTAT.NE.0) THEN XNODE(1) = -1.D0 ELSE C C GET COLUMN POINTERS C CALL UTPGTI(TBDSCR,TBNROW,NODES,ISTAT) IF(NODES.GT.30) THEN NODES=30 CONTXT='Read too many nodes, using 30' CALL UMSPUT(CONTXT,STDOUT+STDERR,0,STATUS) ENDIF CALL UTCNUM(TBDSCR,1,COLIDS(1),ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error getting ptr to column 1 for node file ' * //NODFIL GOTO 999 ENDIF CALL UTCNUM(TBDSCR,2,COLIDS(2),ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error getting ptr to column 2 for node file ' * //NODFIL GOTO 999 ENDIF C C READ NODE VALUES C CALL UTCGTD(TBDSCR,COLIDS(1),1,NODES,XNODE,NULFLG,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error reading node file '//NODFIL GOTO 999 ENDIF CALL UTCGTD(TBDSCR,COLIDS(2),1,NODES,DNODE,NULFLG,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error reading node file '//NODFIL GOTO 999 ENDIF C C CLOSE TABLE C CALL UTTCLO(TBDSCR, ISTAT) IF (ISTAT.NE.0) THEN CONTXT = 'Error closing node file '//NODFIL GOTO 999 ENDIF ENDIF C C COMPUTE THE FLAT FIELD RESPONSE -------------------------------------------- C CALL YFF1(DATA,M1,M2,NS,INDEX1,INDEX2,MINVAL, * NODES,XNODE,DNODE,NITER,DOFIT,FIT,FF,FFMASK,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR COMPUTING FLAT FIELD RESPONSE' GO TO 999 ENDIF C C WRITE OUTPUT RESPONSE FILE USING INPUT TEMPLATE ---------------------------- C CALL ZTPLAT(TMPLT,FLATF,FF,NS,IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error writing output response file' GO TO 999 ENDIF C C WRITE HEADER VALUES C CALL UHDPST(IDOUT,'DETECTOR',DET,ISTATS(1)) CALL UHDPSI(IDOUT,'FCHNL',FCHNL,ISTATS(2)) CALL UHDPSI(IDOUT,'NCHNLS',NCHNL,ISTATS(3)) CALL UHDPSI(IDOUT,'NXSTEPS',XSTEPS,ISTATS(4)) CALL UHDPSI(IDOUT,'OVERSCAN',OVRSCN,ISTATS(5)) CALL UHDPST(IDOUT,'APER_ID',APER,ISTATS(6)) CALL UHDPST(IDOUT,'POLAR_ID',POLAR,ISTATS(7)) CALL UHDPST(IDOUT,'FGWA_ID',FGWA,ISTATS(8)) CALL UHDPSI(IDOUT,'PASS_DIR',PASSDR,ISTATS(9)) CALL UHDPST(IDOUT,'APER_POS',APERPS,ISTATS(10)) CALL UHDPST(IDOUT,'USEAFTER',USEAFT,ISTATS(11)) DO 500 I=1,11 IF(ISTATS(I).NE.0)THEN CONTXT='Error updating keyword in output response'// * ' file' GO TO 999 ENDIF 500 CONTINUE C CALL UIMCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output response file ' GO TO 999 ENDIF C C WRITE OUTPUT FIT FILE ---------------------------------------------------- C CALL UIMCRE(FITNAM,TYREAL,1,NS,IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error creating output fit file' GO TO 999 ENDIF CALL UIPL1D(IDOUT,FIT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error writing to output fit file' GO TO 999 ENDIF CALL UIMCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output fit file' GO TO 999 ENDIF C C WRITE MASK FIT FILE ---------------------------------------------------- C CALL UIMCRE(FFMSK,TYREAL,1,NS,IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error creating output ffmask file' GO TO 999 ENDIF CALL UIPL1D(IDOUT,FFMASK,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error writing to output ffmask file' GO TO 999 ENDIF CALL UIMCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output ffmask file' GO TO 999 ENDIF C C WRITE NODE FILE AS A TABLE --------------------------------------------- C C INITIALIZE TABLE AND SET TABLE PARAMETERS C IF(NODFIL.EQ.' ') GOTO 1000 CALL UTTINN(NODFIL,TBDSCR,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error initializing node table '//nodfil GOTO 999 ENDIF CALL UTPPTI(TBDSCR,TBWTYP,TBLTXT,ISTAT) CALL UTPPTI(TBDSCR,TBMXPR,10,ISTAT) CALL UTPPTI(TBDSCR,TBALLR,30,ISTAT) CALL UTCDEF(TBDSCR,COLNMS,CUNIT,CFMT,TYPE,2,COLIDS,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error defining column in node file '//NODFIL GOTO 999 ENDIF C C CREATE TABLE C CALL UTTCRE(TBDSCR,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error creating node file '//NODFIL GOTO 999 ENDIF C C WRITE TABLE C CALL UTCPTD(TBDSCR,COLIDS(1),1,NODES,XNODE,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error writing column to node file '//NODFIL GOTO 999 ENDIF CALL UTCPTD(TBDSCR,COLIDS(2),1,NODES,DNODE,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error writing column to node file '//NODFIL GOTO 999 ENDIF C C CLOSE TABLE C CALL UTTCLO(TBDSCR,ISTAT) IF(ISTAT.NE.0) THEN CONTXT='Error closing node file '//NODFIL GOTO 999 ENDIF C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END