WSJT-X/lib/hopping.f90

177 lines
4.1 KiB
Fortran
Raw Normal View History

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