SUBROUTINE YFND C C Module Number: 14.8.2 C C Module Name: yfnd C C Keyphrase: C ---------- C Find Spectral line positions C C Description: C ------------ C Using an observation of the internal FOS spectral calibration lamp, C line positions (of lines stored in a line library) are found using C Cross correlation with a template. Approximate sample positions for C the lines are also stored in the line library. C C FORTRAN Name: yfnd.for C C C Keywords of Accessed Files : C -------------------------- C input input Observation of spectral calibration lamp C linlib input Spectral line library (table) C table output Table with the found line locations C template input Optional input cross-correlation template C C Modules Called: C --------------- C CDBS: C yccor, yccorp C SDAS: * uclgs* , umsput * uttinn, utppti, utcdef, utrpt*, utcpt*, uthad*, uttclo, utccre * uttopn, utpgti, utcfnd, utrgt*, utcgt*, uthgt*, uttclo * uimotp, uimxtp, uimctp, uimopn, uimgid, uimclo, uhdgs* uimclo C OTHERS: C C History: C -------- C Version Date Author Description C 1 1-10-85 D. Lindler Design and coded C 2 Jan 88 D. Lindler New sdas i/o and standards C 3 Aug 88 D. Lindler Added optional template file C 3.1 May 94 H. Bushouse Added YBASE,YSPACE to YXPTRN C------------------------------------------------------------------------ C ---> Declare everything C INCLUDE FILE FOR THE IRAF77 FORTRAN INTERFACE TO THE IRAF VOS C C C FILE I/O ACCESS MODES C INTEGER RDONLY PARAMETER (RDONLY = 1) INTEGER RDWRIT PARAMETER (RDWRIT = 2) INTEGER WRONLY PARAMETER (WRONLY = 3) INTEGER APPEND PARAMETER (APPEND = 4) C C CODES FOR DATA TYPES C INTEGER TYBOOL PARAMETER (TYBOOL = 1) INTEGER TYCHAR PARAMETER (TYCHAR = 2) INTEGER TYINT PARAMETER (TYINT = 4) 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 C UHDAS HEADER PARM TYPES -- CB, DAO, 5-SEP-87 C INTEGER GENHDR PARAMETER (GENHDR = 0) INTEGER IMSPEC PARAMETER (IMSPEC = 1) C C THIS SECTION IS FOR PARAMETERS RELEVANT TO TABLE I/O. C C THESE MAY BE SET BY UTPPTI AND/OR READ BY UTPGTI: C C LENGTH OF ROW (UNIT = SIZE OF REAL) INTEGER TBRLEN PARAMETER (TBRLEN = 1) C INCREASE ROW LENGTH INTEGER TBIRLN PARAMETER (TBIRLN = 2) C NUMBER OF ROWS TO ALLOCATE INTEGER TBALLR PARAMETER (TBALLR = 3) C INCREASE ALLOC NUM OF ROWS INTEGER TBIALR PARAMETER (TBIALR = 4) C WHICH TYPE OF TABLE? (ROW OR COLUMN) INTEGER TBWTYP PARAMETER (TBWTYP = 5) C MAXIMUM NUMBER OF USER PARAMETERS INTEGER TBMXPR PARAMETER (TBMXPR = 6) C MAXIMUM NUMBER OF COLUMNS INTEGER TBMXCL PARAMETER (TBMXCL = 7) C TYPE = ROW-ORDERED TABLE INTEGER TBTYPR PARAMETER (TBTYPR = 11) C TYPE = COLUMN-ORDERED TABLE INTEGER TBTYPC PARAMETER (TBTYPC = 12) C C THESE MAY BE READ BY UTPGTI BUT MAY NOT BE SET: C C NUMBER OF ROWS WRITTEN TO INTEGER TBNROW PARAMETER (TBNROW = 21) C C END IRAF77.INC C C Error processing parameters C INTEGER STATUS,ISTATS(10),ISTAT CHARACTER*130 CONTXT C ---> What happened C C KEYWORD PARAMETERS C INTEGER TWIDTH, C ---> Template width & SWIDTH C ---> Search width DOUBLE PRECISION MAXDEV C ---> Maximum deviation of found line DOUBLE PRECISION MININT C ---> Minimum line intensity DOUBLE PRECISION AVEDS C ---> avergae offset DOUBLE PRECISION OFFSET C ---> input sample offset C C OBSERVATION MODE C CHARACTER*5 DET CHARACTER*3 APERID,FGWAID CHARACTER*6 APERPS CHARACTER*1 POLID INTEGER PASSDR INTEGER XSTEPS,CHAN1,NCHNLS,OVRSCN,YBASE,YSPACE C C INPUT LINLIB TABLE C CHARACTER*64 LINLIB CHARACTER*10 COLIN(3) DOUBLE PRECISION WLL(200) C ---> Wavelengths DOUBLE PRECISION SAPPX(200) C ---> approximate sample positions DOUBLE PRECISION WEIGHT(200) C ---> wieghts for spectral lines LOGICAL NULLS(200) INTEGER NLL C --->number of rows in table C C OUTPUT SAMPLE TABLE C CHARACTER*64 TABLE INTEGER IDOUT,COLIDS(5),CTYPE(5) CHARACTER*12 COLNAM(5),CFORM(5),CUNITS(5) C C INPUT FILE I/O C CHARACTER*130 NAME,TNAME INTEGER IDIN,NAXIS,DTYPE,DIMEN(8),NS DOUBLE PRECISION DATA(5000),TEMPLT(31) C C OTHER LOCAL VARAIBLES C INTEGER I C ---> Loop indices DOUBLE PRECISION INTE(200), C ---> peak counts in line & SEXACT(200) C ---> found line positions INTEGER NGOOD C ---> good lines found DOUBLE PRECISION TOTAL,DIFF INTEGER NX C C DATA DECLARATIONS C DATA COLIN/'WAVELENGTH','SAMPLE','WEIGHT'/ DATA COLNAM/'WAVELENGTH','SAPPROX','SFOUND','PEAK_COUNT', * 'WEIGHT'/ DATA CFORM/5*' '/ DATA CUNITS/5*' '/ DATA CTYPE/5*TYREAL/ C--------------------------------------------------------------------------- C C get input parameters and file names C CALL UCLGST('input',NAME,ISTATS(1)) CALL UCLGST('linlib',LINLIB,ISTATS(2)) CALL UCLGST('table',TABLE,ISTATS(3)) CALL UCLGSI('twidth',TWIDTH,ISTATS(4)) CALL UCLGSI('swidth',SWIDTH,ISTATS(5)) CALL UCLGSD('maxdev',MAXDEV,ISTATS(6)) CALL UCLGSD('minint',MININT,ISTATS(7)) CALL UCLGSD('offset',OFFSET,ISTATS(8)) CALL UCLGST('template',TNAME,ISTATS(9)) DO 10 I=1,9 IF(ISTATS(I).NE.0)THEN CONTXT='Error reading cl parameter' GO TO 999 ENDIF 10 CONTINUE C C READ OPTIONAL INPUT TEMPLATE FILE ----------------------------------------- C IF(TNAME.NE.' ')THEN CALL UIMOPN(TNAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening template file '//TNAME GO TO 999 ENDIF C C READ TEMPLATE SIZE INFO C CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading template file '//TNAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF(NAXIS.NE.1)THEN CONTXT='Input template must be one dimensional' GO TO 999 ENDIF TWIDTH=DIMEN(1) IF((TWIDTH.GT.31).OR.(TWIDTH.LT.1))THEN CONTXT='Template length must be between 1 and 31 points' GO TO 999 ENDIF C C READ TEMPLATE C CALL UIGL1D(IDIN,TEMPLT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading template file '//TNAME GO TO 999 ENDIF CALL UIMCLO(IDIN,ISTAT) C C IF TEMPLATE NOT SUPPLIED, USE ALL 1.0s C ELSE DO 17 I=1,TWIDTH TEMPLT(I)=1.0 17 CONTINUE ENDIF C C READ INPUT DATA 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 IF(NAXIS.NE.1)THEN CONTXT='Input data must be one dimensional' GO TO 999 ENDIF NS=DIMEN(1) IF(NS.GT.5000)THEN CONTXT='Input data can not exceed 5000 points in length' 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 OBSERVING MODE C CALL YGMODE(IDIN,DET,FGWAID,APERID,APERPS,POLID,PASSDR,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error processing data file '//NAME GO TO 999 ENDIF C C GET X PATTERN INFORMATION C CALL YXPTRN(IDIN,CHAN1,NCHNLS,XSTEPS,OVRSCN,YBASE,YSPACE, * ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error processing data file '//NAME GO TO 999 ENDIF C C CHECK DATA CONSISTENCY C NX=(NCHNLS+OVRSCN-1)*XSTEPS IF(NX.NE.NS)THEN CONTXT='ERROR: data length must = (nchnls+overscan-1)*nxsteps' GO TO 999 ENDIF C C CLOSE IMAGE C CALL UIMCLO(IDIN,ISTAT) C C READ LINE LIBRARY --------------------------------------------------------- C CALL UTTOPN(LINLIB,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening line library '//LINLIB GO TO 999 ENDIF CALL UTPGTI(IDIN,TBNROW,NLL,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting number of rows in '//LINLIB GO TO 999 ENDIF CALL UTCFND(IDIN,COLIN,3,COLIDS,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error locating correct columns in '//LINLIB GO TO 999 ENDIF CALL UTCGTD(IDIN,COLIDS(1),1,NLL,WLL,NULLS,ISTATS(1)) CALL UTCGTD(IDIN,COLIDS(2),1,NLL,SAPPX,NULLS,ISTATS(2)) CALL UTCGTD(IDIN,COLIDS(3),1,NLL,WEIGHT,NULLS,ISTATS(3)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0).OR. * (ISTATS(3).NE.0))THEN CONTXT='ERROR reading line library '//LINLIB GO TO 999 ENDIF CALL UTTCLO(IDIN,ISTAT) C C ADD OFFSET TO SAMPLE LOCATIONS C DO 50 I=1,NLL SAPPX(I)=SAPPX(I)+OFFSET 50 CONTINUE C C FIND EXACT LINE POSITIONS USING CROSS CORRELATION C CALL YCCOR(DATA,NS,SWIDTH,TEMPLT,TWIDTH,XSTEPS, * CHAN1,NLL,SAPPX,SEXACT,INTE) C C PRINT RESULTS C CALL YCCORP(NLL,WLL,SAPPX,SEXACT,INTE) C C COMPUTE AVERAGE SHIFT C NGOOD=0 TOTAL=0.0 DO 100 I=1,NLL IF((INTE(I).GE.MININT).AND.(SEXACT(I).GT.0))THEN DIFF=(SEXACT(I)-SAPPX(I)) IF(ABS(DIFF).LE.MAXDEV)THEN TOTAL=TOTAL+DIFF NGOOD=NGOOD+1 ENDIF ENDIF 100 CONTINUE IF(NGOOD.LT.1)THEN CALL UMSPUT('No valid lines found',STDOUT, * 0,ISTAT) AVEDS=0.0 ELSE AVEDS=TOTAL/NGOOD WRITE(CONTXT,199)AVEDS 199 FORMAT(' --- AVERAGE DEVIATION OF GOOD LINES=',F10.2) CALL UMSPUT(CONTXT,STDOUT,0,ISTAT) ENDIF C C WRITE AVERAGE DIFFERENCE PARAMETER C CALL UCLPSD('aveds',AVEDS,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR IN OUTPUT OF CL PARAMETER aveds' GO TO 999 ENDIF C C WRITE OUTPUT TABLE C C C OPEN OUTPUT TABLE C CALL UTTINN(TABLE,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBWTYP,TBTYPC,ISTATS(2)) CALL UTPPTI(IDOUT,TBMXCL,5,ISTATS(3)) CALL UTPPTI(IDOUT,TBMXPR,12,ISTATS(6)) CALL UTCDEF(IDOUT,COLNAM,CUNITS,CFORM,CTYPE,5,COLIDS,ISTATS(4)) CALL UTTCRE(IDOUT,ISTATS(5)) DO 200 I=1,6 IF(ISTATS(I).NE.0)THEN CONTXT='Error creating output table '//TABLE GO TO 999 ENDIF 200 CONTINUE C C COPY RESULTS TO TABLE C CALL UTCPTD(IDOUT,COLIDS(1),1,NLL,WLL,ISTATS(1)) CALL UTCPTD(IDOUT,COLIDS(2),1,NLL,SAPPX,ISTATS(2)) CALL UTCPTD(IDOUT,COLIDS(3),1,NLL,SEXACT,ISTATS(3)) CALL UTCPTD(IDOUT,COLIDS(4),1,NLL,INTE,ISTATS(4)) CALL UTCPTD(IDOUT,COLIDS(5),1,NLL,WEIGHT,ISTATS(5)) DO 210 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error writing to output table' GO TO 999 ENDIF 210 CONTINUE C C ADD OBSMODE TO OUTPUT TABLE C CALL UTHADT(IDOUT,'DETECTOR',DET,ISTATS(1)) CALL UTHADT(IDOUT,'FGWA_ID',FGWAID,ISTATS(2)) CALL UTHADT(IDOUT,'APER_ID',APERID,ISTATS(3)) CALL UTHADT(IDOUT,'APER_POS',APERPS,ISTATS(4)) CALL UTHADT(IDOUT,'POLAR_ID',POLID,ISTATS(5)) CALL UTHADI(IDOUT,'PASS_DIR',PASSDR,ISTATS(6)) DO 220 I=1,6 IF(ISTATS(I).NE.0)THEN CONTXT='ERROR writing parameter to output table' GO TO 999 ENDIF 220 CONTINUE CALL UTTCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output table '//TABLE GO TO 999 ENDIF C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END