OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
init_mid_pid_array.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23
24!||====================================================================
25!|| init_mid_pid_array ../starter/source/spmd/tools/init_mid_pid_array.F
26!||--- called by ------------------------------------------------------
27!|| initwg ../starter/source/spmd/domain_decomposition/initwg.F
28!||--- uses -----------------------------------------------------
29!|| mid_pid_mod ../starter/share/modules1/mid_pid_mod.F
30!||====================================================================
31 SUBROUTINE init_mid_pid_array(MODE ,TAILLE ,NUMMAT ,NPART ,CONCORDANCE_MAT,
32 1 TAB_UMP ,PID_SHELL ,PID_TRI ,PID_SOL,
33 2 MID_PID_SHELL ,MID_PID_TRI ,MID_PID_SOL,
34 3 IPART ,IPM ,GEO ,CPUTIME_MP_OLD_2,
35 4 POIN_PART_SHELL,POIN_PART_TRI,POIN_PART_SOL)
36
37 USE mid_pid_mod
38
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com01_c.inc"
47#include "param_c.inc"
48#include "scr17_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52! integer
53 INTEGER, INTENT(IN) :: MODE,TAILLE,NUMMAT,NPART
54 INTEGER, DIMENSION(TAILLE), INTENT(INOUT) :: CONCORDANCE_MAT
55 INTEGER, DIMENSION(7,TAILLE), INTENT(IN) :: TAB_UMP
56 INTEGER, DIMENSION(2,NPART), INTENT(INOUT) :: POIN_PART_SHELL,POIN_PART_TRI
57 INTEGER, DIMENSION(2,NPART,7), INTENT(INOUT) :: POIN_PART_SOL
58 INTEGER, DIMENSION(NPROPMI,*), INTENT(IN) :: IPM
59
60 INTEGER, DIMENSION(LIPART1,*), INTENT(IN) :: IPART
61 INTEGER, DIMENSION(NUMMAT) :: PID_SHELL,PID_TRI
62 INTEGER, DIMENSION(NUMMAT,7) :: PID_SOL
63! real
64 my_real, DIMENSION(NPROPG,*), INTENT(IN) :: geo
65 my_real, DIMENSION(*) :: cputime_mp_old_2
66! other type
67 TYPE(mid_pid_type), DIMENSION(NUMMAT), INTENT(INOUT) :: MID_PID_SHELL,MID_PID_TRI
68 TYPE(mid_pid_type), DIMENSION(NUMMAT,7), INTENT(INOUT) :: MID_PID_SOL
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER :: ELM_TYP,MID,PID,IPID,ID,IGTYP,INDI,IGTYP_LOC,ILAW
73 INTEGER :: I,J
74C-----------------------------------------------
75C E x t e r n a l F u n c t i o n s
76C-----------------------------------------------
77
78C=======================================================================
79
80
81! ------------------------------------------------------------------------
82! MODE = 0 : create the mid_pid arrays for each element type that
83! will be used in INITWG_[X] subroutine (X = SHELL, SOL
84! or TRI). The mid_pid arrays will be initialized with
85! the Radioss element cost if MODE = 1 is not used.
86! If MODE = 1 is used, mid_pid will be initialized to
87! the element costs obtained from a previous Radioss run
88!
89! MODE = 1 : initialize the mid_pid arrays to the element costs
90! obtained from a previous Radioss run
91!
92! MODE = 0 : allocate and initialize the mid_pid_1 arrays for
93! each element type :
94! * check the number of pid properties
95! per mid ( %NBR_PID )
96! * allocate each array(mid)%pid1d ( number of
97! pid ) + %cost1d( number of pid )
98!
99! MODE = 1 : initialize each array(mid)%pid1d(pid) + %cost1d(pid)
100! ------------------------------------------------------------------------
101
102 IF(mode==0) THEN
103 concordance_mat(1:taille) = 0
104 DO i=1,taille
105 elm_typ = tab_ump(7,i)
106 mid = tab_ump(3,i)
107 pid = tab_ump(4,i)
108 IF(elm_typ==3.OR.elm_typ==7.OR.elm_typ==1.OR.
109 . elm_typ==1004.OR.elm_typ==1006.OR.elm_typ==1008.OR.
110 . elm_typ==1010.OR.elm_typ==1016.OR.elm_typ==1020) THEN
111 concordance_mat(i) = 1
112 ENDIF
113 ENDDO
114 ENDIF
115
116! -----------------------
117! check the number of pid properties per mid
118! -----------------------
119!
120! *********************************
121! mode = 0
122 IF(mode==0) THEN
123 DO i=1,taille
124 j = concordance_mat(i)
125 IF(j>0) THEN
126 elm_typ = tab_ump(7,i)
127 mid = tab_ump(3,i)
128 pid = tab_ump(4,i)
129 IF(elm_typ==3) THEN
130 pid_shell(mid) = pid_shell(mid) + 1
131 ELSEIF(elm_typ==7) THEN
132 pid_tri(mid) = pid_tri(mid) + 1
133 ELSE
134 indi = 0
135 IF(elm_typ==1) THEN
136 indi=1
137 ELSEIF(elm_typ==1004) THEN
138 indi = 6
139 ELSEIF(elm_typ==1006) THEN
140 indi = 5
141 ELSEIF(elm_typ==1008) THEN
142 indi = 7
143 ELSEIF(elm_typ==1010) THEN
144 indi = 2
145 ELSEIF(elm_typ==1016) THEN
146 indi = 3
147 ELSEIF(elm_typ==1020) THEN
148 indi = 4
149 ENDIF
150 IF(indi/=0) pid_sol(mid,indi) = pid_sol(mid,indi) + 1
151 ENDIF
152 ENDIF
153 ENDDO
154
155! -----------------------
156! allocate each array(mid)%pid1d ( number of pid ) + %cost1d
157! -----------------------
158 DO i=1,nummat
159 mid_pid_shell(i)%NBR_PID = 0
160 mid_pid_tri(i)%NBR_PID = 0
161 mid_pid_sol(i,1:7)%NBR_PID = 0
162 IF(pid_shell(i)>0) THEN
163 ALLOCATE( mid_pid_shell(i)%PID1D( pid_shell(i) ) )
164 ALLOCATE( mid_pid_shell(i)%COST1D( pid_shell(i) ) )
165 mid_pid_shell(i)%PID1D( 1:pid_shell(i) ) = 0
166 mid_pid_shell(i)%COST1D( 1:pid_shell(i) ) = zero
167 mid_pid_shell(i)%NBR_PID = pid_shell(i)
168 ENDIF
169 IF(pid_tri(i)>0) THEN
170 ALLOCATE( mid_pid_tri(i)%PID1D( pid_tri(i) ) )
171 ALLOCATE( mid_pid_tri(i)%COST1D( pid_tri(i) ) )
172 mid_pid_tri(i)%PID1D( 1 : pid_tri(i) ) = 0
173 mid_pid_tri(i)%COST1D( 1 : pid_tri(i) ) = zero
174 mid_pid_tri(i)%NBR_PID = pid_tri(i)
175 ENDIF
176 DO indi=1,7
177 IF(pid_sol(i,indi)>0) THEN
178 ALLOCATE( mid_pid_sol(i,indi)%PID1D( pid_sol(i,indi) ) )
179 ALLOCATE( mid_pid_sol(i,indi)%COST1D( pid_sol(i,indi) ) )
180 mid_pid_sol(i,indi)%PID1D( 1:pid_sol(i,indi) ) = 0
181 mid_pid_sol(i,indi)%COST1D( 1:pid_sol(i,indi) ) = zero
182 mid_pid_sol(i,indi)%NBR_PID = pid_sol(i,indi)
183 ELSE
184 mid_pid_sol(i,indi)%NBR_PID = 0
185 ENDIF
186 ENDDO
187 ENDDO
188 ENDIF
189
190! end of mode = 0
191! *********************************
192! mode = 0 or 1
193! mode = 0 --> %cost1d = 0
194! mode = 1 --> %cost1d = old cost
195! -----------------------
196! initialize each array(mid)%pid1d(pid) + %cost1d
197! -----------------------
198 pid_shell(1:nummat) = 0
199 pid_tri(1:nummat) = 0
200 pid_sol(1:nummat,1:7) = 0
201 DO i=1,taille
202 j = concordance_mat(i)
203 IF(j/=0) THEN
204 elm_typ = tab_ump(7,i)
205 mid = tab_ump(3,i)
206 pid = tab_ump(4,i)
207 IF(elm_typ==3) THEN
208 pid_shell(mid) = pid_shell(mid) + 1
209 mid_pid_shell(mid)%PID1D( pid_shell(mid) ) = pid
210 IF(mode==0) THEN
211 mid_pid_shell(mid)%COST1D( pid_shell(mid) ) = zero
212 ELSE
213 mid_pid_shell(mid)%COST1D( pid_shell(mid) ) = cputime_mp_old_2(j)
214 ENDIF
215 ELSEIF(elm_typ==7) THEN
216 pid_tri(mid) = pid_tri(mid) + 1
217 mid_pid_tri(mid)%PID1D( pid_tri(mid) ) = pid
218 IF(mode==0) THEN
219 mid_pid_tri(mid)%COST1D( pid_tri(mid) ) = zero
220 ELSE
221 mid_pid_tri(mid)%COST1D( pid_tri(mid) ) = cputime_mp_old_2(j)
222 ENDIF
223 ELSE
224 indi=0
225 IF(elm_typ==1) THEN
226 indi=1
227 ELSEIF(elm_typ==1004) THEN
228 indi = 6
229 ELSEIF(elm_typ==1006) THEN
230 indi = 5
231 ELSEIF(elm_typ==1008) THEN
232 indi = 7
233 ELSEIF(elm_typ==1010) THEN
234 indi = 2
235 ELSEIF(elm_typ==1016) THEN
236 indi = 3
237 ELSEIF(elm_typ==1020) THEN
238 indi = 4
239 ENDIF
240 IF(indi/=0) THEN
241 pid_sol(mid,indi) = pid_sol(mid,indi) + 1
242 mid_pid_sol(mid,indi)%PID1D( pid_sol(mid,indi) ) = pid
243 IF(mode==0) THEN
244 mid_pid_sol(mid,indi)%COST1D( pid_sol(mid,indi) ) = zero
245 ELSE
246 mid_pid_sol(mid,indi)%COST1D( pid_sol(mid,indi) ) = cputime_mp_old_2(j)
247 ENDIF
248 ENDIF
249 ENDIF
250 ENDIF
251 ENDDO
252! -----------------------
253! initialize the pointer POIN_PART_[x] :
254! POIN_PART gives the location of the (mid ; pid) pair in the mid_pid array
255! POIN_PART(1) = mid
256! POIN_PART(2) = place of the pid in all the properties of the mid
257! -----------------------
258! *********************************
259! mode = 0
260 IF(mode==0) THEN
261 DO i=1,npart
262 ipid = ipart(2,i)
263 id = ipart(4,i)
264 mid = ipart(1,i) ! Radioss internal mid per /PART
265 pid = ipart(2,i) ! Radioss internal pid per /PART
266 igtyp_loc=nint(geo(12,ipid))
267 IF(ipart(1,i) == 0)cycle !error message was printed, user must update mat_id
268 ilaw = ipm(2,ipart(1,i))
269! for /TRIA element, force the IGTYP flag
270! --> not really the best way to define a TRIA element but the TRIA element dev. was not
271! a beautiful dev! TRIA element are solid element but TRIA does not use the solid arrays (too simple!)
272! and use the SHELL3N arrays !!!!!!!!
273 IF(ilaw==151.AND.n2d/=0) igtyp_loc = 1
274 igtyp = igtyp_loc
275
276 IF(igtyp==1 .OR. igtyp==9 .OR. igtyp==10 .OR. igtyp==11 .OR.
277 . igtyp==16 .OR. igtyp==17 .OR. igtyp==19 .OR. igtyp==51 .OR.
278 . igtyp==52 .OR. igtyp==0 ) THEN
279! -----------------
280! SHELL ELEMENT
281! -----------------
282 IF(mid_pid_shell(mid)%NBR_PID>0) THEN
283 DO j=1,mid_pid_shell(mid)%NBR_PID
284 IF(pid==mid_pid_shell(mid)%PID1D(j)) THEN
285 poin_part_shell(1,i)=mid
286 poin_part_shell(2,i) = j
287 ENDIF
288 ENDDO
289 ENDIF
290! -----------------
291! SHELL3N ELEMENT
292! -----------------
293 IF(mid_pid_tri(mid)%NBR_PID>0) THEN
294 DO j=1,mid_pid_tri(mid)%NBR_PID
295 IF(pid==mid_pid_tri(mid)%PID1D(j)) THEN
296 poin_part_tri(1,i)=mid
297 poin_part_tri(2,i) = j
298 ENDIF
299 ENDDO
300 ENDIF
301 ELSEIF(igtyp==6 .OR. igtyp==14 .OR. igtyp==15 .OR.
302 . igtyp==20 .OR. igtyp==21 .OR. igtyp==22 .OR.
303 . igtyp==43 ) THEN
304! -----------------
305! SOLID ELEMENT
306! -----------------
307 DO indi=1,7
308 IF(mid_pid_sol(mid,indi)%NBR_PID>0) THEN
309 DO j=1,mid_pid_sol(mid,indi)%NBR_PID
310 IF(pid==mid_pid_sol(mid,indi)%PID1D(j)) THEN
311 poin_part_sol(1,i,indi)=mid
312 poin_part_sol(2,i,indi) = j
313 ENDIF
314 ENDDO
315 ENDIF
316 ENDDO
317 ELSEIF(igtyp==29.OR.igtyp==30.OR.igtyp==31 ) THEN
318! -----------------
319! USER ELEMENT
320! -----------------
321 DO indi=1,7
322 IF(mid_pid_sol(mid,indi)%NBR_PID>0) THEN
323 DO j=1,mid_pid_sol(mid,indi)%NBR_PID
324 IF(pid==mid_pid_sol(mid,indi)%PID1D(j)) THEN
325 poin_part_sol(1,i,indi)=mid
326 poin_part_sol(2,i,indi) = j
327 ENDIF
328 ENDDO
329 ENDIF
330 ENDDO
331 ENDIF
332 ENDDO
333 ENDIF
334! end of mode = 0
335! *********************************
336 RETURN
337
338 END SUBROUTINE init_mid_pid_array
my_real
#define my_real
Definition cppsort.cpp:32
init_mid_pid_array
subroutine init_mid_pid_array(mode, taille, nummat, npart, concordance_mat, tab_ump, pid_shell, pid_tri, pid_sol, mid_pid_shell, mid_pid_tri, mid_pid_sol, ipart, ipm, geo, cputime_mp_old_2, poin_part_shell, poin_part_tri, poin_part_sol)
Definition init_mid_pid_array.F:36
mid_pid_mod
Definition mid_pid_mod.F:36
mid_pid_mod::mid_pid_type
Definition mid_pid_mod.F:44