PROGRAM td2gf c*********************************************************************** c c PROGRAM NAME: td2gf c c SOURCE FILE: td2gf.f c c PURPOSE: Simple interface program betwwen Hipparcos Transit c Data (TD) and the GaussFit program. c c DESCRIPTION: This program will, for a given HIP identifier, c extract Hipparcos Transit Data (TD) from CD-ROM #6 c of the Hipparcos and Tycho Catalogues (ESA SP-1200) c and create a data file that can be used as input c for the GaussFit program. The output file is called c tdXXXXXX.gf, where XXXXXX is the (zero-padded) c HIP number. c c AUTHORS: Lennart Lindegren and Carl Fredrik Quist c (lennart@astro.lu.se, fredrikq@astro.lu.se) c Lund Observatory c c DATE: 1999 February 5 (Version 1.0) c c*********************************************************************** c c IMPORTANT NOTES: c c 1. Before compilation it is necessary to set the character c variables filedat and fileidx to the correct path+filenames c of the TD files on the CD-ROM (see examples below for UNIX c and DOS/Windows) c c 2. The program automatically corrects the six records in hipj.dat c that contain fields with numerical overfow (asterisks). c c*********************************************************************** IMPLICIT REAL*8 (a-h,o-z) CHARACTER ht*1, db*6, filedat*100, fileidx*100 CHARACTER filegf*11, err1*3, err2*3, err3*5 DIMENSION b(5), sd(5), id(3), vmi(3), in(9), ix(9), iy(9) INTEGER ip, fx, fy, fp c c Variables for the transit data index - c idx = hip2idx(hip) is the record number in filedat for entry hip: c INTEGER hip, hipmax, idx PARAMETER (hipmax = 120416) INTEGER hip2idx(hipmax) c c Character string for reading records of the transit data file: c CHARACTER indat*127 c======================================================================= c c Paths to transit data and transit data index file c (Hipparcos and Tycho Catalogues CD-ROM #6) c - un/comment and edit as appropriate: c c Typical filenames for a UNIX installation: c filedat = '/cdrom/cats/hip_j.dat' fileidx = '/cdrom/cats/hip_j.idx' c c Typical filenames for a PC (DOS or Windows) installation: c c filedat = 'E:\cats\hip_j.dat' c fileidx = 'E:\cats\hip_j.idx' c c======================================================================= c c Various constants: c pi = 3.14159265358979324d0 rpmas = pi/(180d0*3600d3) year = 365.25d0*86400d0 ht = char(9) db = 'double' c c Open and read the transit data index file: c OPEN(UNIT = 11, + FILE = fileidx, + FORM = 'FORMATTED', + STATUS = 'OLD') WRITE(*,'(1x,a)') 'Reading the index file - please wait...' DO i = 1, hipmax READ(11,'(i7,1x)') hip2idx(i) ENDDO CLOSE(11) c c Open the transit data file: c OPEN(UNIT = 12, + FILE = filedat, + ACCESS = 'DIRECT', + RECL = 127, + FORM = 'UNFORMATTED', + STATUS = 'OLD') c c Input a HIP number and construct the output file name (filegf): c 100 CONTINUE WRITE(*,'(1x,a)') 'Enter a HIP number (or 0 or EOF to quit):' READ(*,*,END=300) hip IF (hip .LT. 1 .OR. hip .GT. hipmax) GOTO 300 idx = hip2idx(hip) IF (idx .EQ. -1) THEN WRITE(6,'(1x,a,i6)') 'no Transit Data available for HIP ',hip GOTO 100 ENDIF WRITE(filegf,'(a2,i6.6,a3)') 'td', hip, '.gf' c c Read header record: c READ(12,REC=idx) indat READ(indat,'(3(i6,x),i2,x,i3,x,2(f12.8,x),f6.2,x,2(f8.2,x), , 3(f7.3,x))') (id(i),i=1,3), np, nt, a0, d0, par0, , pma0, pmd0, (vmi(i),i=1,3) c c Read pointing record: c READ(12,REC=idx+1) indat IF(HIP .EQ. 46586) THEN READ(indat,'(i1,1x,i3,1x,a3,1x,8(i1,1x,i3,1x,i3,1x))') , in(1),ix(1),err1,(in(j),ix(j),iy(j),j=2,9) iy(1) = 1308 ELSEIF (HIP .EQ. 99819) THEN READ(indat,'(i1,1x,i3,1x,i3,1x,i1,1x,i3,1x,a3,1x, , 7(i1,1x,i3,1x,i3,1x))')in(1),ix(1),iy(1), , in(2),ix(2),err1,(in(j),ix(j),iy(j),j=3,9) iy(2) = -105 ELSEIF (HIP .EQ. 101043) THEN READ(indat,'(i1,1x,a3,1x,i3,1x,8(i1,1x,i3,1x,i3,1x))') , in(1),err1,iy(1),(in(j),ix(j),iy(j),j=2,9) ix(1) = -157 ELSEIF (HIP .EQ. 116191) THEN READ(indat,'(i1,1x,a3,1x,i3,1x,8(i1,1x,i3,1x,i3,1x))') , in(1),err1,iy(1),(in(j),ix(j),iy(j),j=2,9) ix(1) = -204 ELSEIF (HIP .EQ. 117011) THEN READ(indat,'(i1,1x,i3,1x,a3,1x,i1,1x,i3,1x,a3,1x, , 7(i1,1x,i3,1x,i3,1x))') in(1),ix(1),err1,in(2), , ix(2),err2,(in(j),ix(j),iy(j),j=3,9) iy(1) = -234 iy(2) = -234 ELSE READ(indat,'(9(i1,x,i3,x,i3,x))') (in(i),ix(i),iy(i),i=1,np) ENDIF c c If there is more than one target position, c determine which of them to extract data for: c IF (np .GT. 1 ) THEN WRITE(*,'(/1x,a)') 'There are multiple target positions:' WRITE(*,'(1x,a)') 'IP HIP Xoff Yoff (arcsec)' DO i = 1, np WRITE(*,'(1x,i2,1x,3i6)') i, id(in(i)), ix(i), iy(i) ENDDO WRITE(*,'(1x,a)') 'All IP are included on output file!' ENDIF c c Open the output file (filegf): c OPEN(UNIT = 13, + FILE = filegf, + FORM = 'FORMATTED', + STATUS = 'UNKNOWN') c c Write the header portion of the Midas-type table (filegf): c WRITE(13,'(a,15(a,a))') 'obs',ht,'ip',ht,'t',ht,'fx',ht,'fy', , ht,'fp',ht,'b1',ht,'b2',ht,'b3',ht,'b4',ht,'b5', , ht,'b1_b1',ht,'b2_b2',ht,'b3_b3',ht,'b4_b4',ht,'b5_b5' WRITE(13,'(a,15(a,a))') (db,ht,i=1,15),db c c Loop through transit records: c DO j = 1, nt c c Read the transit record: c READ(12,REC=idx+1+j) indat IF((HIP .EQ. 48036) .AND. (j .EQ. 22))THEN READ(indat,'(i1,1x,f10.7,1x,3(i8,1x),f6.3,1x,4(f7.4,1x), , 3(f5.2,1x),a5,1x,f5.2,1x,2(f4.2,1x),f4.1,1x,i1)') , ip,t,fx,fy,fp,x1,x2,x3,x4,x5,y1,y2,y3,err3,y5, , s1,s2,sa,ifv y4 = -10.0d0 ELSE READ(indat,'(i1,1x,f10.7,1x,3(i8,1x),f6.3,1x,4(f7.4,1x), , 5(f5.2,1x),2(f4.2,1x),f4.1,1x,i1)') , ip,t,fx,fy,fp,x1,x2,x3,x4,x5,y1,y2,y3,y4,y5, , s1,s2,sa,ifv ENDIF c c Convert to Fourier coefficients b() and standard errors sd(): b(1) = dexp(x1) b(2) = b(1)*x2 b(3) = b(1)*x3 b(4) = b(1)*x4 b(5) = b(1)*x5 sd(1) = dexp(y1) sd(2) = dexp(y2) sd(3) = dexp(y3) sd(4) = dexp(y4) sd(5) = dexp(y5) WRITE(13,'(i3,a,i2,14(a,g13.6))') j,ht,ip,ht,t, , ht,dble(fx),ht,dble(fy),ht,dble(fp), , (ht,b(i),i=1,5), (ht,sd(i)**2,i=1,5) 200 CONTINUE ENDDO CLOSE(13) WRITE(*,'(1x,a,a,a)') 'File ', filegf, ' has been written' GOTO 100 300 CONTINUE CLOSE(12) END