WSJT-X/lib/genmsk40.f90

subroutine genmsk40(msg,msgsent,ichk,itone,itype,pchk_file,fname1,fname2)

  use hashing
  character*22 msg,msgsent,hashmsg
  character*32 cwstring
  character*2  cwstrbit
  character*4 crpt,rpt(0:15)
  character*512 pchk_file,gen_file
  character*512 pchk_file40,gen_file40
  character*120 fname1,fname2
  character*2048 cmnd
  logical first
  integer itone(144)
  integer*1 message(16),codeword(32),bitseq(40)
  integer*1 s8r(8)
  data s8r/1,0,1,1,0,0,0,1/
  data first/.true./
  data rpt/"-03 ","+00 ","+03 ","+06 ","+10 ","+13 ","+16 ", &
           "R-03","R+00","R+03","R+06","R+10","R+13","R+16", &
           "RRR ","73  "/
  save first,rpt

! Temporarily hardwire filenames and init on every call
  i=index(pchk_file,"128-80")
  pchk_file40=pchk_file(1:i-1)//"32-16"//pchk_file(i+6:)
  i=index(pchk_file40,".pchk")
  gen_file40=pchk_file40(1:i-1)//".gen"
!  call init_ldpc(trim(pchk_file40)//char(0),trim(gen_file40)//char(0))
  itype=-1
  msgsent='*** bad message ***'
  itone=0
  i1=index(msg,'>')
  if(i1.lt.9) go to 900
  call fmtmsg(msg,iz)
  crpt=msg(i1+2:i1+5)
  do i=0,15
     if(crpt.eq.rpt(i)) go to 10
  enddo
  go to 900

10 irpt=i                               !Report index, 0-63
  if(ichk.lt.10000) then
     hashmsg=msg(2:i1-1)//' '//crpt
     call hash(hashmsg,22,ihash)          
     ihash=iand(ihash,4095)                 !10-bit hash 
     ig=16*ihash + irpt                     !6-bit report 
  else
     ig=ichk-10000
  endif

  do i=1,16
    message(i)=iand(1,ishft(ig,1-i))
  enddo

!  call ldpc_encode(message,codeword)
  open(24,file=fname1,status='unknown')
  write(24,1010) message
1010 format(16i1)
  close(24)
  cmnd='encode "'//trim(pchk_file40)//'" "'//trim(gen_file40)//'" "'        &
       //trim(fname1)//'" "'//trim(fname2)//'"'
  call system(cmnd)
  open(24,file=fname2,status='old')
  read(24,1020) codeword
1020 format(32i1)
  close(24)

  cwstring=" "
  do i=1,32
    write(cwstrbit,'(i2)') codeword(i)
    cwstring=cwstring//cwstrbit
  enddo
!  write(*,'(a6,i6,2x,a6,i6,2x,a6,i6)') ' msg: ',ig,'rprt: ',irpt,'hash: ',ihash
!  write(*,'(a6,32i1)') '  cw: ',codeword

  bitseq(1:8)=s8r
  bitseq(9:40)=codeword
  bitseq=2*bitseq-1

! Map I and Q  to tones.
  itone=0
  do i=1, 20
    itone(2*i-1)=(bitseq(2*i)*bitseq(2*i-1)+1)/2;
    itone(2*i)=-(bitseq(2*i)*bitseq(mod(2*i,40)+1)-1)/2;
  enddo

! Flip polarity
  itone=-itone+1 

  msgsent=msg
  itype=7

900 return
end subroutine genmsk40