mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-12-24 11:40:31 -05:00
Through type 0.3.
This commit is contained in:
Joe Taylor
parent
9ccb96397d
commit
9d5a2e6f5a
@ -1,6 +1,7 @@
|
|||||||
program t2
|
program encode77
|
||||||
|
|
||||||
character msg*37,msg0*37,cerr*1
|
character msg*37,msg0*37,cerr*1
|
||||||
|
character*77 c77
|
||||||
|
|
||||||
open(10,file='msgtypes.txt',status='old')
|
open(10,file='msgtypes.txt',status='old')
|
||||||
|
|
||||||
@ -10,17 +11,30 @@ program t2
|
|||||||
1001 format(a1)
|
1001 format(a1)
|
||||||
|
|
||||||
do iline=1,999
|
do iline=1,999
|
||||||
read(10,1002,end=999) i3,n3,msg
|
read(10,1002,end=999) i3a,n3a,msg0
|
||||||
1002 format(i1,i4,1x,a37)
|
1002 format(i1,i4,1x,a37)
|
||||||
msg0=msg
|
if(i3a.gt.0 .or. n3a.gt.3) cycle
|
||||||
call parse77(msg,i3a,n3a)
|
call pack77(msg0,i3,n3,c77)
|
||||||
|
call unpack77(c77,msg)
|
||||||
cerr=' '
|
cerr=' '
|
||||||
if(i3a.ne.i3 .or. n3a.ne.n3 .or. msg.ne.msg0) cerr='*'
|
if(i3a.ne.i3 .or. n3a.ne.n3 .or. msg.ne.msg0) cerr='*'
|
||||||
write(*,1004) i3,n3,i3a,n3a,cerr,msg
|
write(*,1004) i3,n3,cerr,msg0,msg
|
||||||
1004 format(i1,3i3,2x,a1,2x,a37)
|
1004 format(i1,'.',i1,1x,a1,1x,a37,1x,a37)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
999 end program t2
|
999 end program encode77
|
||||||
|
|
||||||
include 'parse77.f90'
|
|
||||||
include '../chkcall.f90'
|
include '../chkcall.f90'
|
||||||
|
include 'pack77.f90'
|
||||||
|
include 'unpack77.f90'
|
||||||
|
include 'pack28.f90'
|
||||||
|
include 'unpack28.f90'
|
||||||
|
include 'split77.f90'
|
||||||
|
include 'pack77_01.f90'
|
||||||
|
include 'pack77_02.f90'
|
||||||
|
include 'pack77_03.f90'
|
||||||
|
include 'chk77_1.f90'
|
||||||
|
include 'chk77_2.f90'
|
||||||
|
include 'chk77_3.f90'
|
||||||
|
include 'packtext77.f90'
|
||||||
|
include 'unpacktext77.f90'
|
||||||
|
|||||||
@ -1,4 +1,5 @@
|
|||||||
gfortran -c ../packjt.f90
|
gfortran -c ../packjt.f90
|
||||||
gfortran -o t2 -fbounds-check -Wall -Wno-conversion -Wno-real-q-constant t2.f90 \
|
gfortran -o encode77 -fbounds-check -Wall -Wno-conversion -Wno-real-q-constant \
|
||||||
../deg2grid.f90 ../grid2deg.f90 ../fix_contest_msg.f90 \
|
encode77.f90 ../deg2grid.f90 ../grid2deg.f90 ../fix_contest_msg.f90 \
|
||||||
../to_contest_msg.f90 ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 packjt.o
|
../to_contest_msg.f90 ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 \
|
||||||
|
ihashcall.f90 hash10.f90 packjt.o
|
||||||
|
|||||||
@ -1,7 +1,7 @@
|
|||||||
i3 n3
|
i3 n3
|
||||||
--------------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------------
|
||||||
0 0 FREE TEXT MSG 71 0 71
|
0 0 FREE TEXT MSG 71 0 71
|
||||||
0 1 K1ABC RR73; W9XYZ <KH1/KH7Z> -11 28 28 10 5 1 71 DXpedition Mode
|
0 1 K1ABC RR73; W9XYZ <KH1/KH7Z> -12 28 28 10 5 1 71 DXpedition Mode
|
||||||
0 2 PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 2 70 EU VHF contest (2)
|
0 2 PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 2 70 EU VHF contest (2)
|
||||||
0 3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 3 71 ARRL Field Day
|
0 3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 3 71 ARRL Field Day
|
||||||
0 4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 4 71 ARRL Field Day
|
0 4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 4 71 ARRL Field Day
|
||||||
|
|||||||
@ -47,14 +47,22 @@ subroutine pack28(c13,n28)
|
|||||||
! We have a standard callsign
|
! We have a standard callsign
|
||||||
n=len(trim(callsign))
|
n=len(trim(callsign))
|
||||||
callsign=adjustr(callsign)
|
callsign=adjustr(callsign)
|
||||||
n28=index(c1,callsign(1:1))-1
|
|
||||||
n28=n28*nc(2) + index(c2,callsign(2:2)) - 1
|
|
||||||
n28=n28*nc(3) + index(c3,callsign(3:3)) - 1
|
|
||||||
n28=n28*nc(4) + index(c4,callsign(4:4)) - 1
|
|
||||||
n28=n28*nc(5) + index(c4,callsign(5:5)) - 1
|
|
||||||
n28=n28*nc(6) + index(c4,callsign(6:6)) - 1
|
|
||||||
n28=n28 + NTOKENS + N24
|
|
||||||
|
|
||||||
|
i1=36*10*27*27*27*(index(c1,callsign(1:1))-1)
|
||||||
|
i2=10*27*27*27*(index(c2,callsign(2:2))-1)
|
||||||
|
i3=27*27*27*(index(c3,callsign(3:3))-1)
|
||||||
|
i4=27*27*(index(c4,callsign(4:4))-1)
|
||||||
|
i5=27*(index(c4,callsign(5:5))-1)
|
||||||
|
i6=index(c4,callsign(6:6))-1
|
||||||
|
n28=i1+i2+i3+i4+i5+i6
|
||||||
|
|
||||||
|
! n28=index(c1,callsign(1:1))-1
|
||||||
|
! n28=n28*nc(2) + index(c2,callsign(2:2)) - 1
|
||||||
|
! n28=n28*nc(3) + index(c3,callsign(3:3)) - 1
|
||||||
|
! n28=n28*nc(4) + index(c4,callsign(4:4)) - 1
|
||||||
|
! n28=n28*nc(5) + index(c4,callsign(5:5)) - 1
|
||||||
|
! n28=n28*nc(6) + index(c4,callsign(6:6)) - 1
|
||||||
|
n28=n28 + NTOKENS + N24
|
||||||
|
|
||||||
return
|
return
|
||||||
end subroutine pack28
|
end subroutine pack28
|
||||||
|
|||||||
@ -15,13 +15,12 @@ subroutine pack77(msg,i3,n3,c77)
|
|||||||
! Check 0.1 (DXpedition mode)
|
! Check 0.1 (DXpedition mode)
|
||||||
call pack77_01(nwords,w,i3,n3,c77)
|
call pack77_01(nwords,w,i3,n3,c77)
|
||||||
if(i3.ge.0) go to 900
|
if(i3.ge.0) go to 900
|
||||||
|
|
||||||
! Check 0.2 (EU VHF contest exchange)
|
! Check 0.2 (EU VHF contest exchange)
|
||||||
call chk77_02(nwords,w,i3,n3)
|
call pack77_02(nwords,w,i3,n3,c77)
|
||||||
if(i3.ge.0) go to 900
|
if(i3.ge.0) go to 900
|
||||||
|
|
||||||
! Check 0.3 and 0.4 (ARRL Field Day exchange)
|
! Check 0.3 and 0.4 (ARRL Field Day exchange)
|
||||||
call chk77_03(nwords,w,i3,n3)
|
call pack77_03(nwords,w,i3,n3,c77)
|
||||||
if(i3.ge.0) go to 900
|
if(i3.ge.0) go to 900
|
||||||
|
|
||||||
|
|
||||||
@ -45,7 +44,6 @@ subroutine pack77(msg,i3,n3,c77)
|
|||||||
write(c77(72:77),'(2b3.3)') n3,i3
|
write(c77(72:77),'(2b3.3)') n3,i3
|
||||||
|
|
||||||
900 continue
|
900 continue
|
||||||
! print*,'B: ',c77
|
|
||||||
|
|
||||||
return
|
return
|
||||||
end subroutine pack77
|
end subroutine pack77
|
||||||
|
|||||||
@ -3,10 +3,11 @@ subroutine pack77_01(nwords,w,i3,n3,c77)
|
|||||||
! Pack a Type 0.1 message: DXpedition mode
|
! Pack a Type 0.1 message: DXpedition mode
|
||||||
! Example message: "K1ABC RR73; W9XYZ <KH1/KH7Z> -11" 28 28 10 5
|
! Example message: "K1ABC RR73; W9XYZ <KH1/KH7Z> -11" 28 28 10 5
|
||||||
|
|
||||||
character*13 w(19)
|
character*13 w(19),chash(20)
|
||||||
character*77 c77
|
character*77 c77
|
||||||
character*6 bcall_1,bcall_2
|
character*6 bcall_1,bcall_2
|
||||||
logical ok1,ok2
|
logical ok1,ok2
|
||||||
|
common/hashcom/ihash10(20),chash
|
||||||
|
|
||||||
if(nwords.ne.5) return !Must have 5 words
|
if(nwords.ne.5) return !Must have 5 words
|
||||||
if(trim(w(2)).ne.'RR73;') return !2nd word must be "RR73;"
|
if(trim(w(2)).ne.'RR73;') return !2nd word must be "RR73;"
|
||||||
@ -14,19 +15,22 @@ subroutine pack77_01(nwords,w,i3,n3,c77)
|
|||||||
if(index(w(4),'>').lt.1) return
|
if(index(w(4),'>').lt.1) return
|
||||||
n=-99
|
n=-99
|
||||||
read(w(5),*,err=1) n
|
read(w(5),*,err=1) n
|
||||||
1 if(n.lt.-30 .or. n.gt.30) return !5th word must be a valid report
|
1 if(n.eq.-99) return !5th word must be a valid report
|
||||||
|
n5=(n+30)/2
|
||||||
|
if(n5.lt.0) n5=0
|
||||||
|
if(n5.gt.31) n5=31
|
||||||
call chkcall(w(1),bcall_1,ok1)
|
call chkcall(w(1),bcall_1,ok1)
|
||||||
if(.not.ok1) return !1st word must be a valid basecall
|
if(.not.ok1) return !1st word must be a valid basecall
|
||||||
call chkcall(w(3),bcall_2,ok2)
|
call chkcall(w(3),bcall_2,ok2)
|
||||||
if(.not.ok2) return !3rd word must be a valid basecall
|
if(.not.ok2) return !3rd word must be a valid basecall
|
||||||
|
|
||||||
! It's a Type 0.1 message
|
! Type 0.1: K1ABC RR73; W9XYZ <KH1/KH7Z> -11 28 28 10 5 71 DXpedition Mode
|
||||||
i3=0
|
i3=0
|
||||||
n3=1
|
n3=1
|
||||||
call pack28(w(1),n28a)
|
call pack28(w(1),n28a)
|
||||||
call pack28(w(3),n28b)
|
call pack28(w(3),n28b)
|
||||||
n10=0
|
n10=ihashcall(w(4),10) !Get the 10-bit hash code
|
||||||
n5=17
|
call hash10(n10,w(4),0) !Save this hash and its callsign
|
||||||
write(c77,1010) n28a,n28b,n10,n5,n3,i3
|
write(c77,1010) n28a,n28b,n10,n5,n3,i3
|
||||||
1010 format(2b28.28,b10.10,b5.5,2b3.3)
|
1010 format(2b28.28,b10.10,b5.5,2b3.3)
|
||||||
|
|
||||||
|
|||||||
@ -1,6 +1,7 @@
|
|||||||
subroutine chk77_02(nwords,w,i3,n3)
|
subroutine pack77_02(nwords,w,i3,n3,c77)
|
||||||
|
|
||||||
character*13 w(19)
|
character*13 w(19),c13
|
||||||
|
character*77 c77
|
||||||
character*6 bcall_1,grid6
|
character*6 bcall_1,grid6
|
||||||
logical ok1,is_grid6
|
logical ok1,is_grid6
|
||||||
|
|
||||||
@ -13,14 +14,38 @@ subroutine chk77_02(nwords,w,i3,n3)
|
|||||||
grid6(6:6).ge.'A' .and. grid6(6:6).le.'X'
|
grid6(6:6).ge.'A' .and. grid6(6:6).le.'X'
|
||||||
|
|
||||||
call chkcall(w(1),bcall_1,ok1)
|
call chkcall(w(1),bcall_1,ok1)
|
||||||
if(nwords.eq.3 .or. nwords.eq.4) then
|
if(.not.ok1) return !bcall_1 must be a valid basecall
|
||||||
n=-1
|
if(nwords.lt.3 .or. nwords.gt.4) return !nwords must be 3 or 4
|
||||||
if(nwords.ge.2) read(w(nwords-1),*,err=2) n
|
nx=-1
|
||||||
2 if(ok1 .and. n.ge.520001 .and. n.le.594095 .and. is_grid6(w(nwords)(1:6))) then
|
if(nwords.ge.2) read(w(nwords-1),*,err=2) nx
|
||||||
i3=0
|
2 if(nx.lt.520001 .or. nx.gt.594095) return !Exchange between 520001 - 594095
|
||||||
n3=2 !Type 0.2: EU VHF+ Contest
|
if(.not.is_grid6(w(nwords)(1:6))) return !Last word must be a valid grid6
|
||||||
endif
|
|
||||||
|
! Type 0.2: PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 70 EU VHF contest
|
||||||
|
i3=0
|
||||||
|
n3=2
|
||||||
|
ip=0
|
||||||
|
c13=w(1)
|
||||||
|
i=index(w(1),'/P')
|
||||||
|
if(i.ge.4) then
|
||||||
|
ip=1
|
||||||
|
c13=w(1)(1:i-1)//' '
|
||||||
endif
|
endif
|
||||||
|
call pack28(c13,n28a)
|
||||||
|
ir=0
|
||||||
|
if(w(2)(1:2).eq.'R ') ir=1
|
||||||
|
irpt=nx/10000 - 52
|
||||||
|
iserial=mod(nx,10000)
|
||||||
|
grid6=w(nwords)(1:6)
|
||||||
|
j1=(ichar(grid6(1:1))-ichar('A'))*18*10*10*24*24
|
||||||
|
j2=(ichar(grid6(2:2))-ichar('A'))*10*10*24*24
|
||||||
|
j3=(ichar(grid6(3:3))-ichar('0'))*10*24*24
|
||||||
|
j4=(ichar(grid6(4:4))-ichar('0'))*24*24
|
||||||
|
j5=(ichar(grid6(5:5))-ichar('A'))*24
|
||||||
|
j6=(ichar(grid6(6:6))-ichar('A'))
|
||||||
|
igrid6=j1+j2+j3+j4+j5+j6
|
||||||
|
write(c77,1010) n28a,ip,ir,irpt,iserial,igrid6,n3,i3
|
||||||
|
1010 format(b28.28,2b1,b3.3,b12.12,b25.25,b4.4,b3.3)
|
||||||
|
|
||||||
return
|
return
|
||||||
end subroutine chk77_02
|
end subroutine pack77_02
|
||||||
|
|||||||
@ -1,12 +1,12 @@
|
|||||||
subroutine chk77_03(nwords,w,i3,n3)
|
subroutine pack77_03(nwords,w,i3,n3,c77)
|
||||||
! Check 0.3 and 0.4 (ARRL Field Day exchange)
|
! Check 0.3 and 0.4 (ARRL Field Day exchange)
|
||||||
|
|
||||||
parameter (NSEC=83) !Number of ARRL Sections
|
parameter (NSEC=84) !Number of ARRL Sections
|
||||||
character*13 w(19)
|
character*13 w(19)
|
||||||
|
character*77 c77
|
||||||
character*6 bcall_1,bcall_2
|
character*6 bcall_1,bcall_2
|
||||||
character*3 csec(NSEC),section
|
character*3 csec(NSEC)
|
||||||
logical ok1,ok2
|
logical ok1,ok2
|
||||||
|
|
||||||
data csec/ &
|
data csec/ &
|
||||||
"AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", &
|
"AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", &
|
||||||
"EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ", &
|
"EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ", &
|
||||||
@ -16,31 +16,47 @@ subroutine chk77_03(nwords,w,i3,n3)
|
|||||||
"ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV", &
|
"ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV", &
|
||||||
"SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", &
|
"SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", &
|
||||||
"UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", &
|
"UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", &
|
||||||
"WV ","WWA","WY "/
|
"WV ","WWA","WY ","DX "/
|
||||||
|
|
||||||
|
if(nwords.lt.4 .or. nwords.gt.5) return
|
||||||
call chkcall(w(1),bcall_1,ok1)
|
call chkcall(w(1),bcall_1,ok1)
|
||||||
call chkcall(w(2),bcall_2,ok2)
|
call chkcall(w(2),bcall_2,ok2)
|
||||||
|
if(.not.ok1 .or. .not.ok2) return
|
||||||
|
|
||||||
if(nwords.eq.4 .or. nwords.eq.5) then
|
ntx=-1
|
||||||
n=-1
|
j=len(trim(w(nwords-1)))-1
|
||||||
j=len(trim(w(nwords-1)))-1
|
if(j.ge.2) read(w(nwords-1)(1:j),*,err=1) ntx !Number of transmitters
|
||||||
if(j.ge.2) read(w(nwords-1)(1:j),*,err=4) n !Number of transmitters
|
1 if(ntx.lt.1 .or. ntx.gt.32) return
|
||||||
4 m=len(trim(w(nwords))) !Length of section abbreviation
|
nclass=ichar(w(nwords-1)(j+1:j+1))-ichar('A')
|
||||||
if(ok1 .and. ok2 .and. n.ge.1 .and. n.le.32 .and. (m.eq.2 .or. m.eq.3)) then
|
|
||||||
section=' '
|
m=len(trim(w(nwords))) !Length of section abbreviation
|
||||||
do i=1,NSEC
|
if(m.lt.2 .or. m.gt.3) return
|
||||||
if(csec(i).eq.w(nwords)) then
|
|
||||||
section=csec(i)
|
isec=-1
|
||||||
exit
|
do i=1,NSEC
|
||||||
endif
|
if(csec(i).eq.w(nwords)) then
|
||||||
enddo
|
isec=i
|
||||||
if(section.ne.' ') then
|
exit
|
||||||
i3=0
|
|
||||||
if(n.ge.1 .and. n.le.16) n3=3 !Type 0.3 ARRL Field Day
|
|
||||||
if(n.ge.17 .and. n.le.32) n3=4 !Type 0.4 ARRL Field Day
|
|
||||||
endif
|
|
||||||
endif
|
endif
|
||||||
|
enddo
|
||||||
|
if(isec.eq.-1) return
|
||||||
|
|
||||||
|
! 0.3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 71 ARRL Field Day
|
||||||
|
! 0.4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 71 ARRL Field Day
|
||||||
|
|
||||||
|
i3=0
|
||||||
|
n3=3 !Type 0.3 ARRL Field Day
|
||||||
|
intx=ntx-1
|
||||||
|
if(intx.ge.16) then
|
||||||
|
n3=4 !Type 0.4 ARRL Field Day
|
||||||
|
intx=ntx-16
|
||||||
endif
|
endif
|
||||||
|
call pack28(w(1),n28a)
|
||||||
|
call pack28(w(2),n28b)
|
||||||
|
ir=0
|
||||||
|
if(w(3)(1:2).eq.'R ') ir=1
|
||||||
|
write(c77,1010) n28a,n28b,ir,intx,nclass,isec,n3,i3
|
||||||
|
1010 format(2b28.28,b1,b4.4,b3.3,b7.7,2b3.3)
|
||||||
|
|
||||||
return
|
return
|
||||||
end subroutine chk77_03
|
end subroutine pack77_03
|
||||||
|
|||||||
@ -1,197 +0,0 @@
|
|||||||
subroutine parse77(msg,i3,n3)
|
|
||||||
|
|
||||||
use packjt
|
|
||||||
parameter (NSEC=83) !Number of ARRL Sections
|
|
||||||
parameter (NUSCAN=65) !Number of US states and Canadian provinces/territories
|
|
||||||
character*37 msg
|
|
||||||
character*22 msg22
|
|
||||||
character*13 w(19),c13
|
|
||||||
character*13 call_1,call_2
|
|
||||||
character*6 bcall_1,bcall_2,grid6
|
|
||||||
character*4 grid4
|
|
||||||
character crpt*3,crrpt*4
|
|
||||||
character*77 c77bit
|
|
||||||
character*1 c,c0
|
|
||||||
character*3 csec(NSEC),cmult(NUSCAN),section,mult
|
|
||||||
logical ok1,ok2,text1,text2
|
|
||||||
logical is_grid4,is_grid6
|
|
||||||
|
|
||||||
data csec/ &
|
|
||||||
"AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", &
|
|
||||||
"EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ", &
|
|
||||||
"KS ","KY ","LA ","LAX","MAR","MB ","MDC","ME ","MI ","MN ", &
|
|
||||||
"MO ","MS ","MT ","NC ","ND ","NE ","NFL","NH ","NL ","NLI", &
|
|
||||||
"NM ","NNJ","NNY","NT ","NTX","NV ","OH ","OK ","ONE","ONN", &
|
|
||||||
"ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV", &
|
|
||||||
"SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", &
|
|
||||||
"UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", &
|
|
||||||
"WV ","WWA","WY "/
|
|
||||||
|
|
||||||
data cmult/ &
|
|
||||||
"AL ","AK ","AZ ","AR ","CA ","CO ","CT ","DE ","FL ","GA ", &
|
|
||||||
"HI ","ID ","IL ","IN ","IA ","KS ","KY ","LA ","ME ","MD ", &
|
|
||||||
"MA ","MI ","MN ","MS ","MO ","MT ","NE ","NV ","NH ","NJ ", &
|
|
||||||
"NM ","NY ","NC ","ND ","OH ","OK ","OR ","PA ","RI ","SC ", &
|
|
||||||
"SD ","TN ","TX ","UT ","VT ","VA ","WA ","WV ","WI ","WY ", &
|
|
||||||
"NB ","NS ","QC ","ON ","MB ","SK ","AB ","BC ","NWT","NF ", &
|
|
||||||
"LB ","NU ","VT ","PEI","DC "/
|
|
||||||
|
|
||||||
is_grid4(grid4)=len(trim(grid4)).eq.4 .and. &
|
|
||||||
grid4(1:1).ge.'A' .and. grid4(1:1).le.'R' .and. &
|
|
||||||
grid4(2:2).ge.'A' .and. grid4(2:2).le.'R' .and. &
|
|
||||||
grid4(3:3).ge.'0' .and. grid4(3:3).le.'9' .and. &
|
|
||||||
grid4(4:4).ge.'0' .and. grid4(4:4).le.'9'
|
|
||||||
|
|
||||||
is_grid6(grid6)=len(trim(grid6)).eq.6 .and. &
|
|
||||||
grid6(1:1).ge.'A' .and. grid6(1:1).le.'R' .and. &
|
|
||||||
grid6(2:2).ge.'A' .and. grid6(2:2).le.'R' .and. &
|
|
||||||
grid6(3:3).ge.'0' .and. grid6(3:3).le.'9' .and. &
|
|
||||||
grid6(4:4).ge.'0' .and. grid6(4:4).le.'9' .and. &
|
|
||||||
grid6(5:5).ge.'A' .and. grid6(5:5).le.'X' .and. &
|
|
||||||
grid6(6:6).ge.'A' .and. grid6(6:6).le.'X'
|
|
||||||
|
|
||||||
iz=len(trim(msg))
|
|
||||||
! Convert to upper case; parse into words.
|
|
||||||
j=0
|
|
||||||
k=0
|
|
||||||
n=0
|
|
||||||
c0=' '
|
|
||||||
w=' '
|
|
||||||
do i=1,iz
|
|
||||||
c=msg(i:i) !Single character
|
|
||||||
if(c.eq.' ' .and. c0.eq.' ') cycle !Skip over leading or 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
|
|
||||||
msg(j:j)=c
|
|
||||||
if(c.ge.'a' .and. c.le.'z') msg(j:j)=char(ichar(c)-32) !Force upper case
|
|
||||||
w(k)(n:n)=c !Copy character c into word
|
|
||||||
c0=c
|
|
||||||
enddo
|
|
||||||
iz=j !Message length
|
|
||||||
nw=k !Number of words in msg
|
|
||||||
msg(iz+1:)=' '
|
|
||||||
|
|
||||||
! Check 0.1 (DXpedition mode)
|
|
||||||
i3=0
|
|
||||||
n3=0
|
|
||||||
i0=index(msg," RR73; ")
|
|
||||||
call chkcall(w(1)(1:12),bcall_1,ok1)
|
|
||||||
call chkcall(w(3)(1:12),bcall_2,ok2)
|
|
||||||
|
|
||||||
if(i0.ge.4 .and. i0.le.7 .and. nw.eq.5 .and. ok1 .and. ok2) then
|
|
||||||
i0=0
|
|
||||||
n3=1 !Type 0.1: DXpedition mode
|
|
||||||
go to 900
|
|
||||||
endif
|
|
||||||
|
|
||||||
! Check 0.2 (EU VHF contest exchange)
|
|
||||||
if(nw.eq.3 .or. nw.eq.4) then
|
|
||||||
n=-1
|
|
||||||
if(nw.ge.2) read(w(nw-1),*,err=2) n
|
|
||||||
2 if(ok1 .and. n.ge.520001 .and. n.le.594095 .and. is_grid6(w(nw)(1:6))) then
|
|
||||||
i3=0
|
|
||||||
n3=2 !Type 0.2: EU VHF+ Contest
|
|
||||||
go to 900
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
call chkcall(w(2)(1:12),bcall_2,ok2)
|
|
||||||
|
|
||||||
! Check 0.3 and 0.4 (ARRL Field Day exchange)
|
|
||||||
if(nw.eq.4 .or. nw.eq.5) then
|
|
||||||
n=-1
|
|
||||||
j=len(trim(w(nw-1)))-1
|
|
||||||
if(j.ge.2) read(w(nw-1)(1:j),*,err=4) n !Number of transmitters
|
|
||||||
4 m=len(trim(w(nw))) !Length of section abbreviation
|
|
||||||
if(ok1 .and. ok2 .and. n.ge.1 .and. n.le.32 .and. (m.eq.2 .or. m.eq.3)) then
|
|
||||||
section=' '
|
|
||||||
do i=1,NSEC
|
|
||||||
if(csec(i).eq.w(nw)) then
|
|
||||||
section=csec(i)
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
if(section.ne.' ') then
|
|
||||||
i3=0
|
|
||||||
if(n.ge.1 .and. n.le.16) n3=3 !Type 0.3 ARRL Field Day
|
|
||||||
if(n.ge.17 .and. n.le.32) n3=4 !Type 0.4 ARRL Field Day
|
|
||||||
go to 900
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
n3=0
|
|
||||||
! Check Type 1 (Standard 77-bit message) and Type 4 (ditto, with a "/P" call)
|
|
||||||
if(nw.eq.3 .or. nw.eq.4) then
|
|
||||||
if(ok1 .and. ok2 .and. is_grid4(w(nw)(1:4))) then
|
|
||||||
if(nw.eq.3 .or. (nw.eq.4 .and. w(3)(1:2).eq.'R ')) then
|
|
||||||
i3=1 !Type 1: Standard message
|
|
||||||
if(index(w(1),'/P').ge.4 .or. index(w(2),'/P').ge.4) i3=4
|
|
||||||
go to 900
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
! Check Type 2 (ARRL RTTY contest exchange)
|
|
||||||
if(nw.eq.4 .or. nw.eq.5 .or. nw.eq.6) then
|
|
||||||
i1=1
|
|
||||||
if(trim(w(1)).eq.'TU;') i1=2
|
|
||||||
call chkcall(w(i1),bcall_1,ok1)
|
|
||||||
call chkcall(w(i1+1),bcall_2,ok2)
|
|
||||||
crpt=w(nw-1)(1:3)
|
|
||||||
if(crpt(1:1).eq.'5' .and. crpt(2:2).ge.'2' .and. crpt(2:2).le.'9' .and. &
|
|
||||||
crpt(3:3).eq.'9') then
|
|
||||||
i3=2
|
|
||||||
n3=0
|
|
||||||
go to 900
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
! Check Type 3 (One nonstandard call and one hashed call)
|
|
||||||
if(nw.eq.3) then
|
|
||||||
call_1=w(1)
|
|
||||||
if(call_1(1:1).eq.'<') call_1=w(1)(2:len(trim(w(1)))-1)
|
|
||||||
call_2=w(2)
|
|
||||||
if(call_2(1:1).eq.'<') call_2=w(2)(2:len(trim(w(2)))-1)
|
|
||||||
call chkcall(call_1,bcall_1,ok1)
|
|
||||||
call chkcall(call_2,bcall_2,ok2)
|
|
||||||
crrpt=w(nw)(1:4)
|
|
||||||
i1=1
|
|
||||||
if(crrpt(1:1).eq.'R') i1=2
|
|
||||||
n=-99
|
|
||||||
read(crrpt(i1:),*,err=6) n
|
|
||||||
6 if(ok1 .and. ok2 .and. n.ne.-99) then
|
|
||||||
i3=3
|
|
||||||
n3=0
|
|
||||||
go to 900
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
! It's free text
|
|
||||||
i3=0
|
|
||||||
n3=0
|
|
||||||
msg(iz+1:)=' '
|
|
||||||
call packtext(msg(1:22),nc1,nc2,ng)
|
|
||||||
write(c77bit,1100) nc1,nc2,ng,i3,n3 !c77bit is the 77-bit message
|
|
||||||
1100 format(2b28.28,b15.15,b3.3,b3.3)
|
|
||||||
print*,c77bit
|
|
||||||
read(c77bit,1102) nc1,nc2,ng,i3,n3
|
|
||||||
1102 format(2b28,b15,2b3)
|
|
||||||
call unpacktext(nc1,nc2,ng,msg22)
|
|
||||||
write(*,3002) nc1,nc2,ng,i3,n3,msg22(1:13)
|
|
||||||
3002 format(2i12,i8,2i3,2x,a13)
|
|
||||||
|
|
||||||
900 continue
|
|
||||||
|
|
||||||
call packcall(bcall_1,nc1,text1)
|
|
||||||
call packcall(bcall_2,nc2,text2)
|
|
||||||
if(.not.text1) write(*,3001) bcall_1,nc1
|
|
||||||
if(.not.text2) write(*,3001) bcall_2,nc2
|
|
||||||
3001 format(50x,a6,i12)
|
|
||||||
|
|
||||||
return
|
|
||||||
end subroutine parse77
|
|
||||||
@ -13,30 +13,34 @@ subroutine unpack28(n28,c13)
|
|||||||
data c4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
|
data c4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
|
||||||
data nc/37,36,19,27,27,27/
|
data nc/37,36,19,27,27,27/
|
||||||
|
|
||||||
n=n28 - NTOKENS - N24
|
if(n28.lt.NTOKENS) then
|
||||||
j=mod(n,nc(6))
|
!code for tokens CQ, DE, QRZ, etc.
|
||||||
c13(6:6)=c4(j+1:j+1)
|
endif
|
||||||
n=n/nc(6)
|
n28=n28-NTOKENS
|
||||||
|
if(n28.lt.N24) then
|
||||||
|
!code for 24-bit hash
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Standard callsign
|
||||||
|
n=n28 - N24
|
||||||
|
|
||||||
|
i1=n/(36*10*27*27*27)
|
||||||
|
n=n-36*10*27*27*27*i1
|
||||||
|
|
||||||
j=mod(n,nc(5))
|
i2=n/(10*27*27*27)
|
||||||
c13(5:5)=c4(j+1:j+1)
|
n=n-10*27*27*27*i2
|
||||||
n=n/nc(5)
|
|
||||||
|
|
||||||
j=mod(n,nc(4))
|
i3=n/(27*27*27)
|
||||||
c13(4:4)=c4(j+1:j+1)
|
n=n-27*27*27*i3
|
||||||
n=n/nc(4)
|
|
||||||
|
|
||||||
j=mod(n,nc(3))
|
i4=n/(27*27)
|
||||||
c13(3:3)=c3(j+1:j+1)
|
n=n-27*27*i4
|
||||||
n=n/nc(3)
|
|
||||||
|
|
||||||
j=mod(n,nc(2))
|
i5=n/27
|
||||||
c13(2:2)=c2(j+1:j+1)
|
i6=n-27*i5
|
||||||
n=n/nc(2)
|
c13=c1(i1+1:i1+1)//c2(i2+1:i2+1)//c3(i3+1:i3+1)//c4(i4+1:i4+1)// &
|
||||||
|
c4(i5+1:i5+1)//c4(i6+1:i6+1)//' '
|
||||||
j=n
|
c13=adjustl(c13)
|
||||||
c13(1:1)=c1(j+1:j+1)
|
|
||||||
c13(7:)=' '
|
|
||||||
|
|
||||||
return
|
return
|
||||||
end subroutine unpack28
|
end subroutine unpack28
|
||||||
|
|||||||
@ -1,23 +1,92 @@
|
|||||||
subroutine unpack77(c77,msg)
|
subroutine unpack77(c77,msg)
|
||||||
|
|
||||||
|
parameter (NSEC=84) !Number of ARRL Sections
|
||||||
character*77 c77
|
character*77 c77
|
||||||
character*37 msg
|
character*37 msg
|
||||||
character*13 c13
|
character*13 call_1,call_2,call_3
|
||||||
|
character*3 crpt,cntx
|
||||||
|
character*6 cexch,grid6
|
||||||
|
character*3 csec(NSEC)
|
||||||
|
data csec/ &
|
||||||
|
"AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", &
|
||||||
|
"EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ", &
|
||||||
|
"KS ","KY ","LA ","LAX","MAR","MB ","MDC","ME ","MI ","MN ", &
|
||||||
|
"MO ","MS ","MT ","NC ","ND ","NE ","NFL","NH ","NL ","NLI", &
|
||||||
|
"NM ","NNJ","NNY","NT ","NTX","NV ","OH ","OK ","ONE","ONN", &
|
||||||
|
"ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV", &
|
||||||
|
"SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", &
|
||||||
|
"UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", &
|
||||||
|
"WV ","WWA","WY ","DX "/
|
||||||
|
|
||||||
read(c77(72:77),'(2b3)') n3,i3
|
read(c77(72:77),'(2b3)') n3,i3
|
||||||
msg=repeat(' ',37)
|
msg=repeat(' ',37)
|
||||||
if(i3.eq.0 .and. n3.eq.0) then
|
if(i3.eq.0 .and. n3.eq.0) then
|
||||||
|
! 0.0 Free text
|
||||||
call unpacktext77(c77(1:71),msg(1:13))
|
call unpacktext77(c77(1:71),msg(1:13))
|
||||||
msg(14:)=' '
|
msg(14:)=' '
|
||||||
|
|
||||||
else if(i3.eq.0 .and. n3.eq.1) then
|
else if(i3.eq.0 .and. n3.eq.1) then
|
||||||
|
! 0.1 K1ABC RR73; W9XYZ <KH1/KH7Z> -11 28 28 10 5 71 DXpedition Mode
|
||||||
read(c77,1010) n28a,n28b,n10,n5
|
read(c77,1010) n28a,n28b,n10,n5
|
||||||
1010 format(2b28,b10,b5)
|
1010 format(2b28,b10,b5)
|
||||||
print*,'C1:',n28a,n28b,n10,n5,n3,i3
|
irpt=2*n5 - 30
|
||||||
call unpack28(n28a,c13)
|
write(crpt,1012) irpt
|
||||||
print*,'C2: ',c13
|
1012 format(i3.2)
|
||||||
call unpack28(n28b,c13)
|
if(irpt.ge.0) crpt(1:1)='+'
|
||||||
print*,'C3: ',c13
|
call unpack28(n28a,call_1)
|
||||||
|
call unpack28(n28b,call_2)
|
||||||
|
call hash10(n10,call_3,-1)
|
||||||
|
msg=trim(call_1)//' RR73; '//trim(call_2)//' '//trim(call_3)//' '//crpt
|
||||||
|
|
||||||
|
else if(i3.eq.0 .and. n3.eq.2) then
|
||||||
|
! 0.2 PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 70 EU VHF contest
|
||||||
|
read(c77,1020) n28a,ip,ir,irpt,iserial,igrid6
|
||||||
|
1020 format(b28,2b1,b3,b12,b25)
|
||||||
|
call unpack28(n28a,call_1)
|
||||||
|
nrs=52+irpt
|
||||||
|
if(ip.eq.1) call_1=trim(call_1)//'/P'//' '
|
||||||
|
write(cexch,1022) nrs,iserial
|
||||||
|
1022 format(i2,i4.4)
|
||||||
|
n=igrid6
|
||||||
|
j1=n/(18*10*10*24*24)
|
||||||
|
n=n-j1*18*10*10*24*24
|
||||||
|
j2=n/(10*10*24*24)
|
||||||
|
n=n-j2*10*10*24*24
|
||||||
|
j3=n/(10*24*24)
|
||||||
|
n=n-j3*10*24*24
|
||||||
|
j4=n/(24*24)
|
||||||
|
n=n-j4*24*24
|
||||||
|
j5=n/24
|
||||||
|
j6=n-j5*24
|
||||||
|
grid6(1:1)=char(j1+ichar('A'))
|
||||||
|
grid6(2:2)=char(j2+ichar('A'))
|
||||||
|
grid6(3:3)=char(j3+ichar('0'))
|
||||||
|
grid6(4:4)=char(j4+ichar('0'))
|
||||||
|
grid6(5:5)=char(j5+ichar('A'))
|
||||||
|
grid6(6:6)=char(j6+ichar('A'))
|
||||||
|
msg=trim(call_1)//' '//cexch//' '//grid6
|
||||||
|
if(ir.eq.1) msg=trim(call_1)//' R '//cexch//' '//grid6
|
||||||
|
|
||||||
|
else if(i3.eq.0 .and. (n3.eq.3 .or. n3.eq.4)) then
|
||||||
|
! 0.3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 71 ARRL Field Day
|
||||||
|
! 0.4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 71 ARRL Field Day
|
||||||
|
read(c77,1030) n28a,n28b,ir,intx,nclass,isec
|
||||||
|
1030 format(2b28,b1,b4,b3,b7)
|
||||||
|
call unpack28(n28a,call_1)
|
||||||
|
call unpack28(n28b,call_2)
|
||||||
|
ntx=intx+1
|
||||||
|
if(n3.eq.4) ntx=ntx+16
|
||||||
|
write(cntx(1:2),1032) ntx
|
||||||
|
1032 format(i2)
|
||||||
|
cntx(3:3)=char(ichar('A')+nclass)
|
||||||
|
if(ir.eq.0 .and. ntx.lt.10) msg=trim(call_1)//' '//trim(call_2)// &
|
||||||
|
cntx//' '//csec(isec)
|
||||||
|
if(ir.eq.1 .and. ntx.lt.10) msg=trim(call_1)//' '//trim(call_2)// &
|
||||||
|
' R'//cntx//' '//csec(isec)
|
||||||
|
if(ir.eq.0 .and. ntx.ge.10) msg=trim(call_1)//' '//trim(call_2)// &
|
||||||
|
' '//cntx//' '//csec(isec)
|
||||||
|
if(ir.eq.1 .and. ntx.ge.10) msg=trim(call_1)//' '//trim(call_2)// &
|
||||||
|
' R '//cntx//' '//csec(isec)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
return
|
return
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user