* Last processed by NICE on 12-Jun-2000 15:53:00 * Customized for : IEEE, LINUX, UNIX, MOTIF, F77 * * Written by r.neri July-1994 * * Computes best focus for multibeam bolometer channels * Normally channel 1 is used for the focus evaluation. * SUBROUTINE SOLVE_FOCUS (LINE,ERROR) * *---------------------------------------------------------------------- * Support routine for command * SOLVE /CHANNEL * Arguments : * LINE C*(*) Command line Input * ERROR L Logical error flag Output * *---------------------------------------------------------------------- * INCLUDE 'nic.inc' INCLUDE 'parameter.inc' INCLUDE 'par.inc' * LOGICAL ERROR, SIC_PRESENT CHARACTER*(*) LINE CHARACTER*80 DRAW_TEXT, DRAW_RELO, DRAW_LINE INTEGER IFOC, CHAN, LEN, LENC INTEGER*4 IPSIGNAL REAL A, VAL1, VAL2, USER_YMAX, USER_YMIN REAL FOC CHARACTER ITALIC*3,SCRIPT*2 * * Test if file open * IF (IADDRRECORD.EQ.0) THEN CALL MESSAGE(2,1,'SOLVE','No input file opened') ERROR = .TRUE. RETURN ENDIF * Option /CHANNEL * CHAN = REFERENCE_RECEIVER IF (SIC_PRESENT(1,0) .AND. SIC_PRESENT(1,1)) THEN CALL SIC_I4(LINE,1,1,CHAN,.TRUE.,ERROR) IF (ERROR) GOTO 99 IF (CHAN.GT.NCHAN.OR.CHAN.LT.1) THEN CALL MESSAGE (2,1,'SOLVE','Bad channel number ') ERROR = .TRUE. RETURN ENDIF ENDIF IPSIGNAL = IP_SIGNAL + (CHAN-1)*NRECORD * ITALIC = CHAR(92)//CHAR(92)//'i' ! '\\i' SCRIPT = CHAR(92)//'s' ! '\s' DRAW_TEXT = 'dra tex' DRAW_RELO = 'dra rel' DRAW_LINE = 'dra lin' DRAW_RELO(27:31) = '/user' DRAW_LINE(27:31) = '/user' * CALL GR_EXEC ('clear plot') CALL GR_EXEC1 ('set box 4 20 4 16') CALL GR_EXEC1 ('set exp .8') * CALL FIND_FOCUS (NRECORD,MEMORY(IP_SCAN_COORD), $MEMORY(IPSIGNAL),IFOC,VAL1,A) FOC = IFOC CALL SIC_GET_REAL ('USER_YMAX',USER_YMAX,ERROR) CALL SIC_GET_REAL ('USER_YMIN',USER_YMIN,ERROR) LEN = (USER_YMAX-USER_YMIN)/2 WRITE (DRAW_TEXT(9:15),'(f7.1)') FOC WRITE (DRAW_RELO(9:15),'(f7.1)') FOC WRITE (DRAW_LINE(9:15),'(f7.1)') FOC IF (USER_YMAX-VAL1.LT.VAL1-USER_YMIN) THEN DRAW_TEXT(27:38) = '"'//SCRIPT//'{" 5 /user' VAL2 = VAL1-(VAL1-USER_YMIN)/10. WRITE (DRAW_TEXT(17:25),'(f9.1)') VAL2 WRITE (DRAW_RELO(17:25),'(f9.1)') VAL2 WRITE (DRAW_LINE(17:25),'(f9.1)') VAL2-8*(VAL2-USER_YMIN)/10. CALL GR_EXEC1 (DRAW_TEXT) CALL GR_EXEC1 (DRAW_RELO) CALL GR_EXEC1 (DRAW_LINE) DRAW_TEXT(27:) = '"'//ITALIC// $ ' SFCZ = " 5 /user' WRITE (DRAW_TEXT(17:25),'(f9.1)') VAL2-9*(VAL2-USER_YMIN)/10 WRITE (DRAW_TEXT(39:44),'(f6.3)') IFOC/1000. CALL GR_EXEC1 (DRAW_TEXT) ELSE DRAW_TEXT(27:) = '"'//SCRIPT//'}" 5 /user' VAL2 = VAL1+(USER_YMAX-VAL1)/10. WRITE (DRAW_TEXT(17:25),'(f9.1)') VAL2 WRITE (DRAW_RELO(17:25),'(f9.1)') VAL2 WRITE (DRAW_LINE(17:25),'(f9.1)') VAL2+8*(USER_YMAX-VAL2)/10. CALL GR_EXEC1 (DRAW_TEXT) CALL GR_EXEC1 (DRAW_RELO) CALL GR_EXEC1 (DRAW_LINE) DRAW_TEXT(27:) = '"'//ITALIC// $ ' SFCZ = " 5 /user' WRITE (DRAW_TEXT(17:25),'(f9.1)') VAL2+9*(USER_YMAX-VAL2)/10. WRITE (DRAW_TEXT(39:44),'(f6.3)') IFOC/1000. CALL GR_EXEC1 (DRAW_TEXT) ENDIF WRITE (DRAW_TEXT(9:15),'(f7.4)') .7 WRITE (DRAW_TEXT(17:25),'(f7.4)') -.152 DRAW_TEXT(26:) = '"'//ITALIC//'SCAN = " 6 /box 9' WRITE (DRAW_TEXT(37:42),'(i6)') SCAN_NUMBER CALL GR_EXEC1 (DRAW_TEXT) * WRITE (DRAW_TEXT(17:24),'(f7.4)') -.752 LEN = LENC(SOURCE_NAME) DRAW_TEXT(26:) = '"'//ITALIC//'SOURCE = '// $SOURCE_NAME(1:LEN)//' " 6 /box 9' CALL GR_EXEC1 (DRAW_TEXT) * WRITE (DRAW_TEXT(17:24),'(f7.4)') -1.352 DRAW_TEXT(26:) = '"'//ITALIC//'CHANNEL = " 6 /box 9' WRITE (DRAW_TEXT(40:42),'(i3)') CHAN CALL GR_EXEC1 (DRAW_TEXT) * CALL GR_EXEC1 ('set exp 1.') RETURN * 99 ERROR = .TRUE. RETURN END * SUBROUTINE FIND_FOCUS (NRECORD,SCAN_COORD,SIGNAL, $FOC,VAL1,A) * INCLUDE 'parameter.inc' INCLUDE 'par.inc' * INTEGER NRECORD, FOC REAL SCAN_COORD(NRECORD) REAL SIGNAL(NRECORD) REAL VAL1,A * REAL COUNTS(3), FOCUS_POS(3), VAL2, FOCUS_VAL(300) REAL FITX(300), FITY(300) REAL B, C, D2, D3, E2, E3, E4, E5 REAL MINX, MAXX, MINY, MAXY, AMPL INTEGER I, IC, POINTS(3) LOGICAL ERROR * DO I=1,3 COUNTS(I) = 0 FOCUS_POS(I) = -50000 ! fictive infinite focus position POINTS(I) = 0 ENDDO FOCUS_POS(1) = SCAN_COORD(1) MINX = SCAN_COORD(1) MAXX = MINX MINY = SIGNAL(1) MAXY = MINY DO I = 1,NRECORD IC = 1 VAL1 = SCAN_COORD(I) VAL2 = FOCUS_POS(IC) FOCUS_VAL(I) = SIGNAL(I) MINX = AMIN1(MINX,VAL1) MAXX = AMAX1(MAXX,VAL1) MINY = AMIN1(MINY,FOCUS_VAL(I)) MAXY = AMAX1(MAXY,FOCUS_VAL(I)) DO WHILE (VAL1.NE.VAL2) IC = IC+1 IF (FOCUS_POS(IC).EQ.-50000) FOCUS_POS(IC) = SCAN_COORD(I) VAL1 = SCAN_COORD(I) VAL2 = FOCUS_POS(IC) ENDDO FOCUS_POS(IC) = SCAN_COORD(I) COUNTS(IC) = COUNTS(IC)+SIGNAL(I) POINTS(IC) = POINTS(IC)+1 ENDDO DO I=1,3 COUNTS(I) = COUNTS(I)/POINTS(I) ENDDO D2 = COUNTS(1)-COUNTS(2) D3 = COUNTS(1)-COUNTS(3) E2 = FOCUS_POS(1)-FOCUS_POS(2) E3 = FOCUS_POS(1)-FOCUS_POS(3) E4 = FOCUS_POS(1)**2-FOCUS_POS(2)**2 E5 = FOCUS_POS(1)**2-FOCUS_POS(3)**2 A = (D3*E2-D2*E3)/(E5*E2-E4*E3) B = (D2-A*E4)/E2 C = COUNTS(2)-A*FOCUS_POS(2)**2-B*FOCUS_POS(2) DO I=1,300 FITX(I) = FOCUS_POS(1)+(FOCUS_POS(3)-FOCUS_POS(1))*(I-1)/299 FITY(I) = A*FITX(I)**2+B*FITX(I)+C ENDDO * AMPL = MAXX-MINX MINX = MINX-.05*AMPL MAXX = MAXX+.05*AMPL AMPL = MAXY-MINY MINY = MINY-.05*AMPL MAXY = MAXY+.05*AMPL CALL GR_LIMI (4,MINX/1000.,MAXX/1000.,MINY,MAXY) CALL GR_EXEC1 ('box') CALL GR_LIMI (4,MINX,MAXX,MINY,MAXY) * CALL GR_EXEC1 ('label "Scanning coordinate (mm)" /x') IF (JANSKY_FLAG) THEN CALL GR_EXEC1 ('label "Flux (Jy)" /y') ELSE CALL GR_EXEC1 ('label "Counts" /y') ENDIF FOC = -NINT(B/(2*A)) ! microns CALL GR_SEGM ('plot',ERROR) CALL GR4_MARKER (NRECORD,SCAN_COORD,FOCUS_VAL,BLANKING,10D0) CALL GR4_CONNECT (300,FITX,FITY,0.,-1.) CALL GR_OUT VAL1 = A*FOC**2+B*FOC+C RETURN END *