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 46 of file init_th.F.

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