OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i12vit3.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!|| i12vit3 ../engine/source/interfaces/interf/i12vit3.F
25!||--- called by ------------------------------------------------------
26!|| intti12v ../engine/source/interfaces/interf/intti12.F
27!||====================================================================
28 SUBROUTINE i12vit3(NSN , NMN,
29 2 A ,IRECT ,
30 3 CRST ,MSR , NSV , IRTL,
31 4 V , MS ,WEIGHT , MMASS ,TAGKINE,
32 5 SKEW , WA ,TETS ,TETM,ILEV,IREF)
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C D u m m y A r g u m e n t s
39C-----------------------------------------------
40 INTEGER NSN, NMN,
41 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*),TAGKINE(*),
42 . ILEV,IREF
43 my_real
44 . a(*), crst(2,*), v(*),ms(*), mmass(*),wa(6,*),
45 . skew(lskew,*),tets(*),tetm(*)
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "param_c.inc"
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER NIR, I, J, I3, J3, I2, J2, I1, J1, II, L, JJ
55 my_real
56 . H(4), SS, TT, AMX, AMY, AMZ, VMX, VMY, VMZ,SP,SM,TP,TM,
57 . P(9),AXR,AYR,AZR,CST,SST
58C-----------------------------------------------
59 nir=2
60 IF(n2d==0)nir=4
61 IF(ilev==1)THEN
62 DO i=1,9
63 p(i)=skew(i,iref+1)
64 ENDDO
65 DO ii=1,nmn
66 j=msr(ii)
67 j3=3*j
68 j2=j3-1
69 j1=j2-1
70 cst=cos(tetm(ii))
71 sst=sin(tetm(ii))
72
73 amx=a(j1)
74 amy=a(j2)
75 amz=a(j3)
76 axr=amx*p(1)+amy*p(2)+amz*p(3)
77 ayr=amx*p(4)+amy*p(5)+amz*p(6)
78 azr=amx*p(7)+amy*p(8)+amz*p(9)
79 wa(1,ii)=axr
80 wa(2,ii)= ayr*cst+azr*sst
81 wa(3,ii)= -ayr*sst+azr*cst
82
83 amx=v(j1)
84 amy=v(j2)
85 amz=v(j3)
86 axr=amx*p(1)+amy*p(2)+amz*p(3)
87 ayr=amx*p(4)+amy*p(5)+amz*p(6)
88 azr=amx*p(7)+amy*p(8)+amz*p(9)
89 wa(4,ii)=axr
90 wa(5,ii)= ayr*cst+azr*sst
91 wa(6,ii)= -ayr*sst+azr*cst
92 ENDDO
93 ENDIF
94
95 DO ii=1,nsn
96 IF(tagkine(ii)<0)cycle
97 i=nsv(ii)
98 l=irtl(ii)
99 ss=crst(1,ii)
100 tt=crst(2,ii)
101 sp=one + ss
102 sm=one - ss
103 tp=fourth*(one + tt)
104 tm=fourth*(one - tt)
105 h(1)=tm*sm
106 h(2)=tm*sp
107 h(3)=tp*sp
108 h(4)=tp*sm
109 i3=3*i
110 i2=i3-1
111 i1=i2-1
112 amx=zero
113 amy=zero
114 amz=zero
115 vmx=zero
116 vmy=zero
117 vmz=zero
118 IF(ilev==1)THEN
119 IF(tets(ii)<10000.)THEN
120 DO jj=1,nir
121 j=irect(jj,l)
122 amx=amx+wa(1,j)*h(jj)
123 amy=amy+wa(2,j)*h(jj)
124 amz=amz+wa(3,j)*h(jj)
125 vmx=vmx+wa(4,j)*h(jj)
126 vmy=vmy+wa(5,j)*h(jj)
127 vmz=vmz+wa(6,j)*h(jj)
128 ENDDO
129 cst=cos(tets(ii))
130 sst=sin(tets(ii))
131 axr=amx
132 ayr= amy*cst-amz*sst
133 azr= amy*sst+amz*cst
134 amx=axr*p(1)+ayr*p(4)+azr*p(7)
135 amy=axr*p(2)+ayr*p(5)+azr*p(8)
136 amz=axr*p(3)+ayr*p(6)+azr*p(9)
137 axr=vmx
138 ayr= vmy*cst-vmz*sst
139 azr= vmy*sst+vmz*cst
140 vmx=axr*p(1)+ayr*p(4)+azr*p(7)
141 vmy=axr*p(2)+ayr*p(5)+azr*p(8)
142 vmz=axr*p(3)+ayr*p(6)+azr*p(9)
143 ELSE
144 DO jj=1,nir
145 j=msr(irect(jj,l))
146 j3=3*j
147 j2=j3-1
148 j1=j2-1
149 amx=amx+a(j1)*h(jj)
150 amy=amy+a(j2)*h(jj)
151 amz=amz+a(j3)*h(jj)
152 vmx=vmx+v(j1)*h(jj)
153 vmy=vmy+v(j2)*h(jj)
154 vmz=vmz+v(j3)*h(jj)
155 ENDDO
156 ENDIF !(TETS(II)<10000.)
157 ELSE
158 DO jj=1,nir
159 j=msr(irect(jj,l))
160 j3=3*j
161 j2=j3-1
162 j1=j2-1
163 amx=amx+a(j1)*h(jj)
164 amy=amy+a(j2)*h(jj)
165 amz=amz+a(j3)*h(jj)
166 vmx=vmx+v(j1)*h(jj)
167 vmy=vmy+v(j2)*h(jj)
168 vmz=vmz+v(j3)*h(jj)
169 ENDDO
170 ENDIF
171 a(i1)=amx
172 a(i2)=amy
173 a(i3)=amz
174 v(i1)=vmx
175 v(i2)=vmy
176 v(i3)=vmz
177 END DO !II=1,NSN
178
179 DO ii=1,nmn
180 j=msr(ii)
181 ms(j)=mmass(ii)
182 ENDDO
183
184 RETURN
185 END
186
i12vit3
subroutine i12vit3(nsn, nmn, a, irect, crst, msr, nsv, irtl, v, ms, weight, mmass, tagkine, skew, wa, tets, tetm, ilev, iref)
Definition i12vit3.F:33