WSJT-X/qmap/libqmap/save_qm.f90

64 lines
1.3 KiB
Fortran

subroutine save_qm(fname,revision,mycall,mygrid,dd,ntx30a,ntx30b,fcenter, &
nutc,ndop00,ndop58)
parameter(NMAX=60*96000)
character*120 fname
character*22 revision
character*12 mycall
character*6 mygrid
real*4 dd(2,NMAX)
real*8 fcenter
integer nxtra(15) !For possible future additions
integer*1,allocatable :: id1(:,:)
ia=1
ib=NMAX
if(ntx30a.gt.5) ia=NMAX/2+1
if(ntx30b.gt.5) ib=NMAX/2
sq=0.
do i=ia,ib
x=dd(1,i)
y=dd(2,i)
sq=sq + x*x + y*y
enddo
nsum=2*(ib-ia+1)
rms=sqrt(sq/nsum)
nbad=0
dmax=0.
fac0=10.0/rms
allocate(id1(1:2,1:NMAX))
do i=ia,ib
x=fac0*dd(1,i)
y=fac0*dd(2,i)
ax=abs(x)
ay=abs(y)
dmax=max(dmax,ax,ay)
if(ax.gt.127.0) then
x=0.
nbad=nbad+1
endif
if(ay.gt.127.0) then
y=0.
nbad=nbad+1
endif
id1(1,i)=nint(x)
id1(2,i)=nint(y)
enddo
if(ia.gt.30*96000) id1(1:2,1:ia-1)=0
if(ib.eq.30*96000) id1(1:2,ib+1:60*96000)=0
open(29,file=trim(fname),status='unknown',access='stream')
nxtra=0
write(29) revision//' ',mycall,mygrid,fcenter,nutc,ntx30a,ntx30b, &
ndop00,ndop58,ia,ib,fac0,nxtra !Write header to disk
write(29) id1(1:2,ia:ib) !Write 8-bit data to disk
close(29)
deallocate(id1)
return
end subroutine save_qm