mirror of
				https://github.com/saitohirga/WSJT-X.git
				synced 2025-10-29 20:10:28 -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
 |