SUBROUTINE READ_VIS (INFIL,IDSTAR,IDATE,NDATSTRT,NDATREAD) C----------------------------------------------------------------------- C Read data from file INFIL, for star IDSTAR. C Skip negative visibilities C C From the calling program via parameter list: C INFIL C IDSTAR C C To the calling program via parameter list: C IDATE integer date YYMMDD C HOURS ut time of observation in hours C C From common blocks: C C To common blocks: C OBSVIS2 calibrated visibility squared C VISERR estimated error of data C NDATA number of data points returned. C BASELINE baseline number. C LAMBDA0 filter wavelength C DLAMBDA filter bandwidth C DATE integer date of data file in form YYMMDD C C Expected format for the header line: Cddddddddd#bbbbblllll.l##############llllll.l##############llllll.l C date base filt 1 filter 2 filter 3 C line wavel. wavelength wavelength C The date string is in the form YYMMDD. C C Expected format for visibilities (FORMAT statement 1000): C #=space C#hh.hhhhhhsssss#######vvv.vvveee.eee########vvv.vvveee.eee########vvv.vvveee.eee C hours starno vis^2 error vis^2 error vis^2 error C The second, third, and fourth series of #'s (respectively 7, 8, C and 8 spaces long) are where the uncalibrated visibilities are C written in the input file. C C *************** NOTE !!! ****************** C This routine assumes that there are no more than three filters' C worth of data in the input file and no more than three filters' C worth of data in each record. If (when?) this is adapted for C a system with more filters, this must be modified. Look for C "3" 's, as in the dimension of IFILT, S, and J, and as in the C loop that reads the data into OBSVIS2 and VISERR. I think every- C thing else is quite general, i.e., that changing the parameters C in BINFIT.INC is all that would be needed to enable the program C to handle more channels. C C Written by D. Mozurkewich C Modified by J.T. Armstrong 16 Jan 1991 C----------------------------------------------------------------------- INCLUDE 'BINFIT.INC' INTEGER*4 IDSTAR, IDATE(MXREC), IERR, NDATSTRT, NDATREAD, NDATALL INTEGER*4 IFILT(3) INTEGER*4 FBASE, ISTAR REAL*8 V(3), S(3), FILTER(3), DELFILT REAL*8 UT CHARACTER*80 CARD CHARACTER*1 EXCL CHARACTER*(*) INFIL DATA EXCL/'!'/ C J = INDEX( INFIL, ' ' ) OPEN ( UNIT=4, FILE=INFIL, STATUS='OLD', IOSTAT=IERR ) IF ( IERR .NE. 0 ) THEN WRITE(OUTC,*) ' Cannot find file ', INFIL(1:J), '.' GO TO 900 ! Close and return ELSE WRITE(OUTC,*) ' File ', INFIL(1:J), ' opened.' END IF 10 READ(4,'(80A)',END=900) CARD IF (CARD(1:1).EQ.EXCL) GO TO 10 READ(CARD,'(I9,1X,I5,F7.1,2(14X,F8.1))') $ DATE, FBASE, (FILTER(I), I=1,3) C WRITE(OUTC,'(1X,80A)') CARD C WRITE(OUTC,'(A, I10 )') ' Date in file is ', DATE C WRITE(OUTC,'(A, I10 )') ' Baseline in file is ', FBASE DO I = 1, 3 IFILT(I) = 0 WRITE(OUTC,'(A,F5.1,A)') '$Width of ',FILTER(I), 1 ' nm filter [0 => don''t use]: ' READ(INC,*) DELFILT IF (DELFILT .GT. 0.0) THEN DO IG = 1, MXFILT C WRITE(OUTC,'(A,I3)') ' Value of IG: ',IG IF( (ABS(LAMBDA0(IG)-FILTER(I)) .LT. 1.0) 1 .AND. 2 (ABS(DLAMBDA(IG)-DELFILT) .LT. 1.0 ) ) THEN IFILT(I) = IG LAMBDA0(IG) = FILTER(I) DLAMBDA(IG) = DELFILT NFILT = NFILT + 1 WRITE(OUTC,'(1X,F5.1,A,F4.1,A,I2)') 1 LAMBDA0(IG),' nm filter of width ', 1 DLAMBDA(IG),' nm is filter number ',IG GO TO 100 ! Get next filter ELSE IF (LAMBDA0(IG) .EQ. 0.) THEN IFILT(I) = IG LAMBDA0(IG) = FILTER(I) DLAMBDA(IG) = DELFILT NFILT = NFILT + 1 WRITE(OUTC,'(1X,F5.1,A,F4.1,A,I2)') 1 LAMBDA0(IG),' nm filter of width ', 1 DLAMBDA(IG),' nm is filter number ',IG GO TO 100 ! Get next filter END IF END DO WRITE (OUTC,'(I2,A)') MXFILT, ' wavelengths already ', 1 ' being used; can''t use any more.' GO TO 110 ! Leave filter loop END IF 100 CONTINUE END DO D WRITE(OUTC,'(A,3I3)') ' IFILT = ',(IFILT(I),I=1,3) D WRITE(OUTC,'(A,I3)') ' NFILT = ',NFILT 110 CONTINUE NDATREAD = 1 ! Number of next datum to be read DO WHILE ( (NDATSTRT+NDATREAD) .LE. MXREC ) READ(4,1000,END=900,ERR=900) UT, ISTAR, (V(J), S(J), J=1,3) IF ( (IDSTAR .EQ. ISTAR) ) THEN D WRITE(OUTC,'(A,3(G11.4,2X))') ' V = ',(V(J),J=1,3) D WRITE(OUTC,'(A,3(G11.4,2X))') ' S = ',(S(J),J=1,3) C WRITE(OUTC,'(1X,F9.6,2X,I4,6(1X,F5.3))') C 1 UT,ISTAR,(V(J),S(J),J=1,3) NDATALL = NDATSTRT + NDATREAD NDATREAD = NDATREAD + 1 BASELINE(NDATALL) = FBASE C WRITE(OUTC,'(A,I4,A,I2)') ' BASELINE(',NDATALL,') = ', C 1 BASELINE(NDATALL) IDATE(NDATALL) = DATE HOURS(NDATALL) = UT DO J = 1, 3 D WRITE(OUTC,'(A,I1,A,I1)') ' IFILT(',J,') = ',IFILT(J) IF(IFILT(J).NE.0) THEN OBSVIS2(NDATALL,IFILT(J)) = V(J) VISERR (NDATALL,IFILT(J)) = S(J) END IF END DO D WRITE(OUTC,'(A,I3,A,3(G11.4,2X))') D 1 ' OBSVIS2(',NDATALL,') = ',(OBSVIS2(NDATALL,J),J=1,3) D WRITE(OUTC,'(A,I3,A,3(G11.4,2X))') D 1 ' VISERR (',NDATALL,') = ',(VISERR (NDATALL,J),J=1,3) C ELSE C WRITE(OUTC,'(A,I4)') ' No match with IDSTAR = ',IDSTAR END IF END DO 900 CONTINUE CLOSE(4) NDATREAD = NDATREAD - 1 C DO I = NDATSTRT+1, NDATALL C WRITE(OUTC,'(1X,I4,A,3(F7.3,2X,F7.3))') C 1 I, 'th vis^2, errors: ', C 2 (OBSVIS2(I,IFILT(J)),VISERR(I,IFILT(J)), J=1,3) C END DO RETURN 1000 FORMAT ( 1X, F9.6, I5, 7X, 2F7.3, 8X, 2F7.3, 8X, 2F7.3 ) END