OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fill_gr.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!|| fill_gr ../starter/source/model/sets/fill_gr.F
25!||--- called by ------------------------------------------------------
26!|| fill_igr ../starter/source/model/sets/fill_igr.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| message_mod ../starter/share/message_module/message_mod.F
30!||====================================================================
31 SUBROUTINE fill_gr(IGRELE, NGRELEM ,IELT,
32 . SET_ID ,SET_TITLE,GETELEM, NELEM,SET_GREID)
33C-----------------------------------------------
34C ROUTINE DESCRIPTION :
35C ===================
36C Merge one SET type in Group
37C-----------------------------------------------
38C DUMMY ARGUMENTS DESCRIPTION:
39C ===================
40C
41C NAME DESCRIPTION
42C
43C SET Set Structure - Current SET
44C IGRXX Surfaces & Groups
45C============================================================================
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE my_alloc_mod
50 USE message_mod
51 USE groupdef_mod
52 USE setdef_mod
53 USE names_and_titles_mod , ONLY : nchartitle
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER,INTENT(IN) :: SET_ID
65 INTEGER,INTENT(INOUT) :: NGRELEM
66 INTEGER,INTENT(IN) :: NELEM,IELT
67 INTEGER,INTENT(IN) :: GETELEM(*)
68 INTEGER,INTENT(OUT) :: SET_GREID
69C-----------------------------------------------
70 TYPE (GROUP_) , TARGET ,INTENT(INOUT):: IGRELE(*)
71 CHARACTER(LEN=NCHARTITLE)::SET_TITLE
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER IGRE
76C-----------------------------------------------
77 !IF (NELEM == 0) RETURN create even if empty
78!
79! NELEM ==> nb of the elemes of the new group of element (IGRBRIC, ...)
80! (from /SET)
81!
82 igre = ngrelem
83!
84! create new grelem (IGRBRIC, etc) from elems of /SET
85!
86!---
87 igre = igre + 1
88!---
89 igrele(igre)%ID = set_id
90 igrele(igre)%TITLE = set_title
91 igrele(igre)%NENTITY = nelem
92 igrele(igre)%GRTYPE = ielt
93
94! not printout empty group
95 IF (nelem == 0) igrele(igre)%SET_GROUP = 1
96!
97 IF (nelem > 0) THEN
98 CALL my_alloc(igrele(igre)%ENTITY,nelem)
99 igrele(igre)%ENTITY(1:nelem) = getelem(1:nelem)
100 ENDIF
101
102 ! increment NGRELEM
103 ngrelem = igre
104
105 ! In SET save GRID
106 set_greid = igre
107C-----
108 RETURN
109 END
110!||====================================================================
111!|| fill_surf ../starter/source/model/sets/fill_gr.f
112!||--- called by ------------------------------------------------------
113!|| fill_igr ../starter/source/model/sets/fill_igr.F
114!||--- calls -----------------------------------------------------
115!||--- uses -----------------------------------------------------
116!|| message_mod ../starter/share/message_module/message_mod.F
117!||====================================================================
118 SUBROUTINE fill_surf(SET,IGRSURF,IGRS)
119C-----------------------------------------------
120C ROUTINE DESCRIPTION :
121C ===================
122C Merge SET%SURFACE into Radioss Surface
123C-----------------------------------------------
124C DUMMY ARGUMENTS DESCRIPTION:
125C ===================
126C
127C NAME DESCRIPTION
128C
129C SET Set Structure - Current SET
130C IGRSURF SURFACES
131C============================================================================
132C-----------------------------------------------
133C M o d u l e s
134C-----------------------------------------------
135 USE my_alloc_mod
136 USE message_mod
137 USE groupdef_mod
138 USE setdef_mod
139 USE qa_out_mod
140C-----------------------------------------------
141C I m p l i c i t T y p e s
142C-----------------------------------------------
143#include "implicit_f.inc"
144C-----------------------------------------------
145C D u m m y A r g u m e n t s
146C-----------------------------------------------
147 INTEGER IGRS
148 TYPE (SURF_) , TARGET ,INTENT(INOUT):: IGRSURF(*)
149 TYPE (SET_) , INTENT(INOUT) :: SET
150C-----------------------------------------------
151C L o c a l V a r i a b l e s
152C-----------------------------------------------
153 LOGICAL LINE_SEG, SURF_SEG
154 INTEGER NSEG
155 CHARACTER MESS*40
156 DATA mess/'SET SURF GROUP DEFINITION '/
157C-----------------------------------------------
158!
159! create new grelem (IGRBRIC, etc) from elems of /SET
160!
161 ! 3D or 2D
162 surf_seg = .false.
163 line_seg = .false.
164 nseg = 0
165 IF(set%NB_SURF_SEG > 0) THEN
166 !3D case
167 nseg = set%NB_SURF_SEG
168 surf_seg = .true.
169 ELSEIF(set%NB_LINE_SEG > 0)THEN
170 !2D case
171 nseg = set%NB_LINE_SEG
172 line_seg = .true.
173 ENDIF
174 !IF (NSEG == 0) RETURN ! create a Surface if empty
175!---
176 igrs = igrs + 1
177!
178 igrsurf(igrs)%ID = set%SET_ID
179 igrsurf(igrs)%TITLE = set%TITLE
180 igrsurf(igrs)%NSEG = nseg
181!
182 igrsurf(igrs)%TYPE = 0
183 igrsurf(igrs)%ID_MADYMO = 0
184 igrsurf(igrs)%IAD_BUFR = 0
185 igrsurf(igrs)%NB_MADYMO = 0
186 igrsurf(igrs)%TYPE_MADYMO = 0
187 igrsurf(igrs)%LEVEL = 1
188 igrsurf(igrs)%TH_SURF = 0
189 igrsurf(igrs)%ISH4N3N = 0
190 igrsurf(igrs)%NSEG_R2R_ALL = 0
191 igrsurf(igrs)%NSEG_R2R_SHARE = 0
192!
193! not printout empty group
194!
195 IF (nseg == 0) igrsurf(igrs)%SET_GROUP = 1
196!
197!
198 IF (nseg > 0) THEN
199!
200 IF (ALLOCATED(igrsurf(igrs)%NODES)) DEALLOCATE(igrsurf(igrs)%NODES)
201 IF (ALLOCATED(igrsurf(igrs)%ELTYP)) DEALLOCATE(igrsurf(igrs)%ELTYP)
202 IF (ALLOCATED(igrsurf(igrs)%ELEM)) DEALLOCATE(igrsurf(igrs)%ELEM)
203!
204 CALL my_alloc(igrsurf(igrs)%NODES,nseg,4)
205 CALL my_alloc(igrsurf(igrs)%ELTYP,nseg)
206 CALL my_alloc(igrsurf(igrs)%ELEM,nseg)
207!
208 IF(surf_seg)THEN
209 igrsurf(igrs)%NODES(1:nseg,1) = set%SURF_NODES(1:nseg,1)
210 igrsurf(igrs)%NODES(1:nseg,2) = set%SURF_NODES(1:nseg,2)
211 igrsurf(igrs)%NODES(1:nseg,3) = set%SURF_NODES(1:nseg,3)
212 igrsurf(igrs)%NODES(1:nseg,4) = set%SURF_NODES(1:nseg,4)
213 igrsurf(igrs)%ELTYP(1:nseg) = set%SURF_ELTYP(1:nseg)
214 igrsurf(igrs)%ELEM(1:nseg) = set%SURF_ELEM(1:nseg)
215 igrsurf(igrs)%EXT_ALL = set%EXT_ALL
216 ENDIF
217
218 IF(line_seg)THEN
219 igrsurf(igrs)%NODES(1:nseg,1) = set%LINE_NODES(1:nseg,1)
220 igrsurf(igrs)%NODES(1:nseg,2) = set%LINE_NODES(1:nseg,2)
221 igrsurf(igrs)%NODES(1:nseg,3) = 0
222 igrsurf(igrs)%NODES(1:nseg,4) = 0
223 igrsurf(igrs)%ELTYP(1:nseg) = set%LINE_ELTYP(1:nseg)
224 igrsurf(igrs)%ELEM(1:nseg) = set%LINE_ELEM(1:nseg)
225 ENDIF
226
227 ENDIF ! IF (NSEG > 0)
228
229 set%SET_NSURF_ID = igrs
230 set%HAS_SURF_SEG = nseg
231
232C-----
233 RETURN
234 END
235!||====================================================================
236!|| fill_line ../starter/source/model/sets/fill_gr.F
237!||--- called by ------------------------------------------------------
238!|| fill_igr ../starter/source/model/sets/fill_igr.F
239!||--- calls -----------------------------------------------------
240!||--- uses -----------------------------------------------------
241!|| message_mod ../starter/share/message_module/message_mod.F
242!||====================================================================
243 SUBROUTINE fill_line(SET,IGRSLIN ,IGRL)
244C-----------------------------------------------
245C ROUTINE DESCRIPTION :
246C ===================
247C Merge SET%LINE into Radioss Lines
248C-----------------------------------------------
249C DUMMY ARGUMENTS DESCRIPTION:
250C ===================
251C
252C NAME DESCRIPTION
253C
254C SET Set Structure - Current SET
255C IGRSURF SURFACES
256C============================================================================
257C-----------------------------------------------
258C M o d u l e s
259C-----------------------------------------------
260 USE my_alloc_mod
261 USE message_mod
262 USE groupdef_mod
263 USE setdef_mod
264C-----------------------------------------------
265C I m p l i c i t T y p e s
266C-----------------------------------------------
267#include "implicit_f.inc"
268C-----------------------------------------------
269C D u m m y A r g u m e n t s
270C-----------------------------------------------
271 INTEGER,INTENT(INOUT) :: IGRL
272C-----------------------------------------------
273 TYPE (SURF_) , INTENT(INOUT) :: IGRSLIN(*)
274 TYPE (SET_) , INTENT(INOUT) :: SET
275 CHARACTER(LEN=NCHARTITLE)::SET_TITLE
276C-----------------------------------------------
277C L o c a l V a r i a b l e s
278C-----------------------------------------------
279 INTEGER NSEG
280 CHARACTER MESS*40
281 DATA mess/'SET LINE GROUP DEFINITION '/
282C-----------------------------------------------
283!
284 nseg = set%NB_LINE_SEG
285 !IF (NSEG == 0) RETURN ! create a Surface if empty
286
287 igrl = igrl + 1
288!
289!
290 igrslin(igrl)%ID = set%SET_ID
291 igrslin(igrl)%TITLE = set%TITLE
292 igrslin(igrl)%NSEG = nseg
293!
294 igrslin(igrl)%TYPE = 0
295 igrslin(igrl)%LEVEL = 1
296 igrslin(igrl)%NSEG_R2R_ALL = 0
297 igrslin(igrl)%NSEG_R2R_SHARE = 0
298!
299! not printout empty group
300!
301 IF (nseg == 0) igrslin(igrl)%SET_GROUP = 1
302!
303!
304 IF (nseg > 0) THEN
305!
306 IF (ALLOCATED(igrslin(igrl)%NODES)) DEALLOCATE(igrslin(igrl)%NODES)
307 IF (ALLOCATED(igrslin(igrl)%ELTYP)) DEALLOCATE(igrslin(igrl)%ELTYP)
308 IF (ALLOCATED(igrslin(igrl)%ELEM)) DEALLOCATE(igrslin(igrl)%ELEM)
309 IF (ALLOCATED(igrslin(igrl)%PROC)) DEALLOCATE(igrslin(igrl)%PROC)
310!
311 CALL my_alloc(igrslin(igrl)%NODES,nseg,2)
312 CALL my_alloc(igrslin(igrl)%ELTYP,nseg)
313 CALL my_alloc(igrslin(igrl)%ELEM,nseg)
314 CALL my_alloc(igrslin(igrl)%PROC,nseg)
315!
316 igrslin(igrl)%NODES(1:nseg,1) = set%LINE_NODES(1:nseg,1)
317 igrslin(igrl)%NODES(1:nseg,2) = set%LINE_NODES(1:nseg,2)
318 igrslin(igrl)%ELTYP(1:nseg) = set%LINE_ELTYP(1:nseg)
319 igrslin(igrl)%ELEM(1:nseg) = set%LINE_ELEM(1:nseg)
320 igrslin(igrl)%PROC(1:nseg) = 0
321 ENDIF ! IF (NSEG > 0)
322C-----
323 set%SET_NSLIN_ID=igrl
324 set%HAS_LINE_SEG = nseg
325
326 RETURN
327 END
328
fill_line
subroutine fill_line(set, igrslin, igrl)
Definition fill_gr.F:244
fill_gr
subroutine fill_gr(igrele, ngrelem, ielt, set_id, set_title, getelem, nelem, set_greid)
Definition fill_gr.F:33
fill_surf
subroutine fill_surf(set, igrsurf, igrs)
Definition fill_gr.F:119
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
qa_out_mod
Definition qa_out_mod.F:78
setdef_mod
Definition setdef_mod.F:107
starter
program starter
Definition starter.F:39