mirror of
				https://github.com/saitohirga/WSJT-X.git
				synced 2025-10-31 04:50:34 -04:00 
			
		
		
		
	
		
			
				
	
	
		
			224 lines
		
	
	
		
			6.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
			
		
		
	
	
			224 lines
		
	
	
		
			6.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
| module gf64math
 | |
| ! add and subtract in GF(2^6) based on primitive polynomial x^6+x+1
 | |
| 
 | |
|    implicit none
 | |
|    integer, private ::  gf64log(0:63)
 | |
|    integer, private ::  gf64antilog(0:62)
 | |
| 
 | |
| ! table of the logarithms of the elements of GF(M) (log(0) never used)
 | |
|    data gf64log/    &
 | |
|       -1,   0,   1,   6,   2,  12,   7,  26,   3,  32,  &
 | |
|       13,  35,   8,  48,  27,  18,   4,  24,  33,  16,  &
 | |
|       14,  52,  36,  54,   9,  45,  49,  38,  28,  41,  &
 | |
|       19,  56,   5,  62,  25,  11,  34,  31,  17,  47,  &
 | |
|       15,  23,  53,  51,  37,  44,  55,  40,  10,  61,  &
 | |
|       46,  30,  50,  22,  39,  43,  29,  60,  42,  21,  &
 | |
|       20,  59,  57,  58/
 | |
| 
 | |
| ! table of GF(M) elements given their logarithm
 | |
|    data gf64antilog/   &
 | |
|       1,   2,   4,   8,  16,  32,   3,   6,  12,  24, &
 | |
|       48,  35,   5,  10,  20,  40,  19,  38,  15,  30, &
 | |
|       60,  59,  53,  41,  17,  34,   7,  14,  28,  56, &
 | |
|       51,  37,   9,  18,  36,  11,  22,  44,  27,  54, &
 | |
|       47,  29,  58,  55,  45,  25,  50,  39,  13,  26, &
 | |
|       52,  43,  21,  42,  23,  46,  31,  62,  63,  61, &
 | |
|       57,  49,  33/
 | |
| 
 | |
| contains
 | |
| 
 | |
|    integer function gf64_add(i1,i2)
 | |
|       implicit none
 | |
|       integer::i1
 | |
|       integer::i2
 | |
|       gf64_add=iand(ieor(i1,i2),63)
 | |
|    end function gf64_add
 | |
| 
 | |
|    integer function gf64_mult(i1,i2)
 | |
|       implicit none
 | |
|       integer::i1
 | |
|       integer::i2
 | |
|       integer::j
 | |
| 
 | |
|       if(i1.eq.0 .or. i2.eq.0) then
 | |
|          gf64_mult=0
 | |
|       elseif(i1.eq.1) then
 | |
|          gf64_mult=i2
 | |
|       elseif(i2.eq.1) then
 | |
|          gf64_mult=i1
 | |
|       else
 | |
|          j=mod(gf64log(i1)+gf64log(i2),63)
 | |
|          gf64_mult=gf64antilog(j)
 | |
|       endif
 | |
|    end function gf64_mult
 | |
| 
 | |
| end module gf64math
 | |
| 
 | |
| module q65_generator
 | |
| 
 | |
|    integer generator(15,50)
 | |
|    data generator/  &
 | |
|       0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, &
 | |
|       0,20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, &
 | |
|       0,20, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, &
 | |
|       0,20, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, &
 | |
|       0,20, 0, 1, 1, 0, 0, 0,10, 0, 0, 0, 0, 1, 0, &
 | |
|       0,20, 0, 1, 1, 0, 0, 0,10, 0, 0, 0,44, 1, 0, &
 | |
|       0,20, 0, 1, 1, 0, 0, 0,10, 1, 0, 0,44, 1, 0, &
 | |
|       0,20, 0, 1, 1, 0, 0, 0,10, 1, 0, 0,44, 1,14, &
 | |
|       0,20, 0, 1, 1, 0, 0, 0,10, 1,31, 0,44, 1,14, &
 | |
|       0,20, 0, 1, 1,33, 0, 0,10, 1,31, 0,44, 1,14, &
 | |
|       56,20, 0, 1, 1,33, 0, 0,10, 1,31, 0,44, 1,14, &
 | |
|       56,20, 0, 1, 1,33, 0, 1,10, 1,31, 0,44, 1,14, &
 | |
|       56, 1, 0, 1, 1,33, 0, 1,10, 1,31, 0,44, 1,14, &
 | |
|       56, 1, 0, 1, 1,33, 0, 1,10, 1,31,36,44, 1,14, &
 | |
|       56, 1, 0, 1, 1,33, 0, 1,43, 1,31,36,44, 1,14, &
 | |
|       56, 1, 0, 1, 1,33, 0, 1,43,17,31,36,44, 1,14, &
 | |
|       56, 1, 0, 1, 1,33, 0, 1,43,17,31,36,36, 1,14, &
 | |
|       56, 1, 0, 1, 1,33,53, 1,43,17,31,36,36, 1,14, &
 | |
|       56, 1, 0,35, 1,33,53, 1,43,17,31,36,36, 1,14, &
 | |
|       56, 1, 0,35, 1,33,53, 1,43,17,30,36,36, 1,14, &
 | |
|       56, 1, 0,35, 1,33,53,52,43,17,30,36,36, 1,14, &
 | |
|       56, 1, 0,35, 1,32,53,52,43,17,30,36,36, 1,14, &
 | |
|       56, 1,60,35, 1,32,53,52,43,17,30,36,36, 1,14, &
 | |
|       56, 1,60,35, 1,32,53,52,43,17,30,36,36,49,14, &
 | |
|       56, 1,60,35, 1,32,53,52,43,17,30,36,37,49,14, &
 | |
|       56, 1,60,35,54,32,53,52,43,17,30,36,37,49,14, &
 | |
|       56, 1,60,35,54,32,53,52, 1,17,30,36,37,49,14, &
 | |
|       1, 1,60,35,54,32,53,52, 1,17,30,36,37,49,14, &
 | |
|       1, 0,60,35,54,32,53,52, 1,17,30,36,37,49,14, &
 | |
|       1, 0,60,35,54,32,53,52, 1,17,30,37,37,49,14, &
 | |
|       1, 0,61,35,54,32,53,52, 1,17,30,37,37,49,14, &
 | |
|       1, 0,61,35,54,32,53,52, 1,48,30,37,37,49,14, &
 | |
|       1, 0,61,35,54,32,53,52, 1,48,30,37,37,49,15, &
 | |
|       1, 0,61,35,54, 0,53,52, 1,48,30,37,37,49,15, &
 | |
|       1, 0,61,35,54, 0,52,52, 1,48,30,37,37,49,15, &
 | |
|       1, 0,61,35,54, 0,52,52, 1,48,30,37,37, 0,15, &
 | |
|       1, 0,61,35,54, 0,52,34, 1,48,30,37,37, 0,15, &
 | |
|       1, 0,61,35,54, 0,52,34, 1,48,30,37, 0, 0,15, &
 | |
|       1, 0,61,35,54, 0,52,34, 1,48,30,20, 0, 0,15, &
 | |
|       1, 0, 0,35,54, 0,52,34, 1,48,30,20, 0, 0,15, &
 | |
|       1, 0, 0,35,54, 0,52,34, 1, 0,30,20, 0, 0,15, &
 | |
|       0, 0, 0,35,54, 0,52,34, 1, 0,30,20, 0, 0,15, &
 | |
|       0, 0, 0,35,54, 0,52,34, 1, 0,38,20, 0, 0,15, &
 | |
|       0, 0, 0,35, 0, 0,52,34, 1, 0,38,20, 0, 0,15, &
 | |
|       0, 0, 0,35, 0, 0,52, 0, 1, 0,38,20, 0, 0,15, &
 | |
|       0, 0, 0,35, 0, 0,52, 0, 1, 0,38,20, 0, 0, 0, &
 | |
|       0, 0, 0,35, 0, 0,52, 0, 0, 0,38,20, 0, 0, 0, &
 | |
|       0, 0, 0,35, 0, 0,52, 0, 0, 0,38, 0, 0, 0, 0, &
 | |
|       0, 0, 0, 0, 0, 0,52, 0, 0, 0,38, 0, 0, 0, 0, &
 | |
|       0, 0, 0, 0, 0, 0, 0, 0, 0, 0,38, 0, 0, 0, 0/
 | |
| 
 | |
| end module q65_generator
 | |
| 
 | |
| module q65_encoding
 | |
| 
 | |
| contains
 | |
| 
 | |
| subroutine q65_encode(message,codeword)
 | |
|    use gf64math
 | |
|    use q65_generator
 | |
|    integer message(15)
 | |
|    integer codeword(65)
 | |
|    integer i,j
 | |
| 
 | |
|    codeword=0
 | |
|    codeword(1:15)=message
 | |
|    do i=1,15
 | |
|       do j=16,65
 | |
|          codeword(j)=gf64_add(codeword(j),gf64_mult(message(i),generator(i,j-15)))
 | |
|       enddo
 | |
|    enddo
 | |
| 
 | |
|    return
 | |
| end
 | |
| 
 | |
| subroutine get_q65crc12(mc2,ncrc1,ncrc2)
 | |
| !
 | |
|    character c12*12,c6*6
 | |
|    integer*1 mc(90),mc2(90),tmp(6)
 | |
|    integer*1 r(13),p(13)
 | |
|    integer ncrc
 | |
| ! polynomial for 12-bit CRC 0xF01
 | |
|    data p/1,1,0,0,0,0,0,0,0,1,1,1,1/
 | |
| 
 | |
| ! flip bit order of each 6-bit symbol for consistency with Nico's calculation
 | |
|    do i=0,14
 | |
|       tmp=mc2(i*6+1:i*6+6)
 | |
|       mc(i*6+1:i*6+6)=tmp(6:1:-1)
 | |
|    enddo
 | |
| 
 | |
| ! divide by polynomial
 | |
|    r=mc(1:13)
 | |
|    do i=0,77
 | |
|       r(13)=mc(i+13)
 | |
|       r=mod(r+r(1)*p,2)
 | |
|       r=cshift(r,1)
 | |
|    enddo
 | |
| 
 | |
|    write(c6,'(6b1)') r(6:1:-1)
 | |
|    read(c6,'(b6.6)') ncrc1
 | |
|    read(c6,'(6b1)') mc2(79:84)
 | |
|    write(c6,'(6b1)') r(12:7:-1)
 | |
|    read(c6,'(b6.6)') ncrc2
 | |
|    read(c6,'(6b1)') mc2(85:90)
 | |
| 
 | |
| end subroutine get_q65crc12
 | |
| 
 | |
| subroutine get_q65_tones(msg37,codeword,itone)
 | |
|    use packjt77
 | |
|    implicit none
 | |
|    character*37 msg37
 | |
|    character*77 c77
 | |
|    character*12 c12
 | |
|    character*6  c6
 | |
|    integer codeword(65)
 | |
|    integer sync(22)
 | |
|    integer message(15)
 | |
|    integer shortcodeword(63)
 | |
|    integer itone(85)
 | |
|    integer i,j,k
 | |
|    integer*1 mbits(90)
 | |
|    integer i3,n3,ncrc1,ncrc2
 | |
|    data sync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/
 | |
| 
 | |
|    i3=-1
 | |
|    n3=-1
 | |
|    call pack77(msg37,i3,n3,c77)
 | |
|    mbits=0
 | |
|    read(c77,'(77i1)') mbits(1:77)
 | |
| 
 | |
| ! Message is 77 bits long. Add a 0 bit to create a 78-bit message and pad with 
 | |
| ! 12 zeros to create 90-bit mbit array for CRC calculation. 
 | |
|    call get_q65crc12(mbits,ncrc1,ncrc2)
 | |
| 
 | |
| ! Now have message in bits 1:78 and CRC in bits 79:90.
 | |
| ! Group message bits into 15 6-bit symbols:
 | |
|    do i=0,14
 | |
|       write(c6,'(6i1)') mbits( (i*6+1):(i*6+6) )
 | |
|       read(c6,'(b6.6)') message(i+1)
 | |
|    enddo
 | |
| 
 | |
| ! Encode to create a 65-symbol codeword
 | |
|    call q65_encode(message,codeword)
 | |
| 
 | |
| !Shorten the codeword by omitting the CRC symbols (symbols 14 and 15)
 | |
|    shortcodeword(1:13)=codeword(1:13)
 | |
|    shortcodeword(14:63)=codeword(16:65)
 | |
| 
 | |
| !Insert sync symbols to create array of channel symbols
 | |
|    j=1
 | |
|    k=0
 | |
|    do i=1,85
 | |
|       if(i.eq.sync(j)) then
 | |
|          j=j+1
 | |
|          itone(i)=0
 | |
|       else
 | |
|          k=k+1
 | |
|          itone(i)=shortcodeword(k)+1
 | |
|       endif
 | |
|    enddo
 | |
| end subroutine get_q65_tones
 | |
| 
 | |
| end module q65_encoding
 |