FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
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
18contains
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
270end 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, public hecmw_cmat_init(cmat)
I/O and Utility.
Definition: hecmw_util_f.F90:7