OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fill_gr.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fill_gr (igrele, ngrelem, ielt, set_id, set_title, getelem, nelem, set_greid)
subroutine fill_surf (set, igrsurf, igrs)
subroutine fill_line (set, igrslin, igrl)

Function/Subroutine Documentation

◆ fill_gr()

subroutine fill_gr ( type (group_), dimension(*), intent(inout), target igrele,
integer, intent(inout) ngrelem,
integer, intent(in) ielt,
integer, intent(in) set_id,
character(len=nchartitle) set_title,
integer, dimension(*), intent(in) getelem,
integer, intent(in) nelem,
integer, intent(out) set_greid )

Definition at line 31 of file fill_gr.F.

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 IGRxxx 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 I,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
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
setdef_mod
Definition setdef_mod.F:107

◆ fill_line()

subroutine fill_line ( type (set_), intent(inout) set,
type (surf_), dimension(*), intent(inout) igrslin,
integer, intent(inout) igrl )

Definition at line 243 of file fill_gr.F.

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

◆ fill_surf()

subroutine fill_surf ( type (set_), intent(inout) set,
type (surf_), dimension(*), intent(inout), target igrsurf,
integer igrs )

Definition at line 118 of file fill_gr.F.

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
qa_out_mod
Definition qa_out_mod.F:78