mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-19 10:32:02 -05:00
132 lines
3.2 KiB
Fortran
132 lines
3.2 KiB
Fortran
|
!----------------------------------------------------------- savedata
|
||
|
|
subroutine savedata
|
||
|
|
|
||
|
|
#ifdef Win32
|
||
|
|
use dfport
|
||
|
|
#endif
|
||
|
|
|
||
|
|
character fname*24,longname*80
|
||
|
|
data ibuf0z/1/
|
||
|
|
include 'gcom1.f90'
|
||
|
|
include 'gcom2.f90'
|
||
|
|
include 'gcom3.f90'
|
||
|
|
save
|
||
|
|
|
||
|
|
if(mode(1:4).eq.'JT65') then
|
||
|
|
call get_fname(hiscall,ntime,trperiod,lauto,fname0)
|
||
|
|
ibuf1=ibuf0
|
||
|
|
ibuf2=ibuf
|
||
|
|
go to 1
|
||
|
|
else
|
||
|
|
call get_fname(hiscall,ntime-trperiod,trperiod,lauto,fname0)
|
||
|
|
endif
|
||
|
|
|
||
|
|
if(ibuf0.eq.ibuf0z) go to 999 !Startup condition, do not save
|
||
|
|
if(ntrbuf(ibuf0z).eq.1) go to 999 !We were transmitting, do not save
|
||
|
|
|
||
|
|
! Get buffer pointers, then copy completed Rx sequence from y1 to d2a:
|
||
|
|
ibuf1=ibuf0z
|
||
|
|
ibuf2=ibuf0-1
|
||
|
|
1 jza=2048*(ibuf2-ibuf1)
|
||
|
|
if(jza.lt.0) jza=jza+NRxMax
|
||
|
|
lenok=1
|
||
|
|
if(jza.lt.110250) go to 999 !Don't save files less than 10 s
|
||
|
|
if(jza.gt.60*11025) go to 999 !Don't save if something's fishy
|
||
|
|
k=2048*(ibuf1-1)
|
||
|
|
if(mode(1:4).ne.'JT65') k=k+3*2048
|
||
|
|
if(mode(1:4).ne.'JT65' .and. jza.gt.30*11025) then
|
||
|
|
k=k + (jza-30*11025)
|
||
|
|
if(k.gt.NRxMax) k=k-NRxMax
|
||
|
|
jza=30*11025
|
||
|
|
endif
|
||
|
|
|
||
|
|
! Check timestamps of buffers used for this data
|
||
|
|
msbig=0
|
||
|
|
i=k/2048
|
||
|
|
if(msmax.eq.0) i=i+1
|
||
|
|
nz=jza/2048
|
||
|
|
if(msmax.eq.0) then
|
||
|
|
i=i+1
|
||
|
|
nz=nz-1
|
||
|
|
endif
|
||
|
|
do n=1,nz
|
||
|
|
i=i+1
|
||
|
|
if(i.gt.1024) i=i-1024
|
||
|
|
i0=i-1
|
||
|
|
if(i0.lt.1) i0=i0+1024
|
||
|
|
dtt=tbuf(i)-tbuf(i0)
|
||
|
|
ms=0
|
||
|
|
if(dtt.gt.0.d0 .and. dtt.lt.80000.0) ms=1000.d0*dtt
|
||
|
|
msbig=max(ms,msbig)
|
||
|
|
enddo
|
||
|
|
|
||
|
|
if(ndebug.gt.0 .and. msbig.gt.msmax .and. msbig.gt.330) then
|
||
|
|
write(*,1020) msbig
|
||
|
|
1020 format('Warning: interrupt service interval',i11,' ms.')
|
||
|
|
endif
|
||
|
|
msmax=max(msbig,msmax)
|
||
|
|
|
||
|
|
do i=1,jza
|
||
|
|
k=k+1
|
||
|
|
if(k.gt.NRxMax) k=k-NRxMax
|
||
|
|
xx=dgain*y1(k)
|
||
|
|
xx=min(32767.0,max(-32767.0,xx))
|
||
|
|
d2a(i)=nint(xx)
|
||
|
|
enddo
|
||
|
|
fnamea=fname0
|
||
|
|
|
||
|
|
npingtime=0
|
||
|
|
fname=fnamea !Save filename for output to disk
|
||
|
|
nagain=0
|
||
|
|
ndecoding=1 !Request decoding
|
||
|
|
|
||
|
|
! Generate file name and write data to file
|
||
|
|
! if(nsave.ge.2 .and. ichar(fname(1:1)).ne.0) then
|
||
|
|
if(ichar(fname(1:1)).ne.0) then
|
||
|
|
|
||
|
|
! Generate header for wavefile:
|
||
|
|
ariff='RIFF'
|
||
|
|
awave='WAVE'
|
||
|
|
afmt='fmt '
|
||
|
|
adata='data'
|
||
|
|
lenfmt=16
|
||
|
|
nfmt2=1
|
||
|
|
nchan2=1
|
||
|
|
nsamrate=11025
|
||
|
|
nbytesam2=2
|
||
|
|
nbytesec=nchan2*nsamrate*nbytesam2
|
||
|
|
nbitsam2=16
|
||
|
|
ndata=2*jza
|
||
|
|
nbytes=ndata+44
|
||
|
|
nchunk=nbytes-8
|
||
|
|
|
||
|
|
do i=80,1,-1
|
||
|
|
if(appdir(i:i).ne.' ') go to 10
|
||
|
|
enddo
|
||
|
|
10 longname=AppDir(1:i)//'/RxWav/'//fname
|
||
|
|
|
||
|
|
#ifdef Win32
|
||
|
|
open(17,file=longname,status='unknown',form='binary',err=20)
|
||
|
|
#else
|
||
|
|
open(17,file=longname,status='unknown',form='unformatted',err=20)
|
||
|
|
#endif
|
||
|
|
write(17) ariff,nchunk,awave,afmt,lenfmt,nfmt2,nchan2,nsamrate, &
|
||
|
|
nbytesec,nbytesam2,nbitsam2,adata,ndata,(d2a(j),j=1,jza)
|
||
|
|
close(17)
|
||
|
|
filetokillb=filetokilla
|
||
|
|
filetokilla=longname
|
||
|
|
go to 30
|
||
|
|
20 print*,'Error opening Fortran unit 17.'
|
||
|
|
print*,longname
|
||
|
|
30 continue
|
||
|
|
endif
|
||
|
|
|
||
|
|
999 if(mode(1:4).ne.'JT65') then
|
||
|
|
ibuf0z=ibuf0
|
||
|
|
ntime0=ntime
|
||
|
|
call get_fname(hiscall,ntime,trperiod,lauto,fname0)
|
||
|
|
endif
|
||
|
|
|
||
|
|
return
|
||
|
|
end subroutine savedata
|