OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
frontplus.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!|| frontplus_rm ../starter/source/spmd/node/frontplus.F
25!||--- called by ------------------------------------------------------
26!|| domdec2 ../starter/source/spmd/domdec2.F
27!||====================================================================
28 SUBROUTINE frontplus_rm(FRONT,INDEX)
29C-----------------------------------------------
30C I m p l i c i t T y p e s
31C-----------------------------------------------
32#include "implicit_f.inc"
33C-----------------------------------------------
34C D u m m y A r g u m e n t s
35C-----------------------------------------------
36 INTEGER FRONT,INDEX
37C-----------------------------------------------
38C L o c a l V a r i a b l e s
39C-----------------------------------------------
40 INTEGER F_INT,F_KIN,F_ACC
41C-----------------------------------------------------
42C S o u r c e L i n e s
43C-----------------------------------------------------
44 f_int = front / 100
45 f_kin = ( front - f_int*100 ) / 10
46 f_acc = front - f_int*100 - f_kin*10
47
48 IF(index==1) THEN
49 IF(f_acc==0) front = front + 1
50 ELSE IF(index==10) THEN
51 IF(f_kin==0) front = front + 10
52 ELSE IF(index==100) THEN
53 IF(f_int==0) front = front + 100
54 ENDIF
55
56 RETURN
57 END
58!||====================================================================
59!|| ifrontplus ../starter/source/spmd/node/frontplus.F
60!||--- called by ------------------------------------------------------
61!|| c_doms10 ../starter/source/spmd/domdec2.F
62!|| check_skew ../starter/source/spmd/domain_decomposition/check_skew.F
63!|| dd_fr ../starter/source/spmd/domain_decomposition/domdec1.F
64!|| dd_fr_2 ../starter/source/spmd/domain_decomposition/domdec1.F
65!|| dd_frx ../starter/source/spmd/domain_decomposition/domdec1.F
66!|| domain_decomposition_pcyl ../starter/source/loads/general/load_pcyl/domain_decomposition_pcyl.F
67!|| domdec2 ../starter/source/spmd/domdec2.F
68!|| hierarchy_rbody_ddm ../starter/source/constraints/general/rbody/hierarchy_rbody.F90
69!|| hm_read_cyljoint ../starter/source/constraints/general/cyl_joint/hm_read_cyljoint.F
70!|| hm_read_frm ../starter/source/tools/skew/hm_read_frm.F
71!|| hm_read_interfaces ../starter/source/interfaces/reader/hm_read_interfaces.F
72!|| hm_read_mpc ../starter/source/constraints/general/mpc/hm_read_mpc.F
73!|| hm_read_rbe2 ../starter/source/constraints/general/rbe2/hm_read_rbe2.F
74!|| hm_read_rivet ../starter/source/elements/reader/hm_read_rivet.F
75!|| i24setnodes ../starter/source/interfaces/inter3d1/i24setnodes.F
76!|| igrsurf_split ../starter/source/spmd/igrsurf_split.F
77!|| ini_seatbelt ../starter/source/tools/seatbelts/ini_seatbelt.f
78!|| iniend ../starter/source/interfaces/inter3d1/iniend.F
79!|| iniend2d ../starter/source/interfaces/inter3d1/iniend.F
80!|| inirbe3 ../starter/source/constraints/general/rbe3/hm_read_rbe3.F
81!|| lecstamp ../starter/source/interfaces/interf1/lecstamp.F
82!|| lectur ../starter/source/starter/lectur.F
83!|| pornod ../starter/source/ale/pornod.F
84!|| python_duplicate_nodes ../starter/source/spmd/domain_decomposition/python_duplicate_nodes.F90
85!|| r2r_domdec ../starter/source/coupling/rad2rad/r2r_domdec.F
86!|| read_dfs_detcord ../starter/source/initial_conditions/detonation/read_dfs_detcord.f
87!|| read_dfs_wave_shaper ../starter/source/initial_conditions/detonation/read_dfs_wave_shaper.F
88!|| read_ebcs ../starter/source/boundary_conditions/ebcs/read_ebcs.F
89!|| read_sensor_disp ../starter/source/tools/sensor/read_sensor_disp.F
90!|| set_ibufssg_io ../starter/source/starter/lectur.F
91!|| split_joint ../starter/source/constraints/general/cyl_joint/split_joint.F
92!|| spmdset ../starter/source/constraints/general/rbody/spmdset.F
93!|| uelt_spmd_additional_node ../starter/source/user_interface/uaccess.F
94!|| userwis_front ../starter/source/user_interface/user_windows_tools.F
95!||--- calls -----------------------------------------------------
96!|| realloc_ifront ../starter/source/spmd/node/ddtools.F
97!||--- uses -----------------------------------------------------
98!|| front_mod ../starter/share/modules1/front_mod.F
99!||====================================================================
100 SUBROUTINE ifrontplus(N,P)
101C sort insert in chained-list IFRONT node N on SPMD domain P
102C IFRONT%IENTRY : entry in IFRONT for node N
103C IFRONT%P(1,N) : SPMD domain for node N
104C IFRONT%P(2,N) : next index in IFRONT for node N
105C-----------------------------------------------
106C M o d u l e s
107C-----------------------------------------------
108 USE front_mod
109C-----------------------------------------------
110C I m p l i c i t T y p e s
111C-----------------------------------------------
112#include "implicit_f.inc"
113C-----------------------------------------------
114C D u m m y A r g u m e n t s
115C-----------------------------------------------
116 INTEGER N, P
117 LOGICAL SEARCH
118C-----------------------------------------------
119C L o c a l V a r i a b l e s
120C-----------------------------------------------
121 INTEGER CURR, NEXT
122C-----------------------------------------------------
123C S o u r c e L i n e s
124C-----------------------------------------------------
125
126c no SPMD domain already attributed for this node
127 IF(ifront%IENTRY(n)==-1)THEN
128 ! create new entry in IFRONT
129 ! plug IENTRY(N) to this new entry
130 ifront%IENTRY(n) = n
131 ifront%P(1,n) = p
132 ifront%P(2,n) = 0
133 RETURN
134 ENDIF
135
136c one or more SPMD domain(s) already attributed for this node
137
138 ! set current index to IENTRY(N)
139 curr = ifront%IENTRY(n)
140
141 ! if domain to insert is equal than current domain -> quit
142 IF(ifront%P(1,curr)==p) RETURN
143
144 ! test if domain to insert is lower than current domain
145 ! test assure that P is different from IFRONT%P(1,CURR)
146 IF(ifront%P(1,curr)>p)THEN
147 ! insert P at beginning of the list
148 IF(ifront_end+1>sifront)THEN
149 ! realloc if needed
150 CALL realloc_ifront()
151 ENDIF
152 ! create a new entry
153 ! plug IENTRY(N) to this new entry
154 ifront_end = ifront_end+1
155 ifront%IENTRY(n) = ifront_end
156 ! set new entry to P
157 ifront%P(1,ifront_end) = p
158 ! following is CURR index
159 ifront%P(2,ifront_end) = curr
160 RETURN
161 ENDIF
162
163 next = ifront%P(2,curr)
164 ! insertion must be done between CURR and NEXT
165 ! when CURR < P < NEXT
166 search = .true.
167 ! move forward in the list while IFRONT%P(1,CURR) < P
168 ! and while P not found
169 DO WHILE((search .EQV. .true.).AND.(ifront%P(1,curr)/=p))
170 IF(next==0)THEN
171 ! insert at end of list
172 IF(ifront_end+1>sifront)THEN
173 CALL realloc_ifront()
174 ENDIF
175 ifront_end = ifront_end+1
176 ifront%P(2,curr) = ifront_end
177 ifront%P(1,ifront_end) = p
178 ifront%P(2,ifront_end) = 0
179 search = .false.
180 RETURN
181 ELSEIF(ifront%P(1,next)>p)THEN
182 !insert between current and next
183 IF(ifront_end+1>sifront)THEN
184 CALL realloc_ifront()
185 ENDIF
186 ifront_end = ifront_end+1
187 ifront%P(2,curr) = ifront_end
188 ifront%P(1,ifront_end) = p
189 ifront%P(2,ifront_end) = next
190 search = .false.
191 RETURN
192 ELSE
193 !move forward in list
194 curr = next
195 next = ifront%P(2,next)
196 ENDIF
197 ENDDO
198
199 RETURN
200 END
201!||====================================================================
202!|| iddconnectplus ../starter/source/spmd/node/frontplus.F
203!||--- called by ------------------------------------------------------
204!|| dometis ../starter/source/spmd/domain_decomposition/grid2mat.F
205!||--- calls -----------------------------------------------------
206!|| realloc_iddconnect ../starter/source/spmd/node/ddtools.F
207!||--- uses -----------------------------------------------------
208!|| front_mod ../starter/share/modules1/front_mod.F
209!||====================================================================
210 SUBROUTINE iddconnectplus(N,P,NUMEL)
211C-----------------------------------------------
212C M o d u l e s
213C-----------------------------------------------
214 USE front_mod
215C-----------------------------------------------
216C I m p l i c i t T y p e s
217C-----------------------------------------------
218#include "implicit_f.inc"
219C-----------------------------------------------
220C D u m m y A r g u m e n t s
221C-----------------------------------------------
222 INTEGER N,P,NUMEL
223C-----------------------------------------------
224C L o c a l V a r i a b l e s
225C-----------------------------------------------
226 INTEGER CURR, NEXT
227 LOGICAL SEARCH
228C-----------------------------------------------------
229C S o u r c e L i n e s
230C-----------------------------------------------------
231
232 ! New entry for this node
233 IF(iddconnect%IENTRYDOM(1,n)==-1)THEN
234 ! create new entry in IFRONT
235 ! plug IENTRY(N) to this new entry
236 iddconnect%IENTRYDOM(1,n) = n
237 iddconnect%IENTRYDOM(2,n) = iddconnect%IENTRYDOM(2,n) + 1
238 iddconnect%PDOM(1,n) = p
239 iddconnect%PDOM(2,n) = 0
240 RETURN
241 ENDIF
242 ! One or more entries for this node
243
244 ! Set current index to IENTRY(N)
245 curr = iddconnect%IENTRYDOM(1,n)
246
247 ! If node N to insert is equal than current node --> quit
248 IF(iddconnect%PDOM(1,curr)==p) RETURN
249
250 ! Test if node to insert is lower than current node
251 ! Test assure that P is different from IFRONT%P(1,CURR)
252 IF(iddconnect%PDOM(1,curr)>p)THEN
253 ! Insert P at beginning of the list
254 IF(iddconnect_end+1>siddconnect)THEN
255 ! Realloc if needed
256 CALL realloc_iddconnect(numel)
257 ENDIF
258 ! create a new entry
259 ! plug IENTRY(N) to this new entry
260 iddconnect_end = iddconnect_end+1
261 iddconnect%IENTRYDOM(1,n) = iddconnect_end
262 ! set new entry to P
263 iddconnect%PDOM(1,iddconnect_end) = p
264 ! following is CURR index
265 iddconnect%PDOM(2,iddconnect_end) = curr
266 iddconnect%IENTRYDOM(2,n) = iddconnect%IENTRYDOM(2,n) + 1
267 RETURN
268 ENDIF
269
270 next = iddconnect%PDOM(2,curr)
271 ! insertion must be done between CURR and NEXT
272 ! when CURR < P < NEXT
273 search = .true.
274 ! move forward in the list while IFRONT%P(1,CURR) < P
275 ! and while P not found
276 DO WHILE((search .EQV. .true.).AND.(iddconnect%PDOM(1,curr)/=p))
277 IF(next==0)THEN
278 ! insert at end of list
279 IF(iddconnect_end+1>siddconnect)THEN
280 CALL realloc_iddconnect(numel)
281 ENDIF
282 iddconnect_end = iddconnect_end+1
283 iddconnect%PDOM(2,curr) = iddconnect_end
284 iddconnect%PDOM(1,iddconnect_end) = p
285 iddconnect%PDOM(2,iddconnect_end) = 0
286 search = .false.
287 iddconnect%IENTRYDOM(2,n) = iddconnect%IENTRYDOM(2,n) + 1
288 RETURN
289 ELSEIF(iddconnect%PDOM(1,next)>p)THEN
290 ! insert between current and next
291 IF(iddconnect_end+1>siddconnect)THEN
292 CALL realloc_iddconnect(numel)
293 ENDIF
294 iddconnect_end = iddconnect_end+1
295 iddconnect%PDOM(2,curr) = iddconnect_end
296 iddconnect%PDOM(1,iddconnect_end) = p
297 iddconnect%PDOM(2,iddconnect_end) = next
298 search = .false.
299 iddconnect%IENTRYDOM(2,n) = iddconnect%IENTRYDOM(2,n) + 1
300 RETURN
301 ELSE
302 ! move forward in list
303 curr = next
304 next = iddconnect%PDOM(2,next)
305 ENDIF
306 ENDDO
307
308 RETURN
309 END
realloc_iddconnect
subroutine realloc_iddconnect(nelem)
Definition ddtools.F:1157
realloc_ifront
subroutine realloc_ifront()
Definition ddtools.F:73
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:101
iddconnectplus
subroutine iddconnectplus(n, p, numel)
Definition frontplus.F:211
frontplus_rm
subroutine frontplus_rm(front, index)
Definition frontplus.F:29
ini_seatbelt
subroutine ini_seatbelt(iparg, elbuf_tab, knod2el1d, nod2el1d, ixr, x, itab, ipm, alea, knod2elc, nod2elc, ixc)
Definition ini_seatbelt.F:38
front_mod
Definition front_mod.F:84
front_mod::iddconnect_end
integer iddconnect_end
Definition front_mod.F:102
front_mod::ifront
type(my_front) ifront
Definition front_mod.F:93
front_mod::siddconnect
integer siddconnect
Definition front_mod.F:102
front_mod::sifront
integer sifront
Definition front_mod.F:107
front_mod::iddconnect
type(my_connectdom) iddconnect
Definition front_mod.F:101
front_mod::ifront_end
integer ifront_end
Definition front_mod.F:107
read_dfs_detcord
subroutine read_dfs_detcord(detonators, x, igrnod, ipm, itabm1, unitab, lsubmodel, itab)
Definition read_dfs_detcord.F:48
starter
program starter
Definition starter.F:39