2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								program plrs
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Pseudo-Linrad "Send" program.  Reads recorded Linrad data from "*.tf2"
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! files, and multicasts it as Linrad would do for timf2 data.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  integer RMODE
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  parameter(RMODE=0)
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  parameter (NBPP=1392)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  parameter (NZ=60*96000)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  parameter (NBYTES=8*NZ)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  parameter (NPPR=NBYTES/NBPP)
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  integer*1 userx_no,iusb
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  integer*2 nblock
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  real*8 d(NZ),buf8
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  integer fd
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  integer open,read,close
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer nm(11)
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-23 15:03:19 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  character*8 fname,arg
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  logical fast
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real*8 center_freq,dmsec,dtmspacket,tmsec
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  common/plrscom/center_freq,msec2,fsample,iptr,nblock,userx_no,iusb,buf8(174)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!                     8        4      4      4    2       1       1    1392
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  data nm/45,46,48,50,52,54,55,56,57,58,59/
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-23 15:03:19 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  data nblock/0/,fast/.false./
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  nargs=iargc()
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-23 15:03:19 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  if(nargs.ne.1 .and. nargs.ne.2) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     print*,'Usage: plrs [-f] <iters>'
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     go to 999
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  endif
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-23 15:03:19 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  call getarg(1,arg)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  if(arg(1:2).eq.'-f') then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     fast=.true.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     call getarg(2,arg)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  read(arg,*) iters
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  fname="all.tf2"//char(0)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  userx_no=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  iusb=1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  center_freq=144.125d0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dtmspacket=1000.d0*NBPP/(8.d0*96000.d0)
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  fsample=96000.0
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  npkt=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  call setup_ssocket                       !Open a socket for multicasting
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  do iter=1,iters
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     fd=open(fname,RMODE)                  !Open file for reading
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     dmsec=-dtmspacket
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     nsec0=time()
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     do ifile=1,11
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        print*,'Reading file',ifile
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ns0=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        tmsec=1000*(3600*7 + 60*nm(ifile))-dtmspacket
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        nr=read(fd,d,NBYTES)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        if(nr.ne.NBYTES) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           print*,'Error reading file all.tf2'
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           go to 999
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        k=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        do ipacket=1,NPPR
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           dmsec=dmsec+dtmspacket
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           tmsec=tmsec+dtmspacket
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           msec2=nint(tmsec)
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           msec=nint(dmsec)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           do i=1,NBPP/8
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              k=k+1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              buf8(i)=d(k)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           enddo
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           nblock=nblock+1
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           call send_pkt(center_freq)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           npkt=npkt+1
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           if(mod(npkt,100).eq.0) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              nsec=time()-nsec0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              nwait=msec-1000*nsec
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!  Pace the data at close to its real-time rate
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-23 15:03:19 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              if(nwait.gt.0 .and. .not.fast) call usleep(nwait*1000)
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           endif
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-22 14:38:03 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           ns=mod(msec2/1000,60)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           if(ns.ne.ns0) write(*,1010) npkt,ns,0.001*msec2,nwait
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								1010       format('npkt:',i10,'   ns:',i6,'   t:',f10.3,'   nwait:',i8)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           ns0=ns
							 | 
						
					
						
							
								
									
										
										
										
											2007-06-20 15:53:56 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     i=close(fd)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								999 end program plrs
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! To compile: % gfortran -o plrs plrs.f90 plrs_subs.c cutil.c
							 |