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
51 use element_mod , only : nixs,nixc,nixt,nixp,nixr,nixtg
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com04_c.inc"
60#include "units_c.inc"
61#include "fxbcom.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER ITABM1(*),FXBIPM(NBIPM,*)
66 INTEGER IXS(NIXS,*),ISOLOFF(*),
67 * IXC(NIXC,*),ISHEOFF(*),
68 * IXT(NIXT,*),ITRUOFF(*),
69 * IXP(NIXP,*),IPOUOFF(*),
70 * IXR(NIXR,*),IRESOFF(*),
71 * IXTG(NIXTG,*),ITRIOFF(*)
72 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER NFX,ID,NMOD,NMST,NBNO,NME,NTR,ADRGLM,
77 . ADRCP,ADRLM,ADRFLS,ADRDLS,ADRVAR,ADRRPM,IMOD,INO,I,LEN,
78 . NLIG,NRES,ILIG,ADRCP2,IR,ADRNOD,NUMNO(10),IDAMP,ISHELL,
79 . ADRMCD,IBLO,IFILE,IMIN,IMAX
80 INTEGER IDUM1
81 INTEGER NOD
82 INTEGER II,NALL,LENGTH,FLAG,SIZE_STIFF,SIZE_MASS
83 my_real rdum1,rdum2,rdum3,rdum4,rdum5
84 CHARACTER(LEN=NCHARTITLE) :: TITR
85 CHARACTER :: MESS*40,NWLINE*100,FXBFILE*100,EXTENSION*3
86
87 INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG
88
89 INTEGER :: LEN_TMP_NAME
90 CHARACTER(len=2148) :: TMP_NAME
91 LOGICAL :: IS_AVAILABLE
92C-----------------------------------------------
93C E x t e r n a l F u n c t i o n s
94C-----------------------------------------------
95 INTEGER USR2SYS
96C=====================================================================
97 ALLOCATE (itag(numnod))
98C
99 lenmat = 0
100 adrnod = 1
101 adrglm = 1
102 adrcp = 1
103 adrlm = 1
104 adrfls = 1
105 adrdls = 1
106 adrvar = 1
107 adrrpm = 1
108 adrmcd = 1
109 is_available = .false.
110C
111 ! Start ready FXBODY
112 CALL hm_option_start('/FXBODY')
113C
114 ! Loop over FXBODY
115 DO nfx = 1,nfxbody
116C
117 itag(1:numnod) = 0
118 size_stiff = 0
119 size_mass = 0
120C
121 ! Title and ID
122 titr = ''
123 CALL hm_option_read_key(lsubmodel,
124 . option_id = id,
125 . option_titr = titr)
126C
127 ! Integer data card
128 CALL hm_get_intv('node_IDm',idum1 ,is_available,lsubmodel)
129 CALL hm_get_intv('Imin' ,imin ,is_available,lsubmodel)
130 CALL hm_get_intv('Imax' ,imax ,is_available,lsubmodel)
131C
132 ! File name
133 CALL hm_get_string('Filename',fxbfile ,100 ,is_available)
134C
135 length = len_trim(fxbfile)
136 IF (length > 2) extension = fxbfile(length-2:length)
137C
138 IF ((extension == "pch").OR.(extension == "PCH")) THEN
139C-- Pre-reading of pch file for tag of nodes and number of nodes
140 flag = 0
141 CALL read_pch_file(flag,rdum1,itag,idum1,size_stiff,
142 . size_mass,itabm1,fxbfile,id,titr)
143C
144 nbno = 0
145 DO i=1,numnod
146 IF (itag(i) > 0) THEN
147 nbno = nbno + 1
148 ENDIF
149 ENDDO
150C
151 fxbipm(41,nfx) = 2
152 fxbipm(42,nfx) = size_stiff
153 fxbipm(43,nfx) = size_mass
154C
155 ELSE
156C
157C-- Pre-reading of Radioss fxb file for dimensions and tag of nodes
158 fxbipm(41,nfx) = 1
159C
160 len_tmp_name = infile_name_len+len_trim(fxbfile)
161 tmp_name=infile_name(1:infile_name_len)//fxbfile(1:len_trim(fxbfile))
162 OPEN(unit=ificm,file=tmp_name(1:len_tmp_name),
163 . access='SEQUENTIAL',form='FORMATTED',
164 . status='OLD',err=999)
165
166 CALL fxrline(ificm,nwline,id,titr)
167 READ(nwline,fmt='(7I8)',err=9999)
168 . nmod, nmst, nbno, ishell, idamp, iblo, ifile
169C
170 IF (ishell == 0) THEN
171 nme = 12
172 ELSE
173 nme = 15
174 ENDIF
175 imin = 0
176 IF (imax == 0) imax = nmod
177 imin = max(1,imin)
178 imax = min(nmod,imax)
179C
180 adrmcd = adrmcd+nme*nme
181C
182 nlig = nbno/10
183 nres = nbno-nlig*10
184 DO ilig = 1,nlig
185 CALL fxrline(ificm,nwline,id,titr)
186 READ(nwline,'(10I8)',err=9999)
187 . (numno(i),i=1,10)
188 DO i=1,10
189 nod = usr2sys(numno(i),itabm1,mess,id)
190 itag(nod)=1
191 ENDDO
192 ENDDO
193 IF (nres > 0) THEN
194 CALL fxrline(ificm,nwline,id,titr)
195 READ(nwline,'(10I8)',err=9999)
196 . (numno(i),i=1,nres)
197 DO i = 1,nres
198 nod = usr2sys(numno(i),itabm1,mess,id)
199 itag(nod) = 1
200 ENDDO
201 ENDIF
202C
203 ntr = 9
204 CALL fxrline(ificm,nwline,id,titr)
205 READ(nwline,'(5F16.0)',err=9999)
206 . rdum1,rdum2,rdum3,rdum4,rdum5
207 CALL fxrline(ificm,nwline,id,titr)
208 READ(nwline,'(5F16.0)',err=9999)
209 . rdum1,rdum2,rdum3,rdum4,rdum5
210C
211 IF (idamp > 0) THEN
212 CALL fxrline(ificm,nwline,id,titr)
213 READ(nwline,'(2F16.0)',err=9999)
214 . rdum1,rdum2
215 ELSE
216
217 ENDIF
218C
219 IF (iblo == 0) THEN
220 DO imod = 1,nme
221 DO ino = 1,nbno
222 CALL fxrline(ificm,nwline,id,titr)
223 CALL fxrline(ificm,nwline,id,titr)
224 ENDDO
225 ENDDO
226 ENDIF
227 DO imod = 1,nmod
228 DO ino = 1,nbno
229 CALL fxrline(ificm,nwline,id,titr)
230 CALL fxrline(ificm,nwline,id,titr)
231 ENDDO
232 ENDDO
233C
234 IF (nmod > 0) THEN
235 len = nmod
236 nlig = len/5
237 nres = len-nlig*5
238 DO ilig = 1,nlig
239 CALL fxrline(ificm,nwline,id,titr)
240 READ(nwline,'(5F16.0)',err=9999)
241 . rdum1,rdum2,rdum3,rdum4,rdum5
242 ENDDO
243 IF (nres > 0) THEN
244 CALL fxrline(ificm,nwline,id,titr)
245 READ(nwline,'(5F16.0)',err=9999)
246 . rdum1,rdum2,rdum3,rdum4,rdum5
247 ENDIF
248 ENDIF
249C
250 IF (nmst > 0) THEN
251 len = nmst*(2*nmod-nmst+1)/2
252 nlig = len/5
253 nres = len-nlig*5
254 DO ilig = 1,nlig
255 CALL fxrline(ificm,nwline,id,titr)
256 READ(nwline,'(5F16.0)',err=9999)
257 . rdum1,rdum2,rdum3,rdum4,rdum5
258 ENDDO
259 IF (nres > 0) THEN
260 CALL fxrline(ificm,nwline,id,titr)
261 READ(nwline,'(5F16.0)',err=9999)
262 . rdum1,rdum2,rdum3,rdum4,rdum5
263 ENDIF
264 ENDIF
265C
266 IF ((nmod-nmst) > 0) THEN
267 len = nmod-nmst
268 nlig = len/5
269 nres = len-nlig*5
270 DO ilig = 1,nlig
271 CALL fxrline(ificm,nwline,id,titr)
272 READ(nwline,'(5F16.0)',err=9999)
273 . rdum1,rdum2,rdum3,rdum4,rdum5
274 ENDDO
275 IF (nres > 0) THEN
276 CALL fxrline(ificm,nwline,id,titr)
277 READ(nwline,'(5F16.0)',err=9999)
278 . rdum1,rdum2,rdum3,rdum4,rdum5
279 ENDIF
280 ENDIF
281C
282 IF (iblo == 1) THEN
283 GOTO 100
284 ENDIF
285C
286 len = nme*(nme+1)/2
287 nlig = len/5
288 nres = len-nlig*5
289 DO ilig = 1,nlig
290 CALL fxrline(ificm,nwline,id,titr)
291 READ(nwline,'(5F16.0)',err=9999)
292 . rdum1,rdum2,rdum3,rdum4,rdum5
293 ENDDO
294 IF (nres > 0) THEN
295 CALL fxrline(ificm,nwline,id,titr)
296 READ(nwline,'(5F16.0)',err=9999)
297 . rdum1,rdum2,rdum3,rdum4,rdum5
298 ENDIF
299C
300 IF (nmod > 0) THEN
301 adrcp2 = adrcp
302 DO ir = 1,ntr
303 len = nme*nmod
304 nlig = len/5
305 nres = len-nlig*5
306 DO ilig = 1,nlig
307 CALL fxrline(ificm,nwline,id,titr)
308 READ(nwline,'(5F16.0)',err=9999)
309 . rdum1,rdum2,rdum3,rdum4,rdum5
310 ENDDO
311 IF (nres > 0) THEN
312 CALL fxrline(ificm,nwline,id,titr)
313 READ(nwline,'(5F16.0)',err=9999)
314 . rdum1,rdum2,rdum3,rdum4,rdum5
315 ENDIF
316 ENDDO
317C
318 DO ir = 1,ntr
319 len = nme*nmod
320 nlig = len/5
321 nres = len-nlig*5
322 DO ilig = 1,nlig
323 CALL fxrline(ificm,nwline,id,titr)
324 READ(nwline,'(5F16.0)',err=9999)
325 . rdum1,rdum2,rdum3,rdum4,rdum5
326 ENDDO
327 IF (nres > 0) THEN
328 CALL fxrline(ificm,nwline,id,titr)
329 READ(nwline,'(5F16.0)',err=9999)
330 . rdum1,rdum2,rdum3,rdum4,rdum5
331 ENDIF
332 ENDDO
333 ENDIF
334C
335 ENDIF
336C
337 100 CLOSE(ificm)
338C
339 fxbipm(3,nfx) = nbno
340 lennod = lennod + nbno
341 lenmat = lenmat + size_stiff + size_mass
342C
343C Solid elements
344 DO ii = 1,numels
345 nall = itag(ixs(2,ii)) * itag(ixs(3,ii)) *
346 + itag(ixs(4,ii)) * itag(ixs(5,ii)) *
347 + itag(ixs(6,ii)) * itag(ixs(7,ii)) *
348 + itag(ixs(8,ii)) * itag(ixs(9,ii))
349 IF (nall /= 0) THEN
350 isoloff(ii) = 3
351 END IF
352 ENDDO
353
354C 4-nodes shell elements
355 DO ii=1,numelc
356 nall = itag(ixc(2,ii)) * itag(ixc(3,ii)) *
357 + itag(ixc(4,ii)) * itag(ixc(5,ii))
358 IF (nall /= 0) THEN
359 isheoff(ii) = 3
360 END IF
361 ENDDO
362
363C Truss elements
364 DO ii=1,numelt
365 nall = itag(ixt(2,ii)) * itag(ixt(3,ii))
366 IF (nall /= 0) THEN
367 itruoff(ii) = 3
368 END IF
369 ENDDO
370
371C Beam elements
372 DO ii=1,numelp
373 nall = itag(ixp(2,ii)) * itag(ixp(3,ii))
374 IF (nall /= 0) THEN
375 ipouoff(ii) = 3
376 END IF
377 ENDDO
378
379C Spring elements
380 DO ii=1,numelr
381 nall = itag(ixr(2,ii)) * itag(ixr(3,ii))
382 IF (nall /= 0) THEN
383 iresoff(ii) = 3
384 END IF
385 ENDDO
386
387C 3-nodes shell elements
388 DO ii=1,numeltg
389 nall = itag(ixtg(2,ii)) * itag(ixtg(3,ii)) * itag(ixtg(4,ii))
390 IF (nall /= 0) THEN
391 itrioff(ii) = 3
392 END IF
393 ENDDO
394C
395 ENDDO ! end loop on flexible bodies
396
397
398 IF (ALLOCATED(itag)) DEALLOCATE (itag)
399C
400 RETURN
401 999 CALL freerr(3)
402 IF (ALLOCATED(itag)) DEALLOCATE (itag)
403 RETURN
4049999 CALL ancmsg(msgid=566,
405 . msgtype=msgerror,
406 . anmode=aninfo,
407 . i1=id,
408 . c1=titr,
409 . c2=fxbfile,
410 . c3=nwline)
411 IF (ALLOCATED(itag)) DEALLOCATE (itag)
412 RETURN
413C
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:528
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:78
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
fxrline
subroutine fxrline(ific, nwline, id, titr)
Definition hm_read_fxb.F:1023
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
hm_option_read_mod
Definition hm_option_read_mod.F:412
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::infile_name_len
integer infile_name_len
Definition inoutfile_mod.F:114
inoutfile_mod::infile_name
character(len=infile_char_len) infile_name
Definition inoutfile_mod.F:116
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
submodel_mod
Definition submodel_mod.F:717
read_pch_file
subroutine read_pch_file(flag, matrix, itag, matrix_add, cpt_stiff, cpt_mass, itabm1, pch_file, id, titr)
Definition read_pch_file.F:37
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
freerr
subroutine freerr(it)
Definition freform.F:501
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146