1C> \ingroup selci 2C> @{ 3C> 4C> \brief Insert a new configuration into the list 5C> 6C> The routine works on a list of items where each item 7C> `nintpo` integers long. This routine inserts a new item 8C> at the position given by `ipos`. To make space for the new 9C> item all subsequent items are shuffled to the right, 10C> then the new item is inserted at the specifiedd position. 11C> 12C> Next the number of elements on the list `n` is increased 13C> before the routine returns. 14C> 15 subroutine selci_insert(n,item,list,nintpo,ipos) 16 implicit none 17c 18#include "errquit.fh" 19c 20 integer n !< [In/Output] The number of items on the list 21 integer nintpo !< [Input] The number of integers in an item 22 integer ipos !< [Input] The position for the new item 23 integer list(*) !< [In/Output] The list of items 24 integer item(*) !< [Input] The new item 25* 26* $Id$ 27* 28c 29c insert item into the list before position ipos 30c each item is nintpo integers long 31c 32c n is incremented before return 33c 34c first shuffle the array to the right ... this can 35c be vectorized on some machines but NOT run concurrently 36c without modification 37c 38c Local 39c 40 integer i, ilast, ifirst 41c 42 ilast = n*nintpo 43 ifirst = (ipos-1)*nintpo 44 do 10 i = ilast,ifirst+1,-1 45 list(i+nintpo) = list(i) 4610 continue 47c 48c now insert the item 49c 50cvd$ nodepchk 51cvd$ noconcur 52 do 20 i = 1,nintpo 53 list(i+ifirst) = item(i) 5420 continue 55c 56 n = n + 1 57c 58 end 59C> 60C> \brief Find the location for a configuration in the configuration table 61C> 62C> Perform a binary search through an ordered list of items (each item 63C> is `nintpo` integers long). The result is returned in `ipos`. 64C> if `ipos` is positive then it represents the element in the list the 65C> new item should precede, if `ipos` is negative it is already present 66C> in the list. 67C> 68 subroutine selci_bserch(n,item,list,nintpo,ipos) 69 implicit none 70c 71#include "errquit.fh" 72c 73 integer n !< [Input] The length of the list 74 integer nintpo !< [Input] The number of integers per item 75 integer list(nintpo,*) !< [Input] The list of items 76 integer item(*) !< [Input] The new item 77 integer ipos !< [Output] The position 78 !< - if ipos > 0: the new item should precede 79 !< list(1:nintpo,ipos) 80 !< - if ipos < 0: then item(1:nintpo) equals 81 !< list(1:nintpo,-ipos) 82 integer selci_icmp 83 integer*4 isum1 84c 85c binary search thru ordered list of items (each nintpo integers). 86c return in ipos: 87c if +ve item should precede item at position ipos 88c if -ve item is already present at position |ipos| 89c 90c Local 91c 92 integer middle, left, iright 93 integer ifist, ilast, i 94c 95 if (n.lt.0) call errquit('bserch: n.lt.0 ',n, UNKNOWN_ERR) 96c 97 left = 1 98 iright = n 99 10 if ((iright-left).le.1) goto 50 100 middle=(left+iright)/2 101 isum1=selci_icmp(item,list(1,middle),nintpo) 102 if (isum1) 20,30,40 103c 104 20 iright = middle 105 goto 10 106c 107 30 ipos = -middle 108 return 109c 110 40 left = middle 111 goto 10 112c 113 50 isum1=selci_icmp(item,list(1,iright),nintpo) 114 if (isum1) 60,70,80 115c 116c item<list(iright) 117 60 isum1=selci_icmp(item,list(1,left), nintpo) 118 if (isum1) 61,62,63 119c 120c item<list(left) 121 61 ipos = left 122 return 123c 124c item=list(left) 125 62 ipos = -left 126 return 127c 128c item>list(left) & item<list(iright) 129 63 ipos = iright 130 return 131c 132c item=list(iright) 133 70 ipos = -iright 134 return 135c 136c item>list(iright) 137 80 ipos = iright + 1 138 return 139c 140 end 141C> 142C> \brief Compare two configurations 143C> 144C> Compares two configurations stored in compressed form. 145C> 146C> \return Returns 147C> - -1 if item1 < item2 148C> - 0 if item1 = item2 149C> - 1 if item1 > item2 150C> 151 integer function selci_icmp(item1,item2,n) 152 implicit none 153 integer n !< [Input] The length of the items in number of integers 154 integer item1(n) !< [Input] Item1 155 integer item2(n) !< [Input] Item2 156c 157c item1 and item2 are packed orbital occupations 158c 159c icmp = -1 item1<item2, 0 item1=item2, 1 item1>item2 160c 161 integer i !< Counter 162c 163 do 10 i = 1,n 164 if (item1(i).gt.item2(i)) then 165 selci_icmp = 1 166 return 167 else if (item1(i).lt.item2(i)) then 168 selci_icmp = -1 169 return 170 endif 17110 continue 172 selci_icmp = 0 173c 174 end 175C> 176C> @} 177