| 1 | subroutine f_get_coeff(nn,mm,rr,ww,avec,nj,id,pp,np) |
|---|
| 2 | !=============================================================================== |
|---|
| 3 | ! Compute MT jump ahead polynomial coefficients |
|---|
| 4 | ! uses GF(2)[x] computation |
|---|
| 5 | !=============================================================================== |
|---|
| 6 | use mt_kind_defs |
|---|
| 7 | use gf2xe |
|---|
| 8 | implicit none |
|---|
| 9 | integer(INT32), intent(in) :: nn,mm,rr,ww,avec,nj,id |
|---|
| 10 | integer(INT32), intent(inout) :: pp(0:nn-1),np |
|---|
| 11 | type(gf2x_obj) :: af,bf,ff,f1,f2 |
|---|
| 12 | type(gf2x_prime_obj) :: fp |
|---|
| 13 | integer(INT32) :: i,ib,nws |
|---|
| 14 | |
|---|
| 15 | !============================== |
|---|
| 16 | ! MT characteristic polynomial |
|---|
| 17 | ! ff : MT char poly. |
|---|
| 18 | !============================== |
|---|
| 19 | call set_coef(af,nn) |
|---|
| 20 | call set_coef(af,mm) ! af = x^nn + x^mm |
|---|
| 21 | call set_coef(bf,nn-1) |
|---|
| 22 | call set_coef(bf,mm-1) ! bf = x^(nn-1) + x^(mm-1) |
|---|
| 23 | |
|---|
| 24 | call pow(f1,af,ww-rr) ! f1 = af^(ww-rr) |
|---|
| 25 | call pow(f2,bf,rr) ! f2 = bf^(rr) |
|---|
| 26 | call mult(ff,f1,f2) ! ff = f1*f2 |
|---|
| 27 | do i=0,rr-1 |
|---|
| 28 | ib = mod(i,ww) |
|---|
| 29 | if (BTEST(avec,ib)) then |
|---|
| 30 | call pow(f2,bf,rr-1-i) |
|---|
| 31 | call mult_assign(f2,f1) |
|---|
| 32 | call add_assign(ff,f2) |
|---|
| 33 | endif |
|---|
| 34 | enddo |
|---|
| 35 | do i=rr,ww-1 |
|---|
| 36 | ib = mod(i,ww) |
|---|
| 37 | if (BTEST(avec,ib)) then |
|---|
| 38 | call pow(f1,af,ww-1-i) |
|---|
| 39 | call add_assign(ff,f1) |
|---|
| 40 | endif |
|---|
| 41 | enddo |
|---|
| 42 | |
|---|
| 43 | !#ifdef _DEBUG_ |
|---|
| 44 | ! write(*,'("@",$)') |
|---|
| 45 | ! call print_hex(ff) |
|---|
| 46 | !#endif |
|---|
| 47 | |
|---|
| 48 | call delete(af) |
|---|
| 49 | call delete(bf) |
|---|
| 50 | call delete(f1) |
|---|
| 51 | call delete(f2) |
|---|
| 52 | |
|---|
| 53 | !============================== |
|---|
| 54 | ! set ff for Barrett reduction |
|---|
| 55 | !============================== |
|---|
| 56 | call set_prime(fp,ff) ! fp = ff |
|---|
| 57 | call delete(ff) |
|---|
| 58 | call delete(f1) |
|---|
| 59 | call delete(f2) |
|---|
| 60 | |
|---|
| 61 | !=============== |
|---|
| 62 | ! jump ahead |
|---|
| 63 | ! long jump |
|---|
| 64 | !=============== |
|---|
| 65 | call gf2x_pow_pow_2(f1,nj,fp) ! f1 = x**(2**nj) mod fp |
|---|
| 66 | |
|---|
| 67 | !#ifdef _DEBUG_ |
|---|
| 68 | ! write(*,'("@",$)') |
|---|
| 69 | ! call print_hex(f1) |
|---|
| 70 | !#endif |
|---|
| 71 | |
|---|
| 72 | !=============== |
|---|
| 73 | ! short jump |
|---|
| 74 | !=============== |
|---|
| 75 | call pow(ff,f1,id,fp) ! ff = f1**id mod fp |
|---|
| 76 | |
|---|
| 77 | !#ifdef _DEBUG_ |
|---|
| 78 | ! write(*,'("@",$)') |
|---|
| 79 | ! call print_hex(ff) |
|---|
| 80 | !#endif |
|---|
| 81 | |
|---|
| 82 | pp(:) = 0 |
|---|
| 83 | np = get_deg(ff)+1 |
|---|
| 84 | nws = CEILING(real(np,kind=KIND(1.0d0))/32) |
|---|
| 85 | pp(0:nws-1) = ff%c(0:nws-1) |
|---|
| 86 | |
|---|
| 87 | call delete(f1) |
|---|
| 88 | call delete(f2) |
|---|
| 89 | call delete(ff) |
|---|
| 90 | call delete(fp) |
|---|
| 91 | |
|---|
| 92 | return |
|---|
| 93 | end subroutine |
|---|
