1 subroutine fillsparseI( iens, xKebe, lhsK, 2 & xGoC, lhsP, 3 1 row, col) 4c 5c 6c 7 include "common.h" 8 real*8 xKebe(npro,9,nshl,nshl), xGoC(npro,4,nshl,nshl) 9 integer ien(npro,nshl), col(nshg+1), row(nshg*nnz) 10 real*8 lhsK(9,nnz_tot), lhsP(4,nnz_tot) 11c 12 integer aa, b, c, e, i, k, n 13c 14 integer sparseloc 15 16 integer iens(npro,nshl) 17c 18c prefer to show explicit absolute value needed for cubic modes and 19c higher rather than inline abs on pointer as in past versions 20c iens is the signed ien array ien is unsigned 21c 22 ien=abs(iens) 23c 24c.... Accumulate the lhs 25c 26 do e = 1, npro ! loop over the elements 27 do aa = 1, nshl ! loop over the local equation numbers 28 i = ien(e,aa) ! finds the global equation number or 29 ! block-row of our matrix 30 c = col(i) ! starting point to look for the matching column 31 n = col(i+1) - c !length of the list of entries in rowp 32 do b = 1, nshl ! local variable number tangent respect 33 ! to 34c function that searches row until it finds the match that gives the 35c global equation number 36 37 k = sparseloc( row(c), n, ien(e,b) ) + c-1 38c 39c * * 40c dimension egmass(npro,ndof,nenl,ndof,nenl) 41c 42c compressible lhsT(1:5,1:5,k)=lhsT(1:5,1:5,k)+egmass(e,1:5,aa,1:5,b) 43c 44 lhsK(1,k) = lhsK(1,k) + xKebe(e,1,aa,b) 45 lhsK(2,k) = lhsK(2,k) + xKebe(e,2,aa,b) 46 lhsK(3,k) = lhsK(3,k) + xKebe(e,3,aa,b) 47 lhsK(4,k) = lhsK(4,k) + xKebe(e,4,aa,b) 48 lhsK(5,k) = lhsK(5,k) + xKebe(e,5,aa,b) 49 lhsK(6,k) = lhsK(6,k) + xKebe(e,6,aa,b) 50 lhsK(7,k) = lhsK(7,k) + xKebe(e,7,aa,b) 51 lhsK(8,k) = lhsK(8,k) + xKebe(e,8,aa,b) 52 lhsK(9,k) = lhsK(9,k) + xKebe(e,9,aa,b) 53c 54 lhsP(1,k) = lhsP(1,k) + xGoC(e,1,aa,b) 55 lhsP(2,k) = lhsP(2,k) + xGoC(e,2,aa,b) 56 lhsP(3,k) = lhsP(3,k) + xGoC(e,3,aa,b) 57 lhsP(4,k) = lhsP(4,k) + xGoC(e,4,aa,b) 58 enddo 59 enddo 60 enddo 61c 62c.... end 63c 64 return 65 end 66 67 68 subroutine fillsparseC( iens, EGmass, lhsK, 69 1 row, col) 70c 71c----------------------------------------------------------- 72c This routine fills up the spasely stored LHS mass matrix 73c 74c Nahid Razmra, Spring 2000. (Sparse Matrix) 75c----------------------------------------------------------- 76c 77c 78 79 include "common.h" 80 81 real*8 EGmass(npro,nedof,nedof) 82 integer ien(npro,nshl), col(nshg+1), row(nnz*nshg) 83 real*8 lhsK(nflow*nflow,nnz_tot) 84 85c 86 integer aa, b, c, e, i, k, n, n1 87 integer f, g, r, s, t 88c 89 integer sparseloc 90 91 integer iens(npro,nshl) 92c 93c prefer to show explicit absolute value needed for cubic modes and 94c higher rather than inline abs on pointer as in past versions 95c iens is the signed ien array ien is unsigned 96c 97 ien=abs(iens) 98c 99c.... Accumulate the lhsK 100c 101 do e = 1, npro 102 do aa = 1, nshl 103 i = ien(e,aa) 104 c = col(i) 105 n = col(i+1) - c 106 r = (aa-1)*nflow 107 do b = 1, nshl 108 s = (b-1)*nflow 109 k = sparseloc( row(c), n, ien(e,b) ) + c-1 110c 111 do g = 1, nflow 112 t = (g-1)*nflow 113 do f = 1, nflow 114 115 lhsK(t+f,k) = lhsK(t+f,k) + EGmass(e,r+f,s+g) 116c 117 118 enddo 119 enddo 120 enddo 121 enddo 122 enddo 123c 124c.... end 125c 126 return 127 end 128 129 subroutine fillsparseSclr( iens, xSebe, lhsS, 130 1 row, col) 131c 132c 133c 134 include "common.h" 135 real*8 xSebe(npro,nshl,nshl) 136 integer ien(npro,nshl), col(nshg+1), row(nshg*nnz) 137 real*8 lhsS(nnz_tot) 138c 139 integer aa, b, c, e, i, k, n 140c 141 integer sparseloc 142 143 integer iens(npro,nshl) 144c 145c prefer to show explicit absolute value needed for cubic modes and 146c higher rather than inline abs on pointer as in past versions 147c iens is the signed ien array ien is unsigned 148c 149 ien=abs(iens) 150c 151c.... Accumulate the lhs 152c 153 do e = 1, npro 154 do aa = 1, nshl 155 i = ien(e,aa) 156 c = col(i) 157 n = col(i+1) - c 158 do b = 1, nshl 159 k = sparseloc( row(c), n, ien(e,b) ) + c-1 160c 161 lhsS(k) = lhsS(k) + xSebe(e,aa,b) 162 enddo 163 enddo 164 enddo 165c 166c.... end 167c 168 return 169 end 170 171 integer function sparseloc( list, n, target ) 172 173c----------------------------------------------------------- 174c This function finds the location of the non-zero elements 175c of the LHS matrix in the sparsely stored matrix 176c lhsK(nflow*nflow,nnz*numnp) 177c 178c Nahid Razmara, Spring 2000. (Sparse Matrix) 179c----------------------------------------------------------- 180 181 integer list(n), n, target 182 integer rowvl, rowvh, rowv 183 184c 185c.... Initialize 186c 187 rowvl = 1 188 rowvh = n + 1 189c 190c.... do a binary search 191c 192100 if ( rowvh-rowvl .gt. 1 ) then 193 rowv = ( rowvh + rowvl ) / 2 194 if ( list(rowv) .gt. target ) then 195 rowvh = rowv 196 else 197 rowvl = rowv 198 endif 199 goto 100 200 endif 201c 202c.... return 203c 204 sparseloc = rowvl 205c 206 return 207 end 208 209