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!|| nintrn ../starter/source/system/nintrn.F
31!|| usr2sys ../starter/source/system/sysfus.F
32!|| vdouble ../starter/source/system/sysfus.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
36!|| submodel_mod ../starter/share/modules1/submodel_mod.F
37!||====================================================================
38 SUBROUTINE hm_read_beam(IXP ,ITAB ,ITABM1,IPART,IPARTP,
39 . IPM ,IGEO ,LSUBMODEL,IBEAM_VECTOR,RBEAM_VECTOR)
40C-----------------------------------------------
41C ROUTINE DESCRIPTION :
42C ===================
43C READ /BEAM ELEMENTS USING HM_READER
44C-----------------------------------------------
45C DUMMY ARGUMENTS DESCRIPTION:
46C ===================
47C
48C NAME DESCRIPTION
49C
50C IXP /BEAM ARRAY : CONNECTIVITY, ID, PID
51C ITAB USER ID OF NODES
52C ITABM1 REVERSE TAB ITAB
53C IPART PART ARRAY
54C IPARTP INTERNAL PART ID OF A GIVEN BEAM (INTERNAL ID)
55C IPM MATERIAL ARRAY (INTEGER)
56C IGEO PROP ARRAY (INTEGER)
57C LSUBMODEL SUBMODEL STRUCTURE
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE message_mod
62 USE submodel_mod , ONLY : submodel_data, nsubmod
63 USE reader_old_mod , ONLY : line
64 USE user_id_mod , ONLY : id_limit
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,ID,IDS,J,N,JC,STAT
99 INTEGER CPT,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 INTEGER NINTRN
110 DATA mess /'3D BEAM ELEMENTS DEFINITION '/
111 DATA mess2/'3D BEAM ELEMENTS SELECTION FOR TH PLOT '/
112C=======================================================================
113C--------------------------------------------------
114C ALLOCS & INITS
115C--------------------------------------------------
116 ALLOCATE (sub_beam(numelp),stat=stat)
117 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SUB_BEAM')
118 sub_beam(1:numelp) = 0
119 ALLOCATE (vx(numelp),stat=stat)
120 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='VX')
121 vx(1:numelp) = zero
122 ALLOCATE (vy(numelp),stat=stat)
123 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='VY')
124 vy(1:numelp) = zero
125 ALLOCATE (vz(numelp),stat=stat)
126 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='VZ')
127 vz(1:numelp) = zero
128 index_part = 1
129C--------------------------------------------------
130C READING BEAM INPUTS IN HM STRUCTURE
131C--------------------------------------------------
132 CALL cpp_beam_read(ixp,nixp,ipartp,sub_beam,vx,vy,vz)
133C--------------------------------------------------
134C FILL OTHER STRUCTURES + CHECKS
135C--------------------------------------------------
136 DO i=1,numelp
137C--------------------------------------------------
138C INTERNAL PART ID
139C--------------------------------------------------
140 IF( ipart(4,index_part) /= ipartp(i) )THEN
141 DO j=1,npart
142 IF(ipart(4,j)== ipartp(i) ) index_part = j
143 ENDDO
144 ENDIF
145 IF(ipart(4,index_part) /= ipartp(i)) THEN
146 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,c1="BEAM",i1=ipartp(i),i2=ipartp(i),prmod=msg_cumu)
147 ENDIF
148 ipartp(i) = index_part
149C--------------------------------------------------
150 mt=ipart(1,index_part)
151 ipid=ipart(2,index_part)
152 ixp(1,i)=mt
153 ixp(5,i)=ipid
154 IF (ixp(6,i)>id_limit%GLOBAL) THEN
155 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,i1=ixp(6,i),c1=line,c2='/BEAM')
156 ENDIF
157C direction input by vector VX,VY,VZ
158 norm = sqrt(vx(i)**2 + vy(i)**2 + vz(i)**2)
159 IF (norm > zero) THEN
160 ibeam_vector(i) = 1
161 rbeam_vector(1,i) = vx(i) / norm
162 rbeam_vector(2,i) = vy(i) / norm
163 rbeam_vector(3,i) = vz(i) / norm
164 ixp(4,i) = ixp(3,i)
165 ELSE
166 ibeam_vector(i) = 0
167 rbeam_vector(1:3,i) = zero
168 ENDIF
169C optional Node 3
170 IF ((ixp(4,i)==0 .OR. ixp(4,i)==ixp(2,i) .OR. ixp(4,i)==ixp(3,i)).
171 . and.(ibeam_vector(i)==0)) THEN
172 CALL ancmsg(msgid=2093,msgtype=msginfo,anmode=aninfo_blind_1,i1=ipart(4,index_part),i2=ixp(6,i),prmod=msg_cumu)
173 ixp(4,i) = ixp(3,i)
174 ENDIF
175 DO j=2,4
176 ixp(j,i)=usr2sys(ixp(j,i),itabm1,mess,ixp(6,i))
177 ENDDO
178C Node 1 and 2 Must be connected to something (CHECK_BEAM)
179C Node 3 is just a used node, to define directions (CHECK_USED)
180 CALL anodset(ixp(2,i), check_beam)
181 CALL anodset(ixp(3,i), check_beam)
182 CALL anodset(ixp(4,i), check_used)
183 ENDDO
184 IF(ALLOCATED(sub_beam)) DEALLOCATE(sub_beam)
185 IF(ALLOCATED(vx)) DEALLOCATE(vx)
186 IF(ALLOCATED(vy)) DEALLOCATE(vy)
187 IF(ALLOCATED(vz)) DEALLOCATE(vz)
188C-----------
189 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1, prmod=msg_print)
190C
191 CALL ancmsg(msgid=2093,msgtype=msginfo,anmode=aninfo_blind_1,prmod=msg_print)
192C-------------------------------------
193C Recherche des ID doubles
194C-------------------------------------
195 ids = 79
196 i = 0
197 j = 0
198 CALL vdouble(ixp(nixp,1),nixp,numelp,mess,0,bid)
199 ids = 28
200 i1=1
201 i2=min0(50,numelp)
202C-------------------------------------
203 90 WRITE (iout,300)
204 DO i=i1,i2
205 mid=ipm(1,ixp(1,i))
206 pid=igeo(1,ixp(5,i))
207 n2=ixp(2,i)
208 n3=ixp(3,i)
209 n4=ixp(4,i)
210 IF(n2>0)n2=itab(n2)
211 IF(n3>0)n3=itab(n3)
212 IF(n4>0)n4=itab(n4)
213 IF (ibeam_vector(i) == 0) THEN
214 WRITE (iout,'(7(I10,1X))')i,ixp(6,i),mid,pid,n2,n3,n4
215 ELSE
216 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)
217 ENDIF
218C----------------------------------------------------------------------------------
219 ENDDO
220 IF(i2==numelp)GOTO 200
221 i1=i1+50
222 i2=min0(i2+50,numelp)
223 GOTO 90
224C-------------------------------------
225 200 CONTINUE
226 RETURN
227 300 FORMAT(/' BEAM ELEMENTS'/
228 + ' -------------'/
229 + ' LOC-EL GLO-EL MATER GEOM NODE1 NODE2 NODE3/VECTOR')
230 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:40
message_mod
Definition message_mod.F:1249
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
vdouble
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:884
submodel_mod::submodel_data
Definition submodel_mod.F:723