Add routines needed for QRA65code.

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6795 ab8295b8-cf94-4d9e-aec4-7959e3be5d79

lib/genqra65.f90

@@ -0,0 +1,76 @@
+subroutine genqra65(msg0,ichk,msgsent,itone,itype)
+
+! Encodes a QRA65 message to yieild itone(1:126)
+
+  use packjt
+  character*22 msg0
+  character*22 message          !Message to be generated
+  character*22 msgsent          !Message as it will be received
+  integer itone(126)
+  character*3 cok               !'   ' or 'OOO'
+  integer dgen(13)
+  integer sent(63)
+  integer nprc(126)
+  data nprc/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0,  &
+            0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1,  &
+            0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1,  &
+            0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1,  &
+            1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1,  &
+            0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1,  &
+            1,1,1,1,1,1/
+  save
+
+  if(msg0(1:1).eq.'@') then
+     read(msg0(2:5),*,end=1,err=1) nfreq
+     go to 2
+1    nfreq=1000
+2    itone(1)=nfreq
+  else
+     message=msg0
+     do i=1,22
+        if(ichar(message(i:i)).eq.0) then
+           message(i:)='                      '
+           exit
+        endif
+     enddo
+
+     do i=1,22                               !Strip leading blanks
+        if(message(1:1).ne.' ') exit
+        message=message(i+1:)
+     enddo
+
+     call chkmsg(message,cok,nspecial,flip)
+     if(nspecial.eq.0) then
+        call packmsg(message,dgen,itype)    !Pack message into 72 bits
+        call unpackmsg(dgen,msgsent)        !Unpack to get message sent
+        if(ichk.ne.0) go to 999             !Return if checking only
+
+        call qra65_enc(dgen,sent)           !Encode using QRA65
+        nsym=126                            !Symbols per transmission
+        k=0
+        do j=1,nsym
+           if(nprc(j).eq.0) then
+              k=k+1
+              itone(j)=sent(k)+2
+           else
+              itone(j)=0
+           endif
+        enddo
+     else
+        nsym=32
+        k=0
+        do j=1,nsym
+           do n=1,4
+              k=k+1
+              if(iand(j,1).eq.1) itone(k)=0
+              if(iand(j,1).eq.0) itone(k)=10*nspecial
+              if(k.eq.126) go to 10
+           enddo
+        enddo
+10      msgsent=message
+        itype=7
+     endif
+  endif
+
+999 return
+end subroutine genqra65

lib/qra/qra65/qra65_subs.c

@@ -0,0 +1,21 @@
+// qra65_subs.c 
+// Fortran interface routines for QRA65
+
+#include "qra65.h"
+#include <stdio.h>
+
+void qra65_enc_(int x[], int y[])
+{
+  int ncall=0xf70c238;                          //K1ABC
+  qra65codec *codec = qra65_init(0,ncall);	//codec for ncall
+  qra65_encode(codec, y, x);
+}
+
+void qra65_dec_(float r[], int xdec[], int* rc)
+{
+  //  int ncall=0xf70c238;                          //K1ABC
+  int ncall=0x890c60c;                          //KA1ABC
+  int i;
+  qra65codec *codec = qra65_init(1,ncall);	//codec for ncall
+  *rc = qra65_decode(codec,xdec,r);
+}

lib/qra65code.f90

@@ -0,0 +1,79 @@
+program QRA65code
+
+! Provides examples of message packing, bit and symbol ordering,
+! Reed Solomon encoding, and other necessary details of the QRA65
+! protocol.
+
+  use packjt
+  character*22 msg,msg0,msg1,decoded,cok*3,bad*1,msgtype*10
+  integer dgen(12),sent(63),dec(12)
+  real s3(0:63,1:63)
+  include 'testmsg.f90'
+
+  nargs=iargc()
+  if(nargs.ne.1) then
+     print*,'Usage: qra65code "message"'
+     print*,'       qra65code -t'
+     go to 999
+  endif
+
+  call getarg(1,msg)                     !Get message from command line
+  nmsg=1
+  if(msg(1:2).eq."-t") nmsg=NTEST
+
+  write(*,1010)
+1010 format("     Message                 Decoded                Err? Type             rc"/77("-"))
+
+  do imsg=1,nmsg
+     if(nmsg.gt.1) msg=testmsg(imsg)
+
+     call fmtmsg(msg,iz)                    !To upper, collapse mult blanks
+     msg0=msg                               !Input message
+     call chkmsg(msg,cok,nspecial,flip)     !See if it includes "OOO" report
+     msg1=msg                               !Message without "OOO"
+     call packmsg(msg1,dgen,itype)          !Pack message into 12 six-bit bytes
+     msgtype=""
+     if(itype.eq.1) msgtype="Std Msg"
+     if(itype.eq.2) msgtype="Type 1 pfx"
+     if(itype.eq.3) msgtype="Type 1 sfx"
+     if(itype.eq.4) msgtype="Type 2 pfx"
+     if(itype.eq.5) msgtype="Type 2 sfx"
+     if(itype.eq.6) msgtype="Free text"
+
+     call qra65_enc(dgen,sent)              !Encode using QRA65
+
+! Generate a simulated s3() array with moderately high S/N
+     s3=1.0
+     do j=1,63
+        do i=0,63
+           s3(i,j)=1.0 + 0.1*gran()
+        enddo
+        k=sent(j)
+        s3(k,j)=s3(k,j) + 1.2
+     enddo
+
+     call qra65_dec(s3,dec,irc)            !Decode
+     decoded="                      "
+     if(irc.ge.0) then
+        call unpackmsg(dec,decoded)           !Unpack the user message
+        call fmtmsg(decoded,iz)
+     endif
+
+     bad=" "
+     if(decoded.ne.msg0) bad="*"
+     write(*,1020) imsg,msg0,decoded,bad,itype,msgtype,irc
+1020 format(i2,'.',2x,a22,2x,a22,3x,a1,i3,": ",a13,i3)
+  enddo
+
+  if(nmsg.eq.1) then
+     write(*,1030) dgen
+1030 format(/'Packed message, 6-bit symbols ',12i3) !Display packed symbols
+
+     write(*,1040) sent
+1040 format(/'Information-carrying channel symbols'/(i5,20i3))
+
+     write(*,1050) dec
+1050 format(/'Received message, 6-bit symbols ',12i3) !Display packed symbols
+  endif
+
+999 end program QRA65code