1 subroutine Asadj ( row_fill_list, 2 & iens, adjcnt ) 3c 4c---------------------------------------------------------------------- 5c 6c---------------------------------------------------------------------- 7c 8 include "common.h" 9c 10 integer row_fill_list(nshg,15*nnz), 11 & ien(npro,nshl), 12 & adjcnt(nshg), ndlist(nshl) 13 14 integer iens(npro,nshl) 15c 16c prefer to show explicit absolute value needed for cubic modes and 17c higher rather than inline abs on pointer as in past versions 18c iens is the signed ien array ien is unsigned 19c 20 ien=abs(iens) 21 22 do i=1,npro 23 do j=1,nshl 24 ndlist(j)=ien(i,j) 25 enddo 26 do j=1,nshl 27 jnd=ndlist(j) 28 jlngth=adjcnt(jnd) ! current length of j's list 29 do k=1,nshl 30 knd=ndlist(k) 31 ibroke=zero 32 do l= 1,jlngth 33 if(row_fill_list(jnd,l).eq. knd) then 34 ibroke=1 35 exit 36 endif 37 enddo 38 39c 40c to get here k was not in j's list so add it 41c 42 if(ibroke.eq.0) then 43 jlngth=jlngth+1 ! lenthen list 44 if(jlngth.gt.15*nnz) then 45 write(*,*) 'increase overflow factor in genadj' 46 stop 47 endif 48 row_fill_list(jnd,jlngth)=knd ! add unique entry to list 49 endif 50 enddo ! finished checking all the k's for this j 51 adjcnt(jnd)=jlngth ! update the counter 52 enddo ! done with j's 53 enddo ! done with elements in this block 54c 55c 56c.... end 57c 58 return 59 end 60