w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-12-24 11:40:31 -05:00
Code Issues Packages Projects Releases Wiki Activity

Through type 0.3.

Browse Source
This commit is contained in:
Joe Taylor 2018-06-26 15:20:39 -04:00
parent 9ccb96397d
commit 9d5a2e6f5a
11 changed files with 229 additions and 287 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lib/77bit/encode77.f90
View File

@ -1,6 +1,7 @@
program t2
program encode77
character msg*37,msg0*37,cerr*1
character*77 c77
open(10,file='msgtypes.txt',status='old')
@ -10,17 +11,30 @@ program t2
1001 format(a1)
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)
msg0=msg
call parse77(msg,i3a,n3a)
if(i3a.gt.0 .or. n3a.gt.3) cycle
call pack77(msg0,i3,n3,c77)
call unpack77(c77,msg)
cerr=' '
if(i3a.ne.i3 .or. n3a.ne.n3 .or. msg.ne.msg0) cerr='*'
write(*,1004) i3,n3,i3a,n3a,cerr,msg
1004 format(i1,3i3,2x,a1,2x,a37)
write(*,1004) i3,n3,cerr,msg0,msg
1004 format(i1,'.',i1,1x,a1,1x,a37,1x,a37)
enddo
999 end program t2
999 end program encode77
include 'parse77.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'

7
lib/77bit/g2
View File

@ -1,4 +1,5 @@
gfortran -c ../packjt.f90
gfortran -o t2 -fbounds-check -Wall -Wno-conversion -Wno-real-q-constant t2.f90 \
../deg2grid.f90 ../grid2deg.f90 ../fix_contest_msg.f90 \
../to_contest_msg.f90 ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 packjt.o
gfortran -o encode77 -fbounds-check -Wall -Wno-conversion -Wno-real-q-constant \
encode77.f90 ../deg2grid.f90 ../grid2deg.f90 ../fix_contest_msg.f90 \
../to_contest_msg.f90 ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 \
ihashcall.f90 hash10.f90 packjt.o

2
lib/77bit/msgtypes.txt
View File

@ -1,7 +1,7 @@
i3 n3
--------------------------------------------------------------------------------------
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 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

22
lib/77bit/pack28.f90
View File

@ -47,14 +47,22 @@ subroutine pack28(c13,n28)
! We have a standard callsign
n=len(trim(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
end subroutine pack28

6
lib/77bit/pack77.f90
View File

@ -15,13 +15,12 @@ subroutine pack77(msg,i3,n3,c77)
! Check 0.1 (DXpedition mode)
call pack77_01(nwords,w,i3,n3,c77)
if(i3.ge.0) go to 900
! 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
! 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
@ -45,7 +44,6 @@ subroutine pack77(msg,i3,n3,c77)
write(c77(72:77),'(2b3.3)') n3,i3
900 continue
! print*,'B: ',c77
return
end subroutine pack77

14
lib/77bit/pack77_01.f90
View File

@ -3,10 +3,11 @@ subroutine pack77_01(nwords,w,i3,n3,c77)
! Pack a Type 0.1 message: DXpedition mode
! 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*6 bcall_1,bcall_2
logical ok1,ok2
common/hashcom/ihash10(20),chash
if(nwords.ne.5) return !Must have 5 words
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
n=-99
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)
if(.not.ok1) return !1st word must be a valid basecall
call chkcall(w(3),bcall_2,ok2)
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
n3=1
call pack28(w(1),n28a)
call pack28(w(3),n28b)
n10=0
n5=17
n10=ihashcall(w(4),10) !Get the 10-bit hash code
call hash10(n10,w(4),0) !Save this hash and its callsign
write(c77,1010) n28a,n28b,n10,n5,n3,i3
1010 format(2b28.28,b10.10,b5.5,2b3.3)

43
lib/77bit/pack77_02.f90
View File

@ -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
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'
call chkcall(w(1),bcall_1,ok1)
if(nwords.eq.3 .or. nwords.eq.4) then
n=-1
if(nwords.ge.2) read(w(nwords-1),*,err=2) n
2 if(ok1 .and. n.ge.520001 .and. n.le.594095 .and. is_grid6(w(nwords)(1:6))) then
if(.not.ok1) return !bcall_1 must be a valid basecall
if(nwords.lt.3 .or. nwords.gt.4) return !nwords must be 3 or 4
nx=-1
if(nwords.ge.2) read(w(nwords-1),*,err=2) nx
2 if(nx.lt.520001 .or. nx.gt.594095) return !Exchange between 520001 - 594095
if(.not.is_grid6(w(nwords)(1:6))) return !Last word must be a valid grid6
! Type 0.2: PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 70 EU VHF contest
i3=0
n3=2 !Type 0.2: EU VHF+ Contest
endif
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
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
end subroutine chk77_02
end subroutine pack77_02

52
lib/77bit/pack77_03.f90
View File

@ -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)
parameter (NSEC=83) !Number of ARRL Sections
parameter (NSEC=84) !Number of ARRL Sections
character*13 w(19)
character*77 c77
character*6 bcall_1,bcall_2
character*3 csec(NSEC),section
character*3 csec(NSEC)
logical ok1,ok2
data csec/ &
"AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", &
"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", &
"SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", &
"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(2),bcall_2,ok2)
if(.not.ok1 .or. .not.ok2) return
if(nwords.eq.4 .or. nwords.eq.5) then
n=-1
ntx=-1
j=len(trim(w(nwords-1)))-1
if(j.ge.2) read(w(nwords-1)(1:j),*,err=4) n !Number of transmitters
4 m=len(trim(w(nwords))) !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=' '
if(j.ge.2) read(w(nwords-1)(1:j),*,err=1) ntx !Number of transmitters
1 if(ntx.lt.1 .or. ntx.gt.32) return
nclass=ichar(w(nwords-1)(j+1:j+1))-ichar('A')
m=len(trim(w(nwords))) !Length of section abbreviation
if(m.lt.2 .or. m.gt.3) return
isec=-1
do i=1,NSEC
if(csec(i).eq.w(nwords)) then
section=csec(i)
isec=i
exit
endif
enddo
if(section.ne.' ') then
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
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
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
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
end subroutine chk77_03
end subroutine pack77_03

197
lib/77bit/parse77.f90
View File

@ -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

42
lib/77bit/unpack28.f90
View File

@ -13,30 +13,34 @@ subroutine unpack28(n28,c13)
data c4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
data nc/37,36,19,27,27,27/
n=n28 - NTOKENS - N24
j=mod(n,nc(6))
c13(6:6)=c4(j+1:j+1)
n=n/nc(6)
if(n28.lt.NTOKENS) then
!code for tokens CQ, DE, QRZ, etc.
endif
n28=n28-NTOKENS
if(n28.lt.N24) then
!code for 24-bit hash
endif
j=mod(n,nc(5))
c13(5:5)=c4(j+1:j+1)
n=n/nc(5)
! Standard callsign
n=n28 - N24
j=mod(n,nc(4))
c13(4:4)=c4(j+1:j+1)
n=n/nc(4)
i1=n/(36*10*27*27*27)
n=n-36*10*27*27*27*i1
j=mod(n,nc(3))
c13(3:3)=c3(j+1:j+1)
n=n/nc(3)
i2=n/(10*27*27*27)
n=n-10*27*27*27*i2
j=mod(n,nc(2))
c13(2:2)=c2(j+1:j+1)
n=n/nc(2)
i3=n/(27*27*27)
n=n-27*27*27*i3
j=n
c13(1:1)=c1(j+1:j+1)
c13(7:)=' '
i4=n/(27*27)
n=n-27*27*i4
i5=n/27
i6=n-27*i5
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)//' '
c13=adjustl(c13)
return
end subroutine unpack28

81
lib/77bit/unpack77.f90
View File

@ -1,23 +1,92 @@
subroutine unpack77(c77,msg)
parameter (NSEC=84) !Number of ARRL Sections
character*77 c77
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
msg=repeat(' ',37)
if(i3.eq.0 .and. n3.eq.0) then
! 0.0 Free text
call unpacktext77(c77(1:71),msg(1:13))
msg(14:)=' '
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
1010 format(2b28,b10,b5)
print*,'C1:',n28a,n28b,n10,n5,n3,i3
call unpack28(n28a,c13)
print*,'C2: ',c13
call unpack28(n28b,c13)
print*,'C3: ',c13
irpt=2*n5 - 30
write(crpt,1012) irpt
1012 format(i3.2)
if(irpt.ge.0) crpt(1:1)='+'
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
return