OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_beam.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_beam ../starter/source/elements/reader/hm_read_beam.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| anodset ../starter/source/output/analyse/analyse_node.c
30!|| usr2sys ../starter/source/system/sysfus.F
31!|| vdouble ../starter/source/system/sysfus.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_beam(IXP ,ITAB ,ITABM1,IPART,IPARTP,
38 . IPM ,IGEO ,LSUBMODEL,IBEAM_VECTOR,RBEAM_VECTOR)
39C-----------------------------------------------
40C ROUTINE DESCRIPTION :
41C ===================
42C READ /BEAM ELEMENTS USING HM_READER
43C-----------------------------------------------
44C DUMMY ARGUMENTS DESCRIPTION:
45C ===================
46C
47C NAME DESCRIPTION
48C
49C IXP /BEAM ARRAY : CONNECTIVITY, ID, PID
50C ITAB USER ID OF NODES
51C ITABM1 REVERSE TAB ITAB
52C IPART PART ARRAY
53C IPARTP INTERNAL PART ID OF A GIVEN BEAM (INTERNAL ID)
54C IPM MATERIAL ARRAY (INTEGER)
55C IGEO PROP ARRAY (INTEGER)
56C LSUBMODEL SUBMODEL STRUCTURE
57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE message_mod
61 USE submodel_mod , ONLY : submodel_data, nsubmod
62 USE reader_old_mod , ONLY : line
63 USE user_id_mod , ONLY : id_limit
64 use element_mod , only : nixp
65C-----------------------------------------------
66C I m p l i c i t T y p e s
67C-----------------------------------------------
68#include "implicit_f.inc"
69C-----------------------------------------------
70C A n a l y s e M o d u l e
71C-----------------------------------------------
72#include "analyse_name.inc"
73C-----------------------------------------------
74C C o m m o n B l o c k s
75C-----------------------------------------------
76#include "scr17_c.inc"
77#include "com04_c.inc"
78#include "param_c.inc"
79#include "units_c.inc"
80C-----------------------------------------------
81C D u m m y A r g u m e n t s
82C-----------------------------------------------
83C INPUT ARGUMENTS
84 INTEGER,INTENT(IN)::ITAB(*)
85 INTEGER,INTENT(IN)::ITABM1(*)
86 INTEGER,INTENT(IN)::IPART(LIPART1,*)
87 INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
88 INTEGER,INTENT(IN)::IPM(NPROPMI,*)
89 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(NSUBMOD)
90C OUTPUT ARGUMENTS
91 INTEGER,INTENT(OUT)::IXP(NIXP,*)
92 INTEGER,INTENT(OUT)::IPARTP(*)
93 INTEGER,INTENT(OUT)::IBEAM_VECTOR(NUMELP)
94 my_real,INTENT(OUT)::rbeam_vector(3,numelp)
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 INTEGER I, I1, I2, MID, PID,MT,IPID,IDS,J,STAT
99 INTEGER INDEX_PART
100 CHARACTER MESS*40, MESS2*40
101 my_real bid,norm
102 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_BEAM
103 INTEGER N2,N3,N4
104 real*8, DIMENSION(:), ALLOCATABLE :: vx,vy,vz
105C-----------------------------------------------
106C E x t e r n a l F u n c t i o n s
107C-----------------------------------------------
108 INTEGER USR2SYS
109 DATA mess /'3D BEAM ELEMENTS DEFINITION '/
110 DATA mess2/'3D BEAM ELEMENTS SELECTION FOR TH PLOT '/
111C=======================================================================
112C--------------------------------------------------
113C ALLOCS & INITS
114C--------------------------------------------------
115 ALLOCATE (sub_beam(numelp),stat=stat)
116 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SUB_BEAM')
117 sub_beam(1:numelp) = 0
118 ALLOCATE (vx(numelp),stat=stat)
119 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='VX')
120 vx(1:numelp) = zero
121 ALLOCATE (vy(numelp),stat=stat)
122 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='VY')
123 vy(1:numelp) = zero
124 ALLOCATE (vz(numelp),stat=stat)
125 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='VZ')
126 vz(1:numelp) = zero
127 index_part = 1
128C--------------------------------------------------
129C READING BEAM INPUTS IN HM STRUCTURE
130C--------------------------------------------------
131 CALL cpp_beam_read(ixp,nixp,ipartp,sub_beam,vx,vy,vz)
132C--------------------------------------------------
133C FILL OTHER STRUCTURES + CHECKS
134C--------------------------------------------------
135 DO i=1,numelp
136C--------------------------------------------------
137C INTERNAL PART ID
138C--------------------------------------------------
139 IF( ipart(4,index_part) /= ipartp(i) )THEN
140 DO j=1,npart
141 IF(ipart(4,j)== ipartp(i) ) index_part = j
142 ENDDO
143 ENDIF
144 IF(ipart(4,index_part) /= ipartp(i)) THEN
145 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,c1="BEAM",i1=ipartp(i),i2=ipartp(i),prmod=msg_cumu)
146 ENDIF
147 ipartp(i) = index_part
148C--------------------------------------------------
149 mt=ipart(1,index_part)
150 ipid=ipart(2,index_part)
151 ixp(1,i)=mt
152 ixp(5,i)=ipid
153 IF (ixp(6,i)>id_limit%GLOBAL) THEN
154 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,i1=ixp(6,i),c1=line,c2='/BEAM')
155 ENDIF
156C direction input by vector VX,VY,VZ
157 norm = sqrt(vx(i)**2 + vy(i)**2 + vz(i)**2)
158 IF (norm > em20) THEN
159 ibeam_vector(i) = 1
160 rbeam_vector(1,i) = vx(i) / norm
161 rbeam_vector(2,i) = vy(i) / norm
162 rbeam_vector(3,i) = vz(i) / norm
163 ixp(4,i) = ixp(3,i)
164 ELSE
165 ibeam_vector(i) = 0
166 rbeam_vector(1:3,i) = zero
167 ENDIF
168C optional Node 3
169 IF ((ixp(4,i)==0 .OR. ixp(4,i)==ixp(2,i) .OR. ixp(4,i)==ixp(3,i)).
170 . and.(ibeam_vector(i)==0)) THEN
171 CALL ancmsg(msgid=2093,msgtype=msginfo,anmode=aninfo_blind_1,i1=ipart(4,index_part),i2=ixp(6,i),prmod=msg_cumu)
172 ixp(4,i) = ixp(3,i)
173 ENDIF
174 DO j=2,4
175 ixp(j,i)=usr2sys(ixp(j,i),itabm1,mess,ixp(6,i))
176 ENDDO
177C Node 1 and 2 Must be connected to something (CHECK_BEAM)
178C Node 3 is just a used node, to define directions (CHECK_USED)
179 CALL anodset(ixp(2,i), check_beam)
180 CALL anodset(ixp(3,i), check_beam)
181 CALL anodset(ixp(4,i), check_used)
182 ENDDO
183 IF(ALLOCATED(sub_beam)) DEALLOCATE(sub_beam)
184 IF(ALLOCATED(vx)) DEALLOCATE(vx)
185 IF(ALLOCATED(vy)) DEALLOCATE(vy)
186 IF(ALLOCATED(vz)) DEALLOCATE(vz)
187C-----------
188 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1, prmod=msg_print)
189C
190 CALL ancmsg(msgid=2093,msgtype=msginfo,anmode=aninfo_blind_1,prmod=msg_print)
191C-------------------------------------
192C Search for double IDs
193C-------------------------------------
194 ids = 79
195 i = 0
196 j = 0
197 CALL vdouble(ixp(nixp,1),nixp,numelp,mess,0,bid)
198 ids = 28
199 i1=1
200 i2=min0(50,numelp)
201C-------------------------------------
202 90 WRITE (iout,300)
203 DO i=i1,i2
204 mid=ipm(1,ixp(1,i))
205 pid=igeo(1,ixp(5,i))
206 n2=ixp(2,i)
207 n3=ixp(3,i)
208 n4=ixp(4,i)
209 IF(n2>0)n2=itab(n2)
210 IF(n3>0)n3=itab(n3)
211 IF(n4>0)n4=itab(n4)
212 IF (ibeam_vector(i) == 0) THEN
213 WRITE (iout,'(7(I10,1X))')i,ixp(6,i),mid,pid,n2,n3,n4
214 ELSE
215 WRITE (iout,'(6(I10,1X),3(1PG20.13,1X))')i,ixp(6,i),mid,pid,n2,n3,rbeam_vector(1,i),rbeam_vector(2,i),rbeam_vector(3,i)
216 ENDIF
217C----------------------------------------------------------------------------------
218 ENDDO
219 IF(i2==numelp)GOTO 200
220 i1=i1+50
221 i2=min0(i2+50,numelp)
222 GOTO 90
223C-------------------------------------
224 200 CONTINUE
225 RETURN
226 300 FORMAT(/' BEAM ELEMENTS'/
227 + ' -------------'/
228 + ' LOC-EL GLO-EL MATER GEOM NODE1 NODE2 NODE3/VECTOR')
229 END
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
hm_read_beam
subroutine hm_read_beam(ixp, itab, itabm1, ipart, ipartp, ipm, igeo, lsubmodel, ibeam_vector, rbeam_vector)
Definition hm_read_beam.F:39
message_mod
Definition message_mod.F:1257
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
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
vdouble
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:868
submodel_mod::submodel_data
Definition submodel_mod.F:728