OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecinv.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "param_c.inc"
#include "fxbcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lecinv (niniv, x, v, vr, itab, iframe, xframe, igrnod, fxbipm, fxbvit, fxbrpm)

Function/Subroutine Documentation

◆ lecinv()

subroutine lecinv ( integer niniv,
x,
v,
vr,
integer, dimension(*) itab,
integer, dimension(liskn,*) iframe,
xframe,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(nbipm,nfxbody), intent(in) fxbipm,
dimension(lenvar), intent(inout) fxbvit,
dimension(lenrpm), intent(in) fxbrpm )

Definition at line 36 of file lecinv.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE groupdef_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com04_c.inc"
52#include "units_c.inc"
53#include "com01_c.inc"
54#include "task_c.inc"
55#include "param_c.inc"
56#include "fxbcom.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NINIV,ITAB(*),IFRAME(LISKN,*)
61 INTEGER, INTENT(IN) :: FXBIPM(NBIPM,NFXBODY)
62C-----------------------------------------------
63 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
64C REAL
65 my_real
66 . x(3,*),v(3,*), vr(3,*), xframe(nxframe,*)
67 my_real, INTENT(IN) :: fxbrpm(lenrpm)
68 my_real, INTENT(INOUT) :: fxbvit(lenvar)
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I,J,JJ,K,N,N1,N2,K1,K2,K3,NGR2USR,II
73 INTEGER IDIR,CPT0,CPT1,IFM,IFRA,IGN,CPT20,CPT21
74C REAL
75 my_real
76 . vv ,vtx ,vty ,vtz , nixj(6),
77 . vx ,vy ,vz
78 EXTERNAL ngr2usr
79C-----------------------------------------------
80C
81 IF(ispmd==0) THEN
82 WRITE(iout,'(//,A,/)')' VELOCITY REINITIALISATION'
83 ENDIF
84C
85 cpt0=0
86 cpt1=0
87 cpt20=0
88 cpt21=0
89 j = 0
90C
91 DO i = 1,niniv
92 READ (iin,'(3I10,F20.0)') n1,n2,idir,vv
93 IF (idir < 0) THEN
94 READ (iin,'(3F20.0,I10)') vtx,vty,vtz,ifra
95 ENDIF
96C--------case /INIV/ * /2
97 IF (n1 < 0) THEN
98 ign=ngr2usr(-n1,igrnod,ngrnod)
99C-----
100 IF (ign==0) THEN
101 CALL ancmsg(msgid=292,anmode=aninfo,i1=-n1)
102 CALL arret(2)
103 END IF
104 ENDIF
105C
106 IF (idir < 0) THEN
107 IF(ispmd==0) THEN
108 IF (n1 < 0) THEN
109 IF (cpt20==0) WRITE(iout,3000)
110 WRITE(iout,3100) -n1,vv,vtx,vty,vtz,ifra
111 cpt20=cpt20+1
112 cpt21=0
113 ELSE
114 IF (cpt0==0) WRITE(iout,1000)
115 WRITE(iout,1100) n1,n2,vv,vtx,vty,vtz,ifra
116 cpt0=cpt0+1
117 cpt1=0
118 END IF
119 ENDIF
120C
121 k1=-3*idir-2
122 k2=-3*idir-1
123 k3=-3*idir
124 IF (n1 < 0) THEN
125 DO ii=1,igrnod(ign)%NENTITY
126 n=igrnod(ign)%ENTITY(ii)
127C
128 nixj = zero
129 IF (ifra > 0) THEN
130 vx = zero
131 vy = zero
132 vz = zero
133 DO k=1,numfram
134 j=k+1
135 IF(ifra==iframe(4,k+1)) THEN
136 vx = xframe(1,j)*vtx+xframe(4,j)*vty+xframe(7,j)*vtz
137 vy = xframe(2,j)*vtx+xframe(5,j)*vty+xframe(8,j)*vtz
138 vz = xframe(3,j)*vtx+xframe(6,j)*vty+xframe(9,j)*vtz
139 GO TO 200
140 ENDIF
141 ENDDO
142 CALL ancmsg(msgid=222,anmode=aninfo)
143 CALL arret(2)
144200 CONTINUE
145 nixj(1)=xframe(k1,j)*(x(2,n)-xframe(11,j))
146 nixj(2)=xframe(k2,j)*(x(1,n)-xframe(10,j))
147 nixj(3)=xframe(k2,j)*(x(3,n)-xframe(12,j))
148 nixj(4)=xframe(k3,j)*(x(2,n)-xframe(11,j))
149 nixj(5)=xframe(k3,j)*(x(1,n)-xframe(10,j))
150 nixj(6)=xframe(k1,j)*(x(3,n)-xframe(12,j))
151 IF (iroddl>0) THEN
152 vr(1,n)= vv*xframe(k1,j)
153 vr(2,n)= vv*xframe(k2,j)
154 vr(3,n)= vv*xframe(k3,j)
155 END IF
156 ELSE
157 IF(-idir==1) THEN
158 nixj(1)=x(2,n)
159 nixj(6)=x(3,n)
160 ELSEIF(-idir==2) THEN
161 nixj(2)=x(1,n)
162 nixj(3)=x(3,n)
163 ELSEIF(-idir==3) THEN
164 nixj(4)=x(2,n)
165 nixj(5)=x(1,n)
166 ENDIF
167 vx=vtx
168 vy=vty
169 vz=vtz
170 IF (iroddl>0) THEN
171 IF (idir==-1) vr(1,n)= vv
172 IF (idir==-2) vr(2,n)= vv
173 IF (idir==-3) vr(3,n)= vv
174 END IF
175 ENDIF
176 v(1,n)= vx+vv*(nixj(3)-nixj(4))
177 v(2,n)= vy+vv*(nixj(5)-nixj(6))
178 v(3,n)= vz+vv*(nixj(1)-nixj(2))
179 ENDDO
180 ELSE
181 DO n = 1,numnod
182 IF(itab(n)>=n1.AND.itab(n)<=n2) THEN
183C
184 nixj = zero
185 IF (ifra > 0) THEN
186 vx = zero
187 vy = zero
188 vz = zero
189 DO k=1,numfram
190 j=k+1
191 IF(ifra==iframe(4,k+1)) THEN
192 vx = xframe(1,j)*vtx+xframe(4,j)*vty+xframe(7,j)*vtz
193 vy = xframe(2,j)*vtx+xframe(5,j)*vty+xframe(8,j)*vtz
194 vz = xframe(3,j)*vtx+xframe(6,j)*vty+xframe(9,j)*vtz
195 GO TO 100
196 ENDIF
197 ENDDO
198 CALL ancmsg(msgid=222,anmode=aninfo)
199 CALL arret(2)
200100 CONTINUE
201 nixj(1)=xframe(k1,j)*(x(2,n)-xframe(11,j))
202 nixj(2)=xframe(k2,j)*(x(1,n)-xframe(10,j))
203 nixj(3)=xframe(k2,j)*(x(3,n)-xframe(12,j))
204 nixj(4)=xframe(k3,j)*(x(2,n)-xframe(11,j))
205 nixj(5)=xframe(k3,j)*(x(1,n)-xframe(10,j))
206 nixj(6)=xframe(k1,j)*(x(3,n)-xframe(12,j))
207 IF (iroddl>0) THEN
208 vr(1,n)= vv*xframe(k1,j)
209 vr(2,n)= vv*xframe(k2,j)
210 vr(3,n)= vv*xframe(k3,j)
211 END IF
212 ELSE
213 IF(-idir==1) THEN
214 nixj(1)=x(2,n)
215 nixj(6)=x(3,n)
216 ELSEIF(-idir==2) THEN
217 nixj(2)=x(1,n)
218 nixj(3)=x(3,n)
219 ELSEIF(-idir==3) THEN
220 nixj(4)=x(2,n)
221 nixj(5)=x(1,n)
222 ENDIF
223 vx=vtx
224 vy=vty
225 vz=vtz
226 IF (iroddl>0) THEN
227 IF (idir==-1) vr(1,n)= vv
228 IF (idir==-2) vr(2,n)= vv
229 IF (idir==-3) vr(3,n)= vv
230 END IF
231 ENDIF
232 v(1,n)= vx+vv*(nixj(3)-nixj(4))
233 v(2,n)= vy+vv*(nixj(5)-nixj(6))
234 v(3,n)= vz+vv*(nixj(1)-nixj(2))
235 ENDIF
236 ENDDO
237 END IF !(N1 < 0) THEN
238 ELSE
239C
240 IF (n1 < 0) THEN
241 IF(ispmd==0) THEN
242 IF (cpt21==0) WRITE(iout,4000)
243 WRITE(iout,4100)-n1,idir,vv
244 cpt21=cpt21+1
245 cpt20=0
246 ENDIF
247C
248 IF(idir<=3)THEN
249 DO ii=1,igrnod(ign)%NENTITY
250 n=igrnod(ign)%ENTITY(ii)
251 v(idir,n) = vv
252 ENDDO
253 ELSE
254 DO ii=1,igrnod(ign)%NENTITY
255 n=igrnod(ign)%ENTITY(ii)
256 vr(idir-3,n) = vv
257 ENDDO
258 ENDIF
259 ELSE
260 IF(ispmd==0) THEN
261 IF (cpt1==0) WRITE(iout,2000)
262 WRITE(iout,2100)n1,n2,idir,vv
263 cpt1=cpt1+1
264 cpt0=0
265 ENDIF
266C
267 IF(idir<=3)THEN
268 DO n = 1,numnod
269 IF(itab(n)>=n1.AND.itab(n)<=n2)v(idir,n) = vv
270 ENDDO
271 ELSE
272 DO n = 1,numnod
273 IF(itab(n)>=n1.AND.itab(n)<=n2)vr(idir-3,n) = vv
274 ENDDO
275 ENDIF
276 END IF !(N1 < 0) THEN
277 ENDIF
278 ENDDO
279C----------------
280C Initialization of Fxbvit for flexible bodies
281C----------------
282 IF (nfxbody>0) THEN
283 CALL fxbvini(fxbipm, fxbvit, fxbrpm, v, vr)
284 ENDIF
285C----------------
286C FORMATS
287C----------------
288 1000 FORMAT(3x,'FIRST-N',4x,'LAST-N',10x,'ROTATION',8x,
289 + 'TRANSL X',8x,'TRANSL Y',8x,'TRANSL Z',3x,'FRAME_ID')
290 1100 FORMAT(i10,i10,2x,1pe16.9,1pe16.9,1pe16.9,1pe16.9,i10)
291
292 2000 FORMAT(3x,'FIRST-N',4x,'LAST-N',3x,'DIRECT.',10x,'VELOCITY')
293 2100 FORMAT(i10,i10,i10,2x,1pe16.9)
294 3000 FORMAT(3x,'GRN_id ',20x,'ROTATION',8x,
295 + 'TRANSL X',8x,'TRANSL Y',8x,'TRANSL Z',3x,'FRAME_ID')
296 3100 FORMAT(i10,12x,1pe16.9,1pe16.9,1pe16.9,1pe16.9,i10)
297
298 4000 FORMAT(3x,'GRN_id',13x,'DIRECT.',10x,'velocity')
299 4100 FORMAT(I10,I10,12X,1PE16.9)
300C
301 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
fxbvini
subroutine fxbvini(fxbipm, fxbvit, fxbrpm, v, vr)
Definition fxbvini.F:30
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
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
arret
subroutine arret(nn)
Definition arret.F:87