diff --git a/lib/qra/q65/q65_set_list.f90 b/lib/qra/q65/q65_set_list.f90 index 44b2e12cb..065f7dc09 100644 --- a/lib/qra/q65/q65_set_list.f90 +++ b/lib/qra/q65/q65_set_list.f90 @@ -4,6 +4,7 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw) character*12 mycall,hiscall character*6 hisgrid character*37 msg0,msg,msgsent + logical my_std,his_std integer codewords(63,MAX_NCW) integer itone(85) integer isync(22) @@ -11,12 +12,24 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw) ncw=0 if(hiscall(1:1).eq. ' ') return + call stdcall(mycall,my_std) + call stdcall(hiscall,his_std) ncw=MAX_NCW - msg0=trim(mycall)//' '//trim(hiscall) - j0=len(trim(msg0))+2 do i=1,ncw - msg=msg0 + msg=trim(mycall)//' '//trim(hiscall) + if(.not.my_std) then + if(i.eq.1 .or. i.ge.6) msg='<'//trim(mycall)//'> '//trim(hiscall) + if(i.ge.2 .and. i.le.4) msg=trim(mycall)//' <'//trim(hiscall)//'>' + else if(.not.his_std) then + if(i.le.4) msg='<'//trim(mycall)//'> '//trim(hiscall) + if(i.ge.7) msg=trim(mycall)//' <'//trim(hiscall)//'>' + if(i.eq.6) then + msg='TNX 73 GL' + go to 10 + endif + endif + j0=len(trim(msg))+2 if(i.eq.2) msg(j0:j0+2)='RRR' if(i.eq.3) msg(j0:j0+3)='RR73' if(i.eq.4) msg(j0:j0+1)='73' @@ -32,7 +45,8 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw) if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+' endif endif - call genq65(msg,0,msgsent,itone,i3,n3) + +10 call genq65(msg,0,msgsent,itone,i3,n3) i0=1 j=0 do k=1,85 @@ -49,3 +63,36 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw) return end subroutine q65_set_list + +subroutine stdcall(callsign,std) + + character*12 callsign + character*1 c + logical is_digit,is_letter,std +!Statement functions: + is_digit(c)=c.ge.'0' .and. c.le.'9' + is_letter(c)=c.ge.'A' .and. c.le.'Z' + +! Check for standard callsign + iarea=-1 + n=len(trim(callsign)) + do i=n,2,-1 + if(is_digit(callsign(i:i))) exit + enddo + iarea=i !Right-most digit (call area) + npdig=0 !Digits before call area + nplet=0 !Letters before call area + do i=1,iarea-1 + if(is_digit(callsign(i:i))) npdig=npdig+1 + if(is_letter(callsign(i:i))) nplet=nplet+1 + enddo + nslet=0 !Letters in suffix + do i=iarea+1,n + if(is_letter(callsign(i:i))) nslet=nslet+1 + enddo + std=.true. + if(iarea.lt.2 .or. iarea.gt.3 .or. nplet.eq.0 .or. & + npdig.ge.iarea-1 .or. nslet.gt.3) std=.false. + + return +end subroutine stdcall