Rename fst240 to fst4 in Fortran routines.

This commit is contained in:
Steven Franke
2020-07-23 12:48:50 -05:00
parent 77a6f8f514
commit 085e63e05d
24 changed files with 191 additions and 83 deletions
+13 -13
View File
@@ -8,7 +8,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
use jt9_decode
use ft8_decode
use ft4_decode
use fst240_decode
use fst4_decode
include 'jt9com.f90'
include 'timer_common.inc'
@@ -33,9 +33,9 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
integer :: decoded
end type counting_ft4_decoder
type, extends(fst240_decoder) :: counting_fst240_decoder
type, extends(fst4_decoder) :: counting_fst4_decoder
integer :: decoded
end type counting_fst240_decoder
end type counting_fst4_decoder
real ss(184,NSMAX)
logical baddata,newdat65,newdat9,single_decode,bVHF,bad0,newdat,ex
@@ -53,7 +53,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
type(counting_jt9_decoder) :: my_jt9
type(counting_ft8_decoder) :: my_ft8
type(counting_ft4_decoder) :: my_ft4
type(counting_fst240_decoder) :: my_fst240
type(counting_fst4_decoder) :: my_fst4
!cast C character arrays to Fortran character strings
datetime=transfer(params%datetime, datetime)
@@ -68,7 +68,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
my_jt9%decoded = 0
my_ft8%decoded = 0
my_ft4%decoded = 0
my_fst240%decoded = 0
my_fst4%decoded = 0
! For testing only: return Rx messages stored in a file as decodes
inquire(file='rx_messages.txt',exist=ex)
@@ -193,7 +193,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
iwspr=0
if(iand(params%ndepth,128).ne.0) iwspr=2
call timer('dec240 ',0)
call my_fst240%decode(fst240_decoded,id2,params%nutc, &
call my_fst4%decode(fst4_decoded,id2,params%nutc, &
params%nQSOProgress,params%nfqso,params%nfa,params%nfb, &
params%nsubmode,ndepth,params%ntr,params%nexp_decode, &
params%ntol,params%emedelay, &
@@ -207,7 +207,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
ndepth=iand(params%ndepth,3)
iwspr=1
call timer('dec240 ',0)
call my_fst240%decode(fst240_decoded,id2,params%nutc, &
call my_fst4%decode(fst4_decoded,id2,params%nutc, &
params%nQSOProgress,params%nfqso,params%nfa,params%nfb, &
params%nsubmode,ndepth,params%ntr,params%nexp_decode, &
params%ntol,params%emedelay, &
@@ -335,7 +335,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
! JT65 is not yet producing info for nsynced, ndecoded.
800 ndecoded = my_jt4%decoded + my_jt65%decoded + my_jt9%decoded + &
my_ft8%decoded + my_ft4%decoded + my_fst240%decoded
my_ft8%decoded + my_ft4%decoded + my_fst4%decoded
if(params%nmode.eq.8 .and. params%nzhsym.eq.41) ndec41=ndecoded
if(params%nmode.eq.8 .and. params%nzhsym.eq.47) ndec47=ndecoded
if(params%nmode.eq.8 .and. params%nzhsym.eq.50) then
@@ -697,13 +697,13 @@ contains
return
end subroutine ft4_decoded
subroutine fst240_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap, &
subroutine fst4_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap, &
qual,ntrperiod,lwspr,fmid,w50)
use fst240_decode
use fst4_decode
implicit none
class(fst240_decoder), intent(inout) :: this
class(fst4_decoder), intent(inout) :: this
integer, intent(in) :: nutc
real, intent(in) :: sync
integer, intent(in) :: nsnr
@@ -752,11 +752,11 @@ contains
call flush(13)
select type(this)
type is (counting_fst240_decoder)
type is (counting_fst4_decoder)
this%decoded = this%decoded + 1
end select
return
end subroutine fst240_decoded
end subroutine fst4_decoded
end subroutine multimode_decoder
@@ -1,4 +1,4 @@
! FST240
! FST4
! LDPC(240,101)/CRC24 code, five 8x4 sync
parameter (KK=77) !Information bits (77 + CRC24)
@@ -1,10 +1,10 @@
program fst240sim
program fst4sim
! Generate simulated signals for experimental slow FT4 mode
use wavhdr
use packjt77
include 'fst240_params.f90' !Set various constants
include 'fst4_params.f90' !Set various constants
type(hdr) h !Header for .wav file
logical*1 wspr_hint
character arg*12,fname*17
@@ -21,8 +21,8 @@ program fst240sim
nargs=iargc()
if(nargs.ne.10) then
print*,'Need 10 arguments, got ',nargs
print*,'Usage: fst240sim "message" TRsec f0 DT h fdop del nfiles snr W'
print*,'Examples: fst240sim "K1JT K9AN EN50" 60 1500 0.0 1 0.1 1.0 10 -15 F'
print*,'Usage: fst4sim "message" TRsec f0 DT h fdop del nfiles snr W'
print*,'Examples: fst4sim "K1JT K9AN EN50" 60 1500 0.0 1 0.1 1.0 10 -15 F'
print*,'W (T or F) argument is hint to encoder to use WSPR message when there is abiguity'
go to 999
endif
@@ -86,7 +86,7 @@ program fst240sim
endif
call pack77(msg37,i3,n3,c77)
if(i3.eq.0.and.n3.eq.6) iwspr=1
call genfst240(msg37,0,msgsent37,msgbits,itone,iwspr)
call genfst4(msg37,0,msgsent37,msgbits,itone,iwspr)
write(*,*)
write(*,'(a9,a37,a3,L2,a7,i2)') 'Message: ',msgsent37,'W:',wspr_hint,' iwspr:',iwspr
write(*,1000) f00,xdt,hmod,txt,snrdb
@@ -109,7 +109,7 @@ program fst240sim
fsample=12000.0
icmplx=1
f0=f00+1.5*hmod*baud
call gen_fst240wave(itone,NN,nsps,nwave,fsample,hmod,f0,icmplx,c0,wave)
call gen_fst4wave(itone,NN,nsps,nwave,fsample,hmod,f0,icmplx,c0,wave)
k=nint((xdt+1.0)/dt)
if(nsec.eq.15) k=nint((xdt+0.5)/dt)
c0=cshift(c0,-k)
@@ -152,4 +152,4 @@ program fst240sim
1110 format(i4,f7.2,f8.2,f7.1,2x,a17)
enddo
999 end program fst240sim
999 end program fst4sim
@@ -1,4 +1,4 @@
subroutine gen_fst240wave(itone,nsym,nsps,nwave,fsample,hmod,f0, &
subroutine gen_fst4wave(itone,nsym,nsps,nwave,fsample,hmod,f0, &
icmplx,cwave,wave)
parameter(NTAB=65536)
@@ -88,4 +88,4 @@ subroutine gen_fst240wave(itone,nsym,nsps,nwave,fsample,hmod,f0, &
endif
return
end subroutine gen_fst240wave
end subroutine gen_fst4wave
+108
View File
@@ -0,0 +1,108 @@
subroutine genfst240_64(msg0,ichk,msgsent,msgbits,i4tone,iwspr)
! Input:
! - msg0 requested message to be transmitted
! - ichk if ichk=1, return only msgsent
! - msgsent message as it will be decoded
! - i4tone array of audio tone values, {0,1,2,3}
! - iwspr 0: (240,101)/crc24, 1: (240,74)/crc24
!
! Frame structure:
! s8 d30 s8 d30 s8 d30 s8 d30 s8
use packjt77
include 'fst240_params.f90'
character*37 msg0
character*37 message !Message to be generated
character*37 msgsent !Message as it will be received
character*77 c77
character*24 c24
integer*4 i4tone(NN),itmp(ND)
integer*1 codeword(2*ND)
integer*1 msgbits(101),rvec(77)
integer isyncword1(8),isyncword2(8)
integer ncrc24
integer graymap64(64)
logical unpk77_success
data isyncword1/3,1,4,0,6,5,2/
data rvec/0,1,0,0,1,0,1,0,0,1,0,1,1,1,1,0,1,0,0,0,1,0,0,1,1,0,1,1,0, &
1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1, &
0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/
data graymap64/ 0, 1, 3, 2, 6, 7, 5, 4,12,13,15,14,10,11, 9, 8, &
24,25,27,26,30,31,29,28,20,21,23,22,18,19,17,16, &
48,49,51,50,54,55,53,52,60,61,63,62,58,59,57,56, &
40,41,43,42,46,47,45,44,36,37,39,38,34,35,33,32/
message=msg0
do i=1, 37
if(ichar(message(i:i)).eq.0) then
message(i:37)=' '
exit
endif
enddo
do i=1,37 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
i3=-1
n3=-1
call pack77(message,i3,n3,c77)
call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent
msgbits=0
iwspr=0
if(i3.eq.0.and.n3.eq.6) then
iwspr=1
read(c77,'(50i1)') msgbits(1:50)
call get_crc24(msgbits,74,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') msgbits(51:74)
else
read(c77,'(77i1)') msgbits(1:77)
msgbits(1:77)=mod(msgbits(1:77)+rvec,2)
call get_crc24(msgbits,101,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') msgbits(78:101)
endif
if(ichk.eq.1) go to 999
if(unpk77_success) go to 2
1 msgbits=0
itone=0
msgsent='*** bad message *** '
go to 999
entry get_fst240_tones_from_bits(msgbits,i4tone,iwspr)
2 continue
if(iwspr.eq.0) then
call encode240_101(msgbits,codeword)
else
call encode240_74(msgbits(1:74),codeword)
endif
! Grayscale mapping:
! bits tone
do i=1,40
is=codeword(2*i)+2*codeword(2*i-1)
if(is.le.1) itmp(i)=is
if(is.eq.2) itmp(i)=3
if(is.eq.3) itmp(i)=2
enddo
i4tone( 1: 8)=isyncword1
i4tone( 9: 38)=itmp( 1: 30)
i4tone( 39: 46)=isyncword2
i4tone( 47: 76)=itmp( 31: 60)
i4tone( 77: 84)=isyncword1
i4tone( 85:114)=itmp( 61: 90)
i4tone(115:122)=isyncword2
i4tone(123:152)=itmp( 91:120)
i4tone(153:160)=isyncword1
999 return
end subroutine genfst240_64
subroutine graycode(in
@@ -1,4 +1,4 @@
subroutine genfst240(msg0,ichk,msgsent,msgbits,i4tone,iwspr)
subroutine genfst4(msg0,ichk,msgsent,msgbits,i4tone,iwspr)
! Input:
! - msg0 requested message to be transmitted
@@ -12,7 +12,7 @@ subroutine genfst240(msg0,ichk,msgsent,msgbits,i4tone,iwspr)
! s8 d30 s8 d30 s8 d30 s8 d30 s8
use packjt77
include 'fst240_params.f90'
include 'fst4_params.f90'
character*37 msg0
character*37 message !Message to be generated
character*37 msgsent !Message as it will be received
@@ -73,7 +73,7 @@ subroutine genfst240(msg0,ichk,msgsent,msgbits,i4tone,iwspr)
msgsent='*** bad message *** '
go to 999
entry get_fst240_tones_from_bits(msgbits,i4tone,iwspr)
entry get_fst4_tones_from_bits(msgbits,i4tone,iwspr)
2 continue
if(iwspr.eq.0) then
@@ -108,4 +108,4 @@ subroutine genfst240(msg0,ichk,msgsent,msgbits,i4tone,iwspr)
999 return
end subroutine genfst240
end subroutine genfst4
@@ -1,6 +1,6 @@
subroutine get_fst240_bitmetrics(cd,nss,hmod,nmax,nhicoh,bitmetrics,s4,badsync)
subroutine get_fst4_bitmetrics(cd,nss,hmod,nmax,nhicoh,bitmetrics,s4,badsync)
include 'fst240_params.f90'
include 'fst4_params.f90'
complex cd(0:NN*nss-1)
complex cs(0:3,NN)
complex csymb(nss)
@@ -128,4 +128,4 @@ subroutine get_fst240_bitmetrics(cd,nss,hmod,nmax,nhicoh,bitmetrics,s4,badsync)
call normalizebmet(bitmetrics(:,4),2*NN)
return
end subroutine get_fst240_bitmetrics
end subroutine get_fst4_bitmetrics
@@ -1,6 +1,6 @@
subroutine get_fst240_bitmetrics2(cd,nss,hmod,nsizes,bitmetrics,s4hmod,badsync)
subroutine get_fst4_bitmetrics2(cd,nss,hmod,nsizes,bitmetrics,s4hmod,badsync)
include 'fst240_params.f90'
include 'fst4_params.f90'
complex cd(0:NN*nss-1)
complex csymb(nss)
complex, allocatable, save :: c1(:,:) ! ideal waveforms, 4 tones
@@ -128,4 +128,4 @@ subroutine get_fst240_bitmetrics2(cd,nss,hmod,nsizes,bitmetrics,s4hmod,badsync)
if(hmod.eq.8) s4hmod(:,:)=s4(:,:,4)
return
end subroutine get_fst240_bitmetrics2
end subroutine get_fst4_bitmetrics2
+30 -30
View File
@@ -1,17 +1,17 @@
module fst240_decode
module fst4_decode
type :: fst240_decoder
procedure(fst240_decode_callback), pointer :: callback
type :: fst4_decoder
procedure(fst4_decode_callback), pointer :: callback
contains
procedure :: decode
end type fst240_decoder
end type fst4_decoder
abstract interface
subroutine fst240_decode_callback (this,nutc,sync,nsnr,dt,freq, &
subroutine fst4_decode_callback (this,nutc,sync,nsnr,dt,freq, &
decoded,nap,qual,ntrperiod,lwspr,fmid,w50)
import fst240_decoder
import fst4_decoder
implicit none
class(fst240_decoder), intent(inout) :: this
class(fst4_decoder), intent(inout) :: this
integer, intent(in) :: nutc
real, intent(in) :: sync
integer, intent(in) :: nsnr
@@ -24,7 +24,7 @@ module fst240_decode
logical, intent(in) :: lwspr
real, intent(in) :: fmid
real, intent(in) :: w50
end subroutine fst240_decode_callback
end subroutine fst4_decode_callback
end interface
contains
@@ -36,10 +36,10 @@ contains
use timer_module, only: timer
use packjt77
use, intrinsic :: iso_c_binding
include 'fst240/fst240_params.f90'
include 'fst4/fst4_params.f90'
parameter (MAXCAND=100)
class(fst240_decoder), intent(inout) :: this
procedure(fst240_decode_callback) :: callback
class(fst4_decoder), intent(inout) :: this
procedure(fst4_decode_callback) :: callback
character*37 decodes(100)
character*37 msg,msgsent
character*77 c77
@@ -283,7 +283,7 @@ contains
endif
! Get first approximation of candidate frequencies
call get_candidates_fst240(c_bigfft,nfft1,nsps,hmod,fs,fa,fb, &
call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb, &
minsync,ncand,candidates,base)
ndecodes=0
@@ -300,7 +300,7 @@ contains
! Output array c2 is complex baseband sampled at 12000/ndown Sa/sec.
! The size of the downsampled c2 array is nfft2=nfft1/ndown
call fst240_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2)
call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2)
call timer('sync240 ',0)
fc1=0.0
@@ -316,7 +316,7 @@ contains
do if=-12,12
fc=fc1 + 0.1*baud*if
do istart=max(1,is0-ishw),is0+ishw,4*hmod
call sync_fst240(c2,istart,fc,hmod,nsyncoh,nfft2,nss, &
call sync_fst4(c2,istart,fc,hmod,nsyncoh,nfft2,nss, &
ntrperiod,fs2,sync)
if(sync.gt.smax) then
fc2=fc
@@ -335,7 +335,7 @@ contains
do if=-7,7
fc=fc1 + 0.02*baud*if
do istart=max(1,is0-ishw),is0+ishw,isst
call sync_fst240(c2,istart,fc,hmod,nsyncoh,nfft2,nss, &
call sync_fst4(c2,istart,fc,hmod,nsyncoh,nfft2,nss, &
ntrperiod,fs2,sync)
if(sync.gt.smax) then
fc2=fc
@@ -386,7 +386,7 @@ contains
isbest=nint(candidates(icand,4))
xdt=(isbest-nspsec)/fs2
if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2
call fst240_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2)
call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2)
do ijitter=0,jittermax
if(ijitter.eq.0) ioffset=0
if(ijitter.eq.1) ioffset=1
@@ -396,9 +396,9 @@ contains
cframe=c2(is0:is0+160*nss-1)
bitmetrics=0
if(hmod.eq.1) then
call get_fst240_bitmetrics(cframe,nss,hmod,nblock,nhicoh,bitmetrics,s4,badsync)
call get_fst4_bitmetrics(cframe,nss,hmod,nblock,nhicoh,bitmetrics,s4,badsync)
else
call get_fst240_bitmetrics2(cframe,nss,hmod,nblock,bitmetrics,s4,badsync)
call get_fst4_bitmetrics2(cframe,nss,hmod,nblock,bitmetrics,s4,badsync)
endif
if(badsync) cycle
@@ -538,9 +538,9 @@ contains
decodes(ndecodes)=msg
if(iwspr.eq.0) then
call get_fst240_tones_from_bits(message101,itone,0)
call get_fst4_tones_from_bits(message101,itone,0)
else
call get_fst240_tones_from_bits(message74,itone,1)
call get_fst4_tones_from_bits(message74,itone,1)
endif
inquire(file='plotspec',exist=ex)
fmid=-999.0
@@ -581,12 +581,12 @@ contains
return
end subroutine decode
subroutine sync_fst240(cd0,i0,f0,hmod,ncoh,np,nss,ntr,fs,sync)
subroutine sync_fst4(cd0,i0,f0,hmod,ncoh,np,nss,ntr,fs,sync)
! Compute sync power for a complex, downsampled FST240 signal.
use timer_module, only: timer
include 'fst240/fst240_params.f90'
include 'fst4/fst4_params.f90'
complex cd0(0:np-1)
complex csync1,csync2,csynct1,csynct2
complex ctwk(3200)
@@ -700,9 +700,9 @@ contains
endif
sync = s1+s2+s3+s4+s5
return
end subroutine sync_fst240
end subroutine sync_fst4
subroutine fst240_downsample(c_bigfft,nfft1,ndown,f0,sigbw,c1)
subroutine fst4_downsample(c_bigfft,nfft1,ndown,f0,sigbw,c1)
! Output: Complex data in c(), sampled at 12000/ndown Hz
@@ -724,9 +724,9 @@ contains
call four2a(c1,nfft2,1,1,1) !c2c FFT back to time domain
return
end subroutine fst240_downsample
end subroutine fst4_downsample
subroutine get_candidates_fst240(c_bigfft,nfft1,nsps,hmod,fs,fa,fb, &
subroutine get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb, &
minsync,ncand,candidates,base)
complex c_bigfft(0:nfft1/2) !Full length FFT of raw data
@@ -806,13 +806,13 @@ contains
enddo
return
end subroutine get_candidates_fst240
end subroutine get_candidates_fst4
subroutine write_ref(itone,iwave,nsps,nmax,ndown,hmod,i0,fc,fmid,w50)
! On "plotspec" special request, compute Doppler spread for a decoded signal
include 'fst240/fst240_params.f90'
include 'fst4/fst4_params.f90'
complex, allocatable :: cwave(:) !Reconstructed complex signal
complex, allocatable :: g(:) !Channel gain, g(t) in QEX paper
real,allocatable :: ss(:) !Computed power spectrum of g(t)
@@ -829,7 +829,7 @@ contains
allocate(g(0:nfft-1))
wave=0
fsample=12000.0
call gen_fst240wave(itone,NN,nsps,nwave,fsample,hmod,fc,1,cwave,wave)
call gen_fst4wave(itone,NN,nsps,nwave,fsample,hmod,fc,1,cwave,wave)
cwave=cshift(cwave,-i0*ndown)
fac=1.0/32768
g(0:nmax-1)=fac*float(iwave)*conjg(cwave(:nmax-1))
@@ -905,4 +905,4 @@ contains
return
end subroutine write_ref
end module fst240_decode
end module fst4_decode