OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_setfxrbyon.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "fxbcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_setfxrbyon (itabm1, ixs, isoloff, ixc, isheoff, ixt, itruoff, ixp, ipouoff, ixr, iresoff, ixtg, itrioff, fxbipm, lsubmodel)

Function/Subroutine Documentation

◆ hm_setfxrbyon()

subroutine hm_setfxrbyon ( integer, dimension(*) itabm1,
integer, dimension(nixs,*) ixs,
integer, dimension(*) isoloff,
integer, dimension(nixc,*) ixc,
integer, dimension(*) isheoff,
integer, dimension(nixt,*) ixt,
integer, dimension(*) itruoff,
integer, dimension(nixp,*) ixp,
integer, dimension(*) ipouoff,
integer, dimension(nixr,*) ixr,
integer, dimension(*) iresoff,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) itrioff,
integer, dimension(nbipm,*) fxbipm,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 40 of file hm_setfxrbyon.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE message_mod
47 USE inoutfile_mod
48 USE submodel_mod
49 USE hm_option_read_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com04_c.inc"
59#include "units_c.inc"
60#include "fxbcom.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER ITABM1(*),FXBIPM(NBIPM,*)
65 INTEGER IXS(NIXS,*),ISOLOFF(*),
66 * IXC(NIXC,*),ISHEOFF(*),
67 * IXT(NIXT,*),ITRUOFF(*),
68 * IXP(NIXP,*),IPOUOFF(*),
69 * IXR(NIXR,*),IRESOFF(*),
70 * IXTG(NIXTG,*),ITRIOFF(*)
71 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER NFX,ID,NMOD,NMST,NBNO,NME,NTR,ADRGLM,
76 . ADRCP,ADRLM,ADRFLS,ADRDLS,ADRVAR,ADRRPM,IMOD,INO,I,LEN,
77 . NLIG,NRES,ILIG,ADRCP2,IR,ADRNOD,NUMNO(10),IDAMP,ISHELL,
78 . ADRMCD,IBLO,IFILE,IMIN,IMAX
79 INTEGER IDUM1
80 INTEGER NOD
81 INTEGER II,NALL,LENGTH,FLAG,SIZE_STIFF,SIZE_MASS
82 my_real rdum1,rdum2,rdum3,rdum4,rdum5
83 CHARACTER(LEN=NCHARTITLE) :: TITR
84 CHARACTER :: MESS*40,NWLINE*100,FXBFILE*100,EXTENSION*3
85
86 INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG
87
88 INTEGER :: LEN_TMP_NAME
89 CHARACTER(len=2148) :: TMP_NAME
90 LOGICAL :: IS_AVAILABLE
91C-----------------------------------------------
92C E x t e r n a l F u n c t i o n s
93C-----------------------------------------------
94 INTEGER USR2SYS
95C=====================================================================
96 ALLOCATE (itag(numnod))
97C
98 lenmat = 0
99 adrnod = 1
100 adrglm = 1
101 adrcp = 1
102 adrlm = 1
103 adrfls = 1
104 adrdls = 1
105 adrvar = 1
106 adrrpm = 1
107 adrmcd = 1
108 is_available = .false.
109C
110 ! Start ready FXBODY
111 CALL hm_option_start('/FXBODY')
112C
113 ! Loop over FXBODY
114 DO nfx = 1,nfxbody
115C
116 itag(1:numnod) = 0
117 size_stiff = 0
118 size_mass = 0
119C
120 ! Title and ID
121 titr = ''
122 CALL hm_option_read_key(lsubmodel,
123 . option_id = id,
124 . option_titr = titr)
125C
126 ! Integer data card
127 CALL hm_get_intv('node_IDm',idum1 ,is_available,lsubmodel)
128 CALL hm_get_intv('Imin' ,imin ,is_available,lsubmodel)
129 CALL hm_get_intv('Imax' ,imax ,is_available,lsubmodel)
130C
131 ! File name
132 CALL hm_get_string('Filename',fxbfile ,100 ,is_available)
133C
134 length = len_trim(fxbfile)
135 IF (length > 2) extension = fxbfile(length-2:length)
136C
137 IF ((extension == "pch.OR.")(EXTENSION == "pch")) THEN
138C-- Pre-reading of pch file for tag of nodes and number of nodes
139 FLAG = 0
140 CALL READ_PCH_FILE(FLAG,RDUM1,ITAG,IDUM1,SIZE_STIFF,
141 . SIZE_MASS,ITABM1,FXBFILE,ID,TITR)
142C
143 NBNO = 0
144 DO I=1,NUMNOD
145 IF (ITAG(I) > 0) THEN
146 NBNO = NBNO + 1
147 ENDIF
148 ENDDO
149C
150 FXBIPM(41,NFX) = 2
151 FXBIPM(42,NFX) = SIZE_STIFF
152 FXBIPM(43,NFX) = SIZE_MASS
153C
154 ELSE
155C
156C-- Pre-reading of Radioss fxb file for dimensions and tag of nodes
157 FXBIPM(41,NFX) = 1
158C
159 LEN_TMP_NAME = INFILE_NAME_LEN+len_trim(FXBFILE)
160 TMP_NAME=INFILE_NAME(1:INFILE_NAME_LEN)//FXBFILE(1:len_trim(FXBFILE))
161 OPEN(UNIT=IFICM,FILE=TMP_NAME(1:LEN_TMP_NAME),
162 . ACCESS='SEQUENTIAL',FORM='FORMATTED',
163 . STATUS='OLD',ERR=999)
164
165 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
166 READ(NWLINE,FMT='(7I8)',ERR=9999)
167 . NMOD, NMST, NBNO, ISHELL, IDAMP, IBLO, IFILE
168C
169 IF (ISHELL == 0) THEN
170 NME = 12
171 ELSE
172 NME = 15
173 ENDIF
174 IMIN = 0
175 IF (IMAX == 0) IMAX = NMOD
176 IMIN = MAX(1,IMIN)
177 IMAX = MIN(NMOD,IMAX)
178C
179 ADRMCD = ADRMCD+NME*NME
180C
181 NLIG = NBNO/10
182 NRES = NBNO-NLIG*10
183 DO ILIG = 1,NLIG
184 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
185 READ(NWLINE,'(10I8)',ERR=9999)
186 . (NUMNO(I),I=1,10)
187 DO I=1,10
188 NOD = USR2SYS(NUMNO(I),ITABM1,MESS,ID)
189 ITAG(NOD)=1
190 ENDDO
191 ENDDO
192 IF (NRES > 0) THEN
193 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
194 READ(NWLINE,'(10I8)',ERR=9999)
195 . (NUMNO(I),I=1,NRES)
196 DO I = 1,NRES
197 NOD = USR2SYS(NUMNO(I),ITABM1,MESS,ID)
198 ITAG(NOD) = 1
199 ENDDO
200 ENDIF
201C
202 NTR = 9
203 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
204 READ(NWLINE,'(5F16.0)',ERR=9999)
205 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
206 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
207 READ(NWLINE,'(5F16.0)',ERR=9999)
208 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
209C
210 IF (IDAMP > 0) THEN
211 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
212 READ(NWLINE,'(2F16.0)',ERR=9999)
213 . RDUM1,RDUM2
214 ELSE
215
216 ENDIF
217C
218 IF (IBLO == 0) THEN
219 DO IMOD = 1,NME
220 DO INO = 1,NBNO
221 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
222 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
223 ENDDO
224 ENDDO
225 ENDIF
226 DO IMOD = 1,NMOD
227 DO INO = 1,NBNO
228 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
229 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
230 ENDDO
231 ENDDO
232C
233 IF (NMOD > 0) THEN
234 LEN = NMOD
235 NLIG = LEN/5
236 NRES = LEN-NLIG*5
237 DO ILIG = 1,NLIG
238 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
239 READ(NWLINE,'(5F16.0)',ERR=9999)
240 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
241 ENDDO
242 IF (NRES > 0) THEN
243 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
244 READ(NWLINE,'(5F16.0)',ERR=9999)
245 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
246 ENDIF
247 ENDIF
248C
249 IF (NMST > 0) THEN
250 LEN = NMST*(2*NMOD-NMST+1)/2
251 NLIG = LEN/5
252 NRES = LEN-NLIG*5
253 DO ILIG = 1,NLIG
254 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
255 READ(NWLINE,'(5F16.0)',ERR=9999)
256 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
257 ENDDO
258 IF (NRES > 0) THEN
259 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
260 READ(NWLINE,'(5F16.0)',ERR=9999)
261 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
262 ENDIF
263 ENDIF
264C
265 IF ((NMOD-NMST) > 0) THEN
266 LEN = NMOD-NMST
267 NLIG = LEN/5
268 NRES = LEN-NLIG*5
269 DO ILIG = 1,NLIG
270 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
271 READ(NWLINE,'(5F16.0)',ERR=9999)
272 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
273 ENDDO
274 IF (NRES > 0) THEN
275 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
276 READ(NWLINE,'(5F16.0)',ERR=9999)
277 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
278 ENDIF
279 ENDIF
280C
281 IF (IBLO == 1) THEN
282 GOTO 100
283 ENDIF
284C
285 LEN = NME*(NME+1)/2
286 NLIG = LEN/5
287 NRES = LEN-NLIG*5
288 DO ILIG = 1,NLIG
289 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
290 READ(NWLINE,'(5F16.0)',ERR=9999)
291 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
292 ENDDO
293 IF (NRES > 0) THEN
294 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
295 READ(NWLINE,'(5F16.0)',ERR=9999)
296 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
297 ENDIF
298C
299 IF (NMOD > 0) THEN
300 ADRCP2 = ADRCP
301 DO IR = 1,NTR
302 LEN = NME*NMOD
303 NLIG = LEN/5
304 NRES = LEN-NLIG*5
305 DO ILIG = 1,NLIG
306 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
307 READ(NWLINE,'(5F16.0)',ERR=9999)
308 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
309 ENDDO
310 IF (NRES > 0) THEN
311 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
312 READ(NWLINE,'(5F16.0)',ERR=9999)
313 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
314 ENDIF
315 ENDDO
316C
317 DO IR = 1,NTR
318 LEN = NME*NMOD
319 NLIG = LEN/5
320 NRES = LEN-NLIG*5
321 DO ILIG = 1,NLIG
322 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
323 READ(NWLINE,'(5F16.0)',ERR=9999)
324 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
325 ENDDO
326 IF (NRES > 0) THEN
327 CALL FXRLINE(IFICM,NWLINE,ID,TITR)
328 READ(NWLINE,'(5F16.0)',ERR=9999)
329 . RDUM1,RDUM2,RDUM3,RDUM4,RDUM5
330 ENDIF
331 ENDDO
332 ENDIF
333C
334 ENDIF
335C
336 100 CLOSE(IFICM)
337C
338 FXBIPM(3,NFX) = NBNO
339 LENNOD = LENNOD + NBNO
340 LENMAT = LENMAT + SIZE_STIFF + SIZE_MASS
341C
342C Solid elements
343 DO II = 1,NUMELS
344 NALL = ITAG(IXS(2,II)) * ITAG(IXS(3,II)) *
345 + ITAG(IXS(4,II)) * ITAG(IXS(5,II)) *
346 + ITAG(IXS(6,II)) * ITAG(IXS(7,II)) *
347 + ITAG(IXS(8,II)) * ITAG(IXS(9,II))
348 IF (NALL /= 0) THEN
349 ISOLOFF(II) = 3
350 END IF
351 ENDDO
352
353C 4-nodes shell elements
354 DO II=1,NUMELC
355 NALL = ITAG(IXC(2,II)) * ITAG(IXC(3,II)) *
356 + ITAG(IXC(4,II)) * ITAG(IXC(5,II))
357 IF (NALL /= 0) THEN
358 ISHEOFF(II) = 3
359 END IF
360 ENDDO
361
362C Truss elements
363 DO II=1,NUMELT
364 NALL = ITAG(IXT(2,II)) * ITAG(IXT(3,II))
365 IF (NALL /= 0) THEN
366 ITRUOFF(II) = 3
367 END IF
368 ENDDO
369
370C Beam elements
371 DO II=1,NUMELP
372 NALL = ITAG(IXP(2,II)) * ITAG(IXP(3,II))
373 IF (NALL /= 0) THEN
374 IPOUOFF(II) = 3
375 END IF
376 ENDDO
377
378C Spring elements
379 DO II=1,NUMELR
380 NALL = ITAG(IXR(2,II)) * ITAG(IXR(3,II))
381 IF (NALL /= 0) THEN
382 IRESOFF(II) = 3
383 END IF
384 ENDDO
385
386C 3-nodes shell elements
387 DO II=1,NUMELTG
388 NALL = ITAG(IXTG(2,II)) * ITAG(IXTG(3,II)) * ITAG(IXTG(4,II))
389 IF (NALL /= 0) THEN
390 ITRIOFF(II) = 3
391 END IF
392 ENDDO
393C
394 ENDDO ! end loop on flexible bodies
395
396
397 IF (ALLOCATED(ITAG)) DEALLOCATE (ITAG)
398C
399 RETURN
400 999 CALL FREERR(3)
401 IF (ALLOCATED(ITAG)) DEALLOCATE (ITAG)
402 RETURN
4039999 CALL ANCMSG(MSGID=566,
404 . MSGTYPE=MSGERROR,
405 . ANMODE=ANINFO,
406 . I1=ID,
407 . C1=TITR,
408 . C2=FXBFILE,
409 . C3=NWLINE)
410 IF (ALLOCATED(ITAG)) DEALLOCATE (ITAG)
411 RETURN
412C
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:76
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
id
initmumps id
Definition multiplerhs_example.m:4
hm_option_read_mod
Definition hm_option_read_mod.F:408
inoutfile_mod
Definition inoutfile_mod.F:96
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
submodel_mod
Definition submodel_mod.F:712