OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rivet.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "scr17_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_rivet (ixri, v, vr, ms, in, rivet, geo, itab, itabm1, ikine, ipart, igeo, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_rivet()

subroutine hm_read_rivet ( integer, dimension(4,*), intent(out) ixri,
dimension(3,*), intent(inout) v,
dimension(3,*), intent(inout) vr,
dimension(*), intent(inout) ms,
dimension(*), intent(inout) in,
dimension(*), intent(inout) rivet,
dimension(npropg,*), intent(in) geo,
integer, dimension(*), intent(in) itab,
integer, dimension(*), intent(in) itabm1,
integer, dimension(*), intent(in) ikine,
integer, dimension(lipart1,*), intent(in) ipart,
integer, dimension(npropgi,*), intent(in) igeo,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 40 of file hm_read_rivet.F.

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
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
void anodset(int *id, int *type)
#define my_real
Definition cppsort.cpp:32
integer function nlocal(n, p)
Definition ddtools.F:349
subroutine ifrontplus(n, p)
Definition frontplus.F:100
integer nsubmod
subroutine rivet0(v, vr, ms, in, ixri, rivet, geo, itab, ikine)
Definition rivet0.F:34
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
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:884