Try to ensure that the hopping table satisfies runlength and number of transmissions-per-hour constraints.

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@5482 ab8295b8-cf94-4d9e-aec4-7959e3be5d79

lib/hopping.f90

@@ -1,3 +1,66 @@
+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)
 
@@ -6,7 +69,7 @@ subroutine hopping(nyear,month,nday,uth,mygrid,nduration,npctx,isun,   &
   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)
+  integer ii(1),ibtot(10)
   data n2hr0/-999/
   save n2hr0,tx
 
@@ -60,55 +123,38 @@ subroutine hopping(nyear,month,nday,uth,mygrid,nduration,npctx,isun,   &
      enddo
 
 ! We now have 1 to 3 Tx periods per band in the 2-hour interval.
-! Now go through and limit the number of successive Tx's to two.
-     icnt=0
-     isum=0
-     nkilled=0
-     do i=1,6
+! 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( tx(j,i).eq.1 ) then
-           icnt=icnt+1
-           if( icnt.gt.2 ) then
-             tx(j,i)=0  
-             nkilled=nkilled+1
-             icnt=0
-           endif
-         endif
-         isum=isum+tx(j,i)
-       enddo
-     enddo
-     actual_pct=isum/60.0 
-     write(*,*) "Actual pct = ",actual_pct," nkilled = ",nkilled
-! Not try to put back the slots that were zero'd without causing new runs
-     nz=0
-     do i=1,6
-       do j=1,10
-         if( tx(j,i).eq.0 ) then
-           nz=nz+1
-           if( (nz.eq.3) .and. (nkilled.gt.0) ) then
-             if(j.ge.2) then
-               tx(j-1,i) = 1
-               nkilled=nkilled-1
-             elseif(i.gt.1) then
-               tx(10,i-1) = 1
-               nkilled=nkilled-1
-             endif
-             nz=0
-           endif
+         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 
-
-     isum=0
-     do i=1,6
-       do j=1,10
-         if( tx(j,i) .eq. 1 ) then
-           isum=isum+1
-         endif
-       enddo
-     enddo
-     actual_pct=isum/60.0
-     write(*,*) "Actual pct = ",actual_pct," nkilled = ",nkilled
+     actual_pct=ntot/60.0 
+     write(*,*) "Actual percentage: ",actual_pct
   endif
 
   iband=mod(nsec/120,10) + 1
@@ -121,7 +167,7 @@ subroutine hopping(nyear,month,nday,uth,mygrid,nduration,npctx,isun,   &
   endif
   iband=iband-1
 
-  write(*,3000) iband,iseq,nrx,ntxnext
+  write(*,3000) iband+1,iseq,nrx,ntxnext
 3000 format('Fortran iband, iseq,nrx,ntxnext:',4i5)
      write(*,3001) int(tx)
 3001 format(10i2)