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 !loop over matrix block column index 103 i = ien(e,aa) !get mapping from aath node of element e to 104 ! the ith row of lhsk 105 106 c = col(i) !Get the mapping from the ith row of lhsk to 107 ! to the corresponding location in row 108 n = col(i+1) - c !number of nonzero blocks in the row 109 r = (aa-1)*nflow !starting index of the ath node in EGmass 110 do b = 1, nshl 111 s = (b-1)*nflow !starting index of the bth node's 112 !contribution to node aa. 113 k = sparseloc( row(c), n, ien(e,b) ) + c-1 114 !Find the index of row which corresponds to node b of 115 !element e. This is where contributions from EGmass 116 !will actually get stored. 117 118 do g = 1, nflow !loop over columns in a block 119 t = (g-1)*nflow 120 do f = 1, nflow !loop over rows in a block 121 lhsK(t+f,k) = lhsK(t+f,k) + EGmass(e,r+f,s+g) 122 enddo 123 enddo 124 enddo 125 enddo 126 enddo 127 128 return 129 end 130 131 subroutine fillsparseC_BC( iens, EGmass, 132 & lhsk, row, col) 133! 134!----------------------------------------------------------- 135! This routine adds contributions from heat flux BCs to the 136! spasely stored LHS mass matrix. This routine is modified 137! from fillsparseC. 138! 139! Nicholas Mati, Summer 2014. (Sparse Matrix) 140!----------------------------------------------------------- 141! 142 include "common.h" 143 144 real*8 EGmass(npro, nshl, nshl) !only contains term (5,5) 145 integer ien(npro,nshl), col(nshg+1), row(nnz*nshg) 146 real*8 lhsK(nflow*nflow,nnz_tot) 147 148 integer aa, b, c, e, i, k, n, n1 149 integer f, g, r, s, t 150 151 integer sparseloc 152 integer iens(npro,nshl) 153c 154c prefer to show explicit absolute value needed for cubic modes and 155c higher rather than inline abs on pointer as in past versions 156c iens is the signed ien array ien is unsigned 157c 158 ien=abs(iens) 159 160 !Accumulate the lhsK 161 do e = 1, npro 162 do aa = 1, nshl !loop over matrix block column index 163 i = ien(e,aa) !get mapping from aath node of element e to 164 ! the ith row of lhsk 165 166 c = col(i) !Get the mapping from the ith row of lhsk to 167 ! to the corresponding location in row 168 n = col(i+1) - c !number of nonzero blocks in the row 169! r = (aa-1)*nflow !starting index of the ath node in EGmass 170 do b = 1, nshl 171! s = (b-1)*nflow !starting index of the bth node's 172 !contribution to node aa. 173 k = sparseloc( row(c), n, ien(e,b) ) + c-1 174 !Find the index of row which corresponds to node b of 175 !element e. This is where contributions from EGmass 176 !will actually get stored. 177 178 lhsk(25, k) = lhsk(25, k) + EGmass(e, aa, b) 179! do g = 1, nflow !loop over columns in a block 180! t = (g-1)*nflow 181! do f = 1, nflow !loop over rows in a block 182! lhsK(t+f,k) = lhsK(t+f,k) + EGmass(e,r+f,s+g) 183! enddo 184! enddo 185 enddo !loop over node b 186 enddo !loop over node a 187 enddo !loop over elements 188 189 !end 190 return 191 end 192 193 194 subroutine fillsparseSclr( iens, xSebe, lhsS, 195 1 row, col) 196 197 include "common.h" 198 real*8 xSebe(npro,nshl,nshl) 199 integer ien(npro,nshl), col(nshg+1), row(nshg*nnz) 200 real*8 lhsS(nnz_tot) 201 202 integer aa, b, c, e, i, k, n 203 204 integer sparseloc 205 206 integer iens(npro,nshl) 207c 208c prefer to show explicit absolute value needed for cubic modes and 209c higher rather than inline abs on pointer as in past versions 210c iens is the signed ien array ien is unsigned 211c 212 ien=abs(iens) 213c 214c.... Accumulate the lhs 215c 216 do e = 1, npro 217 do aa = 1, nshl 218 i = ien(e,aa) 219 c = col(i) 220 n = col(i+1) - c 221 do b = 1, nshl 222 k = sparseloc( row(c), n, ien(e,b) ) + c-1 223c 224 lhsS(k) = lhsS(k) + xSebe(e,aa,b) 225 enddo 226 enddo 227 enddo 228c 229c.... end 230c 231 return 232 end 233 234 integer function sparseloc( list, n, target ) 235 236c----------------------------------------------------------- 237c This function finds the location of the non-zero elements 238c of the LHS matrix in the sparsely stored matrix 239c lhsK(nflow*nflow,nnz*numnp) 240c 241c Nahid Razmara, Spring 2000. (Sparse Matrix) 242c----------------------------------------------------------- 243 244 integer list(n), n, target 245 integer rowvl, rowvh, rowv 246 247c 248c.... Initialize 249c 250 rowvl = 1 251 rowvh = n + 1 252c 253c.... do a binary search 254c 255100 if ( rowvh-rowvl .gt. 1 ) then 256 rowv = ( rowvh + rowvl ) / 2 257 if ( list(rowv) .gt. target ) then 258 rowvh = rowv 259 else 260 rowvl = rowv 261 endif 262 goto 100 263 endif 264c 265c.... return 266c 267 sparseloc = rowvl 268c 269 return 270 end 271 272