OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbgrav.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!|| fxbgrav ../starter/source/constraints/fxbody/fxbgrav.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||====================================================================
28 SUBROUTINE fxbgrav(IGRV , IBUF , NSNI, FXBNOD,
29 . FXBGRVI, FXBGRVR, NSN , FXBMOD,
30 . NBML , NBME , MS , GRAV ,
31 . SKEW , IFILE , NFX , IRCM0 )
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C C o m m o n B l o c k s
38C-----------------------------------------------
39#include "param_c.inc"
40#include "com04_c.inc"
41#include "units_c.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER IGRV(NIGRV,*), IBUF(*), NSNI, FXBNOD(*), FXBGRVI(*), NSN,
46 . NBML, NBME, IFILE, NFX, IRCM0
47 my_real
48 . fxbgrvr(*), fxbmod(*), ms(*), grav(lfacgrv,*), skew(lskew,*)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER ITAG(NUMNOD), I, IADG, NL, NN, IAD, NNG, NLG, LIST(NSN),
53 . IG, ISK, N2, K1, K2, K3, IADM, IIM, II, NNP, IM, IN, IRCM
54 my_real
55 . fgrv(3), vmod(nsn*6), vv(6)
56C
57 ircm=ircm0
58 iadg=0
59 nlg=0
60 DO nl=1,ngrav
61 DO i=1,numnod
62 itag(i)=0
63 ENDDO
64 nn=igrv(1,nl)
65 iad=igrv(4,nl)
66 DO i=1,nn
67 itag(abs(ibuf(iad+i-1)))=1
68 ENDDO
69 nng=0
70 DO i=1,nsn
71 ii=fxbnod(i)
72 IF (itag(ii)>0) THEN
73 nng=nng+1
74 fxbgrvi(iadg+2+nng)=ii
75 ENDIF
76 ENDDO
77 IF (nng>0) THEN
78 nlg=nlg+1
79 fxbgrvi(iadg+1)=nl
80 fxbgrvi(iadg+2)=nng
81 iadg=iadg+2+nng
82 ENDIF
83 ENDDO
84C
85 iad=0
86 iadg=0
87 DO i=1,3
88 fgrv(i)=zero
89 ENDDO
90 DO ig=1,nlg
91 nl=fxbgrvi(iadg+1)
92 iadg=iadg+2+fxbgrvi(iadg+2)
93 isk=igrv(2,nl)/10
94 n2=igrv(2,nl)-10*isk
95 nnp=0
96 IF (isk<=1) THEN
97 fgrv(n2)=grav(1,nl)
98 ELSE
99 k1=3*n2-2
100 k2=3*n2-1
101 k3=3*n2
102 fgrv(1)=skew(k1,isk)*grav(1,nl)
103 fgrv(2)=skew(k2,isk)*grav(1,nl)
104 fgrv(3)=skew(k3,isk)*grav(1,nl)
105 ENDIF
106 DO i=1,nsn
107 ii=fxbnod(i)
108 IF (itag(ii)>0) THEN
109 nnp=nnp+1
110 list(nnp)=i
111 ENDIF
112 ENDDO
113C---------------------------
114C Projection on global modes
115C---------------------------
116 DO im=1,nbme
117 IF (ifile==0) THEN
118 iadm=(im-1)*nsn*6
119 DO i=1,nsn*6
120 vmod(i)=fxbmod(iadm+i)
121 ENDDO
122 ELSEIF (ifile==1) THEN
123 iadm=(im-1)*nsni*6
124 DO i=1,nsni*6
125 vmod(i)=fxbmod(iadm+i)
126 ENDDO
127 iadm=nsni*6
128 DO i=1,nsn-nsni
129 ircm=ircm+1
130 READ(ifxm,rec=ircm) (vv(ii),ii=1,6)
131 DO ii=1,6
132 vmod(iadm+ii)=vv(ii)
133 ENDDO
134 iadm=iadm+6
135 ENDDO
136 ENDIF
137 fxbgrvr(iad+im)=zero
138 DO i=1,nnp
139 in=list(i)
140 iadm=(in-1)*6
141 ii=fxbnod(in)
142 fxbgrvr(iad+im)=fxbgrvr(iad+im)+
143 . vmod(iadm+1)*ms(ii)*fgrv(1)+
144 . vmod(iadm+2)*ms(ii)*fgrv(2)+
145 . vmod(iadm+3)*ms(ii)*fgrv(3)
146 ENDDO
147 ENDDO
148C--------------------------
149C Projection on local modes
150C--------------------------
151 iim=0
152 DO im=1,nbml
153 IF (ifile==0) THEN
154 iadm=(nbme+im-1)*nsn*6
155 DO i=1,nsn*6
156 vmod(i)=fxbmod(iadm+i)
157 ENDDO
158 ELSEIF (ifile==1) THEN
159 iadm=(nbme+im-1)*nsni*6
160 DO i=1,nsni*6
161 vmod(i)=fxbmod(iadm+i)
162 ENDDO
163 iadm=nsni*6
164 DO i=1,nsn-nsni
165 ircm=ircm+1
166 READ(ifxm,rec=ircm) (vv(ii),ii=1,6)
167 DO ii=1,6
168 vmod(iadm+ii)=vv(ii)
169 ENDDO
170 iadm=iadm+6
171 ENDDO
172 ENDIF
173 fxbgrvr(iad+nbme+iim+1)=zero
174 fxbgrvr(iad+nbme+iim+2)=zero
175 fxbgrvr(iad+nbme+iim+3)=zero
176 fxbgrvr(iad+nbme+iim+4)=zero
177 fxbgrvr(iad+nbme+iim+5)=zero
178 fxbgrvr(iad+nbme+iim+6)=zero
179 fxbgrvr(iad+nbme+iim+7)=zero
180 fxbgrvr(iad+nbme+iim+8)=zero
181 fxbgrvr(iad+nbme+iim+9)=zero
182 DO i=1,nnp
183 in=list(i)
184 iadm=(in-1)*6
185 ii=fxbnod(in)
186 fxbgrvr(iad+nbme+iim+1)=fxbgrvr(iad+nbme+iim+1)+
187 . vmod(iadm+1)*ms(ii)*fgrv(1)
188 fxbgrvr(iad+nbme+iim+2)=fxbgrvr(iad+nbme+iim+2)+
189 . vmod(iadm+2)*ms(ii)*fgrv(1)
190 fxbgrvr(iad+nbme+iim+3)=fxbgrvr(iad+nbme+iim+3)+
191 . vmod(iadm+3)*ms(ii)*fgrv(1)
192 fxbgrvr(iad+nbme+iim+4)=fxbgrvr(iad+nbme+iim+4)+
193 . vmod(iadm+1)*ms(ii)*fgrv(2)
194 fxbgrvr(iad+nbme+iim+5)=fxbgrvr(iad+nbme+iim+5)+
195 . vmod(iadm+2)*ms(ii)*fgrv(2)
196 fxbgrvr(iad+nbme+iim+6)=fxbgrvr(iad+nbme+iim+6)+
197 . vmod(iadm+3)*ms(ii)*fgrv(2)
198 fxbgrvr(iad+nbme+iim+7)=fxbgrvr(iad+nbme+iim+7)+
199 . vmod(iadm+1)*ms(ii)*fgrv(3)
200 fxbgrvr(iad+nbme+iim+8)=fxbgrvr(iad+nbme+iim+8)+
201 . vmod(iadm+2)*ms(ii)*fgrv(3)
202 fxbgrvr(iad+nbme+iim+9)=fxbgrvr(iad+nbme+iim+9)+
203 . vmod(iadm+3)*ms(ii)*fgrv(3)
204 ENDDO
205 iim=iim+9
206 ENDDO
207 iad=iad+nbme+9*nbml
208 ENDDO
209C
210 RETURN
211 END SUBROUTINE fxbgrav
fxbgrav
subroutine fxbgrav(igrv, ibuf, nsni, fxbnod, fxbgrvi, fxbgrvr, nsn, fxbmod, nbml, nbme, ms, grav, skew, ifile, nfx, ircm0)
Definition fxbgrav.F:32