⟦f1dff36ea⟧

TextFile

*****************************************************************************
*
* subroutine issovlp(segnumb) does the following:
* (is segment overlap)
*    + segment number (segnumb)
*    + initialize list (lstovlp)
*    + is (segnumb) overlaps other segments
*     - yes-->
*       * access overlapping table (iovlap)
*         to build a primary list of all 
*         segments that overlaps (segnumb)
*       * loop
*         # extend list by repeating previous
*           step for each member of list
*         # go to loop until no new members
*           are generated
*           (This method will include all
*            the necessary segments in list
*            (lstovlp) )
*       * sort list (lstovlp) in an ascending
*         manner
*       * mark duplicate entries in (lstovlp)
*       * delete duplicates
*       * resulting list (lstovlp) with (jo)
*         as number of elements in list.
*     - no-->
*       * return with (lstovlp) containing zeros
*         and (jo = 0)
*****************************************************************************
	subroutine issovlp(segnumb)
	integer segnumb
	common/ovlap/iovlap(21,21)
	common/num/numitms
	common lstovlp(380),jo
	integer listdup(360),contr1,contr2,cseg
	integer n,n1,k,i,m,ansseg
c
c  initialize list (lstovlp) and (jo).
	do 20 j=1,380
	  lstovlp(j)=0
20	continue
	jo=1
c
c build primary list of all segments that 
c overlaps (segnumb),then take care of
c special case (segnumb) overlaps
c segment page call (osegp).
	do 23 i=1,numitms
	  if(iovlap(segnumb,i).eq.1)then
	       lstovlp(jo)=i
               jo=jo+1
	  endif
23	continue
	call osegp(segnumb)
c
c extend list by considering each of its
c members one at a time,find segments
c that overlaps it and record results in
c (lstovlp).
	contr1=jo
	do 35 i=1,jo-1
	  k=lstovlp(i)
	if(segnumb.eq.1)then
	                    n1=1
	else
	                    n1=k+1
	endif
	   do 37 n=n1,numitms
	     if(iovlap(k,n).eq.1)then
	       lstovlp(jo)=n
	       jo=jo+1
	     endif
37	   continue
	   call osegp(k)
35	continue
c
c This is a loop that extend list to include
c other necessary segments,stop when loop
c cannot generate more segments.
c
	contr2=jo-1
	cseg=lstovlp(1)
	k=lstovlp(contr1)
c
45	if(k.gt.cseg)then
	   do 46 i=contr1,contr2
	      k=lstovlp(i)
	     do 47 n=k+1,numitms
	        if(iovlap(k,n).eq.1)then
	          lstovlp(jo)=n
	          jo=jo+1
	        endif
47	     continue
	     call osegp(k)
46	   continue
	cseg=lstovlp(contr1)
	contr1=contr2+1
	contr2=jo-1
	k=lstovlp(contr1)
	go to 45
	endif
c sort list (lstovlp) in an ascending manner.
	jo=jo-1
	call sortlst
c mark duplicate entries in (lstovlp).
	m=1
	do 39 i=1,jo
	   iseg=lstovlp(i)
	  do 40 k=i+1,jo
	  if(i.gt.1.and.iseg.eq.lstovlp(i-1))then
	    k=jo+1
	  else
	     if(iseg.eq.lstovlp(k))then
	       listdup(m)=k
	       m=m+1
	     endif
	   endif
40	  continue
39	continue
	m=m-1
c delete duplicate entries in list (lstovlp).
	do 44 i=m,1,-1
	   ientry=listdup(i)
	   call dlentry(ientry)
44	continue
	jo=jo-m
c
c check if segment (segnumb) is included in
c list (lstovlp) if so return else insert
c segment (segnumb) in (lstovlp).
c
	call findsg(segnumb,ansseg)
	  if(ansseg.eq.0)then
	    jo=jo+1
	    lstovlp(jo)=segnumb
	    call sortlst
	  endif
c
c list (lstovlp) is complete
c
	return
	end
*************************************************************************
*
* subroutine findsg(sgnum,ans) does the following:
*************************************************************************
	subroutine findsg(sgnum,ans)
	integer sgnum,ans
	common lstovlp(380),jo
c
	ans=0
	do 20 i=1,jo
	  if(lstovlp(i).eq.sgnum)then
	     ans=1
	     return
	  endif
20	continue
	return
	end
*************************************************************************
*
* subroutine osegp(segnum) does the following:
* (overlap segment page)
*     + segment number (segnum)
*     + is segment (segnum) overlaps segment page?
*      - yes-->
*        * include segment page in (lstovlp)
*      - no-->
*        * return
*
*************************************************************************
	subroutine osegp(segnum)
	integer segnum
	common/ovlap/iovlap(21,21)
	common lstovlp(380),jo
c
	if(iovlap(segnum,21).eq.1)then
	   lstovlp(jo)=21
	   jo=jo+1
	endif
	return
	end
*************************************************************************
*
* subroutine dlentry(sentry) does the following:
* (delete entry)
*     + segment entry in (lstovlp) is (sentry)
*     + delete entry (sentry) from (lstovlp)
*     + update list due to deletion.
*
*************************************************************************
	subroutine dlentry(sentry)
	integer sentry
	common lstovlp(380),jo
c
	if(sentry.gt.0)then
	do 36 i=sentry,jo
	   lstovlp(i)=lstovlp(i+1)
36	continue
	endif
	return
	end
***************************************************************************
*
* subroutine search(oneseg,index) does the following:
*  (search)
*      + segment number (oneseg)
*      + search for segment (oneseg) in (lstovlp)
*      + found?
*       - yes-->
*         * return its entry in (index)
*       - no-->
*         * return (index=0)
*
***************************************************************************
	subroutine search(oneseg,index)
	integer oneseg,index
	common lstovlp(380),jo
c
	index=0
	do 25 i=1,jo
	  if(lstovlp(i).eq.oneseg)then
	      index=i
	      return
	  endif
25	continue
	return
	end
***************************************************************************
*
* subroutine sortlst does the following:
*  (sort list)
*      + sort list (lstovlp) in an ascending
*        manner
*      + method of sorting: (bubble sort)
*
***************************************************************************
	subroutine sortlst
	common lstovlp(380),jo
	integer temp,pairs
	logical done
c
c using bubble sort routine .
	pairs=jo-1
	done=.false.
c while done is false do the following.
20	if(.not.done)then
	   done=.true.
c scan the list comparing consecutive items.
	   do 30 i=1,pairs
	     if(lstovlp(i).gt.lstovlp(i+1))then
c items out of order, interchange them and set (done) to (false).
	     temp=lstovlp(i)
	     lstovlp(i)=lstovlp(i+1)
	     lstovlp(i+1)=temp
	     done=.false.
	     endif
30	    continue
c largest item has sunk into palce so eliminate it on next pass.
	pairs=pairs-1
	go to 20
	endif
	return
	end
**************************************************************************
*
* subroutine blnkrow(row) does the following:
* (blank row and column)
*      + set row (row) and column (row) to 
*        zeros in overlapping table (iovlap)
*        to keep table symmetrical.
*
**************************************************************************
	subroutine blnkrow(row)
	integer row
	common/ovlap/iovlap(21,21)
c
	do 50 i=1,21
	    iovlap(row,i)=0
	    iovlap(i,row)=0
50	continue
	return
	end
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦f1dff36ea⟧ TextFile

Derivation

TextFile
