OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
iqela1.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr07_c.inc"
#include "scr08_a_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "param_c.inc"
#include "comlock.inc"
#include "tabsiz_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine iqela1 (output, a, e, msm, irect, crst, msr, nsv, iloc, irtl, ms, nor, lcode, iskew, fsav, fcont, fncont, h3d_data, nsn, nmn)

Function/Subroutine Documentation

◆ iqela1()

subroutine iqela1 ( type(output_), intent(inout) output,
dimension(sa), intent(inout) a,
dimension(*), intent(inout) e,
dimension(*), intent(inout) msm,
integer, dimension(4,*), intent(inout) irect,
dimension(2,*), intent(inout) crst,
integer, dimension(*), intent(inout) msr,
integer, dimension(*), intent(inout) nsv,
integer, dimension(*), intent(inout) iloc,
integer, dimension(*), intent(inout) irtl,
dimension(*), intent(inout) ms,
dimension(3,*), intent(inout) nor,
integer, dimension(*), intent(inout) lcode,
integer, dimension(*), intent(inout) iskew,
dimension(*), intent(inout) fsav,
dimension(3,*), intent(inout) fcont,
dimension(3,*), intent(inout) fncont,
type(h3d_database) h3d_data,
integer, intent(in) nsn,
integer, intent(in) nmn )

Definition at line 33 of file iqela1.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE h3d_mod
40 USE output_mod
41C-----------------------------------------------
42C D e s c r i p t i o n
43C-----------------------------------------------
44C This subroutine is related to option /INTER/TYPE1
45C and computes forces. See E(1:3)=FSN.N(1:3)
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "com06_c.inc"
56#include "com08_c.inc"
57#include "scr07_c.inc"
58#include "scr08_a_c.inc"
59#include "scr14_c.inc"
60#include "scr16_c.inc"
61#include "param_c.inc"
62#include "comlock.inc"
63#include "tabsiz_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
68 INTEGER,INTENT(INOUT) :: IRECT(4,*), MSR(*), NSV(*), ILOC(*), IRTL(*),LCODE(*), ISKEW(*)
69 my_real,INTENT(INOUT) :: a(sa), e(*), msm(*), crst(2,*), ms(*),nor(3,*),fsav(*)
70 my_real,INTENT(INOUT) :: fcont(3,*),fncont(3,*)
71 INTEGER, INTENT(IN) :: NSN,NMN
72 TYPE(H3D_DATABASE) :: H3D_DATA
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER NIR, I, J, I3, J3, I2, J2, I1, J1, II, L, JJ, NN, JJ3, JJ2, JJ1, ISK, LCOD
77 my_real h(4), n1, n2, n3, aa(3), sss, ttt, xmss, fxi, fyi, fzi, fsn
78 my_real :: fsn_sav, fxi_sav, fyi_sav, fzi_sav,impx,impy,impz
79 LOGICAL ICONT, IPCONT, IANIM
80C-----------------------------------------------
81C S o u r c e L i n e s
82C-----------------------------------------------
83 icont = .false.
84 ipcont = .false.
85 ianim = .false.
86 icont = (anim_v(4)+outp_v(4) > 0+h3d_data%N_VECT_CONT)
87 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT > 0)THEN
88 IF( (tt>=output%TANIM .AND. tt<=output%TANIM_STOP) .OR.tt >= toutp.OR.tt >= h3d_data%TH3D.OR.
89 . (manim >= 4.AND.manim <= 15).OR. h3d_data%MH3D /= 0)THEN
90 ipcont = .true.
91 ENDIF
92 ENDIF
93 IF(icont .OR. ipcont)ianim=.true.
94
95 fsn_sav = zero
96 fxi_sav = zero
97 fyi_sav = zero
98 fzi_sav = zero
99
100 nir=2
101 IF(n2d == 0)nir=4
102 !main nodes
103 DO i=1,nmn
104 j=msr(i)
105 i3=3*i
106 i2=i3-1
107 i1=i2-1
108 msm(i)=ms(j)
109 e(i1)=zero
110 e(i2)=zero
111 e(i3)=zero
112 ENDDO
113
114 !second nodes
115 DO ii=1,nsn
116 i=nsv(ii)
117 j=iloc(ii)
118 IF(j >= 1) THEN
119 l=irtl(ii)
120 DO jj=1,nir
121 nn=irect(jj,l)
122 iy(jj)=nn
123 ENDDO
124 !parametric coordinates on main face
125 sss=crst(1,ii)
126 ttt=crst(2,ii)
127 !normal
128 n1=nor(1,ii)
129 n2=nor(2,ii)
130 n3=nor(3,ii)
131 !A(1:3,I) <-> A(3*I - 1:3)
132 i3=3*i
133 i2=i3-1
134 i1=i2-1
135 CALL shapeh(h,sss,ttt)
136 DO jj=1,nir
137 j3=3*iy(jj)
138 j2=j3-1
139 j1=j2-1
140 jj3=3*msr(iy(jj))
141 jj2=jj3-1
142 jj1=jj2-1
143 aa(1)=a(i1) !Accel for itab(I), where I=NSV(II)
144 aa(2)=a(i2)
145 aa(3)=a(i3)
146 isk=iskew(iy(jj))
147 lcod=lcode(iy(jj))
148 xmss=ms(i)*h(jj)
149 fxi=aa(1)-a(jj1)
150 fyi=aa(2)-a(jj2)
151 fzi=aa(3)-a(jj3)
152 fsn=(fxi*n1+fyi*n2+fzi*n3)*xmss
153 fsn_sav = fsn_sav + fsn
154 fxi_sav = fxi_sav + fxi*xmss
155 fyi_sav = fyi_sav + fyi*xmss
156 fzi_sav = fzi_sav + fzi*xmss
157 e(j1)=e(j1)+fsn*n1
158 e(j2)=e(j2)+fsn*n2
159 e(j3)=e(j3)+fsn*n3
160 msm(iy(jj))=msm(iy(jj))+xmss
161 enddo!next JJ
162 ENDIF
163 enddo!next II
164
165 !SUM(E(1:3,*)) is NF(1:3) on main segment
166
167 !---------------------------------
168 ! /TH/INTER
169 ! NORMAL IMPULSE BACKUP
170 !---------------------------------
171 impx = fxi_sav*dt12
172 impy = fyi_sav*dt12
173 impz = fzi_sav*dt12
174 fsn_sav = fsn_sav*dt12
175#include "lockon.inc"
176 fsav(1)=fsav(1) + impx
177 fsav(2)=fsav(2) + impy
178 fsav(3)=fsav(3) + impz
179 fsav(8)=fsav(8) + abs(impx)
180 fsav(9)=fsav(9) + abs(impy)
181 fsav(10)=fsav(10)+ abs(impz)
182 fsav(11)=fsav(11)+ fsn_sav
183#include "lockoff.inc"
184 !---------------------------------
185
186
187 IF(ianim)THEN
188 !---------------------------------
189 ! /ANIM/VECT/CONT
190 !---------------------------------
191 IF(icont)THEN
192#include "lockon.inc"
193 DO i=1,nmn
194 j = msr(i)
195 i3 = 3*i
196 i2 = i3-1
197 i1 = i2-1
198 fcont(1,j) = fcont(1,j)+e(i1)
199 fcont(2,j) = fcont(2,j)+e(i2)
200 fcont(3,j) = fcont(3,j)+e(i3)
201 ENDDO
202#include "lockoff.inc"
203 ENDIF
204 !---------------------------------
205 ! /ANIM/VECT/PCONT
206 !---------------------------------
207 IF(ipcont)THEN
208#include "lockon.inc"
209 DO i=1,nmn
210 j = msr(i)
211 i3 = 3*i
212 i2 = i3-1
213 i1 = i2-1
214 fncont(1,j) = fncont(1,j)+e(i1)
215 fncont(2,j) = fncont(2,j)+e(i2)
216 fncont(3,j) = fncont(3,j)+e(i3)
217 ENDDO
218#include "lockoff.inc"
219 ENDIF
220 ENDIF
221
222
223
224C-----------------------------------------------------
225
226 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine shapeh(h, s, t)
Definition shapeh.F:34