c c ADTOCL c c This function adds a string to a list of character strings if c that string is not in the list. It returns the index number of c the character string if the insert was successful or the string c already was in the list. It returns a value of 0 if there is no c more room in the list. Do not use this function for creating c sorted lists as it uses a linear search technique. c integer*4 function adtocl(list,size,n,entry) integer size,n character list(1)*(*),entry*(*) c c Arguments: c list The list to be added to c size The maximum number of elements in the list c entry The new entry to be added c n The current number of items in the list c do 100 i=1,n if(list(i).eq.entry)goto 200 100 continue if(n.lt.size)then n=n+1 list(n)=entry adtocl=n else adtocl=0 endif return 200 adtocl=i return end c c ADTOIL c c This function adds a number to a list of integers if c that integer is not in the list. It returns the index number of c the integer if the insert was successful or the integer c already was in the list. It returns a value of 0 if there is no c more room in the list. Do not use this function for creating c sorted lists as it uses a linear search technique. c integer*4 function adtoil(list,size,n,entry) integer*4 size,n integer*4 list(1),entry c c Arguments: c list The list to be added to c size The maximum number of elements in the list c n The current number of items in the list (updated) c entry The new entry to be added c do 100 i=1,n if(list(i).eq.entry)goto 200 100 continue if(n.lt.size)then n=n+1 list(n)=entry adtoil=n else adtoil=0 endif return 200 adtoil=i return end c c CBSRCH c c This function does a binary search on a list of character items c and returns the index number of the entry sought. If the entry is c not present, then the function returns the value .false., otherwise c it returns .true. c logical function cbsrch(list,size,which,item) integer size,which,hi,lo,mid character list(1)*(*),item*(*) c c Arguments are: c list The list to be searched c size The number of items in list c which The index number if the item is found c item The item number to be searched for c if (size.le.0)goto 300 lo=1 hi=size 100 mid=(lo+hi)/2 if(list(mid).eq.item)goto 200 if(list(mid).lt.item)goto 150 hi=mid-1 if(hi.lt.lo)goto 300 goto 100 150 lo=mid+1 if(lo.gt.hi)goto 300 goto 100 200 cbsrch=.true. which=mid return 300 cbsrch=.false. which = 0 return end c c IBSRCH c c This function does a binary search on a list of integer items c and returns the index number of the entry sought. If the entry is c not present, then the function returns the value .false., otherwise c it returns .true. c logical function ibsrch(list,size,which,item) integer size,which,hi,lo,mid integer list(1),item c c Arguments are: c list The list to be searched c size The number of items in list c which The index number if the item is found c item The item number to be searched for c lo=1 hi=size 100 mid=(lo+hi)/2 if(list(mid).eq.item)goto 200 if(list(mid).lt.item)goto 150 hi=mid-1 if(hi.lt.lo)goto 300 goto 100 150 lo=mid+1 if(lo.gt.hi)goto 300 goto 100 200 ibsrch=.true. which=mid return 300 ibsrch=.false. which = 0 return end c c integer*4 function isinil(list,size,entry) implicit integer*4 (a-z) integer list(1) c c Returns index of entry in unsorted integer list. c Returns 0 if not in list. c do 100 i=1,size if(list(i).eq.entry)goto 150 100 continue isinil=0 return 150 isinil=i return end