2018-02-08 21:28:33 -05:00
|
|
|
subroutine genwspr5(msg,msgsent,itone)
|
|
|
|
|
|
|
|
|
|
! Encode a WSPR-LF message, producing array itone().
|
|
|
|
|
|
|
|
|
|
use crc
|
|
|
|
|
include 'wsprlf_params.f90'
|
|
|
|
|
|
|
|
|
|
character*22 msg,msgsent
|
|
|
|
|
character*60 cbits
|
|
|
|
|
integer*1,target :: idat(9)
|
|
|
|
|
integer*1 msgbits(KK),codeword(ND)
|
|
|
|
|
logical first
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
first=.false.
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
idat=0
|
|
|
|
|
call wqencode(msg,ntype0,idat) !Source encoding
|
|
|
|
|
id7=idat(7)
|
|
|
|
|
if(id7.lt.0) id7=id7+256
|
|
|
|
|
id7=id7/64
|
|
|
|
|
icrc=crc10(c_loc(idat),9) !Compute the 10-bit CRC
|
|
|
|
|
idat(8)=icrc/256 !Insert CRC into idat(8:9)
|
|
|
|
|
idat(9)=iand(icrc,255)
|
|
|
|
|
call wqdecode(idat,msgsent,itype)
|
|
|
|
|
|
|
|
|
|
write(cbits,1004) idat(1:6),id7,icrc
|
|
|
|
|
1004 format(6b8.8,b2.2,b10.10)
|
|
|
|
|
read(cbits,1006) msgbits
|
|
|
|
|
1006 format(60i1)
|
|
|
|
|
|
|
|
|
|
! call chkcrc10(msgbits,nbadcrc)
|
|
|
|
|
! print*,msgsent,itype,crc10_check(c_loc(idat),9),nbadcrc
|
|
|
|
|
|
|
|
|
|
call encode300(msgbits,codeword) !Encode the test message
|
|
|
|
|
icw=2*codeword - 1 !NRZ codeword
|
|
|
|
|
|
|
|
|
|
! Message structure:
|
|
|
|
|
! I channel: R1 48*(S1+D1) S13 48*(D1+S1) R1
|
2018-08-05 11:33:30 -04:00
|
|
|
! Q channel: R1 D204 R1
|
2018-02-08 21:28:33 -05:00
|
|
|
! Generate QPSK with no offset, then shift the y array to get OQPSK.
|
|
|
|
|
|
|
|
|
|
! I channel:
|
|
|
|
|
n=0
|
|
|
|
|
k=0
|
|
|
|
|
do j=1,48 !Insert group of 48*(S1+D1)
|
|
|
|
|
n=n+1
|
|
|
|
|
id(n)=2*isync(j)
|
|
|
|
|
k=k+1
|
|
|
|
|
n=n+1
|
|
|
|
|
id(n)=icw(k)
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
do j=1,13 !Insert Barker 13 code
|
|
|
|
|
n=n+1
|
|
|
|
|
id(n)=2*ib13(j)
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
do j=1,48 !Insert group of 48*(S1+D1)
|
|
|
|
|
k=k+1
|
|
|
|
|
n=n+1
|
|
|
|
|
id(n)=icw(k)
|
|
|
|
|
n=n+1
|
|
|
|
|
id(n)=2*isync(j)
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
! Q channel
|
|
|
|
|
do j=1,204
|
|
|
|
|
k=k+1
|
|
|
|
|
n=n+1
|
|
|
|
|
id(n)=icw(k)
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
! 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+2)=-(jd(2*j)*jd(2*j+1)-1)/2;
|
|
|
|
|
enddo
|
|
|
|
|
itone(NS+ND+2)=jd(NS+ND) !### Is this correct ??? ###
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
end subroutine genwspr5
|
