SUBROUTINE ZMFIND(N,YDEF,TOT,TABLE,GRAT,CARPOS,M,YTOL, * THRESH,NFOUND,YPOS,STATUS) C C Module Number: 13.3.3.1.1 C C Module Name: ZMFIND C C Keyphrase: C ---------- C Find HRS spectral order C C Description: C ------------ C Using a table of total counts versus y-deflection the specified C spectral order is found as the average of the half max points of C the y profile of the order. An approximate position of the order C is found using a previous y-deflection calibration. The new position C is searched within YTOL of the computed position C C FORTRAN Name: zmfind.for C C C Keywords of Accessed Files : C -------------------------- C C Modules Called: C --------------- C SDAS: C UMSPUT C C History: C -------- C Version Date Author Description C 1 Oct 86 D. Lindler Designed and coded C 2 Dec 87 D. Lindler New sdas i/o and standards C------------------------------------------------------------------------ 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) 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 INPUT PARAMETERS C INTEGER N C --->NUMBER OF Y-DEFLECTIONS OBS. DOUBLE PRECISION YDEF(N) C --->Y-DEFLECTIONS DOUBLE PRECISION TOT(N) C --->TOTAL COUNTS AT EACH Y-DEF DOUBLE PRECISION TABLE(7) C --->INPUT CARROUSEL TABLE ROW C TABLE(1) = CAP_A C TABLE(2) = CAP_B C TABLE(3) = CAP_C C TABLE(4) = LIT_A C TABLE(5) = LIT_B C TABLE(6) = LIT_C C TABLE(7) = LIT_D CHARACTER*5 GRAT C --->GRATING MODE DOUBLE PRECISION CARPOS C --->CAROUSEL POSITION INTEGER M C --->SPECTRAL ORDER DOUBLE PRECISION YTOL C --->SEARCH TOLERANCE DOUBLE PRECISION THRESH C --->DETECTION THRESHOLD C C INPUT/OUTPUT PARAMETER C INTEGER NFOUND C --->COUNTER OF FOUND LOCATIONS C C OUTPUT PARAMTERS C DOUBLE PRECISION YPOS C --->FOUND Y-DEFLECTION INTEGER STATUS C --->ERROR STATUS C C LOCAL VARIABLES C CHARACTER*130 CONTXT,MESS C --->TEXT MESSAGES INTEGER I,IPOS C --->INDICES DOUBLE PRECISION TMIN,TMAX C --->MINS/MAXS DOUBLE PRECISION HMAX C --->1/2(TMIN+TMAX) DOUBLE PRECISION Y1,Y2 C --->Y-DEFLECTIONS AT HMAX DOUBLE PRECISION DIFF C --->DIFFERENCE IN PREVIOUS AND NEW YDEF DOUBLE PRECISION WAVE C --->WAVLENGTH AT CENTER OF ORDER DOUBLE PRECISION YAPP C --->APPROXIMATE Y POSITION ON PEAK INTEGER ISTAT C C------------------------------------------------------------------------ C C COMPUTE APPROXIMATE LOCATION OF SPECTRAL ORDER USING PREVIOUS C Y-DEFLECTION CALIBRATION C WAVE=TABLE(1)/M*SIN((TABLE(3)-CARPOS)/TABLE(2)) YAPP=TABLE(4) + TABLE(5)*WAVE + TABLE(6)*WAVE*WAVE + * TABLE(7)*M*WAVE C C FIND PEAK BETWEEN YAPP-YTOL AND YAPP+YTOL C Y1=YAPP-YTOL Y2=YAPP+YTOL TMAX=0.0 IPOS=0 DO 10 I=1,N IF( (YDEF(I).GE.Y1) .AND. (YDEF(I).LE.Y2))THEN IF(TOT(I).GT.TMAX) THEN TMAX=TOT(I) IPOS=I ENDIF ENDIF 10 CONTINUE C C FIND MIN BETWEEN YAPP-2*YTOL AND YAPP+2*YTOL C Y1=YAPP-2.0*YTOL Y2=YAPP+2.0*YTOL TMIN=1.1E10 DO 12 I=1,N IF( (YDEF(I).GE.Y1) .AND. (YDEF(I).LE.Y2))THEN IF(TOT(I).LT.TMIN) TMIN=TOT(I) ENDIF 12 CONTINUE C C DID WE FIND A PEAK THAT IS AT LEAST THRESH TIMES THE BACKGOUND VALUE C IF(TMAX.LT.(TMIN*THRESH))THEN WRITE(CONTXT,99)M,YAPP 99 FORMAT(' NO PEAK FOUND FOR ORDER ',I3, * ' AT APPROX Y-DEF ',F10.1) GO TO 999 ENDIF C C PEAK COUNT IS AT IPOS, FIND LOCATION OF Y-DEF AT POSITIONS C WITH COUNTS = (TMIN+TMAX)/2.0. USE LINEAR INTERPOLATION C IN THE INPUT YDEF,TOT TABLES C HMAX=(TMAX+TMIN)/2.0 C C FIRST MOVE DOWN PEAK UNTIL POSITION LESS THAN HMAX IS FOUND C I=IPOS 20 IF (TOT(I).LT.HMAX) GO TO 30 I=I-1 IF(I.LT.1)THEN WRITE(CONTXT,199)M 199 FORMAT(' ORDER ',I3, * ' IS TOO CLOSE TO EDGE OF Y RANGE OBSERVED') GO TO 999 ENDIF GO TO 20 C C INTERPOLATE TO FIND HMAX POINT C 30 Y1=YDEF(I) + (HMAX-TOT(I)) * * (YDEF(I+1)-YDEF(I))/(TOT(I+1)-TOT(I)) C C NOW MOVE UP IN Y-DEFLECTION TO FIND OTHER HMAX POINT C I=IPOS 40 IF (TOT(I).LT.HMAX) GO TO 50 I=I+1 IF(I.GT.N) THEN WRITE(CONTXT,199)M GO TO 999 ENDIF GO TO 40 C C INTERPOLATE TO FIND Y-DEF OF HMAX POINT C 50 Y2 = YDEF(I) + (HMAX-TOT(I)) * * (YDEF(I-1)-YDEF(I))/(TOT(I-1)-TOT(I)) C C USE AVERAGE OF TWO HMAX POINTS AS ORDER LOCATION C YPOS = (Y1+Y2)/2.0 C C PRINT RESULTS TO TERMINAL C DIFF=YAPP-YPOS C --->DIFFERENCE FROM APPROXIMATE POS. C IF(NFOUND.EQ.0)THEN WRITE(MESS,299)GRAT,CARPOS 299 FORMAT(' YDEFLECTION POSITIONS FOR GRATING ',A5, & ' CARROUSEL POSITION',F8.0) CALL UMSPUT(MESS,STDOUT,0,ISTAT) WRITE(MESS,399) 399 FORMAT(' ORDER YAPP YFOUND DIFF') CALL UMSPUT(MESS,STDOUT,0,ISTAT) ENDIF WRITE(MESS,499)M,YAPP,YPOS,DIFF 499 FORMAT(I6,3F9.1) CALL UMSPUT(MESS,STDOUT,0,ISTAT) C C DONE C NFOUND=NFOUND+1 STATUS=0 GO TO 1000 999 STATUS=1 CALL UMSPUT(CONTXT,STDOUT,0,ISTAT) 1000 RETURN END