* Last processed by NICE on 12-Jun-2000 15:53:00 * Customized for : IEEE, LINUX, UNIX, MOTIF, F77 * * Written by r.neri July-1994 * * List scans (=content) in the range fixed by /SCAN scan_first scan_last * Command allows for alternative redirection of output to Filename by /FILE. * /EXTEN allows for ASC or NMB (default) file extens. /TYPE allows for * selection of ON-OFF, ON-THE-FLY, FOCUS, POINTING, SKYDIP and UNKNOWN type * scans. /SOURCE allows for selection of scan belonging to a same source. * * FIND /SCAN [Scanfirst [Scanlast]] /FILE Filename /EXTEN extension * /TYPE observing_mode /SOURCE source_name /APPEND * SUBROUTINE FIND_SCAN (LINE,ERROR) * *---------------------------------------------------------------------- * Support routine for command * Arguments : * LINE C*(*) Command line Input * ERROR L Logical error flag Output * *---------------------------------------------------------------------- * INCLUDE 'nmb.inc' INCLUDE 'nic.inc' INCLUDE 'parameter.inc' INCLUDE 'par.inc' * INTEGER*4 POINTER,LIST INTEGER*4 IP_FINDSTREAM,FINDSTREAM,INPUTSTREAM_SAVE LOGICAL ERROR, SIC_PRESENT,FILE_OPT, EXTEN_OPT, APPEND_OPT LOGICAL FOUND, SIC_CTRLC, FILE_TYP, TYPE_FOUND, ALREADY LOGICAL ANY_SOURCE, SOURCE_FOUND, PARSE_SOURCENAME CHARACTER*(*) LINE CHARACTER*80 FILENAME, EXTEN, EXTMP CHARACTER*80 NAME, INPUT_LINE, MY_SOURCE CHARACTER*80 SCAN_NAME, SOURCE_PAR, SOURCE_PAR_BL,OUTPUT_LINE * CHARACTER*10 MODE(9), TYPE CHARACTER*1 CR, ANYSTAR * INTEGER SIC_GETVM, SCAN_MAX PARAMETER (SCAN_MAX = 1000) INTEGER SCAN_FIRST, SCAN_LAST, COUNTER, I, J, K, IOS, LEN_S, IER INTEGER LENC, ISR1OPTFLAG_PAR, ISRP1_PAR, ISRP2_PAR, SIC_OPEN INTEGER L, M, II, JJ, NC, SCAN_LIST(SCAN_MAX), OLD_NEXT REAL WAIT REAL VAZM_PAR, DAZM_PAR INTEGER NFILE INTEGER SIC_GETLUN,SIC_FRELUN,LUN LOGICAL EXIST CHARACTER*80 FINDNAME * * SAVE OLD_NEXT, LIST * DATA MODE /'ON-OFF ','ON-THE-FLY','SKYDIP ', $'POINTING ','FOCUS ','UNKNOWN ','ON-OFF ', $'SKYPAD ','RASTERDIP '/ * CR = CHAR(13) INPUTSTREAM_SAVE = INPUTSTREAM * * Option /SCAN * SCAN_FIRST = 1 SCAN_LAST = 9999 IF (SIC_PRESENT(1,1)) THEN CALL SIC_CH(LINE,1,1,ANYSTAR,NC,.TRUE.,ERROR) IF (ANYSTAR.NE.'*') THEN CALL SIC_I4(LINE,1,1,SCAN_FIRST,.TRUE.,ERROR) IF (ERROR) GOTO 99 ENDIF ENDIF IF (SIC_PRESENT(1,2)) THEN CALL SIC_CH(LINE,1,2,ANYSTAR,NC,.TRUE.,ERROR) IF (ANYSTAR.NE.'*') THEN CALL SIC_I4(LINE,1,2,SCAN_LAST,.TRUE.,ERROR) IF (ERROR) GOTO 99 ENDIF ENDIF IF (SCAN_FIRST.LT.0.OR.SCAN_FIRST.GT.9999.OR. $SCAN_LAST.LT.0.OR.SCAN_LAST.GT.9999) THEN CALL MESSAGE (2,1,'FIND','Illegal scan number ') ERROR = .TRUE. RETURN ENDIF IF (SCAN_FIRST.EQ.0) SCAN_FIRST = 1 IF (SCAN_LAST.EQ.0) SCAN_LAST = 1 COUNTER = 1 IF (SCAN_FIRST.GT.SCAN_LAST) COUNTER = -1 * * Option /APPEND * APPEND_OPT = .FALSE. IF (SIC_PRESENT(7,0)) APPEND_OPT = .TRUE. * * Option /EXTEN * EXTEN_OPT = .FALSE. EXTEN = 'nmb' IF (SIC_PRESENT(2,1)) THEN CALL SIC_CH(LINE,2,1,EXTEN,NC,.TRUE.,ERROR) CALL SIC_LOWER (EXTEN) EXTEN_OPT = .TRUE. ENDIF * * Option /FILE * FILE_OPT = .FALSE. IF (SIC_PRESENT(3,1)) THEN CALL SIC_CH(LINE,3,1,FILENAME,NC,.TRUE.,ERROR) IF (ERROR) GOTO 99 !DB:03-99 CALL SIC_LOWER(FILENAME) FILE_OPT = .TRUE. IF (APPEND_OPT) THEN IER = SIC_OPEN(2,FILENAME,'OLD',.FALSE.) 100 READ (2,'(A)',END=110,ERR=110) INPUT_LINE GOTO 100 ELSE IER = SIC_OPEN(2,FILENAME,'NEW',.FALSE.) ENDIF 110 IF (IER.NE.0) THEN CALL MESSAGE (2,1,'FIND','Not able to create file') RETURN ENDIF ENDIF * * Option /TYPE * FILE_TYP = .FALSE. IF (SIC_PRESENT(4,1)) THEN CALL SIC_KE(LINE,4,1,TYPE,NC,.TRUE.,ERROR) !DB:03-99 CALL SIC_UPPER(TYPE) FILE_TYP = .TRUE. ENDIF * * Option /SOURCE * ANY_SOURCE = .TRUE. IF (SIC_PRESENT(5,1)) THEN CALL SIC_KE(LINE,5,1,MY_SOURCE,NC,.TRUE.,ERROR) ANY_SOURCE = .FALSE. ENDIF * * Option /WAIT * WAIT = 5.0 IF (SIC_PRESENT(6,0)) THEN IF (SIC_PRESENT(6,1)) THEN CALL SIC_R4(LINE,6,1,WAIT,.TRUE.,ERROR) ENDIF CALL SIC_WAIT(WAIT) ENDIF * * Start search * IER=SIC_GETLUN(LUN) IF (.NOT.APPEND_OPT) THEN IER = SIC_OPEN (LUN,'.nic.find','NEW',.FALSE.) ELSE INQUIRE(FILE='.nic.find',EXIST=EXIST) IF (EXIST) THEN IER = SIC_OPEN (LUN,'.nic.find','OLD',.FALSE.) 155 READ (LUN,'(A)',END=160,ERR=160) INPUT_LINE GOTO 155 ELSE IER = SIC_OPEN (LUN,'.nic.find','NEW',.FALSE.) ENDIF ENDIF 160 EXTMP = EXTEN EXTEN = '.'//EXTMP NAME ='0000.nmb' OUTPUT_LINE = '(8H Scan : ,I4,2X,8H Ty'// $'pe : ,A10,2X,9HSource : ,A00)' NEXT = 1 IF (FIRST_CALL) OLD_NEXT = 0 IF (.NOT.FIRST_CALL.AND.APPEND_OPT) THEN NEXT = NEXT+MAXFOUND OLD_NEXT = NEXT-1 ENDIF WRITE (NAME(1:4),'(i4.4)') SCAN_FIRST CALL SIC_PARSEF (NAME,SCAN_NAME,'BOLO_DATA:',EXTEN) JJ=LENC(SCAN_NAME)-7 DO I=SCAN_FIRST,SCAN_LAST,COUNTER FOUND = SIC_CTRLC () WRITE (SCAN_NAME(JJ:JJ+3),'(i4.4)') I INQUIRE (FILE=SCAN_NAME,EXIST=ERROR) IF (.NOT.ERROR) GOTO 201 * IF (EXTEN.EQ.'.ASC'.OR.EXTEN.EQ.'.asc') THEN OPEN (UNIT=1,FILE=SCAN_NAME,FORM='formatted',STATUS='old', $ ERR=200,IOSTAT=IOS) INPUT_LINE = ' ' DO WHILE (INPUT_LINE(2:).NE.'EndOfHeaderData') READ(1,'(a)',END=200,ERR=200) INPUT_LINE IF (INPUT_LINE(2:11).EQ.'SourceName') THEN SOURCE_PAR = INPUT_LINE(13:) ELSEIF (INPUT_LINE(2:5).EQ.'SRP1') THEN READ (INPUT_LINE(7:),*,END=200) ISRP1_PAR ELSEIF (INPUT_LINE(2:11).EQ.'SR1OPTFLAG') THEN READ (INPUT_LINE(13:),*,END=200) ISR1OPTFLAG_PAR ELSEIF (INPUT_LINE(2:5).EQ.'SRP2') THEN READ (INPUT_LINE(7:),*,END=200) ISRP2_PAR ELSEIF (INPUT_LINE(2:5).EQ.'VAZM') THEN L = 7 IF (I.LT.10) THEN L = 4 ELSEIF (I.LT.100) THEN L = 5 ELSEIF (I.LT.1000) THEN L = 6 ENDIF READ (INPUT_LINE(L:),*,END=200) VAZM_PAR ENDIF ENDDO ELSE * * Open new file FINDNAME = SCAN_NAME NFILE = LENC(FINDNAME) FINDNAME(NFILE+1:NFILE+1)=CHAR(0) INPUTSTREAM=0 CALL OPEN_STREAM(FINDNAME,FINDSTREAM) IF (FINDSTREAM.EQ.0) THEN CALL MESSAGE (2,1,'FIND','Cannot open file '//FINDNAME) GOTO 201 ENDIF * Read Header MULTIBYTEMODE=0 IP_FINDSTREAM = POINTER(FINDSTREAM,MEMORY) HEADER_SOURCENAME = ' ' CALL GETHEADERINFORMATION(MULTIBYTEMODE,MULTIBYTENUM, $ MULTIBYTETEXT, $ HEADER_STRUCT,MEMORY(IP_FINDSTREAM),ERRORSTATUS) * CALL CLOSE_STREAM(FINDSTREAM) FINDSTREAM = 0 IF (ERRORSTATUS.NE.0) GOTO 200 ISRP1_PAR = HEADER_SRP(1) ISRP2_PAR = HEADER_SRP(2) ISR1OPTFLAG_PAR = HEADER_SRP(3) VAZM_PAR = HEADER_AZIMUTH(3) DAZM_PAR = HEADER_DAZM SOURCE_PAR = HEADER_SOURCENAME LEN_S = LENC(SOURCE_PAR) J = 6 IF (ISRP1_PAR.GT.2.AND.ISRP2_PAR.EQ.1) J = 1 ! ON-OFF IF (VAZM_PAR.NE.0) J = 2 ! ON-THE-FLY IF (ISRP1_PAR.EQ.1.AND.ISR1OPTFLAG_PAR.EQ.1) J = 3 ! SKYDIP IF (ISRP1_PAR.EQ.2.AND.ISRP2_PAR.EQ.2) J = 4 ! POINTING IF (ISRP1_PAR.EQ.2.AND.ISRP2_PAR.EQ.1) J = 5 ! FOCUS IF (SOURCE_PAR(1:6).EQ.'SKYPAD') J = 8 ! SKYPAD IF (SOURCE_PAR(1:9).EQ.'RASTERDIP'. $ AND.J.EQ.3) J = 9 ! RASTERDIP IF (J.EQ.5.AND.DAZM_PAR.GT.1E-8) J = 1 ! ON-OFF K = 1 DO WHILE (SOURCE_PAR(K:K).EQ.' ') K = K+1 ENDDO IF (FILE_TYP) THEN TYPE_FOUND = .FALSE. DO M = 1, LENC(TYPE) IF (MODE(J)(M:M).NE.TYPE(M:M)) TYPE_FOUND = .TRUE. ENDDO ENDIF SOURCE_FOUND = .FALSE. IF (.NOT.ANY_SOURCE) $ SOURCE_FOUND = PARSE_SOURCENAME (SOURCE_PAR,MY_SOURCE) IF (((.NOT.FILE_TYP).OR.((FILE_TYP).AND. $ (.NOT.TYPE_FOUND))).AND.((ANY_SOURCE).OR. $ ((.NOT.ANY_SOURCE).AND.(SOURCE_FOUND)))) THEN WRITE (OUTPUT_LINE(50:51),'(i2.2)') LEN_S-K+1 IF (APPEND_OPT) THEN CALL GET_LIST (MEMORY(IPSCANLIST),SCAN_LIST, $ OLD_NEXT) APPEND_OPT = .FALSE. ENDIF ALREADY = .FALSE. DO M = 1,NEXT-1 IF (SCAN_LIST(M).EQ.I) ALREADY = .TRUE. ENDDO IF (.NOT.ALREADY) THEN IF (NEXT.LE.SCAN_MAX) SCAN_LIST (NEXT) = I NEXT = NEXT + 1 ENDIF DO II=K,LEN_S SOURCE_PAR_BL(II:II) = SOURCE_PAR(II:II) IF (SOURCE_PAR(II:II).EQ.'_') $ SOURCE_PAR_BL(II:II)= ' ' ENDDO IF (FILE_OPT) THEN WRITE (2,OUTPUT_LINE) I,MODE(J),SOURCE_PAR_BL(K:LEN_S) ELSE WRITE (6,OUTPUT_LINE) I,MODE(J),SOURCE_PAR_BL(K:LEN_S) ENDIF WRITE (LUN,OUTPUT_LINE) I,MODE(J),SOURCE_PAR_BL(K:LEN_S) ENDIF ENDIF 200 CLOSE (UNIT=1) 201 IF (FOUND) GOTO 300 ENDDO 300 IF (FILE_OPT) CLOSE (UNIT=2) INPUTSTREAM=INPUTSTREAM_SAVE CLOSE (UNIT=LUN) IER = SIC_FRELUN(LUN) LIST_FLAG = .TRUE. IF (.NOT.FIRST_CALL.AND.OLD_NEXT.NE.0) THEN CALL FREE_VM (OLD_NEXT,LIST) CALL SIC_DELVARIABLE('scan_sequence',.FALSE.,ERROR) ENDIF FIRST_CALL = .FALSE. NEXT = NEXT-1 IF (NEXT.GT.SCAN_MAX) THEN CALL MESSAGE (2,1,'FIND','Sequence shortened...') NEXT = SCAN_MAX ENDIF MAXFOUND = 0 CALL SIC_DELVARIABLE('found',.FALSE.,ERROR) NSEQ = NEXT CALL SIC_DEF_INTE('found',NSEQ,0,0,.TRUE.,ERROR) IF (NEXT.GT.0) THEN OLD_NEXT = NEXT IER = SIC_GETVM (NEXT,LIST) IPSCANLIST = POINTER (LIST,MEMORY) CALL FILL_SCAN_LIST (MEMORY(IPSCANLIST),SCAN_LIST,NEXT) MAXFOUND = NEXT ACTUALSCAN = 0 CALL SIC_DEF_INTE('scan_sequence',MEMORY(IPSCANLIST), $ 1,NEXT,.FALSE.,ERROR) ENDIF IF (NEXT.EQ.0) THEN ERROR = .FALSE. OLD_NEXT = 0 ENDIF * * Option /WAIT * IF (SIC_PRESENT(6,2)) THEN CALL SIC_R4(LINE,6,2,WAIT,.TRUE.,ERROR) CALL SIC_WAIT(WAIT) IF (SIC_CTRLC()) GOTO 99 ENDIF RETURN * 99 ERROR = .TRUE. RETURN END * FUNCTION PARSE_SOURCENAME (STRING,SUBSTRING) CHARACTER*(*)STRING, SUBSTRING CHARACTER*40 SOURCE_OBSERVED, MY_SOURCE INTEGER I, J, K, M, N, LENC, COUNT LOGICAL PARSE_SOURCENAME * N = LENC(STRING) M = LENC(SUBSTRING) SOURCE_OBSERVED = STRING(1:N) MY_SOURCE = SUBSTRING(1:M) I = 1 PARSE_SOURCENAME = .FALSE. DO WHILE ((.NOT.PARSE_SOURCENAME).AND.(I.LE.N-M+1)) COUNT = 0 DO J=1,M K = I-1+J IF (SOURCE_OBSERVED(K:K).EQ.MY_SOURCE(J:J)) COUNT = COUNT+1 ENDDO IF (COUNT.EQ.M) PARSE_SOURCENAME = .TRUE. I = I+1 ENDDO RETURN END * SUBROUTINE FILL_SCAN_LIST (SEQUENCE,LIST,NUMBER) INTEGER NUMBER, SEQUENCE(NUMBER), LIST(1), I * DO I=1,NUMBER SEQUENCE(I) = LIST(I) ENDDO RETURN END * SUBROUTINE GET_LIST (SEQUENCE,LIST,NUMBER) INTEGER NUMBER, SEQUENCE(NUMBER), LIST(1), I * DO I=1,NUMBER LIST(I) = SEQUENCE(I) ENDDO RETURN END