mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2025-05-24 10:22:26 -04:00
Convert all *.f files to *.f90.
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@3296 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor
parent
1709ebdab3
commit
09ceb60a4e
@ -1,30 +0,0 @@
|
|||||||
subroutine deg2grid(dlong0,dlat,grid)
|
|
||||||
|
|
||||||
real dlong !West longitude (deg)
|
|
||||||
real dlat !Latitude (deg)
|
|
||||||
character grid*6
|
|
||||||
|
|
||||||
dlong=dlong0
|
|
||||||
if(dlong.lt.-180.0) dlong=dlong+360.0
|
|
||||||
if(dlong.gt.180.0) dlong=dlong-360.0
|
|
||||||
|
|
||||||
C Convert to units of 5 min of longitude, working east from 180 deg.
|
|
||||||
nlong=60.0*(180.0-dlong)/5.0
|
|
||||||
n1=nlong/240 !20-degree field
|
|
||||||
n2=(nlong-240*n1)/24 !2 degree square
|
|
||||||
n3=nlong-240*n1-24*n2 !5 minute subsquare
|
|
||||||
grid(1:1)=char(ichar('A')+n1)
|
|
||||||
grid(3:3)=char(ichar('0')+n2)
|
|
||||||
grid(5:5)=char(ichar('a')+n3)
|
|
||||||
|
|
||||||
C Convert to units of 2.5 min of latitude, working north from -90 deg.
|
|
||||||
nlat=60.0*(dlat+90)/2.5
|
|
||||||
n1=nlat/240 !10-degree field
|
|
||||||
n2=(nlat-240*n1)/24 !1 degree square
|
|
||||||
n3=nlat-240*n1-24*n2 !2.5 minuts subsquare
|
|
||||||
grid(2:2)=char(ichar('A')+n1)
|
|
||||||
grid(4:4)=char(ichar('0')+n2)
|
|
||||||
grid(6:6)=char(ichar('a')+n3)
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
30
lib/deg2grid.f90
Normal file
30
lib/deg2grid.f90
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
subroutine deg2grid(dlong0,dlat,grid)
|
||||||
|
|
||||||
|
real dlong !West longitude (deg)
|
||||||
|
real dlat !Latitude (deg)
|
||||||
|
character grid*6
|
||||||
|
|
||||||
|
dlong=dlong0
|
||||||
|
if(dlong.lt.-180.0) dlong=dlong+360.0
|
||||||
|
if(dlong.gt.180.0) dlong=dlong-360.0
|
||||||
|
|
||||||
|
! Convert to units of 5 min of longitude, working east from 180 deg.
|
||||||
|
nlong=60.0*(180.0-dlong)/5.0
|
||||||
|
n1=nlong/240 !20-degree field
|
||||||
|
n2=(nlong-240*n1)/24 !2 degree square
|
||||||
|
n3=nlong-240*n1-24*n2 !5 minute subsquare
|
||||||
|
grid(1:1)=char(ichar('A')+n1)
|
||||||
|
grid(3:3)=char(ichar('0')+n2)
|
||||||
|
grid(5:5)=char(ichar('a')+n3)
|
||||||
|
|
||||||
|
! Convert to units of 2.5 min of latitude, working north from -90 deg.
|
||||||
|
nlat=60.0*(dlat+90)/2.5
|
||||||
|
n1=nlat/240 !10-degree field
|
||||||
|
n2=(nlat-240*n1)/24 !1 degree square
|
||||||
|
n3=nlat-240*n1-24*n2 !2.5 minuts subsquare
|
||||||
|
grid(2:2)=char(ichar('A')+n1)
|
||||||
|
grid(4:4)=char(ichar('0')+n2)
|
||||||
|
grid(6:6)=char(ichar('a')+n3)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine deg2grid
|
||||||
@ -1,45 +0,0 @@
|
|||||||
subroutine write_char(c, iunit)
|
|
||||||
character c
|
|
||||||
integer iunit
|
|
||||||
write(iunit,1000) c
|
|
||||||
1000 format(a,$)
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine export_wisdom_to_file(iunit)
|
|
||||||
integer iunit
|
|
||||||
external write_char
|
|
||||||
c call dfftw_export_wisdom(write_char, iunit)
|
|
||||||
call sfftw_export_wisdom(write_char, iunit)
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine read_char(ic, iunit)
|
|
||||||
integer ic
|
|
||||||
integer iunit
|
|
||||||
character*256 buf
|
|
||||||
save buf
|
|
||||||
integer ibuf
|
|
||||||
data ibuf/257/
|
|
||||||
save ibuf
|
|
||||||
if (ibuf .lt. 257) then
|
|
||||||
ic = ichar(buf(ibuf:ibuf))
|
|
||||||
ibuf = ibuf + 1
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
read(iunit,1000,end=10) buf
|
|
||||||
1000 format(a256)
|
|
||||||
ic = ichar(buf(1:1))
|
|
||||||
ibuf = 2
|
|
||||||
return
|
|
||||||
10 ic = -1
|
|
||||||
ibuf = 257
|
|
||||||
rewind iunit
|
|
||||||
return
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine import_wisdom_from_file(isuccess, iunit)
|
|
||||||
integer isuccess
|
|
||||||
integer iunit
|
|
||||||
external read_char
|
|
||||||
c call dfftw_import_wisdom(isuccess, read_char, iunit)
|
|
||||||
call sfftw_import_wisdom(isuccess, read_char, iunit)
|
|
||||||
end
|
|
||||||
45
lib/f77_wisdom.f90
Normal file
45
lib/f77_wisdom.f90
Normal file
@ -0,0 +1,45 @@
|
|||||||
|
subroutine write_char(c, iunit)
|
||||||
|
character c
|
||||||
|
integer iunit
|
||||||
|
write(iunit,1000) c
|
||||||
|
1000 format(a,$)
|
||||||
|
end subroutine write_char
|
||||||
|
|
||||||
|
subroutine export_wisdom_to_file(iunit)
|
||||||
|
integer iunit
|
||||||
|
external write_char
|
||||||
|
! call dfftw_export_wisdom(write_char, iunit)
|
||||||
|
call sfftw_export_wisdom(write_char, iunit)
|
||||||
|
end subroutine export_wisdom_to_file
|
||||||
|
|
||||||
|
subroutine read_char(ic, iunit)
|
||||||
|
integer ic
|
||||||
|
integer iunit
|
||||||
|
character*256 buf
|
||||||
|
save buf
|
||||||
|
integer ibuf
|
||||||
|
data ibuf/257/
|
||||||
|
save ibuf
|
||||||
|
if (ibuf .lt. 257) then
|
||||||
|
ic = ichar(buf(ibuf:ibuf))
|
||||||
|
ibuf = ibuf + 1
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
read(iunit,1000,end=10) buf
|
||||||
|
1000 format(a256)
|
||||||
|
ic = ichar(buf(1:1))
|
||||||
|
ibuf = 2
|
||||||
|
return
|
||||||
|
10 ic = -1
|
||||||
|
ibuf = 257
|
||||||
|
rewind iunit
|
||||||
|
return
|
||||||
|
end subroutine read_char
|
||||||
|
|
||||||
|
subroutine import_wisdom_from_file(isuccess, iunit)
|
||||||
|
integer isuccess
|
||||||
|
integer iunit
|
||||||
|
external read_char
|
||||||
|
! call dfftw_import_wisdom(isuccess, read_char, iunit)
|
||||||
|
call sfftw_import_wisdom(isuccess, read_char, iunit)
|
||||||
|
end subroutine import_wisdom_from_file
|
||||||
64
lib/fftw3.f
64
lib/fftw3.f
@ -1,64 +0,0 @@
|
|||||||
INTEGER FFTW_R2HC
|
|
||||||
PARAMETER (FFTW_R2HC=0)
|
|
||||||
INTEGER FFTW_HC2R
|
|
||||||
PARAMETER (FFTW_HC2R=1)
|
|
||||||
INTEGER FFTW_DHT
|
|
||||||
PARAMETER (FFTW_DHT=2)
|
|
||||||
INTEGER FFTW_REDFT00
|
|
||||||
PARAMETER (FFTW_REDFT00=3)
|
|
||||||
INTEGER FFTW_REDFT01
|
|
||||||
PARAMETER (FFTW_REDFT01=4)
|
|
||||||
INTEGER FFTW_REDFT10
|
|
||||||
PARAMETER (FFTW_REDFT10=5)
|
|
||||||
INTEGER FFTW_REDFT11
|
|
||||||
PARAMETER (FFTW_REDFT11=6)
|
|
||||||
INTEGER FFTW_RODFT00
|
|
||||||
PARAMETER (FFTW_RODFT00=7)
|
|
||||||
INTEGER FFTW_RODFT01
|
|
||||||
PARAMETER (FFTW_RODFT01=8)
|
|
||||||
INTEGER FFTW_RODFT10
|
|
||||||
PARAMETER (FFTW_RODFT10=9)
|
|
||||||
INTEGER FFTW_RODFT11
|
|
||||||
PARAMETER (FFTW_RODFT11=10)
|
|
||||||
INTEGER FFTW_FORWARD
|
|
||||||
PARAMETER (FFTW_FORWARD=-1)
|
|
||||||
INTEGER FFTW_BACKWARD
|
|
||||||
PARAMETER (FFTW_BACKWARD=+1)
|
|
||||||
INTEGER FFTW_MEASURE
|
|
||||||
PARAMETER (FFTW_MEASURE=0)
|
|
||||||
INTEGER FFTW_DESTROY_INPUT
|
|
||||||
PARAMETER (FFTW_DESTROY_INPUT=1)
|
|
||||||
INTEGER FFTW_UNALIGNED
|
|
||||||
PARAMETER (FFTW_UNALIGNED=2)
|
|
||||||
INTEGER FFTW_CONSERVE_MEMORY
|
|
||||||
PARAMETER (FFTW_CONSERVE_MEMORY=4)
|
|
||||||
INTEGER FFTW_EXHAUSTIVE
|
|
||||||
PARAMETER (FFTW_EXHAUSTIVE=8)
|
|
||||||
INTEGER FFTW_PRESERVE_INPUT
|
|
||||||
PARAMETER (FFTW_PRESERVE_INPUT=16)
|
|
||||||
INTEGER FFTW_PATIENT
|
|
||||||
PARAMETER (FFTW_PATIENT=32)
|
|
||||||
INTEGER FFTW_ESTIMATE
|
|
||||||
PARAMETER (FFTW_ESTIMATE=64)
|
|
||||||
INTEGER FFTW_ESTIMATE_PATIENT
|
|
||||||
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
|
|
||||||
INTEGER FFTW_BELIEVE_PCOST
|
|
||||||
PARAMETER (FFTW_BELIEVE_PCOST=256)
|
|
||||||
INTEGER FFTW_DFT_R2HC_ICKY
|
|
||||||
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
|
|
||||||
INTEGER FFTW_NONTHREADED_ICKY
|
|
||||||
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
|
|
||||||
INTEGER FFTW_NO_BUFFERING
|
|
||||||
PARAMETER (FFTW_NO_BUFFERING=2048)
|
|
||||||
INTEGER FFTW_NO_INDIRECT_OP
|
|
||||||
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
|
|
||||||
INTEGER FFTW_ALLOW_LARGE_GENERIC
|
|
||||||
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
|
|
||||||
INTEGER FFTW_NO_RANK_SPLITS
|
|
||||||
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
|
|
||||||
INTEGER FFTW_NO_VRANK_SPLITS
|
|
||||||
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
|
|
||||||
INTEGER FFTW_NO_VRECURSE
|
|
||||||
PARAMETER (FFTW_NO_VRECURSE=65536)
|
|
||||||
INTEGER FFTW_NO_SIMD
|
|
||||||
PARAMETER (FFTW_NO_SIMD=131072)
|
|
||||||
64
lib/fftw3.f90
Normal file
64
lib/fftw3.f90
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
INTEGER FFTW_R2HC
|
||||||
|
PARAMETER (FFTW_R2HC=0)
|
||||||
|
INTEGER FFTW_HC2R
|
||||||
|
PARAMETER (FFTW_HC2R=1)
|
||||||
|
INTEGER FFTW_DHT
|
||||||
|
PARAMETER (FFTW_DHT=2)
|
||||||
|
INTEGER FFTW_REDFT00
|
||||||
|
PARAMETER (FFTW_REDFT00=3)
|
||||||
|
INTEGER FFTW_REDFT01
|
||||||
|
PARAMETER (FFTW_REDFT01=4)
|
||||||
|
INTEGER FFTW_REDFT10
|
||||||
|
PARAMETER (FFTW_REDFT10=5)
|
||||||
|
INTEGER FFTW_REDFT11
|
||||||
|
PARAMETER (FFTW_REDFT11=6)
|
||||||
|
INTEGER FFTW_RODFT00
|
||||||
|
PARAMETER (FFTW_RODFT00=7)
|
||||||
|
INTEGER FFTW_RODFT01
|
||||||
|
PARAMETER (FFTW_RODFT01=8)
|
||||||
|
INTEGER FFTW_RODFT10
|
||||||
|
PARAMETER (FFTW_RODFT10=9)
|
||||||
|
INTEGER FFTW_RODFT11
|
||||||
|
PARAMETER (FFTW_RODFT11=10)
|
||||||
|
INTEGER FFTW_FORWARD
|
||||||
|
PARAMETER (FFTW_FORWARD=-1)
|
||||||
|
INTEGER FFTW_BACKWARD
|
||||||
|
PARAMETER (FFTW_BACKWARD=+1)
|
||||||
|
INTEGER FFTW_MEASURE
|
||||||
|
PARAMETER (FFTW_MEASURE=0)
|
||||||
|
INTEGER FFTW_DESTROY_INPUT
|
||||||
|
PARAMETER (FFTW_DESTROY_INPUT=1)
|
||||||
|
INTEGER FFTW_UNALIGNED
|
||||||
|
PARAMETER (FFTW_UNALIGNED=2)
|
||||||
|
INTEGER FFTW_CONSERVE_MEMORY
|
||||||
|
PARAMETER (FFTW_CONSERVE_MEMORY=4)
|
||||||
|
INTEGER FFTW_EXHAUSTIVE
|
||||||
|
PARAMETER (FFTW_EXHAUSTIVE=8)
|
||||||
|
INTEGER FFTW_PRESERVE_INPUT
|
||||||
|
PARAMETER (FFTW_PRESERVE_INPUT=16)
|
||||||
|
INTEGER FFTW_PATIENT
|
||||||
|
PARAMETER (FFTW_PATIENT=32)
|
||||||
|
INTEGER FFTW_ESTIMATE
|
||||||
|
PARAMETER (FFTW_ESTIMATE=64)
|
||||||
|
INTEGER FFTW_ESTIMATE_PATIENT
|
||||||
|
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
|
||||||
|
INTEGER FFTW_BELIEVE_PCOST
|
||||||
|
PARAMETER (FFTW_BELIEVE_PCOST=256)
|
||||||
|
INTEGER FFTW_DFT_R2HC_ICKY
|
||||||
|
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
|
||||||
|
INTEGER FFTW_NONTHREADED_ICKY
|
||||||
|
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
|
||||||
|
INTEGER FFTW_NO_BUFFERING
|
||||||
|
PARAMETER (FFTW_NO_BUFFERING=2048)
|
||||||
|
INTEGER FFTW_NO_INDIRECT_OP
|
||||||
|
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
|
||||||
|
INTEGER FFTW_ALLOW_LARGE_GENERIC
|
||||||
|
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
|
||||||
|
INTEGER FFTW_NO_RANK_SPLITS
|
||||||
|
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
|
||||||
|
INTEGER FFTW_NO_VRANK_SPLITS
|
||||||
|
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
|
||||||
|
INTEGER FFTW_NO_VRECURSE
|
||||||
|
PARAMETER (FFTW_NO_VRECURSE=65536)
|
||||||
|
INTEGER FFTW_NO_SIMD
|
||||||
|
PARAMETER (FFTW_NO_SIMD=131072)
|
||||||
@ -24,7 +24,7 @@ subroutine four2a(a,nfft,ndim,isign,iform)
|
|||||||
integer*8 plan(NPMAX),nl(NPMAX),nloc
|
integer*8 plan(NPMAX),nl(NPMAX),nloc
|
||||||
data nplan/0/,npatience/1/
|
data nplan/0/,npatience/1/
|
||||||
! data nplan/0/,npatience/0/
|
! data nplan/0/,npatience/0/
|
||||||
include 'fftw3.f'
|
include 'fftw3.f90'
|
||||||
save plan,nplan,nn,ns,nf,nl
|
save plan,nplan,nn,ns,nf,nl
|
||||||
|
|
||||||
if(nfft.lt.0) go to 999
|
if(nfft.lt.0) go to 999
|
||||||
|
|||||||
@ -1,97 +0,0 @@
|
|||||||
subroutine getpfx1(callsign,k,nv2)
|
|
||||||
|
|
||||||
character*12 callsign0,callsign,lof,rof
|
|
||||||
character*8 c
|
|
||||||
character addpfx*8,tpfx*4,tsfx*3
|
|
||||||
logical ispfx,issfx,invalid
|
|
||||||
common/pfxcom/addpfx
|
|
||||||
include 'pfx.f'
|
|
||||||
|
|
||||||
callsign0=callsign
|
|
||||||
nv2=0
|
|
||||||
iz=index(callsign,' ') - 1
|
|
||||||
if(iz.lt.0) iz=12
|
|
||||||
islash=index(callsign(1:iz),'/')
|
|
||||||
k=0
|
|
||||||
if(k.eq.0) go to 10 !### Always use JT65v2 ###
|
|
||||||
c=' '
|
|
||||||
if(islash.gt.0 .and. islash.le.(iz-4)) then
|
|
||||||
! Add-on prefix
|
|
||||||
c=callsign(1:islash-1)
|
|
||||||
callsign=callsign(islash+1:iz)
|
|
||||||
do i=1,NZ
|
|
||||||
if(pfx(i)(1:4).eq.c) then
|
|
||||||
k=i
|
|
||||||
go to 10
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
if(addpfx.eq.c) then
|
|
||||||
k=449
|
|
||||||
go to 10
|
|
||||||
endif
|
|
||||||
|
|
||||||
else if(islash.eq.(iz-1)) then
|
|
||||||
! Add-on suffix
|
|
||||||
c=callsign(islash+1:iz)
|
|
||||||
callsign=callsign(1:islash-1)
|
|
||||||
do i=1,NZ2
|
|
||||||
if(sfx(i).eq.c(1:1)) then
|
|
||||||
k=400+i
|
|
||||||
go to 10
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
endif
|
|
||||||
|
|
||||||
10 if(islash.ne.0 .and.k.eq.0) then
|
|
||||||
! Original JT65 would force this compound callsign to be treated as
|
|
||||||
! plain text. In JT65v2, we will encode the prefix or suffix into nc1.
|
|
||||||
! The task here is to compute the proper value of k.
|
|
||||||
lof=callsign0(:islash-1)
|
|
||||||
rof=callsign0(islash+1:)
|
|
||||||
llof=len_trim(lof)
|
|
||||||
lrof=len_trim(rof)
|
|
||||||
ispfx=(llof.gt.0 .and. llof.le.4)
|
|
||||||
issfx=(lrof.gt.0 .and. lrof.le.3)
|
|
||||||
invalid=.not.(ispfx.or.issfx)
|
|
||||||
if(ispfx.and.issfx) then
|
|
||||||
if(llof.lt.3) issfx=.false.
|
|
||||||
if(lrof.lt.3) ispfx=.false.
|
|
||||||
if(ispfx.and.issfx) then
|
|
||||||
i=ichar(callsign0(islash-1:islash-1))
|
|
||||||
if(i.ge.ichar('0') .and. i.le.ichar('9')) then
|
|
||||||
issfx=.false.
|
|
||||||
else
|
|
||||||
ispfx=.false.
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
if(invalid) then
|
|
||||||
k=-1
|
|
||||||
else
|
|
||||||
if(ispfx) then
|
|
||||||
tpfx=lof(1:4)
|
|
||||||
k=nchar(tpfx(1:1))
|
|
||||||
k=37*k + nchar(tpfx(2:2))
|
|
||||||
k=37*k + nchar(tpfx(3:3))
|
|
||||||
k=37*k + nchar(tpfx(4:4))
|
|
||||||
nv2=1
|
|
||||||
i=index(callsign0,'/')
|
|
||||||
callsign=callsign0(:i-1)
|
|
||||||
callsign=callsign0(i+1:)
|
|
||||||
endif
|
|
||||||
if(issfx) then
|
|
||||||
tsfx=rof(1:3)
|
|
||||||
k=nchar(tsfx(1:1))
|
|
||||||
k=37*k + nchar(tsfx(2:2))
|
|
||||||
k=37*k + nchar(tsfx(3:3))
|
|
||||||
nv2=2
|
|
||||||
i=index(callsign0,'/')
|
|
||||||
callsign=callsign0(:i-1)
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
|
|
||||||
97
lib/getpfx1.f90
Normal file
97
lib/getpfx1.f90
Normal file
@ -0,0 +1,97 @@
|
|||||||
|
subroutine getpfx1(callsign,k,nv2)
|
||||||
|
|
||||||
|
character*12 callsign0,callsign,lof,rof
|
||||||
|
character*8 c
|
||||||
|
character addpfx*8,tpfx*4,tsfx*3
|
||||||
|
logical ispfx,issfx,invalid
|
||||||
|
common/pfxcom/addpfx
|
||||||
|
include 'pfx.f90'
|
||||||
|
|
||||||
|
callsign0=callsign
|
||||||
|
nv2=0
|
||||||
|
iz=index(callsign,' ') - 1
|
||||||
|
if(iz.lt.0) iz=12
|
||||||
|
islash=index(callsign(1:iz),'/')
|
||||||
|
k=0
|
||||||
|
if(k.eq.0) go to 10 !### Always use JT65v2 ###
|
||||||
|
c=' '
|
||||||
|
if(islash.gt.0 .and. islash.le.(iz-4)) then
|
||||||
|
! Add-on prefix
|
||||||
|
c=callsign(1:islash-1)
|
||||||
|
callsign=callsign(islash+1:iz)
|
||||||
|
do i=1,NZ
|
||||||
|
if(pfx(i)(1:4).eq.c) then
|
||||||
|
k=i
|
||||||
|
go to 10
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if(addpfx.eq.c) then
|
||||||
|
k=449
|
||||||
|
go to 10
|
||||||
|
endif
|
||||||
|
|
||||||
|
else if(islash.eq.(iz-1)) then
|
||||||
|
! Add-on suffix
|
||||||
|
c=callsign(islash+1:iz)
|
||||||
|
callsign=callsign(1:islash-1)
|
||||||
|
do i=1,NZ2
|
||||||
|
if(sfx(i).eq.c(1:1)) then
|
||||||
|
k=400+i
|
||||||
|
go to 10
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
10 if(islash.ne.0 .and.k.eq.0) then
|
||||||
|
! Original JT65 would force this compound callsign to be treated as
|
||||||
|
! plain text. In JT65v2, we will encode the prefix or suffix into nc1.
|
||||||
|
! The task here is to compute the proper value of k.
|
||||||
|
lof=callsign0(:islash-1)
|
||||||
|
rof=callsign0(islash+1:)
|
||||||
|
llof=len_trim(lof)
|
||||||
|
lrof=len_trim(rof)
|
||||||
|
ispfx=(llof.gt.0 .and. llof.le.4)
|
||||||
|
issfx=(lrof.gt.0 .and. lrof.le.3)
|
||||||
|
invalid=.not.(ispfx.or.issfx)
|
||||||
|
if(ispfx.and.issfx) then
|
||||||
|
if(llof.lt.3) issfx=.false.
|
||||||
|
if(lrof.lt.3) ispfx=.false.
|
||||||
|
if(ispfx.and.issfx) then
|
||||||
|
i=ichar(callsign0(islash-1:islash-1))
|
||||||
|
if(i.ge.ichar('0') .and. i.le.ichar('9')) then
|
||||||
|
issfx=.false.
|
||||||
|
else
|
||||||
|
ispfx=.false.
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(invalid) then
|
||||||
|
k=-1
|
||||||
|
else
|
||||||
|
if(ispfx) then
|
||||||
|
tpfx=lof(1:4)
|
||||||
|
k=nchar(tpfx(1:1))
|
||||||
|
k=37*k + nchar(tpfx(2:2))
|
||||||
|
k=37*k + nchar(tpfx(3:3))
|
||||||
|
k=37*k + nchar(tpfx(4:4))
|
||||||
|
nv2=1
|
||||||
|
i=index(callsign0,'/')
|
||||||
|
callsign=callsign0(:i-1)
|
||||||
|
callsign=callsign0(i+1:)
|
||||||
|
endif
|
||||||
|
if(issfx) then
|
||||||
|
tsfx=rof(1:3)
|
||||||
|
k=nchar(tsfx(1:1))
|
||||||
|
k=37*k + nchar(tsfx(2:2))
|
||||||
|
k=37*k + nchar(tsfx(3:3))
|
||||||
|
nv2=2
|
||||||
|
i=index(callsign0,'/')
|
||||||
|
callsign=callsign0(:i-1)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine getpfx1
|
||||||
|
|
||||||
@ -1,24 +0,0 @@
|
|||||||
subroutine getpfx2(k0,callsign)
|
|
||||||
|
|
||||||
character callsign*12
|
|
||||||
include 'pfx.f'
|
|
||||||
character addpfx*8
|
|
||||||
common/pfxcom/addpfx
|
|
||||||
|
|
||||||
k=k0
|
|
||||||
if(k.gt.450) k=k-450
|
|
||||||
if(k.ge.1 .and. k.le.NZ) then
|
|
||||||
iz=index(pfx(k),' ') - 1
|
|
||||||
callsign=pfx(k)(1:iz)//'/'//callsign
|
|
||||||
else if(k.ge.401 .and. k.le.400+NZ2) then
|
|
||||||
iz=index(callsign,' ') - 1
|
|
||||||
callsign=callsign(1:iz)//'/'//sfx(k-400)
|
|
||||||
else if(k.eq.449) then
|
|
||||||
iz=index(addpfx,' ') - 1
|
|
||||||
if(iz.lt.1) iz=8
|
|
||||||
callsign=addpfx(1:iz)//'/'//callsign
|
|
||||||
endif
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
|
|
||||||
24
lib/getpfx2.f90
Normal file
24
lib/getpfx2.f90
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
subroutine getpfx2(k0,callsign)
|
||||||
|
|
||||||
|
character callsign*12
|
||||||
|
include 'pfx.f90'
|
||||||
|
character addpfx*8
|
||||||
|
common/pfxcom/addpfx
|
||||||
|
|
||||||
|
k=k0
|
||||||
|
if(k.gt.450) k=k-450
|
||||||
|
if(k.ge.1 .and. k.le.NZ) then
|
||||||
|
iz=index(pfx(k),' ') - 1
|
||||||
|
callsign=pfx(k)(1:iz)//'/'//callsign
|
||||||
|
else if(k.ge.401 .and. k.le.400+NZ2) then
|
||||||
|
iz=index(callsign,' ') - 1
|
||||||
|
callsign=callsign(1:iz)//'/'//sfx(k-400)
|
||||||
|
else if(k.eq.449) then
|
||||||
|
iz=index(addpfx,' ') - 1
|
||||||
|
if(iz.lt.1) iz=8
|
||||||
|
callsign=addpfx(1:iz)//'/'//callsign
|
||||||
|
endif
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine getpfx2
|
||||||
|
|
||||||
@ -1,38 +0,0 @@
|
|||||||
subroutine grid2deg(grid0,dlong,dlat)
|
|
||||||
|
|
||||||
C Converts Maidenhead grid locator to degrees of West longitude
|
|
||||||
C and North latitude.
|
|
||||||
|
|
||||||
character*6 grid0,grid
|
|
||||||
character*1 g1,g2,g3,g4,g5,g6
|
|
||||||
|
|
||||||
grid=grid0
|
|
||||||
i=ichar(grid(5:5))
|
|
||||||
if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm'
|
|
||||||
|
|
||||||
if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)=
|
|
||||||
+ char(ichar(grid(1:1))+ichar('A')-ichar('a'))
|
|
||||||
if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)=
|
|
||||||
+ char(ichar(grid(2:2))+ichar('A')-ichar('a'))
|
|
||||||
if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)=
|
|
||||||
+ char(ichar(grid(5:5))-ichar('A')+ichar('a'))
|
|
||||||
if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)=
|
|
||||||
+ char(ichar(grid(6:6))-ichar('A')+ichar('a'))
|
|
||||||
|
|
||||||
g1=grid(1:1)
|
|
||||||
g2=grid(2:2)
|
|
||||||
g3=grid(3:3)
|
|
||||||
g4=grid(4:4)
|
|
||||||
g5=grid(5:5)
|
|
||||||
g6=grid(6:6)
|
|
||||||
|
|
||||||
nlong = 180 - 20*(ichar(g1)-ichar('A'))
|
|
||||||
n20d = 2*(ichar(g3)-ichar('0'))
|
|
||||||
xminlong = 5*(ichar(g5)-ichar('a')+0.5)
|
|
||||||
dlong = nlong - n20d - xminlong/60.0
|
|
||||||
nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0')
|
|
||||||
xminlat = 2.5*(ichar(g6)-ichar('a')+0.5)
|
|
||||||
dlat = nlat + xminlat/60.0
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
38
lib/grid2deg.f90
Normal file
38
lib/grid2deg.f90
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
subroutine grid2deg(grid0,dlong,dlat)
|
||||||
|
|
||||||
|
! Converts Maidenhead grid locator to degrees of West longitude
|
||||||
|
! and North latitude.
|
||||||
|
|
||||||
|
character*6 grid0,grid
|
||||||
|
character*1 g1,g2,g3,g4,g5,g6
|
||||||
|
|
||||||
|
grid=grid0
|
||||||
|
i=ichar(grid(5:5))
|
||||||
|
if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm'
|
||||||
|
|
||||||
|
if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)= &
|
||||||
|
char(ichar(grid(1:1))+ichar('A')-ichar('a'))
|
||||||
|
if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)= &
|
||||||
|
char(ichar(grid(2:2))+ichar('A')-ichar('a'))
|
||||||
|
if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)= &
|
||||||
|
char(ichar(grid(5:5))-ichar('A')+ichar('a'))
|
||||||
|
if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)= &
|
||||||
|
char(ichar(grid(6:6))-ichar('A')+ichar('a'))
|
||||||
|
|
||||||
|
g1=grid(1:1)
|
||||||
|
g2=grid(2:2)
|
||||||
|
g3=grid(3:3)
|
||||||
|
g4=grid(4:4)
|
||||||
|
g5=grid(5:5)
|
||||||
|
g6=grid(6:6)
|
||||||
|
|
||||||
|
nlong = 180 - 20*(ichar(g1)-ichar('A'))
|
||||||
|
n20d = 2*(ichar(g3)-ichar('0'))
|
||||||
|
xminlong = 5*(ichar(g5)-ichar('a')+0.5)
|
||||||
|
dlong = nlong - n20d - xminlong/60.0
|
||||||
|
nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0')
|
||||||
|
xminlat = 2.5*(ichar(g6)-ichar('a')+0.5)
|
||||||
|
dlat = nlat + xminlat/60.0
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine grid2deg
|
||||||
12
lib/grid2k.f
12
lib/grid2k.f
@ -1,12 +0,0 @@
|
|||||||
subroutine grid2k(grid,k)
|
|
||||||
|
|
||||||
character*6 grid
|
|
||||||
|
|
||||||
call grid2deg(grid,xlong,xlat)
|
|
||||||
nlong=nint(xlong)
|
|
||||||
nlat=nint(xlat)
|
|
||||||
k=0
|
|
||||||
if(nlat.ge.85) k=5*(nlong+179)/2 + nlat-84
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
12
lib/grid2k.f90
Normal file
12
lib/grid2k.f90
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
subroutine grid2k(grid,k)
|
||||||
|
|
||||||
|
character*6 grid
|
||||||
|
|
||||||
|
call grid2deg(grid,xlong,xlat)
|
||||||
|
nlong=nint(xlong)
|
||||||
|
nlat=nint(xlat)
|
||||||
|
k=0
|
||||||
|
if(nlat.ge.85) k=5*(nlong+179)/2 + nlat-84
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine grid2k
|
||||||
19
lib/indexx.f
19
lib/indexx.f
@ -1,19 +0,0 @@
|
|||||||
subroutine indexx(n,arr,indx)
|
|
||||||
|
|
||||||
parameter (NMAX=3000)
|
|
||||||
integer indx(n)
|
|
||||||
real arr(n)
|
|
||||||
real brr(NMAX)
|
|
||||||
if(n.gt.NMAX) then
|
|
||||||
print*,'n=',n,' too big in indexx.'
|
|
||||||
stop
|
|
||||||
endif
|
|
||||||
do i=1,n
|
|
||||||
brr(i)=arr(i)
|
|
||||||
indx(i)=i
|
|
||||||
enddo
|
|
||||||
call ssort(brr,indx,n,2)
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
|
|
||||||
19
lib/indexx.f90
Normal file
19
lib/indexx.f90
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
subroutine indexx(n,arr,indx)
|
||||||
|
|
||||||
|
parameter (NMAX=3000)
|
||||||
|
integer indx(n)
|
||||||
|
real arr(n)
|
||||||
|
real brr(NMAX)
|
||||||
|
if(n.gt.NMAX) then
|
||||||
|
print*,'n=',n,' too big in indexx.'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
do i=1,n
|
||||||
|
brr(i)=arr(i)
|
||||||
|
indx(i)=i
|
||||||
|
enddo
|
||||||
|
call ssort(brr,indx,n,2)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine indexx
|
||||||
|
|
||||||
12
lib/k2grid.f
12
lib/k2grid.f
@ -1,12 +0,0 @@
|
|||||||
subroutine k2grid(k,grid)
|
|
||||||
character grid*6
|
|
||||||
|
|
||||||
nlong=2*mod((k-1)/5,90)-179
|
|
||||||
if(k.gt.450) nlong=nlong+180
|
|
||||||
nlat=mod(k-1,5)+ 85
|
|
||||||
dlat=nlat
|
|
||||||
dlong=nlong
|
|
||||||
call deg2grid(dlong,dlat,grid)
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
12
lib/k2grid.f90
Normal file
12
lib/k2grid.f90
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
subroutine k2grid(k,grid)
|
||||||
|
character grid*6
|
||||||
|
|
||||||
|
nlong=2*mod((k-1)/5,90)-179
|
||||||
|
if(k.gt.450) nlong=nlong+180
|
||||||
|
nlat=mod(k-1,5)+ 85
|
||||||
|
dlat=nlat
|
||||||
|
dlong=nlong
|
||||||
|
call deg2grid(dlong,dlat,grid)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine k2grid
|
||||||
23
lib/nchar.f
23
lib/nchar.f
@ -1,23 +0,0 @@
|
|||||||
function nchar(c)
|
|
||||||
|
|
||||||
C Convert ascii number, letter, or space to 0-36 for callsign packing.
|
|
||||||
|
|
||||||
character c*1
|
|
||||||
|
|
||||||
n=0 !Silence compiler warning
|
|
||||||
if(c.ge.'0' .and. c.le.'9') then
|
|
||||||
n=ichar(c)-ichar('0')
|
|
||||||
else if(c.ge.'A' .and. c.le.'Z') then
|
|
||||||
n=ichar(c)-ichar('A') + 10
|
|
||||||
else if(c.ge.'a' .and. c.le.'z') then
|
|
||||||
n=ichar(c)-ichar('a') + 10
|
|
||||||
else if(c.ge.' ') then
|
|
||||||
n=36
|
|
||||||
else
|
|
||||||
Print*,'Invalid character in callsign ',c,' ',ichar(c)
|
|
||||||
stop
|
|
||||||
endif
|
|
||||||
nchar=n
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
23
lib/nchar.f90
Normal file
23
lib/nchar.f90
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
function nchar(c)
|
||||||
|
|
||||||
|
! Convert ascii number, letter, or space to 0-36 for callsign packing.
|
||||||
|
|
||||||
|
character c*1
|
||||||
|
|
||||||
|
n=0 !Silence compiler warning
|
||||||
|
if(c.ge.'0' .and. c.le.'9') then
|
||||||
|
n=ichar(c)-ichar('0')
|
||||||
|
else if(c.ge.'A' .and. c.le.'Z') then
|
||||||
|
n=ichar(c)-ichar('A') + 10
|
||||||
|
else if(c.ge.'a' .and. c.le.'z') then
|
||||||
|
n=ichar(c)-ichar('a') + 10
|
||||||
|
else if(c.ge.' ') then
|
||||||
|
n=36
|
||||||
|
else
|
||||||
|
Print*,'Invalid character in callsign ',c,' ',ichar(c)
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
nchar=n
|
||||||
|
|
||||||
|
return
|
||||||
|
end function nchar
|
||||||
@ -1,79 +0,0 @@
|
|||||||
subroutine packcall(callsign,ncall,text)
|
|
||||||
|
|
||||||
C Pack a valid callsign into a 28-bit integer.
|
|
||||||
|
|
||||||
parameter (NBASE=37*36*10*27*27*27)
|
|
||||||
character callsign*6,c*1,tmp*6
|
|
||||||
logical text
|
|
||||||
|
|
||||||
text=.false.
|
|
||||||
|
|
||||||
C Work-around for Swaziland prefix:
|
|
||||||
if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6)
|
|
||||||
|
|
||||||
if(callsign(1:3).eq.'CQ ') then
|
|
||||||
ncall=NBASE + 1
|
|
||||||
if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and.
|
|
||||||
+ callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and.
|
|
||||||
+ callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
|
|
||||||
read(callsign(4:6),*) nfreq
|
|
||||||
ncall=NBASE + 3 + nfreq
|
|
||||||
endif
|
|
||||||
return
|
|
||||||
else if(callsign(1:4).eq.'QRZ ') then
|
|
||||||
ncall=NBASE + 2
|
|
||||||
return
|
|
||||||
else if(callsign(1:3).eq.'DE ') then
|
|
||||||
ncall=267796945
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
tmp=' '
|
|
||||||
if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then
|
|
||||||
tmp=callsign
|
|
||||||
else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then
|
|
||||||
if(callsign(6:6).ne.' ') then
|
|
||||||
text=.true.
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
tmp=' '//callsign(:5)
|
|
||||||
else
|
|
||||||
text=.true.
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
do i=1,6
|
|
||||||
c=tmp(i:i)
|
|
||||||
if(c.ge.'a' .and. c.le.'z')
|
|
||||||
+ tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A'))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
n1=0
|
|
||||||
if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1
|
|
||||||
if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1
|
|
||||||
n2=0
|
|
||||||
if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1
|
|
||||||
if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1
|
|
||||||
n3=0
|
|
||||||
if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1
|
|
||||||
n4=0
|
|
||||||
if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1
|
|
||||||
n5=0
|
|
||||||
if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1
|
|
||||||
n6=0
|
|
||||||
if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1
|
|
||||||
|
|
||||||
if(n1+n2+n3+n4+n5+n6 .ne. 6) then
|
|
||||||
text=.true.
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
ncall=nchar(tmp(1:1))
|
|
||||||
ncall=36*ncall+nchar(tmp(2:2))
|
|
||||||
ncall=10*ncall+nchar(tmp(3:3))
|
|
||||||
ncall=27*ncall+nchar(tmp(4:4))-10
|
|
||||||
ncall=27*ncall+nchar(tmp(5:5))-10
|
|
||||||
ncall=27*ncall+nchar(tmp(6:6))-10
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
79
lib/packcall.f90
Normal file
79
lib/packcall.f90
Normal file
@ -0,0 +1,79 @@
|
|||||||
|
subroutine packcall(callsign,ncall,text)
|
||||||
|
|
||||||
|
! Pack a valid callsign into a 28-bit integer.
|
||||||
|
|
||||||
|
parameter (NBASE=37*36*10*27*27*27)
|
||||||
|
character callsign*6,c*1,tmp*6
|
||||||
|
logical text
|
||||||
|
|
||||||
|
text=.false.
|
||||||
|
|
||||||
|
! Work-around for Swaziland prefix:
|
||||||
|
if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6)
|
||||||
|
|
||||||
|
if(callsign(1:3).eq.'CQ ') then
|
||||||
|
ncall=NBASE + 1
|
||||||
|
if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and. &
|
||||||
|
callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and. &
|
||||||
|
callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
|
||||||
|
read(callsign(4:6),*) nfreq
|
||||||
|
ncall=NBASE + 3 + nfreq
|
||||||
|
endif
|
||||||
|
return
|
||||||
|
else if(callsign(1:4).eq.'QRZ ') then
|
||||||
|
ncall=NBASE + 2
|
||||||
|
return
|
||||||
|
else if(callsign(1:3).eq.'DE ') then
|
||||||
|
ncall=267796945
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
tmp=' '
|
||||||
|
if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then
|
||||||
|
tmp=callsign
|
||||||
|
else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then
|
||||||
|
if(callsign(6:6).ne.' ') then
|
||||||
|
text=.true.
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
tmp=' '//callsign(:5)
|
||||||
|
else
|
||||||
|
text=.true.
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i=1,6
|
||||||
|
c=tmp(i:i)
|
||||||
|
if(c.ge.'a' .and. c.le.'z') &
|
||||||
|
tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A'))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
n1=0
|
||||||
|
if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1
|
||||||
|
if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1
|
||||||
|
n2=0
|
||||||
|
if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1
|
||||||
|
if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1
|
||||||
|
n3=0
|
||||||
|
if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1
|
||||||
|
n4=0
|
||||||
|
if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1
|
||||||
|
n5=0
|
||||||
|
if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1
|
||||||
|
n6=0
|
||||||
|
if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1
|
||||||
|
|
||||||
|
if(n1+n2+n3+n4+n5+n6 .ne. 6) then
|
||||||
|
text=.true.
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
ncall=nchar(tmp(1:1))
|
||||||
|
ncall=36*ncall+nchar(tmp(2:2))
|
||||||
|
ncall=10*ncall+nchar(tmp(3:3))
|
||||||
|
ncall=27*ncall+nchar(tmp(4:4))-10
|
||||||
|
ncall=27*ncall+nchar(tmp(5:5))-10
|
||||||
|
ncall=27*ncall+nchar(tmp(6:6))-10
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine packcall
|
||||||
@ -1,64 +0,0 @@
|
|||||||
subroutine packdxcc(c,ng,ldxcc)
|
|
||||||
|
|
||||||
character*3 c
|
|
||||||
logical ldxcc
|
|
||||||
|
|
||||||
parameter (NZ=303)
|
|
||||||
character*5 pfx(NZ)
|
|
||||||
data pfx/
|
|
||||||
+ '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ',
|
|
||||||
+ '3D2 ', '3DA ','3V ','3W ','3X ','3Y ',
|
|
||||||
+ '4J ','4L ','4S ','4U1 ', '4W ',
|
|
||||||
+ '4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ',
|
|
||||||
+ '5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ',
|
|
||||||
+ '7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ',
|
|
||||||
+ '9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ',
|
|
||||||
+ '9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ',
|
|
||||||
+ 'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ',
|
|
||||||
+ 'C3 ','C5 ','C6 ','C9 ','CE ','CE0 ',
|
|
||||||
+ 'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ',
|
|
||||||
+ 'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ',
|
|
||||||
+ 'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ',
|
|
||||||
+ 'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ',
|
|
||||||
+ 'F ','FG ','FH ','FJ ','FK ', 'FM ','FO ',
|
|
||||||
+ 'FP ','FR ',
|
|
||||||
+ 'FT5 ', 'FW ','FY ','M ','MD ','MI ',
|
|
||||||
+ 'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ',
|
|
||||||
+ 'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0 ',
|
|
||||||
+ 'HL ','HM ','HP ','HR ','HS ','HV ','HZ ',
|
|
||||||
+ 'I ','IG9 ','IS ','IT9 ','J2 ','J3 ','J5 ','J6 ',
|
|
||||||
+ 'J7 ','J8 ','JA ','JD ', 'JT ','JW ',
|
|
||||||
+ 'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ',
|
|
||||||
+ 'KH4 ','KH5 ', 'KH6 ','KH7 ','KH8 ','KH9 ','KL ',
|
|
||||||
+ 'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ',
|
|
||||||
+ 'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ',
|
|
||||||
+ 'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ',
|
|
||||||
+ 'PJ2 ','PJ7 ','PY ','PY0 ', 'PZ ','R1F ',
|
|
||||||
+ 'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ',
|
|
||||||
+ 'ST ','SU ','SV ', 'SV5 ','SV9 ','T2 ','T30 ',
|
|
||||||
+ 'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ',
|
|
||||||
+ 'TA1 ','TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ',
|
|
||||||
+ 'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ',
|
|
||||||
+ 'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ',
|
|
||||||
+ 'V6 ','V7 ','V8 ','VE ','VK ','VK0 ', 'VK9 ',
|
|
||||||
+ 'VP2 ',
|
|
||||||
+ 'VP5 ','VP6 ', 'VP8 ',
|
|
||||||
+ 'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ',
|
|
||||||
+ 'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ',
|
|
||||||
+ 'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ',
|
|
||||||
+ 'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ',
|
|
||||||
+ 'ZD9 ','ZF ','ZK1 ', 'ZK2 ','ZK3 ','ZL ','ZL7 ',
|
|
||||||
+ 'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 '/
|
|
||||||
|
|
||||||
ldxcc=.false.
|
|
||||||
ng=0
|
|
||||||
do i=1,NZ
|
|
||||||
if(pfx(i)(1:3).eq.c) go to 10
|
|
||||||
enddo
|
|
||||||
go to 20
|
|
||||||
|
|
||||||
10 ng=180*180+61+i
|
|
||||||
ldxcc=.true.
|
|
||||||
|
|
||||||
20 return
|
|
||||||
end
|
|
||||||
64
lib/packdxcc.f90
Normal file
64
lib/packdxcc.f90
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
subroutine packdxcc(c,ng,ldxcc)
|
||||||
|
|
||||||
|
character*3 c
|
||||||
|
logical ldxcc
|
||||||
|
|
||||||
|
parameter (NZ=303)
|
||||||
|
character*5 pfx(NZ)
|
||||||
|
data pfx/ &
|
||||||
|
'1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ', &
|
||||||
|
'3D2 ', '3DA ','3V ','3W ','3X ','3Y ', &
|
||||||
|
'4J ','4L ','4S ','4U1 ', '4W ', &
|
||||||
|
'4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ', &
|
||||||
|
'5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ', &
|
||||||
|
'7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ', &
|
||||||
|
'9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ', &
|
||||||
|
'9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ', &
|
||||||
|
'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ', &
|
||||||
|
'C3 ','C5 ','C6 ','C9 ','CE ','CE0 ', &
|
||||||
|
'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ', &
|
||||||
|
'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ', &
|
||||||
|
'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ', &
|
||||||
|
'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ', &
|
||||||
|
'F ','FG ','FH ','FJ ','FK ', 'FM ','FO ', &
|
||||||
|
'FP ','FR ', &
|
||||||
|
'FT5 ', 'FW ','FY ','M ','MD ','MI ', &
|
||||||
|
'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ', &
|
||||||
|
'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0 ', &
|
||||||
|
'HL ','HM ','HP ','HR ','HS ','HV ','HZ ', &
|
||||||
|
'I ','IG9 ','IS ','IT9 ','J2 ','J3 ','J5 ','J6 ', &
|
||||||
|
'J7 ','J8 ','JA ','JD ', 'JT ','JW ', &
|
||||||
|
'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ', &
|
||||||
|
'KH4 ','KH5 ', 'KH6 ','KH7 ','KH8 ','KH9 ','KL ', &
|
||||||
|
'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ', &
|
||||||
|
'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ', &
|
||||||
|
'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ', &
|
||||||
|
'PJ2 ','PJ7 ','PY ','PY0 ', 'PZ ','R1F ', &
|
||||||
|
'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ', &
|
||||||
|
'ST ','SU ','SV ', 'SV5 ','SV9 ','T2 ','T30 ', &
|
||||||
|
'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ', &
|
||||||
|
'TA1 ','TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ', &
|
||||||
|
'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ', &
|
||||||
|
'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ', &
|
||||||
|
'V6 ','V7 ','V8 ','VE ','VK ','VK0 ', 'VK9 ', &
|
||||||
|
'VP2 ', &
|
||||||
|
'VP5 ','VP6 ', 'VP8 ', &
|
||||||
|
'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ', &
|
||||||
|
'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ', &
|
||||||
|
'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ', &
|
||||||
|
'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ', &
|
||||||
|
'ZD9 ','ZF ','ZK1 ', 'ZK2 ','ZK3 ','ZL ','ZL7 ', &
|
||||||
|
'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 '/
|
||||||
|
|
||||||
|
ldxcc=.false.
|
||||||
|
ng=0
|
||||||
|
do i=1,NZ
|
||||||
|
if(pfx(i)(1:3).eq.c) go to 10
|
||||||
|
enddo
|
||||||
|
go to 20
|
||||||
|
|
||||||
|
10 ng=180*180+61+i
|
||||||
|
ldxcc=.true.
|
||||||
|
|
||||||
|
20 return
|
||||||
|
end subroutine packdxcc
|
||||||
@ -1,47 +0,0 @@
|
|||||||
subroutine packtext(msg,nc1,nc2,nc3)
|
|
||||||
|
|
||||||
parameter (MASK28=2**28 - 1)
|
|
||||||
character*13 msg
|
|
||||||
character*42 c
|
|
||||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
|
||||||
|
|
||||||
nc1=0
|
|
||||||
nc2=0
|
|
||||||
nc3=0
|
|
||||||
|
|
||||||
do i=1,5 !First 5 characters in nc1
|
|
||||||
do j=1,42 !Get character code
|
|
||||||
if(msg(i:i).eq.c(j:j)) go to 10
|
|
||||||
enddo
|
|
||||||
j=37
|
|
||||||
10 j=j-1 !Codes should start at zero
|
|
||||||
nc1=42*nc1 + j
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do i=6,10 !Characters 6-10 in nc2
|
|
||||||
do j=1,42 !Get character code
|
|
||||||
if(msg(i:i).eq.c(j:j)) go to 20
|
|
||||||
enddo
|
|
||||||
j=37
|
|
||||||
20 j=j-1 !Codes should start at zero
|
|
||||||
nc2=42*nc2 + j
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do i=11,13 !Characters 11-13 in nc3
|
|
||||||
do j=1,42 !Get character code
|
|
||||||
if(msg(i:i).eq.c(j:j)) go to 30
|
|
||||||
enddo
|
|
||||||
j=37
|
|
||||||
30 j=j-1 !Codes should start at zero
|
|
||||||
nc3=42*nc3 + j
|
|
||||||
enddo
|
|
||||||
|
|
||||||
C We now have used 17 bits in nc3. Must move one each to nc1 and nc2.
|
|
||||||
nc1=nc1+nc1
|
|
||||||
if(iand(nc3,32768).ne.0) nc1=nc1+1
|
|
||||||
nc2=nc2+nc2
|
|
||||||
if(iand(nc3,65536).ne.0) nc2=nc2+1
|
|
||||||
nc3=iand(nc3,32767)
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
47
lib/packtext.f90
Normal file
47
lib/packtext.f90
Normal file
@ -0,0 +1,47 @@
|
|||||||
|
subroutine packtext(msg,nc1,nc2,nc3)
|
||||||
|
|
||||||
|
parameter (MASK28=2**28 - 1)
|
||||||
|
character*13 msg
|
||||||
|
character*42 c
|
||||||
|
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
||||||
|
|
||||||
|
nc1=0
|
||||||
|
nc2=0
|
||||||
|
nc3=0
|
||||||
|
|
||||||
|
do i=1,5 !First 5 characters in nc1
|
||||||
|
do j=1,42 !Get character code
|
||||||
|
if(msg(i:i).eq.c(j:j)) go to 10
|
||||||
|
enddo
|
||||||
|
j=37
|
||||||
|
10 j=j-1 !Codes should start at zero
|
||||||
|
nc1=42*nc1 + j
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i=6,10 !Characters 6-10 in nc2
|
||||||
|
do j=1,42 !Get character code
|
||||||
|
if(msg(i:i).eq.c(j:j)) go to 20
|
||||||
|
enddo
|
||||||
|
j=37
|
||||||
|
20 j=j-1 !Codes should start at zero
|
||||||
|
nc2=42*nc2 + j
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i=11,13 !Characters 11-13 in nc3
|
||||||
|
do j=1,42 !Get character code
|
||||||
|
if(msg(i:i).eq.c(j:j)) go to 30
|
||||||
|
enddo
|
||||||
|
j=37
|
||||||
|
30 j=j-1 !Codes should start at zero
|
||||||
|
nc3=42*nc3 + j
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! We now have used 17 bits in nc3. Must move one each to nc1 and nc2.
|
||||||
|
nc1=nc1+nc1
|
||||||
|
if(iand(nc3,32768).ne.0) nc1=nc1+1
|
||||||
|
nc2=nc2+nc2
|
||||||
|
if(iand(nc3,65536).ne.0) nc2=nc2+1
|
||||||
|
nc3=iand(nc3,32767)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine packtext
|
||||||
50
lib/pfx.f
50
lib/pfx.f
@ -1,50 +0,0 @@
|
|||||||
parameter (NZ=339) !Total number of prefixes
|
|
||||||
parameter (NZ2=12) !Total number of suffixes
|
|
||||||
character*1 sfx(NZ2)
|
|
||||||
character*5 pfx(NZ)
|
|
||||||
|
|
||||||
data sfx/'P','0','1','2','3','4','5','6','7','8','9','A'/
|
|
||||||
data pfx/
|
|
||||||
+ '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ',
|
|
||||||
+ '3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ',
|
|
||||||
+ '3YB ','3YP ','4J ','4L ','4S ','4U1I ','4U1U ','4W ',
|
|
||||||
+ '4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ',
|
|
||||||
+ '5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ',
|
|
||||||
+ '7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ',
|
|
||||||
+ '9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ',
|
|
||||||
+ '9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ',
|
|
||||||
+ 'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ',
|
|
||||||
+ 'C3 ','C5 ','C6 ','C9 ','CE ','CE0X ','CE0Y ','CE0Z ',
|
|
||||||
+ 'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ',
|
|
||||||
+ 'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ',
|
|
||||||
+ 'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ',
|
|
||||||
+ 'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ',
|
|
||||||
+ 'F ','FG ','FH ','FJ ','FK ','FKC ','FM ','FO ',
|
|
||||||
+ 'FOA ','FOC ','FOM ','FP ','FR ','FRG ','FRJ ','FRT ',
|
|
||||||
+ 'FT5W ','FT5X ','FT5Z ','FW ','FY ','M ','MD ','MI ',
|
|
||||||
+ 'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ',
|
|
||||||
+ 'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0A ',
|
|
||||||
+ 'HK0M ','HL ','HM ','HP ','HR ','HS ','HV ','HZ ',
|
|
||||||
+ 'I ','IS ','IS0 ', 'J2 ','J3 ','J5 ','J6 ',
|
|
||||||
+ 'J7 ','J8 ','JA ','JDM ','JDO ','JT ','JW ',
|
|
||||||
+ 'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ',
|
|
||||||
+ 'KH4 ','KH5 ','KH5K ','KH6 ','KH7 ','KH8 ','KH9 ','KL ',
|
|
||||||
+ 'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ',
|
|
||||||
+ 'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ',
|
|
||||||
+ 'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ',
|
|
||||||
+ 'PJ2 ','PJ7 ','PY ','PY0F ','PT0S ','PY0T ','PZ ','R1F ',
|
|
||||||
+ 'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ',
|
|
||||||
+ 'ST ','SU ','SV ','SVA ','SV5 ','SV9 ','T2 ','T30 ',
|
|
||||||
+ 'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ',
|
|
||||||
+ 'TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ',
|
|
||||||
+ 'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ',
|
|
||||||
+ 'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ',
|
|
||||||
+ 'V6 ','V7 ','V8 ','VE ','VK ','VK0H ','VK0M ','VK9C ',
|
|
||||||
+ 'VK9L ','VK9M ','VK9N ','VK9W ','VK9X ','VP2E ','VP2M ','VP2V ',
|
|
||||||
+ 'VP5 ','VP6 ','VP6D ','VP8 ','VP8G ','VP8H ','VP8O ','VP8S ',
|
|
||||||
+ 'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ',
|
|
||||||
+ 'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ',
|
|
||||||
+ 'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ',
|
|
||||||
+ 'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ',
|
|
||||||
+ 'ZD9 ','ZF ','ZK1N ','ZK1S ','ZK2 ','ZK3 ','ZL ','ZL7 ',
|
|
||||||
+ 'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 ','KC4 ','E5 '/
|
|
||||||
50
lib/pfx.f90
Normal file
50
lib/pfx.f90
Normal file
@ -0,0 +1,50 @@
|
|||||||
|
parameter (NZ=339) !Total number of prefixes
|
||||||
|
parameter (NZ2=12) !Total number of suffixes
|
||||||
|
character*1 sfx(NZ2)
|
||||||
|
character*5 pfx(NZ)
|
||||||
|
|
||||||
|
data sfx/'P','0','1','2','3','4','5','6','7','8','9','A'/
|
||||||
|
data pfx/ &
|
||||||
|
'1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ', &
|
||||||
|
'3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ', &
|
||||||
|
'3YB ','3YP ','4J ','4L ','4S ','4U1I ','4U1U ','4W ', &
|
||||||
|
'4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ', &
|
||||||
|
'5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ', &
|
||||||
|
'7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ', &
|
||||||
|
'9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ', &
|
||||||
|
'9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ', &
|
||||||
|
'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ', &
|
||||||
|
'C3 ','C5 ','C6 ','C9 ','CE ','CE0X ','CE0Y ','CE0Z ', &
|
||||||
|
'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ', &
|
||||||
|
'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ', &
|
||||||
|
'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ', &
|
||||||
|
'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ', &
|
||||||
|
'F ','FG ','FH ','FJ ','FK ','FKC ','FM ','FO ', &
|
||||||
|
'FOA ','FOC ','FOM ','FP ','FR ','FRG ','FRJ ','FRT ', &
|
||||||
|
'FT5W ','FT5X ','FT5Z ','FW ','FY ','M ','MD ','MI ', &
|
||||||
|
'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ', &
|
||||||
|
'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0A ', &
|
||||||
|
'HK0M ','HL ','HM ','HP ','HR ','HS ','HV ','HZ ', &
|
||||||
|
'I ','IS ','IS0 ', 'J2 ','J3 ','J5 ','J6 ', &
|
||||||
|
'J7 ','J8 ','JA ','JDM ','JDO ','JT ','JW ', &
|
||||||
|
'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ', &
|
||||||
|
'KH4 ','KH5 ','KH5K ','KH6 ','KH7 ','KH8 ','KH9 ','KL ', &
|
||||||
|
'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ', &
|
||||||
|
'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ', &
|
||||||
|
'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ', &
|
||||||
|
'PJ2 ','PJ7 ','PY ','PY0F ','PT0S ','PY0T ','PZ ','R1F ', &
|
||||||
|
'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ', &
|
||||||
|
'ST ','SU ','SV ','SVA ','SV5 ','SV9 ','T2 ','T30 ', &
|
||||||
|
'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ', &
|
||||||
|
'TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ', &
|
||||||
|
'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ', &
|
||||||
|
'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ', &
|
||||||
|
'V6 ','V7 ','V8 ','VE ','VK ','VK0H ','VK0M ','VK9C ', &
|
||||||
|
'VK9L ','VK9M ','VK9N ','VK9W ','VK9X ','VP2E ','VP2M ','VP2V ', &
|
||||||
|
'VP5 ','VP6 ','VP6D ','VP8 ','VP8G ','VP8H ','VP8O ','VP8S ', &
|
||||||
|
'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ', &
|
||||||
|
'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ', &
|
||||||
|
'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ', &
|
||||||
|
'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ', &
|
||||||
|
'ZD9 ','ZF ','ZK1N ','ZK1S ','ZK2 ','ZK3 ','ZL ','ZL7 ', &
|
||||||
|
'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 ','KC4 ','E5 '/
|
||||||
@ -1,13 +0,0 @@
|
|||||||
subroutine pfxdump(fname)
|
|
||||||
character*(*) fname
|
|
||||||
include 'pfx.f'
|
|
||||||
|
|
||||||
open(11,file=fname,status='unknown')
|
|
||||||
write(11,1001) sfx
|
|
||||||
1001 format('Supported Suffixes:'/(11('/',a1,2x)))
|
|
||||||
write(11,1002) pfx
|
|
||||||
1002 format(/'Supported Add-On DXCC Prefixes:'/(15(a5,1x)))
|
|
||||||
close(11)
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
13
lib/pfxdump.f90
Normal file
13
lib/pfxdump.f90
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
subroutine pfxdump(fname)
|
||||||
|
character*(*) fname
|
||||||
|
include 'pfx.f90'
|
||||||
|
|
||||||
|
open(11,file=fname,status='unknown')
|
||||||
|
write(11,1001) sfx
|
||||||
|
1001 format('Supported Suffixes:'/(11('/',a1,2x)))
|
||||||
|
write(11,1002) pfx
|
||||||
|
1002 format(/'Supported Add-On DXCC Prefixes:'/(15(a5,1x)))
|
||||||
|
close(11)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine pfxdump
|
||||||
@ -1,4 +0,0 @@
|
|||||||
subroutine sort(n,arr)
|
|
||||||
call ssort(arr,tmp,n,1)
|
|
||||||
return
|
|
||||||
end
|
|
||||||
4
lib/sort.f90
Normal file
4
lib/sort.f90
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
subroutine sort(n,arr)
|
||||||
|
call ssort(arr,tmp,n,1)
|
||||||
|
return
|
||||||
|
end subroutine sort
|
||||||
288
lib/ssort.f
288
lib/ssort.f
@ -1,288 +0,0 @@
|
|||||||
subroutine ssort (x,y,n,kflag)
|
|
||||||
c***purpose sort an array and optionally make the same interchanges in
|
|
||||||
c an auxiliary array. the array may be sorted in increasing
|
|
||||||
c or decreasing order. a slightly modified quicksort
|
|
||||||
c algorithm is used.
|
|
||||||
c
|
|
||||||
c ssort sorts array x and optionally makes the same interchanges in
|
|
||||||
c array y. the array x may be sorted in increasing order or
|
|
||||||
c decreasing order. a slightly modified quicksort algorithm is used.
|
|
||||||
c
|
|
||||||
c description of parameters
|
|
||||||
c x - array of values to be sorted
|
|
||||||
c y - array to be (optionally) carried along
|
|
||||||
c n - number of values in array x to be sorted
|
|
||||||
c kflag - control parameter
|
|
||||||
c = 2 means sort x in increasing order and carry y along.
|
|
||||||
c = 1 means sort x in increasing order (ignoring y)
|
|
||||||
c = -1 means sort x in decreasing order (ignoring y)
|
|
||||||
c = -2 means sort x in decreasing order and carry y along.
|
|
||||||
|
|
||||||
integer kflag, n
|
|
||||||
! real x(n), y(n)
|
|
||||||
! real r, t, tt, tty, ty
|
|
||||||
integer x(n), y(n)
|
|
||||||
real r
|
|
||||||
integer t, tt, tty, ty
|
|
||||||
integer i, ij, j, k, kk, l, m, nn
|
|
||||||
integer il(21), iu(21)
|
|
||||||
|
|
||||||
nn = n
|
|
||||||
if (nn .lt. 1) then
|
|
||||||
! print*,'ssort: The number of sort elements is not positive.'
|
|
||||||
! print*,'ssort: n = ',nn,' kflag = ',kflag
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
c
|
|
||||||
kk = abs(kflag)
|
|
||||||
if (kk.ne.1 .and. kk.ne.2) then
|
|
||||||
print *,
|
|
||||||
+ 'the sort control parameter, k, is not 2, 1, -1, or -2.'
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
c
|
|
||||||
c alter array x to get decreasing order if needed
|
|
||||||
c
|
|
||||||
if (kflag .le. -1) then
|
|
||||||
do 10 i=1,nn
|
|
||||||
x(i) = -x(i)
|
|
||||||
10 continue
|
|
||||||
endif
|
|
||||||
c
|
|
||||||
if (kk .eq. 2) go to 100
|
|
||||||
c
|
|
||||||
c sort x only
|
|
||||||
c
|
|
||||||
m = 1
|
|
||||||
i = 1
|
|
||||||
j = nn
|
|
||||||
r = 0.375e0
|
|
||||||
c
|
|
||||||
20 if (i .eq. j) go to 60
|
|
||||||
if (r .le. 0.5898437e0) then
|
|
||||||
r = r+3.90625e-2
|
|
||||||
else
|
|
||||||
r = r-0.21875e0
|
|
||||||
endif
|
|
||||||
c
|
|
||||||
30 k = i
|
|
||||||
c
|
|
||||||
c select a central element of the array and save it in location t
|
|
||||||
c
|
|
||||||
ij = i + int((j-i)*r)
|
|
||||||
t = x(ij)
|
|
||||||
c
|
|
||||||
c if first element of array is greater than t, interchange with t
|
|
||||||
c
|
|
||||||
if (x(i) .gt. t) then
|
|
||||||
x(ij) = x(i)
|
|
||||||
x(i) = t
|
|
||||||
t = x(ij)
|
|
||||||
endif
|
|
||||||
l = j
|
|
||||||
c
|
|
||||||
c if last element of array is less than than t, interchange with t
|
|
||||||
c
|
|
||||||
if (x(j) .lt. t) then
|
|
||||||
x(ij) = x(j)
|
|
||||||
x(j) = t
|
|
||||||
t = x(ij)
|
|
||||||
c
|
|
||||||
c if first element of array is greater than t, interchange with t
|
|
||||||
c
|
|
||||||
if (x(i) .gt. t) then
|
|
||||||
x(ij) = x(i)
|
|
||||||
x(i) = t
|
|
||||||
t = x(ij)
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
c
|
|
||||||
c find an element in the second half of the array which is smaller
|
|
||||||
c than t
|
|
||||||
c
|
|
||||||
40 l = l-1
|
|
||||||
if (x(l) .gt. t) go to 40
|
|
||||||
c
|
|
||||||
c find an element in the first half of the array which is greater
|
|
||||||
c than t
|
|
||||||
c
|
|
||||||
50 k = k+1
|
|
||||||
if (x(k) .lt. t) go to 50
|
|
||||||
c
|
|
||||||
c interchange these elements
|
|
||||||
c
|
|
||||||
if (k .le. l) then
|
|
||||||
tt = x(l)
|
|
||||||
x(l) = x(k)
|
|
||||||
x(k) = tt
|
|
||||||
go to 40
|
|
||||||
endif
|
|
||||||
c
|
|
||||||
c save upper and lower subscripts of the array yet to be sorted
|
|
||||||
c
|
|
||||||
if (l-i .gt. j-k) then
|
|
||||||
il(m) = i
|
|
||||||
iu(m) = l
|
|
||||||
i = k
|
|
||||||
m = m+1
|
|
||||||
else
|
|
||||||
il(m) = k
|
|
||||||
iu(m) = j
|
|
||||||
j = l
|
|
||||||
m = m+1
|
|
||||||
endif
|
|
||||||
go to 70
|
|
||||||
c
|
|
||||||
c begin again on another portion of the unsorted array
|
|
||||||
c
|
|
||||||
60 m = m-1
|
|
||||||
if (m .eq. 0) go to 190
|
|
||||||
i = il(m)
|
|
||||||
j = iu(m)
|
|
||||||
c
|
|
||||||
70 if (j-i .ge. 1) go to 30
|
|
||||||
if (i .eq. 1) go to 20
|
|
||||||
i = i-1
|
|
||||||
c
|
|
||||||
80 i = i+1
|
|
||||||
if (i .eq. j) go to 60
|
|
||||||
t = x(i+1)
|
|
||||||
if (x(i) .le. t) go to 80
|
|
||||||
k = i
|
|
||||||
c
|
|
||||||
90 x(k+1) = x(k)
|
|
||||||
k = k-1
|
|
||||||
if (t .lt. x(k)) go to 90
|
|
||||||
x(k+1) = t
|
|
||||||
go to 80
|
|
||||||
c
|
|
||||||
c sort x and carry y along
|
|
||||||
c
|
|
||||||
100 m = 1
|
|
||||||
i = 1
|
|
||||||
j = nn
|
|
||||||
r = 0.375e0
|
|
||||||
c
|
|
||||||
110 if (i .eq. j) go to 150
|
|
||||||
if (r .le. 0.5898437e0) then
|
|
||||||
r = r+3.90625e-2
|
|
||||||
else
|
|
||||||
r = r-0.21875e0
|
|
||||||
endif
|
|
||||||
c
|
|
||||||
120 k = i
|
|
||||||
c
|
|
||||||
c select a central element of the array and save it in location t
|
|
||||||
c
|
|
||||||
ij = i + int((j-i)*r)
|
|
||||||
t = x(ij)
|
|
||||||
ty = y(ij)
|
|
||||||
c
|
|
||||||
c if first element of array is greater than t, interchange with t
|
|
||||||
c
|
|
||||||
if (x(i) .gt. t) then
|
|
||||||
x(ij) = x(i)
|
|
||||||
x(i) = t
|
|
||||||
t = x(ij)
|
|
||||||
y(ij) = y(i)
|
|
||||||
y(i) = ty
|
|
||||||
ty = y(ij)
|
|
||||||
endif
|
|
||||||
l = j
|
|
||||||
c
|
|
||||||
c if last element of array is less than t, interchange with t
|
|
||||||
c
|
|
||||||
if (x(j) .lt. t) then
|
|
||||||
x(ij) = x(j)
|
|
||||||
x(j) = t
|
|
||||||
t = x(ij)
|
|
||||||
y(ij) = y(j)
|
|
||||||
y(j) = ty
|
|
||||||
ty = y(ij)
|
|
||||||
c
|
|
||||||
c if first element of array is greater than t, interchange with t
|
|
||||||
c
|
|
||||||
if (x(i) .gt. t) then
|
|
||||||
x(ij) = x(i)
|
|
||||||
x(i) = t
|
|
||||||
t = x(ij)
|
|
||||||
y(ij) = y(i)
|
|
||||||
y(i) = ty
|
|
||||||
ty = y(ij)
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
c
|
|
||||||
c find an element in the second half of the array which is smaller
|
|
||||||
c than t
|
|
||||||
c
|
|
||||||
130 l = l-1
|
|
||||||
if (x(l) .gt. t) go to 130
|
|
||||||
c
|
|
||||||
c find an element in the first half of the array which is greater
|
|
||||||
c than t
|
|
||||||
c
|
|
||||||
140 k = k+1
|
|
||||||
if (x(k) .lt. t) go to 140
|
|
||||||
c
|
|
||||||
c interchange these elements
|
|
||||||
c
|
|
||||||
if (k .le. l) then
|
|
||||||
tt = x(l)
|
|
||||||
x(l) = x(k)
|
|
||||||
x(k) = tt
|
|
||||||
tty = y(l)
|
|
||||||
y(l) = y(k)
|
|
||||||
y(k) = tty
|
|
||||||
go to 130
|
|
||||||
endif
|
|
||||||
c
|
|
||||||
c save upper and lower subscripts of the array yet to be sorted
|
|
||||||
c
|
|
||||||
if (l-i .gt. j-k) then
|
|
||||||
il(m) = i
|
|
||||||
iu(m) = l
|
|
||||||
i = k
|
|
||||||
m = m+1
|
|
||||||
else
|
|
||||||
il(m) = k
|
|
||||||
iu(m) = j
|
|
||||||
j = l
|
|
||||||
m = m+1
|
|
||||||
endif
|
|
||||||
go to 160
|
|
||||||
c
|
|
||||||
c begin again on another portion of the unsorted array
|
|
||||||
c
|
|
||||||
150 m = m-1
|
|
||||||
if (m .eq. 0) go to 190
|
|
||||||
i = il(m)
|
|
||||||
j = iu(m)
|
|
||||||
c
|
|
||||||
160 if (j-i .ge. 1) go to 120
|
|
||||||
if (i .eq. 1) go to 110
|
|
||||||
i = i-1
|
|
||||||
c
|
|
||||||
170 i = i+1
|
|
||||||
if (i .eq. j) go to 150
|
|
||||||
t = x(i+1)
|
|
||||||
ty = y(i+1)
|
|
||||||
if (x(i) .le. t) go to 170
|
|
||||||
k = i
|
|
||||||
c
|
|
||||||
180 x(k+1) = x(k)
|
|
||||||
y(k+1) = y(k)
|
|
||||||
k = k-1
|
|
||||||
if (t .lt. x(k)) go to 180
|
|
||||||
x(k+1) = t
|
|
||||||
y(k+1) = ty
|
|
||||||
go to 170
|
|
||||||
c
|
|
||||||
c clean up
|
|
||||||
c
|
|
||||||
190 if (kflag .le. -1) then
|
|
||||||
do 200 i=1,nn
|
|
||||||
x(i) = -x(i)
|
|
||||||
200 continue
|
|
||||||
endif
|
|
||||||
return
|
|
||||||
end
|
|
||||||
264
lib/ssort.f90
Normal file
264
lib/ssort.f90
Normal file
@ -0,0 +1,264 @@
|
|||||||
|
subroutine ssort (x,y,n,kflag)
|
||||||
|
! Sort an array and optionally make the same interchanges in
|
||||||
|
! an auxiliary array. the array may be sorted in increasing
|
||||||
|
! or decreasing order. a slightly modified quicksort
|
||||||
|
! algorithm is used.
|
||||||
|
|
||||||
|
! ssort sorts array x and optionally makes the same interchanges in
|
||||||
|
! array y. the array x may be sorted in increasing order or
|
||||||
|
! decreasing order. a slightly modified quicksort algorithm is used.
|
||||||
|
|
||||||
|
! Description of parameters
|
||||||
|
! x - array of values to be sorted
|
||||||
|
! y - array to be (optionally) carried along
|
||||||
|
! n - number of values in array x to be sorted
|
||||||
|
! kflag - control parameter
|
||||||
|
! = 2 means sort x in increasing order and carry y along.
|
||||||
|
! = 1 means sort x in increasing order (ignoring y)
|
||||||
|
! = -1 means sort x in decreasing order (ignoring y)
|
||||||
|
! = -2 means sort x in decreasing order and carry y along.
|
||||||
|
|
||||||
|
integer kflag, n
|
||||||
|
integer x(n), y(n)
|
||||||
|
real r
|
||||||
|
integer t, tt, tty, ty
|
||||||
|
integer i, ij, j, k, kk, l, m, nn
|
||||||
|
integer il(21), iu(21)
|
||||||
|
|
||||||
|
nn = n
|
||||||
|
if (nn .lt. 1) then
|
||||||
|
! print*,'ssort: The number of sort elements is not positive.'
|
||||||
|
! print*,'ssort: n = ',nn,' kflag = ',kflag
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
kk = abs(kflag)
|
||||||
|
if (kk.ne.1 .and. kk.ne.2) then
|
||||||
|
print *,'the sort control parameter, k, is not 2, 1, -1, or -2.'
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Alter array x to get decreasing order if needed
|
||||||
|
|
||||||
|
if (kflag .le. -1) then
|
||||||
|
do i=1,nn
|
||||||
|
x(i) = -x(i)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (kk .eq. 2) go to 100
|
||||||
|
|
||||||
|
! Sort x only
|
||||||
|
|
||||||
|
m = 1
|
||||||
|
i = 1
|
||||||
|
j = nn
|
||||||
|
r = 0.375e0
|
||||||
|
|
||||||
|
20 if (i .eq. j) go to 60
|
||||||
|
if (r .le. 0.5898437e0) then
|
||||||
|
r = r+3.90625e-2
|
||||||
|
else
|
||||||
|
r = r-0.21875e0
|
||||||
|
endif
|
||||||
|
|
||||||
|
30 k = i
|
||||||
|
|
||||||
|
! Select a central element of the array and save it in location t
|
||||||
|
|
||||||
|
ij = i + int((j-i)*r)
|
||||||
|
t = x(ij)
|
||||||
|
|
||||||
|
! If first element of array is greater than t, interchange with t
|
||||||
|
|
||||||
|
if (x(i) .gt. t) then
|
||||||
|
x(ij) = x(i)
|
||||||
|
x(i) = t
|
||||||
|
t = x(ij)
|
||||||
|
endif
|
||||||
|
l = j
|
||||||
|
|
||||||
|
! If last element of array is less than than t, interchange with t
|
||||||
|
if (x(j) .lt. t) then
|
||||||
|
x(ij) = x(j)
|
||||||
|
x(j) = t
|
||||||
|
t = x(ij)
|
||||||
|
|
||||||
|
! If first element of array is greater than t, interchange with t
|
||||||
|
if (x(i) .gt. t) then
|
||||||
|
x(ij) = x(i)
|
||||||
|
x(i) = t
|
||||||
|
t = x(ij)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Find an element in the second half of the array which is smaller than t
|
||||||
|
40 l = l-1
|
||||||
|
if (x(l) .gt. t) go to 40
|
||||||
|
|
||||||
|
! Find an element in the first half of the array which is greater than t
|
||||||
|
50 k = k+1
|
||||||
|
if (x(k) .lt. t) go to 50
|
||||||
|
|
||||||
|
! Interchange these elements
|
||||||
|
if (k .le. l) then
|
||||||
|
tt = x(l)
|
||||||
|
x(l) = x(k)
|
||||||
|
x(k) = tt
|
||||||
|
go to 40
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Save upper and lower subscripts of the array yet to be sorted
|
||||||
|
if (l-i .gt. j-k) then
|
||||||
|
il(m) = i
|
||||||
|
iu(m) = l
|
||||||
|
i = k
|
||||||
|
m = m+1
|
||||||
|
else
|
||||||
|
il(m) = k
|
||||||
|
iu(m) = j
|
||||||
|
j = l
|
||||||
|
m = m+1
|
||||||
|
endif
|
||||||
|
go to 70
|
||||||
|
|
||||||
|
! Begin again on another portion of the unsorted array
|
||||||
|
60 m = m-1
|
||||||
|
if (m .eq. 0) go to 190
|
||||||
|
i = il(m)
|
||||||
|
j = iu(m)
|
||||||
|
|
||||||
|
70 if (j-i .ge. 1) go to 30
|
||||||
|
if (i .eq. 1) go to 20
|
||||||
|
i = i-1
|
||||||
|
|
||||||
|
80 i = i+1
|
||||||
|
if (i .eq. j) go to 60
|
||||||
|
t = x(i+1)
|
||||||
|
if (x(i) .le. t) go to 80
|
||||||
|
k = i
|
||||||
|
|
||||||
|
90 x(k+1) = x(k)
|
||||||
|
k = k-1
|
||||||
|
if (t .lt. x(k)) go to 90
|
||||||
|
x(k+1) = t
|
||||||
|
go to 80
|
||||||
|
|
||||||
|
! Sort x and carry y along
|
||||||
|
|
||||||
|
100 m = 1
|
||||||
|
i = 1
|
||||||
|
j = nn
|
||||||
|
r = 0.375e0
|
||||||
|
|
||||||
|
110 if (i .eq. j) go to 150
|
||||||
|
if (r .le. 0.5898437e0) then
|
||||||
|
r = r+3.90625e-2
|
||||||
|
else
|
||||||
|
r = r-0.21875e0
|
||||||
|
endif
|
||||||
|
|
||||||
|
120 k = i
|
||||||
|
! Select a central element of the array and save it in location t
|
||||||
|
ij = i + int((j-i)*r)
|
||||||
|
t = x(ij)
|
||||||
|
ty = y(ij)
|
||||||
|
|
||||||
|
! If first element of array is greater than t, interchange with t
|
||||||
|
if (x(i) .gt. t) then
|
||||||
|
x(ij) = x(i)
|
||||||
|
x(i) = t
|
||||||
|
t = x(ij)
|
||||||
|
y(ij) = y(i)
|
||||||
|
y(i) = ty
|
||||||
|
ty = y(ij)
|
||||||
|
endif
|
||||||
|
l = j
|
||||||
|
|
||||||
|
! If last element of array is less than t, interchange with t
|
||||||
|
if (x(j) .lt. t) then
|
||||||
|
x(ij) = x(j)
|
||||||
|
x(j) = t
|
||||||
|
t = x(ij)
|
||||||
|
y(ij) = y(j)
|
||||||
|
y(j) = ty
|
||||||
|
ty = y(ij)
|
||||||
|
|
||||||
|
! If first element of array is greater than t, interchange with t
|
||||||
|
if (x(i) .gt. t) then
|
||||||
|
x(ij) = x(i)
|
||||||
|
x(i) = t
|
||||||
|
t = x(ij)
|
||||||
|
y(ij) = y(i)
|
||||||
|
y(i) = ty
|
||||||
|
ty = y(ij)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Find an element in the second half of the array which is smaller than t
|
||||||
|
130 l = l-1
|
||||||
|
if (x(l) .gt. t) go to 130
|
||||||
|
|
||||||
|
! Find an element in the first half of the array which is greater than t
|
||||||
|
140 k = k+1
|
||||||
|
if (x(k) .lt. t) go to 140
|
||||||
|
|
||||||
|
! Interchange these elements
|
||||||
|
if (k .le. l) then
|
||||||
|
tt = x(l)
|
||||||
|
x(l) = x(k)
|
||||||
|
x(k) = tt
|
||||||
|
tty = y(l)
|
||||||
|
y(l) = y(k)
|
||||||
|
y(k) = tty
|
||||||
|
go to 130
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Save upper and lower subscripts of the array yet to be sorted
|
||||||
|
if (l-i .gt. j-k) then
|
||||||
|
il(m) = i
|
||||||
|
iu(m) = l
|
||||||
|
i = k
|
||||||
|
m = m+1
|
||||||
|
else
|
||||||
|
il(m) = k
|
||||||
|
iu(m) = j
|
||||||
|
j = l
|
||||||
|
m = m+1
|
||||||
|
endif
|
||||||
|
go to 160
|
||||||
|
|
||||||
|
! Begin again on another portion of the unsorted array
|
||||||
|
150 m = m-1
|
||||||
|
if (m .eq. 0) go to 190
|
||||||
|
i = il(m)
|
||||||
|
j = iu(m)
|
||||||
|
|
||||||
|
160 if (j-i .ge. 1) go to 120
|
||||||
|
if (i .eq. 1) go to 110
|
||||||
|
i = i-1
|
||||||
|
|
||||||
|
170 i = i+1
|
||||||
|
if (i .eq. j) go to 150
|
||||||
|
t = x(i+1)
|
||||||
|
ty = y(i+1)
|
||||||
|
if (x(i) .le. t) go to 170
|
||||||
|
k = i
|
||||||
|
|
||||||
|
180 x(k+1) = x(k)
|
||||||
|
y(k+1) = y(k)
|
||||||
|
k = k-1
|
||||||
|
if (t .lt. x(k)) go to 180
|
||||||
|
x(k+1) = t
|
||||||
|
y(k+1) = ty
|
||||||
|
go to 170
|
||||||
|
|
||||||
|
! Clean up
|
||||||
|
190 if (kflag .le. -1) then
|
||||||
|
do i=1,nn
|
||||||
|
x(i) = -x(i)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine ssort
|
||||||
142
lib/unpackcall.f
142
lib/unpackcall.f
@ -1,142 +0,0 @@
|
|||||||
subroutine unpackcall(ncall,word,iv2,psfx)
|
|
||||||
|
|
||||||
parameter (NBASE=37*36*10*27*27*27)
|
|
||||||
character word*12,c*37,psfx*4
|
|
||||||
|
|
||||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
|
|
||||||
|
|
||||||
n=ncall
|
|
||||||
iv2=0
|
|
||||||
if(n.ge.262177560) go to 20
|
|
||||||
word='......'
|
|
||||||
if(n.ge.262177560) go to 999 !Plain text message ...
|
|
||||||
i=mod(n,27)+11
|
|
||||||
word(6:6)=c(i:i)
|
|
||||||
n=n/27
|
|
||||||
i=mod(n,27)+11
|
|
||||||
word(5:5)=c(i:i)
|
|
||||||
n=n/27
|
|
||||||
i=mod(n,27)+11
|
|
||||||
word(4:4)=c(i:i)
|
|
||||||
n=n/27
|
|
||||||
i=mod(n,10)+1
|
|
||||||
word(3:3)=c(i:i)
|
|
||||||
n=n/10
|
|
||||||
i=mod(n,36)+1
|
|
||||||
word(2:2)=c(i:i)
|
|
||||||
n=n/36
|
|
||||||
i=n+1
|
|
||||||
word(1:1)=c(i:i)
|
|
||||||
do i=1,4
|
|
||||||
if(word(i:i).ne.' ') go to 10
|
|
||||||
enddo
|
|
||||||
go to 999
|
|
||||||
10 word=word(i:)
|
|
||||||
go to 999
|
|
||||||
|
|
||||||
20 if(n.ge.267796946) go to 999
|
|
||||||
|
|
||||||
! We have a JT65v2 message
|
|
||||||
if((n.ge.262178563) .and. (n.le.264002071)) Then
|
|
||||||
! CQ with prefix
|
|
||||||
iv2=1
|
|
||||||
n=n-262178563
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(4:4)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(3:3)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(2:2)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=n+1
|
|
||||||
psfx(1:1)=c(i:i)
|
|
||||||
endif
|
|
||||||
|
|
||||||
if((n.ge.264002072) .and. (n.le.265825580)) Then
|
|
||||||
! QRZ with prefix
|
|
||||||
iv2=2
|
|
||||||
n=n-264002072
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(4:4)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(3:3)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(2:2)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=n+1
|
|
||||||
psfx(1:1)=c(i:i)
|
|
||||||
endif
|
|
||||||
|
|
||||||
if((n.ge.265825581) .and. (n.le.267649089)) Then
|
|
||||||
! DE with prefix
|
|
||||||
iv2=3
|
|
||||||
n=n-265825581
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(4:4)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(3:3)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(2:2)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=n+1
|
|
||||||
psfx(1:1)=c(i:i)
|
|
||||||
endif
|
|
||||||
|
|
||||||
if((n.ge.267649090) .and. (n.le.267698374)) Then
|
|
||||||
! CQ with suffix
|
|
||||||
iv2=4
|
|
||||||
n=n-267649090
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(3:3)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(2:2)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=n+1
|
|
||||||
psfx(1:1)=c(i:i)
|
|
||||||
endif
|
|
||||||
|
|
||||||
if((n.ge.267698375) .and. (n.le.267747659)) Then
|
|
||||||
! QRZ with suffix
|
|
||||||
iv2=5
|
|
||||||
n=n-267698375
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(3:3)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(2:2)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=n+1
|
|
||||||
psfx(1:1)=c(i:i)
|
|
||||||
endif
|
|
||||||
|
|
||||||
if((n.ge.267747660) .and. (n.le.267796944)) Then
|
|
||||||
! DE with suffix
|
|
||||||
iv2=6
|
|
||||||
n=n-267747660
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(3:3)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=mod(n,37)+1
|
|
||||||
psfx(2:2)=c(i:i)
|
|
||||||
n=n/37
|
|
||||||
i=n+1
|
|
||||||
psfx(1:1)=c(i:i)
|
|
||||||
endif
|
|
||||||
|
|
||||||
if(n.eq.267796945) Then
|
|
||||||
! DE with no prefix or suffix
|
|
||||||
iv2=7
|
|
||||||
psfx = ' '
|
|
||||||
endif
|
|
||||||
|
|
||||||
999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
142
lib/unpackcall.f90
Normal file
142
lib/unpackcall.f90
Normal file
@ -0,0 +1,142 @@
|
|||||||
|
subroutine unpackcall(ncall,word,iv2,psfx)
|
||||||
|
|
||||||
|
parameter (NBASE=37*36*10*27*27*27)
|
||||||
|
character word*12,c*37,psfx*4
|
||||||
|
|
||||||
|
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
|
||||||
|
|
||||||
|
n=ncall
|
||||||
|
iv2=0
|
||||||
|
if(n.ge.262177560) go to 20
|
||||||
|
word='......'
|
||||||
|
if(n.ge.262177560) go to 999 !Plain text message ...
|
||||||
|
i=mod(n,27)+11
|
||||||
|
word(6:6)=c(i:i)
|
||||||
|
n=n/27
|
||||||
|
i=mod(n,27)+11
|
||||||
|
word(5:5)=c(i:i)
|
||||||
|
n=n/27
|
||||||
|
i=mod(n,27)+11
|
||||||
|
word(4:4)=c(i:i)
|
||||||
|
n=n/27
|
||||||
|
i=mod(n,10)+1
|
||||||
|
word(3:3)=c(i:i)
|
||||||
|
n=n/10
|
||||||
|
i=mod(n,36)+1
|
||||||
|
word(2:2)=c(i:i)
|
||||||
|
n=n/36
|
||||||
|
i=n+1
|
||||||
|
word(1:1)=c(i:i)
|
||||||
|
do i=1,4
|
||||||
|
if(word(i:i).ne.' ') go to 10
|
||||||
|
enddo
|
||||||
|
go to 999
|
||||||
|
10 word=word(i:)
|
||||||
|
go to 999
|
||||||
|
|
||||||
|
20 if(n.ge.267796946) go to 999
|
||||||
|
|
||||||
|
! We have a JT65v2 message
|
||||||
|
if((n.ge.262178563) .and. (n.le.264002071)) Then
|
||||||
|
! CQ with prefix
|
||||||
|
iv2=1
|
||||||
|
n=n-262178563
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(4:4)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(3:3)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(2:2)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=n+1
|
||||||
|
psfx(1:1)=c(i:i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if((n.ge.264002072) .and. (n.le.265825580)) Then
|
||||||
|
! QRZ with prefix
|
||||||
|
iv2=2
|
||||||
|
n=n-264002072
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(4:4)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(3:3)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(2:2)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=n+1
|
||||||
|
psfx(1:1)=c(i:i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if((n.ge.265825581) .and. (n.le.267649089)) Then
|
||||||
|
! DE with prefix
|
||||||
|
iv2=3
|
||||||
|
n=n-265825581
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(4:4)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(3:3)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(2:2)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=n+1
|
||||||
|
psfx(1:1)=c(i:i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if((n.ge.267649090) .and. (n.le.267698374)) Then
|
||||||
|
! CQ with suffix
|
||||||
|
iv2=4
|
||||||
|
n=n-267649090
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(3:3)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(2:2)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=n+1
|
||||||
|
psfx(1:1)=c(i:i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if((n.ge.267698375) .and. (n.le.267747659)) Then
|
||||||
|
! QRZ with suffix
|
||||||
|
iv2=5
|
||||||
|
n=n-267698375
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(3:3)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(2:2)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=n+1
|
||||||
|
psfx(1:1)=c(i:i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if((n.ge.267747660) .and. (n.le.267796944)) Then
|
||||||
|
! DE with suffix
|
||||||
|
iv2=6
|
||||||
|
n=n-267747660
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(3:3)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=mod(n,37)+1
|
||||||
|
psfx(2:2)=c(i:i)
|
||||||
|
n=n/37
|
||||||
|
i=n+1
|
||||||
|
psfx(1:1)=c(i:i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(n.eq.267796945) Then
|
||||||
|
! DE with no prefix or suffix
|
||||||
|
iv2=7
|
||||||
|
psfx = ' '
|
||||||
|
endif
|
||||||
|
|
||||||
|
999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine unpackcall
|
||||||
@ -1,35 +0,0 @@
|
|||||||
subroutine unpacktext(nc1,nc2,nc3,msg)
|
|
||||||
|
|
||||||
character*22 msg
|
|
||||||
character*44 c
|
|
||||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
|
||||||
|
|
||||||
nc3=iand(nc3,32767) !Remove the "plain text" bit
|
|
||||||
if(iand(nc1,1).ne.0) nc3=nc3+32768
|
|
||||||
nc1=nc1/2
|
|
||||||
if(iand(nc2,1).ne.0) nc3=nc3+65536
|
|
||||||
nc2=nc2/2
|
|
||||||
|
|
||||||
do i=5,1,-1
|
|
||||||
j=mod(nc1,42)+1
|
|
||||||
msg(i:i)=c(j:j)
|
|
||||||
nc1=nc1/42
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do i=10,6,-1
|
|
||||||
j=mod(nc2,42)+1
|
|
||||||
msg(i:i)=c(j:j)
|
|
||||||
nc2=nc2/42
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do i=13,11,-1
|
|
||||||
j=mod(nc3,42)+1
|
|
||||||
msg(i:i)=c(j:j)
|
|
||||||
nc3=nc3/42
|
|
||||||
enddo
|
|
||||||
msg(14:22) = ' '
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
35
lib/unpacktext.f90
Normal file
35
lib/unpacktext.f90
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
subroutine unpacktext(nc1,nc2,nc3,msg)
|
||||||
|
|
||||||
|
character*22 msg
|
||||||
|
character*44 c
|
||||||
|
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
||||||
|
|
||||||
|
nc3=iand(nc3,32767) !Remove the "plain text" bit
|
||||||
|
if(iand(nc1,1).ne.0) nc3=nc3+32768
|
||||||
|
nc1=nc1/2
|
||||||
|
if(iand(nc2,1).ne.0) nc3=nc3+65536
|
||||||
|
nc2=nc2/2
|
||||||
|
|
||||||
|
do i=5,1,-1
|
||||||
|
j=mod(nc1,42)+1
|
||||||
|
msg(i:i)=c(j:j)
|
||||||
|
nc1=nc1/42
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i=10,6,-1
|
||||||
|
j=mod(nc2,42)+1
|
||||||
|
msg(i:i)=c(j:j)
|
||||||
|
nc2=nc2/42
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i=13,11,-1
|
||||||
|
j=mod(nc3,42)+1
|
||||||
|
msg(i:i)=c(j:j)
|
||||||
|
nc3=nc3/42
|
||||||
|
enddo
|
||||||
|
msg(14:22) = ' '
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine unpacktext
|
||||||
|
|
||||||
|
|
||||||
@ -1,4 +1,4 @@
|
|||||||
//-------------------------------------------------------------- MainWindow
|
//--------------------------------------------------------------- MainWindow
|
||||||
#include "mainwindow.h"
|
#include "mainwindow.h"
|
||||||
#include "ui_mainwindow.h"
|
#include "ui_mainwindow.h"
|
||||||
#include "devsetup.h"
|
#include "devsetup.h"
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user