subroutine foxgen2(nslots,cmsg,line) ! Called from foxgen() when it's time to encode a SuperFox message and ! generate the waveform to be transmitted. We need to parse the old-style ! Fox messages and extract the necessary pieces. ! use packjt77 character*120 line character*40 cmsg(5) !Old-style Fox messages are here character*37 msg character*26 sfmsg character*13 mycall character*4 mygrid character*6 hiscall_1,hiscall_2 character*4 rpt1,rpt2 character*13 w(19) integer nw(19) integer ntype !Message type: 0 Free Text ! 1 CQ MyCall MyGrid ! 2 Call_1 MyCall RR73 ! 3 Call_1 MyCall rpt1 ! 4 Call_1 RR73; Call_2 rpt2 if(nslots.lt.1 .or. nslots.gt.5) return k=0 do i=1,nslots hiscall_1='' hiscall_2='' mycall='' mygrid='' rpt1='' rpt2='' msg=cmsg(i)(1:37) call split77(msg,nwords,nw,w) ntype=0 if(msg(1:3).eq.'CQ ') then ntype=1 mycall=w(2)(1:12) mygrid=w(3)(1:4) else if(index(msg,';').gt.0) then ntype=4 hiscall_1=w(1)(1:6) hiscall_2=w(3)(1:6) rpt1='RR73' rpt2=w(5)(1:4) mycall=w(4)(2:nw(4)-1) else if(index(msg,' RR73').gt.0) then ntype=2 hiscall_1=w(1)(1:6) mycall=w(2)(1:12) rpt1='RR73' else if(nwords.eq.3 .and. nw(3).eq.3 .and. & (w(3)(1:1).eq.'-' .or. w(3)(1:1).eq.'+')) then ntype=3 hiscall_1=w(1)(1:6) mycall=w(2)(1:12) rpt1=w(3)(1:4) endif ! write(*,3001) ntype,cmsg(i),hiscall_1,rpt1,hiscall_2,rpt2, & ! mycall(1:6),mygrid !3001 format(i1,2x,a37,1x,a6,1x,a4,1x,a6,1x,a4,1x,a6,1x,a4) k=k+1 if(ntype.le.3) call sfox_assemble(ntype,k,msg(1:26),mycall,mygrid,line) if(ntype.eq.4) then sfmsg=w(1)(1:nw(1))//' '//mycall(1:len(trim(mycall))+1)//'RR73' call sfox_assemble(2,k,sfmsg,mycall,mygrid,line) sfmsg=w(3)(1:nw(3))//' '//mycall(1:len(trim(mycall))+1)//w(5)(1:3) k=k+1 call sfox_assemble(3,k,sfmsg,mycall,mygrid,line) endif enddo call sfox_assemble(ntype,11,msg(1:26),mycall,mygrid,line) !k=11 to finish up return end subroutine foxgen2 subroutine split77(msg,nwords,nw,w) ! Convert msg to upper case; collapse multiple blanks; parse into words. character*37 msg character*13 w(19) character*1 c,c0 character*6 bcall_1 logical ok1 integer nw(19) iz=len(trim(msg)) j=0 k=0 n=0 c0=' ' w=' ' do i=1,iz if(ichar(msg(i:i)).eq.0) msg(i:i)=' ' c=msg(i:i) !Single character if(c.eq.' ' .and. c0.eq.' ') cycle !Skip leading/repeated blanks if(c.ne.' ' .and. c0.eq.' ') then k=k+1 !New word n=0 endif j=j+1 !Index in msg n=n+1 !Index in word if(c.ge.'a' .and. c.le.'z') c=char(ichar(c)-32) !Force upper case msg(j:j)=c if(n.le.13) w(k)(n:n)=c !Copy character c into word c0=c enddo iz=j !Message length nwords=k !Number of words in msg if(nwords.le.0) go to 900 do i=1,nwords nw(i)=len(trim(w(i))) enddo msg(iz+1:)=' ' if(nwords.lt.3) go to 900 call chkcall(w(3),bcall_1,ok1) if(ok1 .and. w(1)(1:3).eq.'CQ ') then w(1)='CQ_'//w(2)(1:10) !Make "CQ " into "CQ_" w(2:12)=w(3:13) !Move all remaining words down by one nwords=nwords-1 endif 900 return end subroutine split77