WSJT-X/lib/fsk4hf/genwsprlf.f90

138 lines
3.4 KiB
Fortran

subroutine genwsprlf(msgbits,id,icw,cbb,csync,itone)
!Encode a WSPR-LF message, produce baseband waveform and sync vector.
include 'wsprlf_params.f90'
complex cbb(0:NZ-1)
complex csync(0:NZ-1)
real x(0:NZ-1)
real y(0:NZ-1)
real pp(N2)
logical first
integer*1 msgbits(KK),codeword(ND)
integer icw(ND)
integer id(NS+ND)
integer jd(NS+ND)
integer isync(48) !Long sync vector
integer ib13(13) !Barker 13 code
integer itone(NN)
integer*8 n8
data ib13/1,1,1,1,1,-1,-1,1,1,-1,1,-1,1/
data first/.true./
save first,isync,twopi,pp
if(first) then
n8=z'cbf089223a51'
do i=1,48
isync(i)=-1
if(iand(n8,1).eq.1) isync(i)=1
n8=n8/2
enddo
twopi=8.0*atan(1.0)
do i=1,N2 !Half-sine shaped pulse
pp(i)=sin(0.5*(i-1)*twopi/N2)
enddo
first=.false.
endif
call encode300(msgbits,codeword) !Encode the test message
icw=2*codeword - 1
! Message structure: R1 48*(S1+D1) S13 48*(D1+S1) R1
! Generate QPSK without any offset; then shift the y array to get OQPSK.
! Do the I channel first: results in array x
n=0
k=0
ia=0
ib=NSPS-1
x(ia:ib)=0. !Ramp up (half-symbol; shape TBD)
do j=1,48 !Insert group of 48*(S1+D1)
ia=ib+1
ib=ia+N2-1
n=n+1
id(n)=2*isync(j)
x(ia:ib)=isync(j)*pp !Insert Sync bit
ia=ib+1
ib=ia+N2-1
k=k+1
n=n+1
id(n)=icw(k)
x(ia:ib)=id(n)*pp !Insert data bit
enddo
do j=1,13 !Insert Barker 13 code
ia=ib+1
ib=ia+N2-1
n=n+1
id(n)=2*ib13(j)
x(ia:ib)=ib13(j)*pp
enddo
do j=1,48 !Insert group of 48*(S1+D1)
ia=ib+1
ib=ia+N2-1
k=k+1
n=n+1
id(n)=icw(k)
x(ia:ib)=id(n)*pp !Insert data bit
ia=ib+1
ib=ia+N2-1
n=n+1
id(n)=2*isync(j)
x(ia:ib)=isync(j)*pp !Insert Sync bit
enddo
ia=ib+1
ib=ia+NSPS-1
x(ia:ib)=0. !Ramp down (half-symbol; shape TBD)
! Now do the Q channel: results in array y
ia=0
ib=NSPS-1
y(ia:ib)=0. !Ramp up (half-symbol; shape TBD)
do j=1,204
ia=ib+1
ib=ia+N2-1
k=k+1
n=n+1
id(n)=icw(k)
y(ia:ib)=id(n)*pp
enddo
ia=ib+1
ib=ia+NSPS-1
y(ia:ib)=0. !Ramp down (half-symbol; shape TBD)
y=cshift(y,-NSPS) !Shift Q array to get OQPSK
cbb=cmplx(x,y) !Complex baseband waveform
ib=NSPS-1
ib2=NSPS-1+64*N2
do j=1,48 !Zero all data symbols in x
ia=ib+1+N2
ib=ia+N2-1
x(ia:ib)=0.
ia2=ib2+1+N2
ib2=ia2+N2-1
x(ia2:ib2)=0.
enddo
csync=x
! Map I and Q to tones.
n=0
jz=(NS+ND+1)/2
do j=1,jz-1
jd(2*j-1)=id(j)/abs(id(j))
jd(2*j)=id(j+jz)/abs(id(j+jz))
enddo
jd(NS+ND)=id(jz)/abs(id(jz))
itone=0
do j=1,jz-1
itone(2*j-1)=(jd(2*j)*jd(2*j-1)+1)/2;
itone(2*j)=-(jd(2*j)*jd(2*j+1)-1)/2;
enddo
itone(NS+ND)=jd(NS+ND) !### Is this correct ??? ###
return
end subroutine genwsprlf