WSJT-X/lib/hopping.f90

subroutine txbandtot(tx,ibtot)
  integer tx(10,6), ibtot(10)
  do j=1,10
    ibtot(j)=0
    do i=1,6
      ibtot(j)=ibtot(j)+tx(j,i)
    enddo
  enddo
  return
end subroutine txbandtot

subroutine txadd(tx,iband)
!add one tx to the requested band
  integer tx(10,6)
  isuccess=0
  do k=1,10
    call random_number(rr)
    islot=rr*6
    islot=islot+1
    if( islot .gt. 6 ) then  
      write(*,*) "should not happen" 
      islot=6 
    endif
    if( tx(iband,islot).eq.0 ) then
      tx(iband,islot)=1
      isuccess=1
    endif
    if( isuccess.eq.1 ) then
      exit
    endif
  enddo
  return
end subroutine txadd 
    
subroutine txtrim(tx,ntxmax,ntot)
!limit sequential runlength to ntxmax 
  integer tx(10,6)
  nrun=0
  do i=1,6
    do j=1,10
      if( tx(j,i).eq.1 ) then        
        nrun=nrun+1
        if(nrun.gt.ntxmax) then
          tx(j,i)=0  
          nrun=0 
        endif
      else
        nrun=0
      endif
    enddo
  enddo

  ntot=0
  do j=1,10
    do i=1,6
      if(tx(j,i).eq.1) then
        ntot=ntot+1
      endif
    enddo
  enddo
return
end subroutine txtrim

subroutine hopping(nyear,month,nday,uth,mygrid,nduration,npctx,isun,   &
     iband,ntxnext)

! Determine Rx or Tx in coordinated hopping mode.

  character*6 mygrid
  integer tx(10,6)    !T/R array for 2 hours: 10 bands, 6 time slots
  real r(6)           !Random numbers
  integer ii(1),ibtot(10)
  data n2hr0/-999/
  save n2hr0,tx

  call grayline(nyear,month,nday,uth,mygrid,nduration,isun)

  ns0=uth*3600.0
  pctx=npctx
  nrx=0
  ntxnext=0
  nsec=(ns0+10)/120                   !Round up to start of next 2-min slot
  nsec=nsec*120
  n2hr=nsec/7200                      !2-hour slot number

  if(n2hr.ne.n2hr0) then
! Compute a new Rx/Tx pattern for this 2-hour interval
     n2hr0=n2hr                       !Mark this one as done
     tx=0                             !Clear the tx array
     do j=1,10                        !Loop over all 10 bands
        call random_number(r)
        do i=1,6,2                    !Select one each of 3 pairs of the 
           if(r(i).gt.r(i+1)) then    !  6 slots for Tx
              tx(j,i)=1
              r(i+1)=0.
           else
              tx(j,i+1)=1
              r(i)=0.
           endif
        enddo

        if(pctx.lt.50.0) then         !If pctx < 50, we may kill one Tx slot
           ii=maxloc(r)
           i=ii(1)
           call random_number(rr)
           rrtest=(50.0-pctx)/16.667
           if(rr.lt.rrtest) then
              tx(j,i)=0
              r(i)=0.
           endif
        endif

        if(pctx.lt.33.333) then       !If pctx < 33, may kill another
           ii=maxloc(r)
           i=ii(1)
           call random_number(rr)
           rrtest=(33.333-pctx)/16.667
           if(rr.lt.rrtest) then
              tx(j,i)=0
              r(i)=0.
           endif
        endif
     enddo

! We now have 1 to 3 Tx periods per band in the 2-hour interval.
! Now, iteratively massage the array to try to satisfy the constraints
     ntxlimit=2
     if( pctx .lt. 33.333 ) then
       minperband=1
     elseif( (pctx .ge. 33.333) .and. (pctx .lt. 50.0) ) then 
       minperband=2
     else
       minperband=3
     endif
     n_needed=60*pctx/100+0.5
! Allow up to 20 iterations
     do k=1,20
       call txtrim(tx,ntxlimit,ntot)
       call txbandtot(tx,ibtot) 
!       write(*,3001) ibtot
       do j=1,10
         if( ibtot(j).le.minperband) then
           do m=1,minperband-ibtot(j) 
             call txadd(tx,j)
           enddo
         endif
       enddo
       call txtrim(tx,ntxlimit,ntot)
       if( abs(ntot-n_needed) .le. 1 ) then
         write(*,*) "Success! Iteration converged"
         exit
       endif
!     write(*,*) "Iteration: ",k,ntot,n_needed
! iteration loop
     enddo 
     actual_pct=ntot/60.0 
     write(*,*) "Actual percentage: ",actual_pct
  endif

  iband=mod(nsec/120,10) + 1
  iseq=mod(nsec/1200,6) + 1
  if(iseq.lt.1) iseq=1
  if(tx(iband,iseq).eq.1) then
     ntxnext=1
  else
     nrx=1
  endif
  iband=iband-1

  write(*,3000) iband+1,iseq,nrx,ntxnext
3000 format('Fortran iband, iseq,nrx,ntxnext:',4i5)
     write(*,3001) int(tx)
3001 format(10i2)

  return
end subroutine hopping