FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_solver_scaling_nn.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
10 implicit none
11
12 private
13 real(kind=kreal), private, allocatable :: scale(:)
14
17
18contains
19
20 subroutine hecmw_solver_scaling_fw_nn(hecMESH, hecMAT, COMMtime)
21 implicit none
22 type (hecmwst_local_mesh), intent(in) :: hecmesh
23 type (hecmwst_matrix), intent(inout) :: hecmat
24 real(kind=kreal), intent(inout) :: commtime
25 integer(kind=kint) :: n, np, ndof, ndof2
26 real(kind=kreal), pointer :: d(:), al(:), au(:), b(:)
27 integer(kind=kint), pointer :: inl(:), ial(:), inu(:), iau(:)
28 integer(kind=kint) :: i,j,k,ii,ij, ip(hecmat%ndof),iq(hecmat%ndof)
29 integer(kind=kint) :: isl, iel, isu, ieu, inod
30 real(kind=kreal) :: start_time, end_time
31
32 if (hecmw_mat_get_scaling(hecmat).eq.0) return
33
34 n = hecmat%N
35 np = hecmat%NP
36 ndof = hecmat%NDOF
37 ndof2 = ndof*ndof
38 d => hecmat%D
39 al => hecmat%AL
40 au => hecmat%AU
41 inl => hecmat%indexL
42 ial => hecmat%itemL
43 inu => hecmat%indexU
44 iau => hecmat%itemU
45 b => hecmat%B
46
47 allocate(scale(ndof*np))
48
49 do i= 1, n
50 do k=1, ndof
51 scale(ndof*(i-1)+k)= 1.d0/dsqrt(dabs(d(ndof*ndof*(i-1)+(k-1)*(ndof+1)+1)))
52 end do
53 enddo
54
55 start_time= hecmw_wtime()
56 call hecmw_update_m_r (hecmesh, scale, hecmesh%n_node, ndof)
57 end_time= hecmw_wtime()
58 commtime = commtime + end_time - start_time
59
60 do i= 1, np
61 do j = 1, ndof
62 ip(j)=ndof*(i-1)+j
63 end do
64 do j = 1, ndof
65 do k = 1, ndof
66 d(ndof2*(i-1)+ndof*(j-1)+k)=d(ndof2*(i-1)+ndof*(j-1)+k)*scale(ip(j))*scale(ip(k))
67 end do
68 end do
69
70 isl= inl(i-1) + 1
71 iel= inl(i )
72 !*voption indep (IAL,AL,SCALE)
73 do k= isl, iel
74 inod= ial(k)
75 do ii = 1, ndof
76 iq(ii) = ndof*(inod-1)+ii
77 end do
78 do ii = 1, ndof
79 do ij = 1, ndof
80 al(ndof2*(k-1)+ndof*(ii-1)+ij)=al(ndof2*(k-1)+ndof*(ii-1)+ij)*scale(ip(ii))*scale(iq(ij))
81 end do
82 end do
83 enddo
84
85 isu= inu(i-1) + 1
86 ieu= inu(i )
87 !*voption indep (IAU,AU,SCALE)
88 do k= isu, ieu
89 inod= iau(k)
90 do ii = 1, ndof
91 iq(ii) = ndof*(inod-1)+ii
92 end do
93 do ii = 1, ndof
94 do ij = 1, ndof
95 au(ndof2*(k-1)+ndof*(ii-1)+ij)=au(ndof2*(k-1)+ndof*(ii-1)+ij)*scale(ip(ii))*scale(iq(ij))
96 end do
97 end do
98 enddo
99 enddo
100 !*voption indep (B,SCALE)
101 do i= 1, n
102 do k = 1, ndof
103 b(ndof*(i-1)+k)=b(ndof*(i-1)+k)*scale(ndof*(i-1)+k)
104 end do
105 enddo
106 end subroutine hecmw_solver_scaling_fw_nn
107
108 subroutine hecmw_solver_scaling_bk_nn(hecMAT)
109 use hecmw_util
110 implicit none
111 type (hecmwst_matrix), intent(inout) :: hecmat
112 integer(kind=kint) :: n, np, ndof, ndof2
113 real(kind=kreal), pointer :: d(:), al(:), au(:), b(:), x(:)
114 integer(kind=kint), pointer :: inl(:), ial(:), inu(:), iau(:)
115 integer(kind=kint) :: i,j,k,ii,ij, ip(hecmat%ndof),iq(hecmat%ndof)
116 integer(kind=kint) :: isl, iel, isu, ieu, inod
117
118 if (hecmw_mat_get_scaling(hecmat).eq.0) return
119
120 n = hecmat%N
121 np = hecmat%NP
122 ndof = hecmat%NDOF
123 ndof2 = ndof*ndof
124 d => hecmat%D
125 al => hecmat%AL
126 au => hecmat%AU
127 inl => hecmat%indexL
128 ial => hecmat%itemL
129 inu => hecmat%indexU
130 iau => hecmat%itemU
131 b => hecmat%B
132 x => hecmat%X
133
134 !*voption indep (X,B,SCALE)
135 do i= 1, n
136 do k=1,ndof
137 x(ndof*(i-1)+k)=x(ndof*(i-1)+k)*scale(ndof*(i-1)+k)
138 b(ndof*(i-1)+k)=b(ndof*(i-1)+k)/scale(ndof*(i-1)+k)
139 end do
140 enddo
141
142 do i= 1, np
143 do j = 1, ndof
144 ip(j)=ndof*(i-1)+j
145 end do
146 do j = 1, ndof
147 do k = 1, ndof
148 d(ndof2*(i-1)+ndof*(j-1)+k)=d(ndof2*(i-1)+ndof*(j-1)+k)/(scale(ip(j))*scale(ip(k)))
149 end do
150 end do
151
152 isl= inl(i-1) + 1
153 iel= inl(i )
154 !*voption indep (IAL,AL,SCALE)
155 do k= isl, iel
156 inod= ial(k)
157 do ii = 1, ndof
158 iq(ii) = ndof*(inod-1)+ii
159 end do
160 do ii = 1, ndof
161 do ij = 1, ndof
162 al(ndof2*(k-1)+ndof*(ii-1)+ij)=al(ndof2*(k-1)+ndof*(ii-1)+ij)/(scale(ip(ii))*scale(iq(ij)))
163 end do
164 end do
165 enddo
166
167 isu= inu(i-1) + 1
168 ieu= inu(i )
169 !*voption indep (IAU,AU,SCALE)
170 do k= isu, ieu
171 inod= iau(k)
172 do ii = 1, ndof
173 iq(ii) = ndof*(inod-1)+ii
174 end do
175 do ii = 1, ndof
176 do ij = 1, ndof
177 au(ndof2*(k-1)+ndof*(ii-1)+ij)=au(ndof2*(k-1)+ndof*(ii-1)+ij)/(scale(ip(ii))*scale(iq(ij)))
178 end do
179 end do
180 enddo
181 enddo
182
183 deallocate(scale)
184 end subroutine hecmw_solver_scaling_bk_nn
185
integer(kind=kint) function, public hecmw_mat_get_scaling(hecmat)
subroutine, public hecmw_solver_scaling_fw_nn(hecmesh, hecmat, commtime)
subroutine, public hecmw_solver_scaling_bk_nn(hecmat)
I/O and Utility.
Definition: hecmw_util_f.F90:7
integer(kind=4), parameter kreal
real(kind=kreal) function hecmw_wtime()
subroutine hecmw_update_m_r(hecmesh, val, n, m)