phSolver/AMG/ramg_coarse.f

38       integer                                   :: i,j,k,m,n,p,q  local
105      &          amg_A_colm(level1)%p,amg_A_rowp(level1)%p,
106      &          amg_A_lhs(level1)%p,amg_paramap(level1)%p,
128          p = iabs(amg_paramap(level1)%p(i))
129          p = subcfrev(p)
130          subnei(p) = subnei(p) + 1
132          subcf(p) = subcf(p) + 1
146       allocate(CF_map(level1)%p(amg_nshg(level1)))
147       allocate(CF_revmap(level1)%p(amg_nshg(level1)))
152              CF_map(level1)%p(k) = i
153              CF_revmap(level1)%p(i) = k
159              CF_map(level1)%p(k) = i
160              CF_revmap(level1)%p(i) = k
167          CF_map(level1)%p(i) = i
168          CF_revmap(level1)%p(i) = i
187       allocate(amg_paramap(level2)%p(amg_nshg(level2)))
188       allocate(amg_paraext(level2)%p(amg_nshg(level2)))
192              amg_paramap(level2)%p(j) = amg_paramap(level1)%p(i)
193              amg_paraext(level2)%p(j) = amg_paraext(level1)%p(i)
200       allocate(amg_I_colm%p(amg_nshg(level1)),stat=mem_err)
217          cfilter = amg_paramap(level1)%p(i)
219              allocate(amg_I_rowp%pp(i)%p(1))
220              allocate(amg_I%pp(i)%p(1))
221              amg_I_colm%p(i) = 1
222              amg_I_rowp%pp(i)%p(1) = amg_Ip(i)
223              amg_I%pp(i)%p(1) = 1
233          diag = -1.0d0/amg_A_lhs(level1)%p(amg_A_colm(level1)%p(i),1)
235          do k = amg_A_colm(level1)%p(i)+1,amg_A_colm(level1)%p(i+1)-1
236             j = amg_A_rowp(level1)%p(k)
237          if (cfilter.eq.amg_paramap(level1)%p(j)) then
245             amg_la(n) = amg_A_lhs(level1)%p(k,1)
252          do k=amg_A_colm(level1)%p(i)+1,amg_A_colm(level1)%p(i+1)-1
253           j = amg_A_rowp(level1)%p(k)
255              rtp = amg_A_lhs(level1)%p(amg_A_colm(level1)%p(j),1)
259            do kj=amg_A_colm(level1)%p(j),amg_A_colm(level1)%p(j+1)-1
260              jj = amg_A_rowp(level1)%p(kj)
270              amg_la(m) = amg_la(m) - rtp*amg_A_lhs(level1)%p(kj,1)
353          amg_I_colm%p(i) = I_nnz
354          allocate(amg_I_rowp%pp(i)%p(I_nnz))
355          allocate(amg_I%pp(i)%p(I_nnz))
357                 amg_I_rowp%pp(i)%p(k) = amg_Ip(amg_Fn(k))
360                    amg_I%pp(i)%p(k) = amg_la(k)
362                     amg_I%pp(i)%p(k) = amg_la(k)
371       allocate(I_cf_colm(level1)%p(amg_nshg(level1)+1),stat=mem_err)
373       allocate(I_cf_rowp(level1)%p(mnnz),stat=mem_err)
375       allocate(I_cf(level1)%p(mnnz),stat=mem_err)
382          I_cf_colm(level1)%p(i)=mnnz+1
383          do j=1,amg_I_colm%p(i)
384             I_cf_rowp(level1)%p(mnnz+j)=amg_I_rowp%pp(i)%p(j)
385             I_cf(level1)%p(mnnz+j)=amg_I%pp(i)%p(j)
387          mnnz = mnnz + amg_I_colm%p(i)
389       I_cf_colm(level1)%p(amg_nshg(level1)+1) = mnnz+1
401          if (amg_I_colm%p(i).ne.0) then
402              deallocate(amg_I_rowp%pp(i)%p,stat=mem_err)
404              deallocate(amg_I%pp(i)%p,stat=mem_err)
408       deallocate(amg_I_colm%p,stat=mem_err)
422       allocate(I_fc_colm(level1)%p(amg_nshg(level2)+1),stat=mem_err)
424       allocate(I_fc_rowp(level1)%p(mnnz),stat=mem_err)
426       allocate(I_fc(level1)%p(mnnz),stat=mem_err)
432       I_fc_colm(level1)%p(1:amg_nshg(level2)+1) = 0
434          I_fc_colm(level1)%p(I_cf_rowp(level1)%p(i)) =
435      &   I_fc_colm(level1)%p(I_cf_rowp(level1)%p(i)) + 1
439          j = I_fc_colm(level1)%p(i)
440          I_fc_colm(level1)%p(i) = mnnz
443       I_fc_colm(level1)%p(amg_nshg(level2)+1) = mnnz
446          do k=I_cf_colm(level1)%p(i),I_cf_colm(level1)%p(i+1)-1
447             j = I_cf_rowp(level1)%p(k)
448             kj = I_fc_colm(level1)%p(j)
449             I_fc_colm(level1)%p(j) = I_fc_colm(level1)%p(j) + 1
450             I_fc_rowp(level1)%p(kj) = i
451             I_fc(level1)%p(kj) = I_cf(level1)%p(k)
456          I_fc_colm(level1)%p(i) = I_fc_colm(level1)%p(i-1)
458       I_fc_colm(level1)%p(1) = 1
633          p = iabs(cfilter)
634          oneck(p) = oneck(p)+1
672              p = iabs(cfilter)
673              oneck(p) = oneck(p)-1
855       integer :: i,j,p  local
878       integer :: i,j,p  local