OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_setfxrbyon.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!|| hm_setfxrbyon ../starter/source/constraints/fxbody/hm_setfxrbyon.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| fxrline ../starter/source/constraints/fxbody/hm_read_fxb.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
31!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
32!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
33!|| read_pch_file ../starter/source/constraints/fxbody/read_pch_file.F
34!|| usr2sys ../starter/source/system/sysfus.F
35!||--- uses -----------------------------------------------------
36!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_setfxrbyon(ITABM1,IXS,ISOLOFF,IXC,ISHEOFF,
41 . IXT,ITRUOFF,IXP,IPOUOFF,IXR,IRESOFF,
42 . IXTG,ITRIOFF,FXBIPM,LSUBMODEL)
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
413 END SUBROUTINE hm_setfxrbyon
414
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
fxrline
subroutine fxrline(ific, nwline, id, titr)
Definition hm_read_fxb.F:1023
hm_setfxrbyon
subroutine hm_setfxrbyon(itabm1, ixs, isoloff, ixc, isheoff, ixt, itruoff, ixp, ipouoff, ixr, iresoff, ixtg, itrioff, fxbipm, lsubmodel)
Definition hm_setfxrbyon.F:43
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
hm_option_read_mod
Definition hm_option_read_mod.F:408
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: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
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:889
freerr
subroutine freerr(it)
Definition freform.F:506
submodel_mod::submodel_data
Definition submodel_mod.F:723