WSJT-X/lib/packmsg.f90

subroutine packmsg(msg,dat,itype)

! Packs a JT4/JT9/JT65 message into twelve 6-bit symbols

! itype Message Type
!--------------------
!   1   Standardd message
!   2   Type 1 prefix
!   3   Type 1 suffix
!   4   Type 2 prefix
!   5   Type 2 suffix
!   6   Free text
!  -1   Does not decode correctly

  parameter (NBASE=37*36*10*27*27*27)
  parameter (NBASE2=262178562)
  character*22 msg
  integer dat(12)
  character*12 c1,c2
  character*4 c3
  character*6 grid6
  logical text1,text2,text3

  itype=1
  call fmtmsg(msg,iz)

  if(msg(1:6).eq.'CQ DX ') msg(3:3)='9'

! See if it's a CQ message
  if(msg(1:3).eq.'CQ ') then
     i=3
! ... and if so, does it have a reply frequency?
     if(msg(4:4).ge.'0' .and. msg(4:4).le.'9' .and.                  &
          msg(5:5).ge.'0' .and. msg(5:5).le.'9' .and.                &
          msg(6:6).ge.'0' .and. msg(6:6).le.'9') i=7
     go to 1
  endif

  do i=1,22
     if(msg(i:i).eq.' ') go to 1       !Get 1st blank
  enddo
  go to 10                             !Consider msg as plain text
      
1 ia=i
  c1=msg(1:ia-1)
  do i=ia+1,22
     if(msg(i:i).eq.' ') go to 2       !Get 2nd blank
  enddo
  go to 10                             !Consider msg as plain text

2 ib=i
  c2=msg(ia+1:ib-1)

  do i=ib+1,22
     if(msg(i:i).eq.' ') go to 3       !Get 3rd blank
  enddo
  go to 10                             !Consider msg as plain text

3 ic=i
  c3='    '
  if(ic.ge.ib+1) c3=msg(ib+1:ic)
  if(c3.eq.'OOO ') c3='    '           !Strip out the OOO flag
  call getpfx1(c1,k1,nv2a)
  if(nv2a.ge.4) go to 10
  call packcall(c1,nc1,text1)
  if(text1) go to 10
  call getpfx1(c2,k2,nv2b)
  call packcall(c2,nc2,text2)
  if(text2) go to 10
  if(nv2a.eq.2 .or. nv2a.eq.3 .or. nv2b.eq.2 .or. nv2b.eq.3) then
     if(k1.lt.0 .or. k2.lt.0 .or. k1*k2.ne.0) go to 10
     if(k2.gt.0) k2=k2+450
     k=max(k1,k2)
     if(k.gt.0) then
        call k2grid(k,grid6)
        c3=grid6(:4)
     endif
  endif
  call packgrid(c3,ng,text3)

  if(nv2a.lt.4 .and. nv2b.lt.4 .and. (.not.text1) .and. (.not.text2) .and.  &
       (.not.text3)) go to 20

  nc1=0
  if(nv2b.eq.4) then
     if(c1(1:3).eq.'CQ ')  nc1=262178563 + k2
     if(c1(1:4).eq.'QRZ ') nc1=264002072 + k2 
     if(c1(1:3).eq.'DE ')  nc1=265825581 + k2
  else if(nv2b.eq.5) then
     if(c1(1:3).eq.'CQ ')  nc1=267649090 + k2
     if(c1(1:4).eq.'QRZ ') nc1=267698375 + k2
     if(c1(1:3).eq.'DE ')  nc1=267747660 + k2
  endif
  if(nc1.ne.0) go to 20

! The message will be treated as plain text.
10 itype=6
  call packtext(msg,nc1,nc2,ng)
  ng=ng+32768

! Encode data into 6-bit words
20 continue
  if(itype.ne.6) itype=max(nv2a,nv2b)
  dat(1)=iand(ishft(nc1,-22),63)                !6 bits
  dat(2)=iand(ishft(nc1,-16),63)                !6 bits
  dat(3)=iand(ishft(nc1,-10),63)                !6 bits
  dat(4)=iand(ishft(nc1, -4),63)                !6 bits
  dat(5)=4*iand(nc1,15)+iand(ishft(nc2,-26),3)  !4+2 bits
  dat(6)=iand(ishft(nc2,-20),63)                !6 bits
  dat(7)=iand(ishft(nc2,-14),63)                !6 bits
  dat(8)=iand(ishft(nc2, -8),63)                !6 bits
  dat(9)=iand(ishft(nc2, -2),63)                !6 bits
  dat(10)=16*iand(nc2,3)+iand(ishft(ng,-12),15) !2+4 bits
  dat(11)=iand(ishft(ng,-6),63)
  dat(12)=iand(ng,63)

  return
end subroutine packmsg