diff --git a/CMakeLists.txt b/CMakeLists.txt index 68d97f99d..6663ff4e7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -434,8 +434,6 @@ set (wsjt_FSRCS lib/extract.f90 lib/extract4.f90 lib/extractmessage77.f90 - lib/ft8/extractmessage174.f90 - lib/ft8/extractmessage174_91.f90 lib/fano232.f90 lib/fast9.f90 lib/fast_decode.f90 @@ -466,7 +464,6 @@ set (wsjt_FSRCS lib/ft8/ft8b.f90 lib/ft8/ft8code.f90 lib/ft8/ft8_downsample.f90 - lib/ft8/ft8sim_fsk.f90 lib/ft8/ft8sim.f90 lib/gen4.f90 lib/gen65.f90 @@ -1316,9 +1313,6 @@ target_link_libraries (ft8code wsjt_fort wsjt_cxx) add_executable (ft4code lib/ft4/ft4code.f90 wsjtx.rc) target_link_libraries (ft4code wsjt_fort wsjt_cxx) -add_executable (ft8sim_fsk lib/ft8/ft8sim_fsk.f90 wsjtx.rc) -target_link_libraries (ft8sim_fsk wsjt_fort wsjt_cxx) - add_executable (ft8sim lib/ft8/ft8sim.f90 wsjtx.rc) target_link_libraries (ft8sim wsjt_fort wsjt_cxx) diff --git a/lib/ft8/encode174_91.f90 b/lib/ft8/encode174_91.f90 index 0ffa4841a..5bae7d564 100644 --- a/lib/ft8/encode174_91.f90 +++ b/lib/ft8/encode174_91.f90 @@ -2,57 +2,57 @@ subroutine encode174_91(message77,codeword) ! ! Add a 14-bit CRC to a 77-bit message and return a 174-bit codeword ! -use, intrinsic :: iso_c_binding -use iso_c_binding, only: c_loc,c_size_t -use crc + use, intrinsic :: iso_c_binding + use iso_c_binding, only: c_loc,c_size_t + use crc -integer, parameter:: N=174, K=91, M=N-K -character*91 tmpchar -integer*1 codeword(N) -integer*1 gen(M,K) -integer*1 message77(77),message(K) -integer*1 pchecks(M) -integer*1, target :: i1MsgBytes(12) -include "ldpc_174_91_c_generator.f90" -logical first -data first/.true./ -save first,gen + integer, parameter:: N=174, K=91, M=N-K + character*91 tmpchar + integer*1 codeword(N) + integer*1 gen(M,K) + integer*1 message77(77),message(K) + integer*1 pchecks(M) + integer*1, target :: i1MsgBytes(12) + include "ldpc_174_91_c_generator.f90" + logical first + data first/.true./ + save first,gen -if( first ) then ! fill the generator matrix - gen=0 - do i=1,M - do j=1,23 - read(g(i)(j:j),"(Z1)") istr - ibmax=4 - if(j.eq.23) ibmax=3 - do jj=1, ibmax - icol=(j-1)*4+jj - if( btest(istr,4-jj) ) gen(i,icol)=1 - enddo - enddo - enddo -first=.false. -endif + if( first ) then ! fill the generator matrix + gen=0 + do i=1,M + do j=1,23 + read(g(i)(j:j),"(Z1)") istr + ibmax=4 + if(j.eq.23) ibmax=3 + do jj=1, ibmax + icol=(j-1)*4+jj + if( btest(istr,4-jj) ) gen(i,icol)=1 + enddo + enddo + enddo + first=.false. + endif ! Add 14-bit CRC to form 91-bit message+CRC14 -write(tmpchar,'(77i1)') message77 -tmpchar(78:80)='000' -i1MsgBytes=0 -read(tmpchar,'(10b8)') i1MsgBytes(1:10) -ncrc14 = crc14 (c_loc (i1MsgBytes), 12) -write(tmpchar(78:91),'(b14)') ncrc14 -read(tmpchar,'(91i1)') message + write(tmpchar,'(77i1)') message77 + tmpchar(78:80)='000' + i1MsgBytes=0 + read(tmpchar,'(10b8)') i1MsgBytes(1:10) + ncrc14 = crc14 (c_loc (i1MsgBytes), 12) + write(tmpchar(78:91),'(b14)') ncrc14 + read(tmpchar,'(91i1)') message -do i=1,M - nsum=0 - do j=1,K - nsum=nsum+message(j)*gen(i,j) - enddo - pchecks(i)=mod(nsum,2) -enddo + do i=1,M + nsum=0 + do j=1,K + nsum=nsum+message(j)*gen(i,j) + enddo + pchecks(i)=mod(nsum,2) + enddo -codeword(1:K)=message -codeword(K+1:N)=pchecks + codeword(1:K)=message + codeword(K+1:N)=pchecks -return + return end subroutine encode174_91 diff --git a/lib/ft8/encode174_91_nocrc.f90 b/lib/ft8/encode174_91_nocrc.f90 index 8197e0762..371e83170 100644 --- a/lib/ft8/encode174_91_nocrc.f90 +++ b/lib/ft8/encode174_91_nocrc.f90 @@ -1,49 +1,49 @@ subroutine encode174_91_nocrc(message,codeword) ! -! Encode a 91-bit message and return a 174-bit codeword. +! Encode a 91-bit message and return a 174-bit codeword. ! -use, intrinsic :: iso_c_binding -use iso_c_binding, only: c_loc,c_size_t -use crc + use, intrinsic :: iso_c_binding + use iso_c_binding, only: c_loc,c_size_t + use crc -integer, parameter:: N=174, K=91, M=N-K -character*91 tmpchar -integer*1 codeword(N) -integer*1 gen(M,K) -integer*1 message(K) -integer*1 pchecks(M) -integer*1, target :: i1MsgBytes(12) -include "ldpc_174_91_c_generator.f90" -logical first -data first/.true./ -save first,gen + integer, parameter:: N=174, K=91, M=N-K + character*91 tmpchar + integer*1 codeword(N) + integer*1 gen(M,K) + integer*1 message(K) + integer*1 pchecks(M) + integer*1, target :: i1MsgBytes(12) + include "ldpc_174_91_c_generator.f90" + logical first + data first/.true./ + save first,gen -if( first ) then ! fill the generator matrix - gen=0 - do i=1,M - do j=1,23 - read(g(i)(j:j),"(Z1)") istr - ibmax=4 - if(j.eq.23) ibmax=3 - do jj=1, ibmax - icol=(j-1)*4+jj - if( btest(istr,4-jj) ) gen(i,icol)=1 - enddo - enddo - enddo -first=.false. -endif + if( first ) then ! fill the generator matrix + gen=0 + do i=1,M + do j=1,23 + read(g(i)(j:j),"(Z1)") istr + ibmax=4 + if(j.eq.23) ibmax=3 + do jj=1, ibmax + icol=(j-1)*4+jj + if( btest(istr,4-jj) ) gen(i,icol)=1 + enddo + enddo + enddo + first=.false. + endif -do i=1,M - nsum=0 - do j=1,K - nsum=nsum+message(j)*gen(i,j) - enddo - pchecks(i)=mod(nsum,2) -enddo + do i=1,M + nsum=0 + do j=1,K + nsum=nsum+message(j)*gen(i,j) + enddo + pchecks(i)=mod(nsum,2) + enddo -codeword(1:K)=message -codeword(K+1:N)=pchecks + codeword(1:K)=message + codeword(K+1:N)=pchecks -return + return end subroutine encode174_91_nocrc diff --git a/lib/ft8/extractmessage174.f90 b/lib/ft8/extractmessage174.f90 deleted file mode 100644 index 252547c43..000000000 --- a/lib/ft8/extractmessage174.f90 +++ /dev/null @@ -1,40 +0,0 @@ -subroutine extractmessage174(decoded,msgreceived,ncrcflag) - use iso_c_binding, only: c_loc,c_size_t - use crc - use packjt - - character*22 msgreceived - character*87 cbits - integer*1 decoded(87) - integer*1, target:: i1Dec8BitBytes(11) - integer*4 i4Dec6BitWords(12) - -! Write decoded bits into cbits: 75-bit message plus 12-bit CRC - write(cbits,1000) decoded -1000 format(87i1) - read(cbits,1001) i1Dec8BitBytes -1001 format(11b8) - read(cbits,1002) ncrc12 !Received CRC12 -1002 format(75x,b12) - - i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),transfer(128+64+32,0_1)) - i1Dec8BitBytes(11)=0 - icrc12=crc12(c_loc(i1Dec8BitBytes),11) !CRC12 computed from 75 msg bits - - if(ncrc12.eq.icrc12 .or. sum(decoded(57:87)).eq.0) then !### Kludge ### -! CRC12 checks out --- unpack 72-bit message - do ibyte=1,12 - itmp=0 - do ibit=1,6 - itmp=ishft(itmp,1)+iand(1_1,decoded((ibyte-1)*6+ibit)) - enddo - i4Dec6BitWords(ibyte)=itmp - enddo - call unpackmsg(i4Dec6BitWords,msgreceived) - ncrcflag=1 - else - msgreceived=' ' - ncrcflag=-1 - endif - return - end subroutine extractmessage174 diff --git a/lib/ft8/extractmessage174_91.f90 b/lib/ft8/extractmessage174_91.f90 deleted file mode 100644 index ecc142469..000000000 --- a/lib/ft8/extractmessage174_91.f90 +++ /dev/null @@ -1,40 +0,0 @@ -subroutine extractmessage174_91(decoded,msgreceived,ncrcflag) - use iso_c_binding, only: c_loc,c_size_t - use crc - use packjt - - character*22 msgreceived - character*91 cbits - integer*1 decoded(91) - integer*1, target:: i1Dec8BitBytes(12) - integer*4 i4Dec6BitWords(12) - -! Write decoded bits into cbits: 77-bit message plus 14-bit CRC - write(cbits,1000) decoded -1000 format(91i1) - read(cbits,1001) i1Dec8BitBytes -1001 format(12b8) - read(cbits,1002) ncrc14 !Received CRC12 -1002 format(77x,b14) - - i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),transfer(128+64+32+16+8,0_1)) - i1Dec8BitBytes(11:12)=0 - icrc14=crc14(c_loc(i1Dec8BitBytes),12) !CRC12 computed from 75 msg bits - - if(ncrc14.eq.icrc14 .or. sum(decoded(57:87)).eq.0) then !### Kludge ### -! CRC14 checks out --- unpack 72-bit message - do ibyte=1,12 - itmp=0 - do ibit=1,6 - itmp=ishft(itmp,1)+iand(1_1,decoded((ibyte-1)*6+ibit)) - enddo - i4Dec6BitWords(ibyte)=itmp - enddo - call unpackmsg(i4Dec6BitWords,msgreceived) - ncrcflag=1 - else - msgreceived=' ' - ncrcflag=-1 - endif - return - end subroutine extractmessage174_91 diff --git a/lib/ft8/ft8sim_fsk.f90 b/lib/ft8/ft8sim_fsk.f90 deleted file mode 100644 index c5dd82bb7..000000000 --- a/lib/ft8/ft8sim_fsk.f90 +++ /dev/null @@ -1,141 +0,0 @@ -program ft8sim - -! Generate simulated "type 2" ft8 files -! Output is saved to a *.wav file. - - use wavhdr - use packjt77 - include 'ft8_params.f90' !Set various constants - parameter (NWAVE=NN*NSPS) - type(hdr) h !Header for .wav file - character arg*12,fname*17 - character msg37*37,msgsent37*37 - character c77*77 - complex c0(0:NMAX-1) - complex c(0:NMAX-1) - real wave(NMAX) - integer itone(NN) - integer*1 msgbits(77) - integer*2 iwave(NMAX) !Generated full-length waveform - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.8) then - print*,'Usage: ft8sim "message" f0 DT fdop del width nfiles snr' - print*,'Examples: ft8sim "K1ABC W9XYZ EN37" 1500.0 0.0 0.1 1.0 0 10 -18' - print*,' ft8sim "WA9XYZ/R KA1ABC/R FN42" 1500.0 0.0 0.1 1.0 0 10 -18' - print*,' ft8sim "K1ABC RR73; W9XYZ -11" 300 0 0 0 25 1 -10' - go to 999 - endif - call getarg(1,msg37) !Message to be transmitted - call getarg(2,arg) - read(arg,*) f0 !Frequency (only used for single-signal) - call getarg(3,arg) - read(arg,*) xdt !Time offset from nominal (s) - call getarg(4,arg) - read(arg,*) fspread !Watterson frequency spread (Hz) - call getarg(5,arg) - read(arg,*) delay !Watterson delay (ms) - call getarg(6,arg) - read(arg,*) width !Filter transition width (Hz) - call getarg(7,arg) - read(arg,*) nfiles !Number of files - call getarg(8,arg) - read(arg,*) snrdb !SNR_2500 - - nsig=1 - if(f0.lt.100.0) then - nsig=f0 - f0=1500 - endif - - nfiles=abs(nfiles) - twopi=8.0*atan(1.0) - fs=12000.0 !Sample rate (Hz) - dt=1.0/fs !Sample interval (s) - tt=NSPS*dt !Duration of symbols (s) - baud=1.0/tt !Keying rate (baud) - bw=8*baud !Occupied bandwidth (Hz) - txt=NZ*dt !Transmission length (s) - bandwidth_ratio=2500.0/(fs/2.0) - sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb) - if(snrdb.gt.90.0) sig=1.0 - txt=NN*NSPS/12000.0 - - ! Source-encode, then get itone() - i3=-1 - n3=-1 - call pack77(msg37,i3,n3,c77) - call genft8(msg37,i3,n3,msgsent37,msgbits,itone) - - write(*,*) - write(*,'(a23,a37,3x,a7,i1,a1,i1)') 'New Style FT8 Message: ',msgsent37,'i3.n3: ',i3,'.',n3 - write(*,1000) f0,xdt,txt,snrdb,bw -1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, & - ' BW:',f4.1) - write(*,*) - if(i3.eq.1) then - write(*,*) ' mycall hiscall hisgrid' - write(*,'(28i1,1x,i1,1x,28i1,1x,i1,1x,i1,1x,15i1,1x,3i1)') msgbits(1:77) - else - write(*,'(a14)') 'Message bits: ' - write(*,'(77i1)') msgbits - endif - write(*,*) - write(*,'(a17)') 'Channel symbols: ' - write(*,'(79i1)') itone - write(*,*) - - call sgran() - - msg0=msg - do ifile=1,nfiles - k=nint((xdt+0.5)/dt) - ia=max(1,k) - phi=0.0 - c0=0.0 - do j=1,NN !Generate complex waveform - dphi=twopi*(f0*dt+itone(j)/real(NSPS)) - do i=1,NSPS - if(k.ge.0 .and. k.lt.NMAX) c0(k)=cmplx(cos(phi),sin(phi)) - k=k+1 - phi=mod(phi+dphi,twopi) - enddo - enddo - if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c0,NMAX,NWAVE,fs,delay,fspread) - c=sig*c0 - - ib=min(k,NMAX) - wave=real(c) - peak=maxval(abs(wave(ia:ib))) - nslots=1 - if(width.gt.0.0) call filt8(f0,nslots,width,wave) - - if(snrdb.lt.90) then - do i=1,NMAX !Add gaussian noise at specified SNR - xnoise=gran() - wave(i)=wave(i) + xnoise - enddo - endif - - gain=100.0 - if(snrdb.lt.90.0) then - wave=gain*wave - else - datpk=maxval(abs(wave)) - fac=32766.9/datpk - wave=fac*wave - endif - if(any(abs(wave).gt.32767.0)) print*,"Warning - data will be clipped." - iwave=nint(wave) - - h=default_header(12000,NMAX) - write(fname,1102) ifile -1102 format('000000_',i6.6,'.wav') - open(10,file=fname,status='unknown',access='stream') - write(10) h,iwave !Save to *.wav file - close(10) - write(*,1110) ifile,xdt,f0,snrdb,fname -1110 format(i4,f7.2,f8.2,f7.1,2x,a17) - enddo -999 end program ft8sim