OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
init_th.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine init_th (iparg, ithbuf, elbuf_tab, igeo, ixr, ithgrp, nthgrp2, id, weight, sithbuf)

Function/Subroutine Documentation

◆ init_th()

subroutine init_th ( integer, dimension(nparg,*) iparg,
integer, dimension(sithbuf) ithbuf,
type (elbuf_struct_), dimension(ngroup) elbuf_tab,
integer, dimension(npropgi,*) igeo,
integer, dimension(nixr,*) ixr,
integer, dimension(nithgr,*) ithgrp,
integer nthgrp2,
integer, intent(in) id,
integer, dimension(numnod) weight,
integer, intent(in) sithbuf )

Definition at line 47 of file init_th.F.

49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE elbufdef_mod
53 USE cluster_mod
54 USE stack_mod
55 USE groupdef_mod
56 USE th_mod
57 use element_mod , only : nixr
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "param_c.inc"
68#include "task_c.inc"
69#include "tabsiz_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER, INTENT(IN) :: SITHBUF
74 INTEGER NTHGRP2
75 INTEGER IPARG(NPARG,*),IGEO(NPROPGI,*),
76 . ITHGRP(NITHGR,*),ITHBUF(SITHBUF),IXR(NIXR,*),WEIGHT(NUMNOD)
77 INTEGER, INTENT(in) :: ID
78C REAL
79 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I,J,N,
84 . ELTYPE
85 INTEGER :: MY_SIZE,TOTAL_INDEX_WA_SIZE,IJK
86 INTEGER, DIMENSION(NTHGRP2+1) :: LOCAL_WA
87 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_WA_ELTYPE_P0,INDEX_WA_SIZE_P0
88 INTEGER, DIMENSION(:), ALLOCATABLE :: WA_INDEX_DIPLS
89 TYPE(TH_COMM), DIMENSION(:), POINTER :: WA_COMM
90 INTEGER, DIMENSION(:), POINTER :: WA_SIZE,TOTAL_WA_SIZE
91 TYPE(TH_PROC_TYPE), DIMENSION(:), POINTER :: ELTYPE_STRUCT
92 TYPE(TH_WA_REAL), DIMENSION(:), POINTER :: WA_P0,WA
93C=======================================================================
94
95C-------------------------------------------------------
96C TH GROUP
97C-------------------------------------------------------
98
99
100! -------------------------------------
101! SPRING ELEMENT
102! TH optimization for spring elements
103! local data on each proc:
104!
105! N= 1 2
106! ________________ ______
107! / \ / \
108! proc= 1 | a1 | a2 | b1 |
109
110! N= 1 2 3
111! ________________ ______ ______
112! / \ / \/ \
113! proc= 2 | a3 | a4 | b3 | c1 |
114!
115! n= 2 3
116! ______ ______
117! / \ / \
118! proc= 3 | b2 | c2 |
119!
120! local data are sent to PROC0 (WA_SPRING_P0):
121! N= 1 1 2 1 1 2 3 2 3
122! | a1 | a2 | b1 ||| a3 | a4 | b3 | c1 ||| b2 | c2 |
123! local proc= 1 ||| 2 ||| 3
124!
125! --> need to know where are the data in wa_spring_p0 and where the data must be
126! written in the TH file
127! for this, the local index (INDEX_WA_ELTYPE) for each proc is sent to PROC0 (INDEX_WA_ELTYPE_P0)
128! in order to build the global index SPRING_STRUCT(I)%TH_ELM(:,:)
129! SPRING_STRUCT(I)%TH_ELM(:,1) = position in the buffer
130! SPRING_STRUCT(I)%TH_ELM(:,2) = N
131!
132! the position of the first element in the TH file is added at the end of each chunk ax, bx, cx...
133!
134
135! proc= 1 1 2 2
136! N=1 | a1 | a2 | a3 | a4 |
137! | | |
138! pos= a1(NVAR+1)..| a4(NVAR+1)
139! a3(NVAR+1)
140!
141! proc= 1 3 2
142! N=2 | b1 | b2 | b3 |
143! | | |
144! pos= b1(NVAR+1)..|b3(NVAR+1)
145! b2(NVAR+1)
146!
147! proc= 2 3
148! N=3 | c1 | c2 |
149!
150! -------------------------------------
151 ! ----------------------------------
152
153 ! allocation of local arrays
154 ALLOCATE( index_wa_eltype(2*nthgrp2+1) )
155 ALLOCATE( index_wa_size_p0(nspmd) )
156 ALLOCATE( wa_index_dipls(nspmd) )
157
158 DO eltype=1,9
159 ! ELTYPE = 1 --> spring
160 ! ELTYPE = 2 --> node
161 ! ELTYPE = 3 --> sol
162 ! ELTYPE = 4 --> quad
163 ! ELTYPE = 5 --> shell/shell3n
164 ! ELTYPE = 6 --> truss
165 ! ELTYPE = 7 --> beam
166 ! ELTYPE = 8 --> sph
167 ! ELTYPE = 9 --> nstrand
168 IF(eltype==1) THEN
169 wa_comm=>wa_spring_comm
170 wa_size=>wa_spring_size
171 total_wa_size=>total_wa_spring_size
172 eltype_struct=>spring_struct
173 wa=>wa_spring
174 wa_p0=>wa_spring_p0
175 ELSEIF(eltype==2) THEN
176 wa_comm=>wa_nod_comm
177 wa_size=>wa_nod_size
178 total_wa_size=>total_wa_nod_size
179 eltype_struct=>nod_struct
180 wa=>wa_nod
181 wa_p0=>wa_nod_p0
182 ELSEIF(eltype==3) THEN
183 wa_comm=>wa_sol_comm
184 wa_size=>wa_sol_size
185 total_wa_size=>total_wa_sol_size
186 eltype_struct=>sol_struct
187 wa=>wa_sol
188 wa_p0=>wa_sol_p0
189 ELSEIF(eltype==4) THEN
190 wa_comm=>wa_quad_comm
191 wa_size=>wa_quad_size
192 total_wa_size=>total_wa_quad_size
193 eltype_struct=>quad_struct
194 wa=>wa_quad
195 wa_p0=>wa_quad_p0
196 ELSEIF(eltype==5) THEN
197 wa_comm=>wa_coq_comm
198 wa_size=>wa_coq_size
199 total_wa_size=>total_wa_coq_size
200 eltype_struct=>coq_struct
201 wa=>wa_coq
202 wa_p0=>wa_coq_p0
203 ELSEIF(eltype==6) THEN
204 wa_comm=>wa_trus_comm
205 wa_size=>wa_trus_size
206 total_wa_size=>total_wa_trus_size
207 eltype_struct=>trus_struct
208 wa=>wa_trus
209 wa_p0=>wa_trus_p0
210 ELSEIF(eltype==7) THEN
211 wa_comm=>wa_pout_comm
212 wa_size=>wa_pout_size
213 total_wa_size=>total_wa_pout_size
214 eltype_struct=>pout_struct
215 wa=>wa_pout
216 wa_p0=>wa_pout_p0
217 ELSEIF(eltype==8) THEN
218 wa_comm=>wa_sph_comm
219 wa_size=>wa_sph_size
220 total_wa_size=>total_wa_sph_size
221 eltype_struct=>sph_struct
222 wa=>wa_sph
223 wa_p0=>wa_sph_p0
224 ELSEIF(eltype==9) THEN
225 wa_comm=>wa_nst_comm
226 wa_size=>wa_nst_size
227 total_wa_size=>total_wa_nst_size
228 eltype_struct=>nst_struct
229 wa=>wa_nst
230 wa_p0=>wa_nst_p0
231 ENDIF
232
233 ALLOCATE( wa_comm(id)%TH_SIZE(nspmd) )
234 ALLOCATE( wa_comm(id)%TH_DIPLS(nspmd) )
235
236 wa_comm(id)%TH_SIZE(1:nspmd) = 0
237 index_wa_eltype(1:2*nthgrp2+1) = 0
238 index_wa_size_p0(1:nspmd) = 0
239 wa_index_dipls(1:nspmd) = 0
240
241 ! count the number of chunk and get the total size of WA_SPRING
242 IF(eltype==1) THEN
243 CALL thres_count(iparg,ithbuf,elbuf_tab,igeo,ixr,
244 . ithgrp,nthgrp2,wa_size(id),index_wa_eltype,sithbuf)
245 ELSEIF(eltype==2) THEN
246 CALL thnod_count(ithgrp,nthgrp2,wa_size(id),index_wa_eltype,ithbuf,
247 . weight,sithbuf)
248 ELSEIF(eltype==3) THEN
249 CALL thsol_count(nthgrp2 ,ithgrp,wa_size(id),index_wa_eltype,
250 . iparg,ithbuf,sithbuf )
251 ELSEIF(eltype==4) THEN
252 CALL thquad_count(nthgrp2 ,ithgrp,wa_size(id),index_wa_eltype,
253 . iparg,ithbuf,sithbuf )
254 ELSEIF(eltype==5) THEN
255 CALL thcoq_count(nthgrp2 ,ithgrp,wa_size(id),index_wa_eltype,
256 . iparg,ithbuf,sithbuf )
257 ELSEIF(eltype==6) THEN
258 CALL thtrus_count(nthgrp2,ithgrp,wa_size(id),index_wa_eltype,
259 . iparg ,ithbuf,sithbuf)
260 ELSEIF(eltype==7) THEN
261 CALL thpout_count(nthgrp2, ithgrp, wa_size(id),index_wa_eltype,
262 . iparg , ithbuf,sithbuf )
263 ELSEIF(eltype==8) THEN
264 CALL thsph_count(nthgrp2, ithgrp, wa_size(id),index_wa_eltype,
265 . iparg, ithbuf ,sithbuf)
266 ELSEIF(eltype==9) THEN
267 CALL thnst_count(nthgrp2, ithgrp, wa_size(id),index_wa_eltype,
268 . iparg,ithbuf,sithbuf)
269 ENDIF
270
271 ! send the local size of index to PROC0
272 my_size = index_wa_eltype(2*nthgrp2+1)
273 IF(nspmd>1) THEN
274 CALL spmd_gather_int(my_size,index_wa_size_p0,0,1,nspmd)
275 ELSE
276 index_wa_size_p0 = my_size
277 ENDIF
278
279
280 wa_comm(id)%TH_DIPLS(1:nspmd) = 0
281 total_wa_size(id) = 0
282 total_index_wa_size = 0
283 IF(ispmd==0) THEN
284 wa_index_dipls(1) = 0
285 DO i=1,nspmd-1
286 wa_index_dipls(i+1) = wa_index_dipls(i) + index_wa_size_p0(i)
287 total_index_wa_size = total_index_wa_size + index_wa_size_p0(i)
288 ENDDO
289 total_index_wa_size = total_index_wa_size + index_wa_size_p0(nspmd)
290 ENDIF
291 ! allocation of INDEX_WA_ELTYPE_P0
292 ALLOCATE( index_wa_eltype_p0(total_index_wa_size) )
293
294 IF(nspmd>1) THEN
295 ! send the local index to PROC0
296 CALL spmd_gatherv_int(index_wa_eltype,index_wa_eltype_p0,0,my_size,total_index_wa_size,
297 . index_wa_size_p0,wa_index_dipls)
298
299 ! send the local size of WA_SPRING to PROC0
300 CALL spmd_gather_int(wa_size(id),wa_comm(id)%TH_SIZE,0,1,nspmd)
301 ELSE
302 index_wa_eltype_p0 = index_wa_eltype
303 wa_comm(id)%TH_SIZE(1) = wa_size(id)
304 ENDIF
305
306 IF(ispmd==0) THEN
307 ! displacement for the gatherv comm and total size of WA_SPRING_P0
308 wa_comm(id)%TH_DIPLS(1) = 0
309 DO i=1,nspmd-1
310 wa_comm(id)%TH_DIPLS(i+1) = wa_comm(id)%TH_DIPLS(i) + wa_comm(id)%TH_SIZE(i)
311 total_wa_size(id) = total_wa_size(id) + wa_comm(id)%TH_SIZE(i)
312 ENDDO
313 total_wa_size(id) = total_wa_size(id) + wa_comm(id)%TH_SIZE(nspmd)
314 ENDIF
315
316 IF(ispmd==0) THEN
317 ! allocation of SPRING_STRUCT + initialization
318 ALLOCATE( eltype_struct(id)%TH_PROC(nspmd) )
319 DO i=1,nspmd
320 local_wa(1:nthgrp2+1) = 0
321 j = wa_index_dipls(i)
322 local_wa(1) = wa_comm(id)%TH_DIPLS(i)
323 ! index initialization
324 DO ijk=1,index_wa_size_p0(i)/2
325 n = index_wa_eltype_p0(2*ijk+j)
326 local_wa(n+1) = wa_comm(id)%TH_DIPLS(i) + index_wa_eltype_p0(2*ijk-1+j)
327 ENDDO
328
329 DO n=2,nthgrp2+1
330 IF(local_wa(n)==0) THEN
331 local_wa(n)=local_wa(n-1)
332 ENDIF
333 ENDDO
334
335 ! if PROC I must send its data to PROC0
336 IF(index_wa_size_p0(i)/2>0) THEN
337 ! count the number of N in order to reduce the size
338 ijk = 0
339 DO n=2,nthgrp2+1
340 IF(local_wa(n)-local_wa(n-1)>0) THEN
341 ijk=ijk+1
342 ENDIF
343 ENDDO
344 ijk=ijk+1
345 ! allocation of %TH_ELM_SIZE
346 eltype_struct(id)%TH_PROC(i)%TH_ELM_SIZE = ijk
347 ijk = eltype_struct(id)%TH_PROC(i)%TH_ELM_SIZE
348 ALLOCATE( eltype_struct(id)%TH_PROC(i)%TH_ELM(ijk,2) )
349 ! initialization of %TH_ELM_SIZE
350 ijk = 0
351 DO n=2,nthgrp2+1
352 IF(local_wa(n)-local_wa(n-1)>0) THEN
353 ijk=ijk+1
354 eltype_struct(id)%TH_PROC(i)%TH_ELM(ijk,1) = local_wa(n-1)
355 eltype_struct(id)%TH_PROC(i)%TH_ELM(ijk,2) = n-1
356 ENDIF
357 ENDDO
358 ijk=ijk+1
359 eltype_struct(id)%TH_PROC(i)%TH_ELM(ijk,1) = local_wa(nthgrp2+1)
360 eltype_struct(id)%TH_PROC(i)%TH_ELM(ijk,2) = nthgrp2+1
361 ELSE
362 ! elseif PROC I do nothing : allocation to 0
363 eltype_struct(id)%TH_PROC(i)%TH_ELM_SIZE = 0
364 ALLOCATE( eltype_struct(id)%TH_PROC(i)%TH_ELM(0,0) )
365 ENDIF
366 ENDDO
367 ENDIF
368
369 ! allocation of WA_SPRING and WA_SPRING_P0 (--> size=0 for every PROC except PROC0)
370 ALLOCATE( wa(id)%WA_REAL(wa_size(id)) )
371 ALLOCATE( wa_p0(id)%WA_REAL(total_wa_size(id)) )
372 ! initialisation done : next element type
373 DEALLOCATE( index_wa_eltype_p0 )
374 ENDDO
375 ! initialisation done
376 DEALLOCATE( index_wa_eltype )
377 DEALLOCATE( index_wa_size_p0 )
378 DEALLOCATE( wa_index_dipls )
379 ! ----------------------------------
380 RETURN
end diagonal values have been computed in the(sparse) matrix id.SOL
initmumps id
type(th_wa_real), dimension(10), target wa_sol
Definition th_mod.F:88
type(th_wa_real), dimension(10), target wa_trus
Definition th_mod.F:103
type(th_wa_real), dimension(10), target wa_coq_p0
Definition th_mod.F:98
integer, dimension(10), target total_wa_sol_size
Definition th_mod.F:85
integer, dimension(10), target total_wa_nst_size
Definition th_mod.F:116
type(th_proc_type), dimension(10), target coq_struct
Definition th_mod.F:96
type(th_wa_real), dimension(10), target wa_nod
Definition th_mod.F:83
type(th_wa_real), dimension(10), target wa_sph
Definition th_mod.F:113
type(th_wa_real), dimension(10), target wa_coq
Definition th_mod.F:98
type(th_proc_type), dimension(10), target nst_struct
Definition th_mod.F:117
type(th_comm), dimension(10), target wa_sol_comm
Definition th_mod.F:87
type(th_wa_real), dimension(10), target wa_sol_p0
Definition th_mod.F:88
type(th_comm), dimension(10), target wa_sph_comm
Definition th_mod.F:112
type(th_wa_real), dimension(10), target wa_nod_p0
Definition th_mod.F:83
integer, dimension(10), target wa_spring_size
Definition th_mod.F:75
integer, dimension(10), target total_wa_nod_size
Definition th_mod.F:80
type(th_comm), dimension(10), target wa_spring_comm
Definition th_mod.F:77
integer, dimension(10), target total_wa_quad_size
Definition th_mod.F:90
type(th_proc_type), dimension(10), target sph_struct
Definition th_mod.F:111
type(th_wa_real), dimension(10), target wa_spring
Definition th_mod.F:78
type(th_wa_real), dimension(10), target wa_pout_p0
Definition th_mod.F:108
integer, dimension(10), target wa_quad_size
Definition th_mod.F:90
type(th_wa_real), dimension(10), target wa_nst
Definition th_mod.F:119
integer, dimension(10), target total_wa_trus_size
Definition th_mod.F:100
type(th_comm), dimension(10), target wa_nod_comm
Definition th_mod.F:82
integer, dimension(10), target total_wa_sph_size
Definition th_mod.F:110
type(th_proc_type), dimension(10), target quad_struct
Definition th_mod.F:91
integer, dimension(10), target wa_nst_size
Definition th_mod.F:116
type(th_proc_type), dimension(10), target spring_struct
Definition th_mod.F:76
integer, dimension(10), target wa_trus_size
Definition th_mod.F:100
integer, dimension(:), allocatable index_wa_eltype
Definition th_mod.F:72
type(th_comm), dimension(10), target wa_coq_comm
Definition th_mod.F:97
type(th_wa_real), dimension(10), target wa_spring_p0
Definition th_mod.F:78
type(th_comm), dimension(10), target wa_pout_comm
Definition th_mod.F:107
integer, dimension(10), target total_wa_pout_size
Definition th_mod.F:105
type(th_wa_real), dimension(10), target wa_pout
Definition th_mod.F:108
type(th_wa_real), dimension(10), target wa_nst_p0
Definition th_mod.F:119
integer, dimension(10), target wa_sph_size
Definition th_mod.F:110
integer, dimension(10), target total_wa_spring_size
Definition th_mod.F:75
integer, dimension(10), target total_wa_coq_size
Definition th_mod.F:95
type(th_proc_type), dimension(10), target sol_struct
Definition th_mod.F:86
type(th_wa_real), dimension(10), target wa_trus_p0
Definition th_mod.F:103
type(th_proc_type), dimension(10), target nod_struct
Definition th_mod.F:81
type(th_comm), dimension(10), target wa_nst_comm
Definition th_mod.F:118
type(th_comm), dimension(10), target wa_trus_comm
Definition th_mod.F:102
type(th_wa_real), dimension(10), target wa_quad_p0
Definition th_mod.F:93
integer, dimension(10), target wa_pout_size
Definition th_mod.F:105
integer, dimension(10), target wa_sol_size
Definition th_mod.F:85
type(th_comm), dimension(10), target wa_quad_comm
Definition th_mod.F:92
integer, dimension(10), target wa_nod_size
Definition th_mod.F:80
type(th_proc_type), dimension(10), target trus_struct
Definition th_mod.F:101
integer, dimension(10), target wa_coq_size
Definition th_mod.F:95
type(th_wa_real), dimension(10), target wa_quad
Definition th_mod.F:93
type(th_proc_type), dimension(10), target pout_struct
Definition th_mod.F:106
type(th_wa_real), dimension(10), target wa_sph_p0
Definition th_mod.F:113
subroutine spmd_gather_int(sendbuf, recvbuf, proc, send_size, rcv_size)
subroutine spmd_gatherv_int(sendbuf, recvbuf, proc, send_size, total_rcv_size, rcv_size, dipls)
subroutine thcoq_count(nthgrp2, ithgrp, wa_size, index_wa_coq, iparg, ithbuf, sithbuf)
Definition thcoq_count.F:30
subroutine thnod_count(ithgrp, nthgrp2, wa_size, index_wa_nod, ithbuf, weight, sithbuf)
Definition thnod_count.F:31
subroutine thnst_count(nthgrp2, ithgrp, wa_size, index_wa_nst, iparg, ithbuf, sithbuf)
Definition thnst_count.F:30
subroutine thpout_count(nthgrp2, ithgrp, wa_size, index_wa_pout, iparg, ithbuf, sithbuf)
subroutine thquad_count(nthgrp2, ithgrp, wa_size, index_wa_quad, iparg, ithbuf, sithbuf)
subroutine thres_count(iparg, ithbuf, elbuf_tab, igeo, ixr, ithgrp, nthgrp2, wa_size, index_wa_spring, sithbuf)
Definition thres_count.F:33
subroutine thsol_count(nthgrp2, ithgrp, wa_size, index_wa_sol, iparg, ithbuf, sithbuf)
Definition thsol_count.F:30
subroutine thsph_count(nthgrp2, ithgrp, wa_size, index_wa_sph, iparg, ithbuf, sithbuf)
Definition thsph_count.F:30
subroutine thtrus_count(nthgrp2, ithgrp, wa_size, index_wa_trus, iparg, ithbuf, sithbuf)