OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_cluster.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_read_cluster ../starter/source/output/cluster/hm_read_cluster.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl ../starter/source/starter/freform.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.f
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
33!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
34!|| itrimhpsort ../starter/source/output/cluster/itrimhpsort.F
35!||--- uses -----------------------------------------------------
36!|| cluster_mod ../starter/share/modules1/cluster_mod.F
37!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
38!|| message_mod ../starter/share/message_module/message_mod.F
39!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_cluster(CLUSTERS,UNITAB ,ISKN ,IGRBRIC,IGRSPRING,
43 . IXS ,IXR ,NOM_OPT ,LSUBMODEL)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE unitab_mod
48 USE message_mod
49 USE cluster_mod
50 USE groupdef_mod
51 USE submodel_mod , ONLY : nsubmod, submodel_data
52 USE hm_option_read_mod
53 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
54 USE reader_old_mod , ONLY : line, kline, key0, kcur
55 use element_mod , only : nixs,nixr
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "units_c.inc"
64#include "com04_c.inc"
65#include "param_c.inc"
66#include "scr17_c.inc"
67#include "sphcom.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
72 INTEGER ISKN(LISKN,*),IXS(NIXS,NUMELS),IXR(NIXR,NUMELR),NOM_OPT(LNOPT1,*)
73 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
74 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(NSUBMOD)
75C-----------------------------------------------
76 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
77 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I, J, K, II, JJ, KK, CLID, UID, IG, IGR, ISK, IFAIL, IEL, NEL, NNOD, IFLAGUNIT, NNOD0, NELMAX
82 INTEGER NOD1(2000),NOD2(2000),SUB_INDEX,ISK_L
83 my_real bid(1),ax(4),nx(4),fmax(2),mmax(2)
84 CHARACTER(LEN=NCHARTITLE)::TITR
85 CHARACTER(LEN=NCHARFIELD) :: KEY
86 parameter(nelmax = 500)
87 LOGICAL :: IS_AVAILABLE,FOUND
88C=======================================================================
89 is_available = .false.
90
91C--------------------------------------------------
92C START BROWSING MODEL CLUSTER
93C--------------------------------------------------
94c
95 CALL hm_option_start('/CLUSTER')
96c
97C--------------------------------------------------
98C EXTRACT DATAS
99C--------------------------------------------------
100 DO i=1,ncluster
101 titr = ''
102 CALL hm_option_read_key(lsubmodel,
103 . option_id = clid,
104 . unit_id = uid,
105 . submodel_index = sub_index,
106 . keyword2 = key,
107 . option_titr = titr)
108c
109 nom_opt(1,i)=clid
110 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
111c
112 iflagunit = 0
113 IF (uid > 0) THEN
114 DO j=1,unitab%NUNITS
115 IF (unitab%UNIT_ID(j) == uid) THEN
116 iflagunit = 1
117 EXIT
118 ENDIF
119 ENDDO
120 ENDIF
121 IF (uid / = 0 .and. iflagunit == 0) THEN
122 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,i1=clid,i2=uid,c1='CLUSTER',c2='CLUSTER',c3=titr)
123 ENDIF
124c----------------------------
125Card1
126 CALL hm_get_intv ('group_ID' ,igr ,is_available, lsubmodel)
127 CALL hm_get_intv ('skew_ID' ,isk ,is_available, lsubmodel)
128 CALL hm_get_intv ('ifail' ,ifail ,is_available, lsubmodel)
129
130Card2 Failure normal traction force
131
132 CALL hm_get_floatv('fn_fail1' ,fmax(1) ,is_available, lsubmodel, unitab)
133 CALL hm_get_floatv('scalefactor_a1',ax(1) ,is_available, lsubmodel, unitab)
134 CALL hm_get_floatv('scalefactor_b1',nx(1) ,is_available, lsubmodel, unitab)
135
136Card3 Failure tangent shear force
137
138 CALL hm_get_floatv('fs_fail' ,fmax(2) ,is_available, lsubmodel, unitab)
139 CALL hm_get_floatv('scalefactor_a2',ax(2) ,is_available, lsubmodel, unitab)
140 CALL hm_get_floatv('scalefactor_b2',nx(2) ,is_available, lsubmodel, unitab)
141
142Card4 Failure torsion moment
143
144 CALL hm_get_floatv('mt_fail' ,mmax(1) ,is_available, lsubmodel, unitab)
145 CALL hm_get_floatv('scalefactor_a3',ax(3) ,is_available, lsubmodel, unitab)
146 CALL hm_get_floatv('scalefactor_b3',nx(3) ,is_available, lsubmodel, unitab)
147
148Card5 Failure bending moment
149
150 CALL hm_get_floatv('mb_fail' ,mmax(2) ,is_available, lsubmodel, unitab)
151 CALL hm_get_floatv('scalefactor_a4',ax(4) ,is_available, lsubmodel, unitab)
152 CALL hm_get_floatv('scalefactor_b4',nx(4) ,is_available, lsubmodel, unitab)
153
154c----------------------------
155 isk_l = isk
156 IF (isk > 0) THEN
157 found = .false.
158 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
159 IF (isk == iskn(4,j+1)) THEN
160 isk = j+1
161 found = .true.
162 EXIT
163 ENDIF
164 ENDDO
165 IF (.NOT.found) THEN
166 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,c1='CLUSTER',c2='CLUSTER',i2=isk,i1=clid,c3=titr)
167 ENDIF
168 ENDIF
169 nod1 = 0
170 nod2 = 0
171 nnod = 0
172 nel = 0
173c----------------------------
174c BRICK CLUSTER
175c----------------------------
176 kk = ngrnod+1
177 IF (key(1:5) == 'BRICK') THEN
178 DO ig = 1,ngrbric
179 ii = ig
180 IF (igr == igrbric(ig)%ID .and. igrbric(ig)%GRTYPE == 1) THEN
181 nel = igrbric(ig)%NENTITY
182 IF (nel > nelmax) THEN
183 CALL ancmsg(msgid=1055, anmode=aninfo, msgtype=msgerror, i1=clid, i2=nel)
184 EXIT
185 ENDIF
186 clusters(i)%ID = clid
187 clusters(i)%IGR = ii
188 clusters(i)%TYPE = 1
189 clusters(i)%SKEW = isk
190 clusters(i)%NEL = nel
191 clusters(i)%IFAIL= ifail
192 clusters(i)%OFF = 1
193 clusters(i)%FAIL = one
194c
195 ALLOCATE (clusters(i)%NG(nel) )
196 ALLOCATE (clusters(i)%ELEM(nel) )
197 DO iel = 1,nel
198 jj = igrbric(ig)%ENTITY(iel)
199 clusters(i)%ELEM(iel) = jj ! Sys number
200c CLUSTERS(I)%ELEM(IEL-IAD+1) = IXS(11,JJ) ! Elem ID
201 DO k=2,5
202 nnod = nnod+1
203 nod1(nnod) = ixs(k ,jj)
204 nod2(nnod) = ixs(k+4,jj)
205 ENDDO
206 ENDDO
207c
208 nnod0=nnod
209 CALL itrimhpsort(nod1,nnod)
210 nnod = nnod0
211 CALL itrimhpsort(nod2,nnod)
212 clusters(i)%NNOD = nnod
213c
214 ALLOCATE (clusters(i)%NOD1(nnod))
215 ALLOCATE (clusters(i)%NOD2(nnod))
216 DO k=1,nnod
217 clusters(i)%NOD1(k) = nod1(k)
218 clusters(i)%NOD2(k) = nod2(k)
219 END DO
220c
221 WRITE(iout,1001) clid
222c
223 EXIT ! group found => exit loop
224 ENDIF
225 ENDDO ! IG = 1,NGRBRIC
226c
227 ELSEIF (key(1:6) == 'SPRING') THEN
228c----------------------------
229c SPRING CLUSTER
230c----------------------------
231 kk = ngrnod+ngrbric+ngrquad+ngrshel+ngrtrus+ngrbeam + 1
232 DO ig = 1,ngrspri
233 ii = kk+ig-1
234 IF (igr == igrspring(ig)%ID .and. igrspring(ig)%GRTYPE == 6) THEN
235 nel = igrspring(ig)%NENTITY
236 IF (nel > nelmax) THEN
237 CALL ancmsg(msgid=1055,
238 . anmode=aninfo,
239 . msgtype=msgerror,
240 . i1=clid,
241 . i2=nel)
242 EXIT
243 ENDIF
244 clusters(i)%ID = clid
245 clusters(i)%IGR = ii
246 clusters(i)%TYPE = 2
247 clusters(i)%SKEW = isk
248 clusters(i)%NEL = nel
249 clusters(i)%IFAIL= ifail
250 clusters(i)%OFF = 1
251 clusters(i)%FAIL = one
252c
253 ALLOCATE (clusters(i)%NG(nel) )
254 ALLOCATE (clusters(i)%ELEM(nel) )
255 DO iel = 1,nel
256 jj = igrspring(ig)%ENTITY(iel)
257 clusters(i)%ELEM(iel) = jj !IXR(6,JJ) ! Elem ID
258 nnod = nnod+1
259 nod1(nnod) = ixr(2,jj)
260 nod2(nnod) = ixr(3,jj)
261 ENDDO
262c
263 nnod0=nnod
264 CALL itrimhpsort(nod1,nnod)
265 nnod = nnod0
266 CALL itrimhpsort(nod2,nnod)
267 clusters(i)%NNOD = nnod
268c
269 ALLOCATE (clusters(i)%NOD1(nnod) )
270 ALLOCATE (clusters(i)%NOD2(nnod) )
271 DO k=1,nnod
272 clusters(i)%NOD1(k) = nod1(k)
273 clusters(i)%NOD2(k) = nod2(k)
274 END DO
275c
276 WRITE(iout,1002) clid
277c
278 EXIT ! group found => exit loop
279 ENDIF
280 ENDDO ! IG = 1,NGRSPRI
281 ENDIF
282c--------------------------
283 IF (nel == 0) THEN
284 CALL ancmsg(msgid=1054,
285 . anmode=aninfo,
286 . msgtype=msgerror,
287 . i1=clid,
288 . i2=igr)
289 cycle
290 ENDIF
291c--------------------------
292 IF (ifail > 0) THEN
293 IF (fmax(1) == zero) fmax(1) = infinity
294 IF (fmax(2) == zero) fmax(2) = infinity
295 IF (mmax(1) == zero) mmax(1) = infinity
296 IF (mmax(2) == zero) mmax(2) = infinity
297 ALLOCATE (clusters(i)%FMAX(2) )
298 ALLOCATE (clusters(i)%MMAX(2) )
299 clusters(i)%FMAX(1) = fmax(1)
300 clusters(i)%FMAX(2) = fmax(2)
301 clusters(i)%MMAX(1) = mmax(1)
302 clusters(i)%MMAX(2) = mmax(2)
303 ELSE
304 ALLOCATE (clusters(i)%FMAX(0) )
305 ALLOCATE (clusters(i)%MMAX(0) )
306 ENDIF
307 IF (ifail == 3) THEN
308 ALLOCATE (clusters(i)%AX(4) )
309 ALLOCATE (clusters(i)%NX(4) )
310 IF (ax(1) == zero) ax(1) = one
311 IF (ax(2) == zero) ax(2) = one
312 IF (ax(3) == zero) ax(3) = one
313 IF (ax(4) == zero) ax(4) = one
314 IF (nx(1) == zero) nx(1) = one
315 IF (nx(2) == zero) nx(2) = one
316 IF (nx(3) == zero) nx(3) = one
317 IF (nx(4) == zero) nx(4) = one
318 clusters(i)%AX(1) = ax(1)
319 clusters(i)%AX(2) = ax(2)
320 clusters(i)%AX(3) = ax(3)
321 clusters(i)%AX(4) = ax(4)
322 clusters(i)%NX(1) = nx(1)
323 clusters(i)%NX(2) = nx(2)
324 clusters(i)%NX(3) = nx(3)
325 clusters(i)%NX(4) = nx(4)
326 ELSE
327 ALLOCATE (clusters(i)%AX(0) )
328 ALLOCATE (clusters(i)%NX(0) )
329 ENDIF
330c-----
331 WRITE(iout,2000) igr, isk_l, nel, nnod*2, ifail
332 IF (ifail > 0) WRITE(iout,2001) fmax(1),fmax(2),mmax(1),mmax(2)
333 IF (ifail == 3) WRITE(iout,2002) ax(1),ax(2),ax(3),ax(4),
334 . nx(1),nx(2),nx(3),nx(4)
335
336 WRITE(iout,9000)
337c-----
338 ENDDO ! I=1,NCLUSTER
339C-------------------------------------
340 1001 FORMAT(/
341 & 5x,'SPOTWELD CLUSTER OF BRICK ELEMENTS, ID=',i10)
342 1002 FORMAT(/
343 & 5x,'SPOTWELD CLUSTER OF SPRING ELEMENTS, ID=',i10)
344 2000 FORMAT(
345 & 10x,'ELEMENT GROUP ID. . . . . . . . . . . . .=',i10/,
346 & 10x,'SKEW ID . . . . . . . . . . . . . . . . .=',i10/,
347 & 10x,'NUMBER OF ELEMENTS. . . . . . . . . . . .=',i10/,
348 & 10x,'NUMBER OF NODES . . . . . . . . . . . . .=',i10/,
349 & 10x,'FAILURE FLAG . . . . . . . . . . . . . .=',i10)
350 2001 FORMAT(
351 & 10x,'MAX NORMAL FORCE. . . . . . . . . . . . .=',1pg20.13/,
352 & 10x,'MAX TANGENT FORCE . . . . . . . . . . . .=',1pg20.13/,
353 & 10x,'MAX TORSION MOMENT. . . . . . . . . . . .=',1pg20.13/,
354 & 10x,'MAX BENDING MOMENT. . . . . . . . . . . .=',1pg20.13)
355 2002 FORMAT(
356 & 10x,'FAILURE COEFFICIENT A1. . . . . . . . . .=',1pg20.13/,
357 & 10x,'FAILURE COEFFICIENT A2. . . . . . . . . .=',1pg20.13/,
358 & 10x,'FAILURE COEFFICIENT A3. . . . . . . . . .=',1pg20.13/,
359 & 10x,'FAILURE COEFFICIENT A4. . . . . . . . . .=',1pg20.13/,
360 & 10x,'FAILURE EXPONENT N1 . . . . . . . . . . .=',1pg20.13/,
361 & 10x,'FAILURE EXPONENT N2 . . . . . . . . . . .=',1pg20.13/,
362 & 10x,'FAILURE EXPONENT N3 . . . . . . . . . . .=',1pg20.13/,
363 & 10x,'FAILURE EXPONENT N4 . . . . . . . . . . .=',1pg20.13)
364 9000 FORMAT(10x/)
365C-----------
366 RETURN
367 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_read_cluster
subroutine hm_read_cluster(clusters, unitab, iskn, igrbric, igrspring, ixs, ixr, nom_opt, lsubmodel)
Definition hm_read_cluster.F:44
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
itrimhpsort
subroutine itrimhpsort(tab, len)
Definition itrimhpsort.F:29
min
#define min(a, b)
Definition macros.h:20
cluster_mod
Definition cluster_mod.F:40
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
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
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:615
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:728