FrontISTR  5.2.0
Large-scale structural analysis program with finit element method
hecmw_mat_con.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! Copyright (c) 2019 FrontISTR Commons
3 ! This software is released under the MIT License, see LICENSE.txt
4 !-------------------------------------------------------------------------------
5 
7  use hecmw_util
8  implicit none
9 
10  private
11 
12  public :: hecmw_mat_con
13 
14  integer(kind=kint) :: NU, NL
15  integer(kind=kint), pointer :: INL(:), INU(:)
16  integer(kind=kint), pointer :: IAL(:,:), IAU(:,:)
17 
18 contains
19  !C***
20  !C*** MAT_CON for solver
21  !C***
22  !C
23  subroutine hecmw_mat_con ( hecMESH, hecMAT )
24 
25  use hecmw_util
27 
28  implicit none
29  type (hecmwst_matrix) :: hecmat
30  type (hecmwst_local_mesh) :: hecmesh
31 
32  call hecmw_mat_con0 (hecmesh, hecmat)
33  call hecmw_mat_con1 ( hecmat)
34  call hecmw_cmat_init (hecmat%cmat)
35 
36  end subroutine hecmw_mat_con
37  !C
38  !C***
39  !C*** MAT_CON0 for solver
40  !C***
41  !C
42  subroutine hecmw_mat_con0 ( hecMESH, hecMAT )
43 
44  use hecmw_util
45  use hecmw_etype
46 
47  implicit none
48  integer(kind=kint) ierr,itype,is,iE,ic_type,nn,icel,j,k,inod
49  type (hecmwST_matrix) :: hecMAT
50  type (hecmwST_local_mesh) :: hecMESH
51  integer(kind=kint) nid(20)
52 
53  integer(kind=kint), dimension(2048) :: NCOL1, NCOL2
54  !C
55  !C +-------+
56  !C | INIT. |
57  !C +-------+
58  !C===
59  hecmat%NP= hecmesh%n_node
60  hecmat%N = hecmesh%nn_internal
61 
62  nu= 10
63  nl= 10
64 
65  allocate (inl(hecmat%NP), ial(hecmat%NP,nl))
66  allocate (inu(hecmat%NP), iau(hecmat%NP,nu))
67 
68  inl= 0
69  ial= 0
70  inu= 0
71  iau= 0
72  !C===
73  !C
74  !C +----------------------------------------+
75  !C | CONNECTIVITY according to ELEMENT TYPE |
76  !C +----------------------------------------+
77  !C===
78  do
79  ierr = 0
80  do itype= 1, hecmesh%n_elem_type
81  is= hecmesh%elem_type_index(itype-1) + 1
82  ie= hecmesh%elem_type_index(itype )
83  ic_type= hecmesh%elem_type_item(itype)
84  if( hecmw_is_etype_patch(ic_type) ) cycle
85  !C Set number of nodes
86  nn = hecmw_get_max_node(ic_type)
87  !C element loop
88  do icel= is, ie
89  is= hecmesh%elem_node_index(icel-1)
90  do j=1,nn
91  nid(j)= hecmesh%elem_node_item (is+j)
92  enddo
93  do j=1,nn
94  do k=1,nn
95  if( k .ne. j ) then
96  call hecmw_find_node( hecmat,nid(j),nid(k), ierr )
97  if( ierr.ne.0 ) then
98  call hecmw_mat_con0_clear (ierr)
99  exit
100  endif
101  endif
102  enddo
103  if( ierr.ne.0 ) exit
104  enddo
105  if( ierr.ne.0 ) exit
106  enddo
107  if( ierr.ne.0 ) exit
108  enddo
109  if( ierr.eq.0 ) exit
110  enddo
111  !C===
112  !C
113  !C +---------+
114  !C | SORTING |
115  !C +---------+
116  !C===
117  do inod= 1, hecmat%NP
118  nn= inl(inod)
119  do k= 1, nn
120  ncol1(k)= ial(inod,k)
121  enddo
122  call hecmw_msort (ncol1, ncol2, nn)
123  do k= nn, 1, -1
124  ial(inod,nn-k+1)= ncol1(ncol2(k))
125  enddo
126  nn= inu(inod)
127  do k= 1, nn
128  ncol1(k)= iau(inod,k)
129  enddo
130  call hecmw_msort (ncol1, ncol2, nn)
131  do k= nn, 1, -1
132  iau(inod,nn-k+1)= ncol1(ncol2(k))
133  enddo
134  enddo
135  !C===
136  contains
137  !C
138  !C*** MAT_CON0_CLEAR
139  !C
140  subroutine hecmw_mat_con0_clear (IERR)
141 
142  implicit none
143  integer(kind=kint) IERR
144 
145  deallocate (inl, ial, inu, iau)
146 
147  if (ierr.eq.1) nl= nl + 5
148  if (ierr.eq.2) nu= nu + 5
149  allocate (inl(hecmat%NP),ial(hecmat%NP,nl))
150  allocate (inu(hecmat%NP),iau(hecmat%NP,nu))
151 
152  inl= 0
153  ial= 0
154  inu= 0
155  iau= 0
156 
157  end subroutine hecmw_mat_con0_clear
158  end subroutine hecmw_mat_con0
159  !C
160  !C***
161  !C*** FIND_TS_NODE
162  !C***
163  !C
164  subroutine hecmw_find_node ( hecMAT, ip1,ip2, IERR )
165 
166  use hecmw_util
167 
168  implicit none
169  integer(kind=kint) ip1,ip2,IERR
170  integer(kind=kint) kk,icou
171  type (hecmwST_matrix) :: hecMAT
172 
173  if (ip1.gt.ip2) then
174  do kk= 1, inl(ip1)
175  if (ip2.eq.ial(ip1,kk)) return
176  enddo
177  icou= inl(ip1) + 1
178  if (icou.gt.nl) then
179  ierr= 1
180  return
181  endif
182  ial(ip1,icou)= ip2
183  inl(ip1 )= icou
184  return
185  endif
186 
187  if (ip2.gt.ip1) then
188  do kk= 1, inu(ip1)
189  if (ip2.eq.iau(ip1,kk)) return
190  enddo
191  icou= inu(ip1) + 1
192  if (icou.gt.nu) then
193  ierr= 2
194  return
195  endif
196  iau(ip1,icou)= ip2
197  inu(ip1 )= icou
198  return
199  endif
200 
201  end subroutine hecmw_find_node
202  !C
203  !C***
204  !C*** fstr_mSORT
205  !C***
206  !C
207  subroutine hecmw_msort (STEM,INUM,NN)
208  use hecmw_util
209 
210  implicit none
211  integer(kind=kint) NN
212  integer(kind=kint) STEM(NN), INUM(NN)
213  integer(kind=kint) ii,jj,ITEM
214  do ii = 1,nn
215  inum(ii)= ii
216  enddo
217  do ii= 1,nn-1
218  !CDIR NOVECTOR
219  do jj= 1,nn-ii
220  if (stem(inum(jj)) .lt. stem(inum(jj+1))) then
221  item = inum(jj+1)
222  inum(jj+1)= inum(jj)
223  inum(jj) = item
224  endif
225  enddo
226  enddo
227  return
228  end subroutine hecmw_msort
229  !C
230  !C***
231  !C*** MAT_CON1 for solver
232  !C***
233  !C
234  subroutine hecmw_mat_con1 (hecMAT)
235 
236  use hecmw_util
237 
238  implicit none
239  integer(kind=kint) i,k,kk
240  type (hecmwST_matrix ) :: hecMAT
241 
242  allocate (hecmat%indexL(0:hecmat%NP), hecmat%indexU(0:hecmat%NP))
243 
244  hecmat%indexL = 0
245  hecmat%indexU = 0
246  do i = 1, hecmat%NP
247  hecmat%indexL(i) = hecmat%indexL(i-1) + inl(i)
248  hecmat%indexU(i) = hecmat%indexU(i-1) + inu(i)
249  enddo
250 
251  hecmat%NPL = hecmat%indexL(hecmat%NP)
252  hecmat%NPU = hecmat%indexU(hecmat%NP)
253 
254  allocate (hecmat%itemL(hecmat%NPL), hecmat%itemU(hecmat%NPU))
255 
256  do i = 1, hecmat%NP
257  do k = 1, inl(i)
258  kk = k + hecmat%indexL(i-1)
259  hecmat%itemL(kk) = ial(i,k)
260  enddo
261  do k= 1, inu(i)
262  kk = k + hecmat%indexU(i-1)
263  hecmat%itemU(kk) = iau(i,k)
264  enddo
265  enddo
266 
267  deallocate (inl, inu, ial, iau)
268 
269  end subroutine hecmw_mat_con1
270 end module hecmw_matrix_con
subroutine hecmw_mat_con0_clear(IERR)
I/O and Utility.
logical function hecmw_is_etype_patch(etype)
integer(kind=kint) function hecmw_get_max_node(etype)
subroutine, public hecmw_mat_con(hecMESH, hecMAT)
subroutine hecmw_mat_con1(hecMAT)
subroutine hecmw_mat_con0(hecMESH, hecMAT)
subroutine hecmw_msort(STEM, INUM, NN)
subroutine, public hecmw_cmat_init(cmat)
I/O and Utility.
Definition: hecmw_util_f.F90:7