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, ISK, ICOD, II, L, JJ,
55 . NN,JL
56 my_real
57 . H(4), SS, TT, AMX, AMY, AMZ, VMX, VMY, VMZ,SP,SM,TP,TM,MAS,
58 . p(9),axr,ayr,azr,cst,sst
59C-----------------------------------------------
60 nir=2
61 IF(n2d==0)nir=4
62 IF(ilev==1)THEN
63 DO i=1,9
64 p(i)=skew(i,iref+1)
65 ENDDO
66 DO ii=1,nmn
67 j=msr(ii)
68 j3=3*j
69 j2=j3-1
70 j1=j2-1
71 cst=cos(tetm(ii))
72 sst=sin(tetm(ii))
73
74 amx=a(j1)
75 amy=a(j2)
76 amz=a(j3)
77 axr=amx*p(1)+amy*p(2)+amz*p(3)
78 ayr=amx*p(4)+amy*p(5)+amz*p(6)
79 azr=amx*p(7)+amy*p(8)+amz*p(9)
80 wa(1,ii)=axr
81 wa(2,ii)= ayr*cst+azr*sst
82 wa(3,ii)= -ayr*sst+azr*cst
83
84 amx=v(j1)
85 amy=v(j2)
86 amz=v(j3)
87 axr=amx*p(1)+amy*p(2)+amz*p(3)
88 ayr=amx*p(4)+amy*p(5)+amz*p(6)
89 azr=amx*p(7)+amy*p(8)+amz*p(9)
90 wa(4,ii)=axr
91 wa(5,ii)= ayr*cst+azr*sst
92 wa(6,ii)= -ayr*sst+azr*cst
93 ENDDO
94 ENDIF
95
96 DO ii=1,nsn
97 IF(tagkine(ii)<0)cycle
98 i=nsv(ii)
99 l=irtl(ii)
100 ss=crst(1,ii)
101 tt=crst(2,ii)
102 sp=one + ss
103 sm=one - ss
104 tp=fourth*(one + tt)
105 tm=fourth*(one - tt)
106 h(1)=tm*sm
107 h(2)=tm*sp
108 h(3)=tp*sp
109 h(4)=tp*sm
110 i3=3*i
111 i2=i3-1
112 i1=i2-1
113 amx=zero
114 amy=zero
115 amz=zero
116 vmx=zero
117 vmy=zero
118 vmz=zero
119 IF(ilev==1)THEN
120 IF(tets(ii)<10000.)THEN
121 DO jj=1,nir
122 j=irect(jj,l)
123 amx=amx+wa(1,j)*h(jj)
124 amy=amy+wa(2,j)*h(jj)
125 amz=amz+wa(3,j)*h(jj)
126 vmx=vmx+wa(4,j)*h(jj)
127 vmy=vmy+wa(5,j)*h(jj)
128 vmz=vmz+wa(6,j)*h(jj)
129 ENDDO
130 cst=cos(tets(ii))
131 sst=sin(tets(ii))
132 axr=amx
133 ayr= amy*cst-amz*sst
134 azr= amy*sst+amz*cst
135 amx=axr*p(1)+ayr*p(4)+azr*p(7)
136 amy=axr*p(2)+ayr*p(5)+azr*p(8)
137 amz=axr*p(3)+ayr*p(6)+azr*p(9)
138 axr=vmx
139 ayr= vmy*cst-vmz*sst
140 azr= vmy*sst+vmz*cst
141 vmx=axr*p(1)+ayr*p(4)+azr*p(7)
142 vmy=axr*p(2)+ayr*p(5)+azr*p(8)
143 vmz=axr*p(3)+ayr*p(6)+azr*p(9)
144 ELSE
145 DO jj=1,nir
146 j=msr(irect(jj,l))
147 j3=3*j
148 j2=j3-1
149 j1=j2-1
150 amx=amx+a(j1)*h(jj)
151 amy=amy+a(j2)*h(jj)
152 amz=amz+a(j3)*h(jj)
153 vmx=vmx+v(j1)*h(jj)
154 vmy=vmy+v(j2)*h(jj)
155 vmz=vmz+v(j3)*h(jj)
156 ENDDO
157 ENDIF !(TETS(II)<10000.)
158 ELSE
159 DO jj=1,nir
160 j=msr(irect(jj,l))
161 j3=3*j
162 j2=j3-1
163 j1=j2-1
164 amx=amx+a(j1)*h(jj)
165 amy=amy+a(j2)*h(jj)
166 amz=amz+a(j3)*h(jj)
167 vmx=vmx+v(j1)*h(jj)
168 vmy=vmy+v(j2)*h(jj)
169 vmz=vmz+v(j3)*h(jj)
170 ENDDO
171 ENDIF
172 a(i1)=amx
173 a(i2)=amy
174 a(i3)=amz
175 v(i1)=vmx
176 v(i2)=vmy
177 v(i3)=vmz
178 END DO !II=1,NSN
179
180 DO ii=1,nmn
181 j=msr(ii)
182 ms(j)=mmass(ii)
183 ENDDO
184
185 RETURN
186 END
187
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