OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rivet.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_rivet ../starter/source/elements/reader/hm_read_rivet.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!|| ifrontplus ../starter/source/spmd/node/frontplus.F
31!|| nlocal ../starter/source/spmd/node/ddtools.F
32!|| rivet0 ../starter/source/elements/reader/rivet0.F
33!|| usr2sys ../starter/source/system/sysfus.F
34!|| vdouble ../starter/source/system/sysfus.F
35!||--- uses -----------------------------------------------------
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_rivet(IXRI ,V ,VR ,MS ,IN ,
41 . RIVET ,GEO ,ITAB ,ITABM1,IKINE ,
42 . IPART ,IGEO ,LSUBMODEL)
43C-----------------------------------------------
44C ROUTINE DESCRIPTION :
45C ===================
46C READ /RIVET ELEMENTS USING HM_READER
47C-----------------------------------------------
48C DUMMY ARGUMENTS DESCRIPTION:
49C ===================
50C
51C NAME DESCRIPTION
52C
53C IXRI /RIVET ARRAY : CONNECTIVITY, ID, PID
54C V NODAL VELOCITIES
55C VR NODAL ROTATIONEAL VELOCITIES
56C MS NODAL MASSES
57C IN NODAL INERTIA
58C RIVET RIVET ARRAY (FLOAT)
59C GEO PROP ARRAY (FLOAT)
60C ITAB USER ID OF NODES
61C ITABM1 REVERSE TAB ITAB
62C IKINE KINEMATIC CONDITION ARRAY
63C IPART PART ARRAY
64C IGEO PROP ARRAY (INTEGER)
65C LSUBMODEL SUBMODEL STRUCTURE
66C-----------------------------------------------
67C M o d u l e s
68C-----------------------------------------------
69 USE message_mod
70 USE submodel_mod , ONLY : nsubmod, submodel_data
71 USE reader_old_mod , ONLY : line
72 USE user_id_mod , ONLY : id_limit
73C-----------------------------------------------
74C I m p l i c i t T y p e s
75C-----------------------------------------------
76#include "implicit_f.inc"
77C-----------------------------------------------
78C A n a l y s e M o d u l e
79C-----------------------------------------------
80#include "analyse_name.inc"
81C-----------------------------------------------
82C C o m m o n B l o c k s
83C-----------------------------------------------
84#include "scr17_c.inc"
85#include "com01_c.inc"
86#include "com04_c.inc"
87#include "param_c.inc"
88#include "units_c.inc"
89C-----------------------------------------------
90C D u m m y A r g u m e n t s
91C-----------------------------------------------
92C INPUT ARGUMENTS
93 my_real,INTENT(INOUT)::ms(*)
94 my_real,INTENT(INOUT)::in(*)
95 my_real,INTENT(IN)::geo(npropg,*)
96 INTEGER,INTENT(IN)::ITAB(*)
97 INTEGER,INTENT(IN)::ITABM1(*)
98 INTEGER,INTENT(IN)::IPART(LIPART1,*)
99 INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
100 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(NSUBMOD)
101C OUTPUT ARGUMENTS
102 INTEGER,INTENT(OUT)::IXRI(4,*)
103C INPUT/OUTPUT ARGUMENTS
104 my_real,INTENT(INOUT)::v(3,*)
105 my_real,INTENT(INOUT)::vr(3,*)
106 my_real,INTENT(INOUT)::rivet(*)
107 INTEGER,INTENT(IN)::IKINE(*)
108C-----------------------------------------------
109C F u n c t i o n
110C-----------------------------------------------
111 INTEGER NLOCAL
112 EXTERNAL NLOCAL
113C-----------------------------------------------
114C L o c a l V a r i a b l e s
115C-----------------------------------------------
116 INTEGER I, I1, I2, PID,MT,IPID,J,N,STAT,P,IF1,IF2
117 INTEGER CPT,INDEX_PART
118 CHARACTER MESS*40, MESS2*40
119 my_real bid
120 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_RIVET,IPART_RIVET
121C-----------------------------------------------
122C E x t e r n a l F u n c t i o n s
123C-----------------------------------------------
124 INTEGER USR2SYS
125 DATA MESS/'RIVET OR SPOTWELD DEFINITION '/
126C=======================================================================
127C--------------------------------------------------
128C ALLOCS & INITS
129C--------------------------------------------------
130 ALLOCATE (sub_rivet(nrivet),stat=stat)
131 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SUB_RIVET')
132 sub_rivet(1:nrivet) = 0
133 ALLOCATE (ipart_rivet(nrivet),stat=stat)
134 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='IPART_RIVET')
135 ipart_rivet(1:nrivet) = 0
136 index_part = 1
137C--------------------------------------------------
138C READING BEAM INPUTS IN HM STRUCTURE
139C--------------------------------------------------
140 CALL cpp_rivet_read(ixri,4,ipart_rivet,sub_rivet)
141C--------------------------------------------------
142C FILL OTHER STRUCTURES + CHECKS
143C--------------------------------------------------
144 DO i=1,nrivet
145C--------------------------------------------------
146C INTERNAL PART ID
147C--------------------------------------------------
148 IF( ipart(4,index_part) /= ipart_rivet(i) )THEN
149 DO j=1,npart
150 IF(ipart(4,j)== ipart_rivet(i) ) index_part = j
151 ENDDO
152 ENDIF
153 IF(ipart(4,index_part) /= ipart_rivet(i)) THEN
154 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,
155 . c1="RIVET",
156 . i1=ipart_rivet(i),
157 . i2=ipart_rivet(i),
158 . prmod=msg_cumu)
159 ENDIF
160 ipart_rivet(i) = index_part
161 mt=ipart(1,index_part)
162 ipid=ipart(2,index_part)
163 ixri(1,i)=ipid
164 IF (ixri(4,i)>id_limit%GLOBAL) THEN
165 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,i1=ixri(4,i),c1=line,c2='/RIVET')
166 ENDIF
167 ENDDO
168C--------------------------------------------------
169 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
170C--------------------------------------------------
171
172 DO j=1,nrivet
173 ixri(2,j)=usr2sys(ixri(2,j),itabm1,mess,ixri(4,nrivet))
174 ixri(3,j)=usr2sys(ixri(3,j),itabm1,mess,ixri(4,nrivet))
175 CALL anodset(ixri(2,j), check_2n)
176 CALL anodset(ixri(3,j), check_2n)
177 ENDDO
178 DO p = 1, nspmd
179 DO j=1,nrivet
180 if1 = nlocal(ixri(2,j),p)
181 if2 = nlocal(ixri(3,j),p)
182 IF (if1==1.OR.if2==1) THEN
183 CALL ifrontplus(ixri(2,j),p)
184 CALL ifrontplus(ixri(3,j),p)
185 ENDIF
186 ENDDO
187 ENDDO
188C-------------------------------------
189C Recherche des ID doubles
190C-------------------------------------
191 CALL vdouble(ixri(4,1),4,nrivet,mess,0,bid)
192C-------------------------------------
193 DO j=1,nrivet
194 if1 = 0
195 DO p = 1, nspmd
196 if1 = if1 + nlocal(ixri(2,j),p)
197 ENDDO
198 IF (if1==0) THEN
199 CALL ifrontplus(ixri(2,j),1)
200 CALL ifrontplus(ixri(3,j),1)
201 ENDIF
202 ENDDO
203 CALL rivet0(v,vr,ms,in,ixri,rivet,geo,itab,ikine)
204
205 i1=1
206 i2=min0(50,nrivet)
207
208 90 WRITE (iout,300)
209 DO i=i1,i2
210 pid=igeo(1,ixri(1,i))
211 WRITE (iout,270) i,ixri(4,i),pid,itab(ixri(2,i)),itab(ixri(3,i))
212 ENDDO
213 IF(i2==nrivet)RETURN
214 i1=i1+50
215 i2=min0(i2+50,nrivet)
216 GOTO 90
217
218 IF(ALLOCATED(sub_rivet)) DEALLOCATE(sub_rivet)
219 IF(ALLOCATED(ipart_rivet)) DEALLOCATE(ipart_rivet)
220C-------------------------------------
221C
222 270 FORMAT(6i10)
223 300 FORMAT(/' RIVET ' /
224 + ,' -------'/
225 + ' LOC-EL GLO-EL GEOM NODE1 NODE2')
226 RETURN
227 END
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:100
hm_read_rivet
subroutine hm_read_rivet(ixri, v, vr, ms, in, rivet, geo, itab, itabm1, ikine, ipart, igeo, lsubmodel)
Definition hm_read_rivet.F:43
message_mod
Definition message_mod.F:1249
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
rivet0
subroutine rivet0(v, vr, ms, in, ixri, rivet, geo, itab, ikine)
Definition rivet0.F:34
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