WSJT-X/libm65/genjtms3.f90
Joe Taylor f1da3b1232 Added makepings.
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/jtms3@2506 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2012-07-12 19:46:02 +00:00

159 lines
3.9 KiB
Fortran

subroutine genjtms3(msg28,iwave,nwave)
!subroutine genjtms3(msg28,iwave,cwave,isrch,nwave)
! Generate a JTMS3 wavefile.
parameter (NMAX=30*48000) !Max length of wave file
integer*2 iwave(NMAX) !Generated wave file
complex cwave(NMAX) !Alternative for searchms
character*28 msg28 !User message
character*29 msg
character cc*64
integer sentsym(203) !Transmitted symbols (0/1)
real sentsam(4872) !Transmitted waveform
real*8 dt,phi,f0,dphi,pi,twopi,samfac
real p(0:420)
real carrier(4872)
real dat(4872),bb(4872),wave(4872)
complex cdat(0:2436)
logical first
integer np(9)
data np/5,7,9,11,13,17,19,23,29/ !Permissible message lengths
! 1 2 3 4 5 6
! 0123456789012345678901234567890123456789012345678901234567890123
data cc/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ./?- _ @'/
data samfac/1.d0/,first/.true./
equivalence (dat,cdat)
save
sinc(x)=sin(pi*x)/(pi*x)
if(first) then
pi=4.d0*atan(1.d0)
twopi=2.d0*pi
x=0.
dx=1.0/24.0
width=3.0
do i=1,420 !Generate the BPSK pulse shape
x=x+dx
fac=0.0
if(x/width.lt.0.5*pi) then
fac=(cos(x/width))**2
ipz=i
endif
p(i)=fac*sinc(x)
enddo
p(0)=1.0
f0=10000.d0/7.d0
dt=1.d0/48000.d0
dphi=twopi*f0*dt
phi=0.d0
do i=1,4872 !Generate the carrier
phi=phi+dphi
if(phi.gt.twopi)phi=phi-twopi
xphi=phi
carrier(i)=sin(xphi)
enddo
first=.false.
endif
msg=msg28//' ' !Extend to 29 characters
do i=28,1,-1 !Find user's message length
if(msg(i:i).ne.' ') go to 1
enddo
1 iz=i+1 !Add one for space at EOM
msglen=iz
if(isrch.ne.0) go to 3
do i=1,9
if(np(i).ge.iz) go to 2
enddo
i=8
2 msglen=np(i)
! Convert message to a bit sequence, 7 bits per character (6 + even parity)
3 sentsym=0
k=0
do j=1,msglen
if(msg(j:j).eq.' ') then
i=58
go to 5
else
do i=1,64
if(msg(j:j).eq.cc(i:i)) go to 5
enddo
endif
5 m=0
do n=5,0,-1 !Each character gets 6 bits
k=k+1
sentsym(k)=iand(1,ishft(i-1,-n))
m=m+sentsym(k)
enddo
k=k+1
sentsym(k)=iand(m,1) !Insert bit for even parity
enddo
nsym=7*msglen !# symbols in message
nsam=24*nsym !# samples in message
bb(1:nsam)=0.
do j=1,nsym
fac=1.0
if(sentsym(j).eq.0) fac=-1.0
k0=24*j - 23
do i=0,ipz
k=k0+i
if(k.gt.nsam) k=k-nsam
bb(k)=bb(k) + fac*p(i)
if(i.gt.0) then
k=k0-i
if(k.lt.1) k=k+nsam
bb(k)=bb(k) + fac*p(i)
endif
enddo
enddo
sq=0.
wmax=0.
do i=1,nsam
wave(i)=carrier(i)*bb(i)
sq=sq + wave(i)**2
wmax=max(wmax,abs(wave(i)))
! write(15,3002) i*dt,bb(i),wave(i)
!3002 format(f12.6,2f12.3)
enddo
rms=sqrt(sq/nsam)
! print*,rms,wmax,wmax/rms
fac=32767.0/wmax
iwave(1:nsam)=fac*wave(1:nsam)
! nwave=nsam
nblk=30*48000/nsam
do n=2,nblk
i0=(n-1)*nsam
iwave(i0+1:i0+nsam)=iwave(1:nsam)
enddo
nwave=i0+nsam
! Compute the spectrum
! nfft=nsam
! df=48000.0/nfft
! ib=4000.0/df
! fac=10.0/nfft
! dat(1:nfft)=fac*bb(1:nfft)
! call four2a(dat,nfft,1,-1,0)
! do i=0,ib
! sq=real(cdat(i))**2 + aimag(cdat(i))**2
! write(14,3010) i*df,sq,10.0*log10(sq)
!3010 format(3f12.3)
! enddo
! if(isrch.eq.0) iwave(k+1:)=0
! nwave=k
return
end subroutine genjtms3