xref: /phasta/phSolver/common/genadj.f (revision 16223cb9c3f88b34f2cb94151b5cf5ffc1aac5e2)
1      subroutine genadj (colm,         rowp, icnt )
2c
3      use pointer_data
4c
5      include "common.h"
6c
7      integer rowp(nshg*nnz),         colm(nshg+1)
8      integer adjcnt(nshg),    row_fill_list(nshg,15*nnz), mloc(1)
9c                                          change ^ if overflow
10c                                   also change overflow check in asadj TWICE
11      integer tmprdim(1), nnonzero
12      real*8, allocatable, dimension(:) :: tmpr
13
14      adjcnt=0
15
16      do iblk = 1, nelblk
17c
18c.... set up the parameters
19c
20         iel    = lcblk(1,iblk)
21         lelCat = lcblk(2,iblk)
22         lcsyst = lcblk(3,iblk)
23         iorder = lcblk(4,iblk)
24         nenl   = lcblk(5,iblk) ! no. of vertices per element
25         nshl   = lcblk(10,iblk)
26         npro   = lcblk(1,iblk+1) - iel
27
28c
29c.... compute sparse matrix data structures
30c
31         call Asadj (row_fill_list,
32     &               mien(iblk)%p,  adjcnt )
33
34      enddo
35
36      call sumgatInt ( adjcnt, nshg, nnonzero)
37      if ( myrank .eq. master) then
38         write (*,*) 'Number of global nonzeros ',nnonzero
39      endif
40
41c
42c     build the colm array
43c
44      colm(1)=1
45      do i=1,nshg
46         colm(i+1)=colm(i)+adjcnt(i)
47      enddo
48c
49c     sort the rowp into increasing order
50c
51      ibig=10*nshg
52      icnt=0
53      tmprdim=maxval(adjcnt)
54      allocate (tmpr(tmprdim(1)))
55      do i=1,nshg
56         ncol=adjcnt(i)
57         tmpr(1:ncol)=row_fill_list(i,1:ncol)
58         do j=1,ncol
59            icnt=icnt+1
60            imin=minval(tmpr(1:ncol))
61            mloc=minloc(tmpr(1:ncol))
62            rowp(icnt)=imin
63            tmpr(mloc(1))=ibig
64         enddo
65      enddo
66      deallocate(tmpr)
67c      maxfill=tmprdim(1)
68c      write(*,*) 'maxfill=',maxfill
69      nnza=icnt/nshg +1
70      if(icnt.gt.nnz*nshg) then
71         write(*,*) 'increase nnz in genmat to',nnza
72         stop
73c      else
74c         write(*,*) 'nnz ok  nnz=',nnz,' actually needed',nnza
75c         write(*,*) myrank,' is my rank and my nnz_tot is: ',icnt
76      endif
77      return
78      end
79
80
81
82
83
84
85
86
87
88