!C
!C***
!C*** POI_GEN
!C***
!C
!C generate COEF. MATRIX for POISSON equations
!C
subroutine POI_GEN
use hpcmw_eps_fvm_all
implicit REAL*8 (A-H,O-Z)
integer, pointer :: IWKX(:,:)
!C
!C +-------+
!C | INIT. |
!C +-------+
!C===
!C
!C-- MATRIX
nn = intNODE_tot
nnp= NODE_tot
allocate (BFORCE(nnp), D(nn), DELPHI(nnp))
BFORCE= 0.d0
DELPHI= 0.d0
D= 0.d0
!C
!C-- ETC.
allocate (IWKX(intNODE_tot,7))
IWKX= 0
do ic= 1, CONN_tot
ic1= CONN_NODE(2*ic-1)
ic2= CONN_NODE(2*ic )
if (ic1.le.intNODE_tot) then
ik1= IWKX(ic1,7) + 1
IWKX(ic1,ik1)= ic
IWKX(ic1,7 )= ik1
endif
if (ic2.le.intNODE_tot) then
ik2= IWKX(ic2,7) + 1
IWKX(ic2,ik2)= ic
IWKX(ic2,7)= ik2
endif
enddo
allocate (index(0:nn))
index= 0
do i= 1, nn
index(i)= index(i-1) + IWKX(i,7)
enddo
NPLU= index(nn)
allocate (item(NPLU), AMAT(NPLU))
do i= 1, intNODE_tot
do j= 1, IWKX(i,7)
k= index(i-1) + j
ic = IWKX(i,j)
ic1= CONN_NODE(2*ic-1)
ic2= CONN_NODE(2*ic )
if (ic1.eq.i) then
item(k)= ic2
else
item(k)= ic1
endif
enddo
enddo
!C===
!C
!C +----------------------------+
!C | INTERIOR NODEs + BODY FLUX |
!C +----------------------------+
!C===
do icel= 1, intNODE_tot
BFORCE(icel)= BFORCE(icel) + BODY_NODE_FLUX(icel)
enddo
do i= 1, intNODE_tot
do j= index(i-1)+1, index(i)
icon= IWKX(i,j-index(i-1))
AMAT(j)= -CONN_COEF(icon)
D (i)= D(i) + CONN_COEF(icon)
enddo
enddo
deallocate (IWKX)
!C===
!C
!C +-----------+
!C | DIRICHLET |
!C +-----------+
!C===
do i= 1, FIX_NODE_tot
icel= FIX_NODE_ID(i)
D (icel)= D (icel) + FIX_NODE_COEF(i)
BFORCE(icel)= BFORCE(icel) + FIX_NODE_COEF(i)*FIX_NODE_VAL(i)
enddo
!C===
!C
!C +--------------+
!C | SURFACE FLUX |
!C +--------------+
!C===
do i= 1, SURF_NODE_tot
icel= SURF_NODE_ID(i)
BFORCE(icel)= BFORCE(icel) + SURF_NODE_FLUX(i)
enddo
!C===
return
end