Initial Commit

2018-02-08 21:28:33 -05:00
commit 678c1d3966
14352 changed files with 3176737 additions and 0 deletions
@@ -0,0 +1,137 @@
+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