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