OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
intstamp_move.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!|| intstamp_move ../engine/source/interfaces/int21/intstamp_move.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- uses -----------------------------------------------------
28!|| intstamp_mod ../engine/share/modules/intstamp_mod.F
29!||====================================================================
30 SUBROUTINE intstamp_move(
31 1 INTSTAMP ,NPC ,TF ,SKEW ,NODNX_SMS,
32 2 V ,VR ,MS ,X ,D ,
33 3 NPBY ,RBY )
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE intstamp_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com08_c.inc"
46#include "param_c.inc"
47#include "task_c.inc"
48#include "intstamp_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER NPC(*), NODNX_SMS(*), NPBY(NNPBY,*)
53C REAL
54 my_real
55 . tf(*), skew(lskew,*), v(3,*), vr(3,*), ms(*), x(3,*), d(3,*),
56 . rby(nrby,*)
57 TYPE(intstamp_data) INTSTAMP(*)
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER NN, IRB, MAIN, J, INTDAMP, MSR, MSRR, IROT
62C REAL
63 my_real
64 . dw, alpha, mass, vis, stf, str, inm, vx, vy, vz,
65 . fvx, fvy, fvz
66C-----------------------------------------------
67 DO nn=1,nintstamp
68C---------------------
69C external work (from damping)
70C---------------------
71 IF(ispmd==0)THEN
72 intdamp=intstamp(nn)%INTDAMP
73 alpha=intstamp(nn)%DAMP
74 mass=intstamp(nn)%MASS
75 stf =intstamp(nn)%STF
76 vis =alpha*sqrt(four*mass*stf)
77 msr=intstamp(nn)%MSR
78 IF(intdamp==0)THEN
79 fvx=vis*intstamp(nn)%V(1)
80 fvy=vis*intstamp(nn)%V(2)
81 fvz=vis*intstamp(nn)%V(3)
82 dw=-(fvx*v(1,msr)+fvy*v(2,msr)+fvz*v(3,msr))
83 ELSE
84 msrr=intstamp(nn)%MSR
85 fvx=vis*(intstamp(nn)%V(1)-intstamp(intdamp)%V(1))
86 fvy=vis*(intstamp(nn)%V(2)-intstamp(intdamp)%V(2))
87 fvz=vis*(intstamp(nn)%V(3)-intstamp(intdamp)%V(3))
88 dw=-two*( fvx*(v(1,msr)-v(1,msrr))
89 . +fvy*(v(2,msr)-v(2,msrr))
90 . +fvz*(v(3,msr)-v(3,msrr)))
91 END IF
92 intstamp(nn)%DW = half * dt2 * dw
93 irot=intstamp(nn)%IROT
94 IF(irot/=0)THEN
95 alpha=intstamp(nn)%DAMPR
96 inm=min(intstamp(nn)%IN(1),
97 . intstamp(nn)%IN(2),
98 . intstamp(nn)%IN(3))
99 str =intstamp(nn)%STR
100 vis =alpha*sqrt(four*inm*str)
101 IF(intdamp==0)THEN
102 fvx=vis*intstamp(nn)%VR(1)
103 fvy=vis*intstamp(nn)%VR(2)
104 fvz=vis*intstamp(nn)%VR(3)
105 dw=-(fvx*vr(1,msr)+fvy*vr(2,msr)+fvz*vr(3,msr))
106 ELSE
107 fvx=vis*(intstamp(nn)%VR(1)-intstamp(intdamp)%VR(1))
108 fvy=vis*(intstamp(nn)%VR(2)-intstamp(intdamp)%VR(2))
109 fvz=vis*(intstamp(nn)%VR(3)-intstamp(intdamp)%VR(3))
110 dw=-two*( fvx*(vr(1,msr)-vr(1,msrr))
111 . +fvy*(vr(2,msr)-vr(2,msrr))
112 . +fvz*(vr(3,msr)-vr(3,msrr)))
113 END IF
114 intstamp(nn)%DW = intstamp(nn)%DW + half * dt2 * dw
115 END IF
116 END IF
117 ENDDO
118C---------------------
119C Transfer Rbody => Interface
120C---------------------
121 DO nn=1,nintstamp
122 irb =intstamp(nn)%IRB
123 main=intstamp(nn)%MSR
124 intstamp(nn)%V(1) =v(1,main)
125 intstamp(nn)%V(2) =v(2,main)
126 intstamp(nn)%V(3) =v(3,main)
127 intstamp(nn)%D(1) =d(1,main)
128 intstamp(nn)%D(2) =d(2,main)
129 intstamp(nn)%D(3) =d(3,main)
130 intstamp(nn)%XG(1) =x(1,main)
131 intstamp(nn)%XG(2) =x(2,main)
132 intstamp(nn)%XG(3) =x(3,main)
133 IF(intstamp(nn)%IROT/=0)THEN
134 intstamp(nn)%VR(1) =vr(1,main)
135 intstamp(nn)%VR(2) =vr(2,main)
136 intstamp(nn)%VR(3) =vr(3,main)
137 intstamp(nn)%MASS =ms(main)
138 DO j=1,9
139 intstamp(nn)%ROT(j)=rby(j,irb)
140 END DO
141 END IF
142 END DO
143C
144 RETURN
145 END
#define alpha
Definition eval.h:35
subroutine intstamp_move(intstamp, npc, tf, skew, nodnx_sms, v, vr, ms, x, d, npby, rby)
#define min(a, b)
Definition macros.h:20