From 01d60d448a09cff5d024926a489a8a88dc23b836 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sun, 31 May 2015 19:12:51 +0000 Subject: [PATCH] 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 | 140 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 93 insertions(+), 47 deletions(-) diff --git a/lib/hopping.f90 b/lib/hopping.f90 index a5018a20a..108e40473 100644 --- a/lib/hopping.f90 +++ b/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)