OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dfuncf.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!|| dfuncf ../starter/source/output/anim/dfuncf.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE dfuncf(ELBUF_TAB,FUNC ,IFUNC ,IPARG ,GEO ,
31 . IXT ,IXP ,IXR ,MASS ,PM ,
32 . EL2FA ,NBF ,IADP ,NBPART ,XFUNC1)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE elbufdef_mod
37 use element_mod , only : nixt,nixp,nixr
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 "mvsiz_p.inc"
46#include "com01_c.inc"
47#include "com04_c.inc"
48#include "scr14_c.inc"
49#include "param_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53C REAL
54 my_real
55 . func(*), mass(*), pm(npropm,*), geo(npropg,*),
56 . xfunc1(10,*)
57 INTEGER IPARG(NPARG,*),EL2FA(*),
58 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IFUNC,NBF,
59 . iadp(*),nbpart,nbf2
60 INTEGER BUF
61C
62 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66C REAL
67 my_real
68 . evar(mvsiz),
69 . off, p, vonm2, vonm, s1, s2, s12, s3, VALUE,
70 . a1,b1,b2,b3,yeq,f1,m1,m2,m3, xm,
71 . for, area, feq
72 INTEGER I, NG, NEL, NFT, ITY, LFT, NPT, ISS, ISC,
73 . IADD, N, J, LLT, MLW,
74 . istrain,nn, k1, k2,jturb,mt,jale, imid, ialel,ipid,
75 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,nf,
76 . offset,k,ii,ii_l,inc,kk,ihbe,jj(3)
77 REAL R4
78C
79 TYPE(g_bufel_) ,POINTER :: GBUF
80C-----------------------------------------------
81C La routine ne fonctionne que pour les IFUNC 3,7,14-19 (stress)
82C-----------------------------------------------
83C
84 nn1 = 1
85 nn3 = 1
86 nn4 = nn3
87 nn5 = nn4
88 nn6 = nn5
89 nn7 = nn6 + numelt
90 nn8 = nn7 + numelp
91 nn9 = nn8 + numelr
92 nn10= nn9
93C
94 DO ng=1,ngroup
95 mlw =iparg(1,ng)
96 nel =iparg(2,ng)
97 ity =iparg(5,ng)
98 gbuf => elbuf_tab(ng)%GBUF
99 DO offset = 0,nel-1,nvsiz
100 nft =iparg(3,ng) + offset
101 lft=1
102 llt=min(nvsiz,nel-offset)
103!
104 DO j=1,3
105 jj(j) = nel*(j-1)
106 ENDDO
107!
108C-----------------------------------------------
109C TRUSS
110C-----------------------------------------------
111 IF (ity == 4) THEN
112 IF (ifunc == 3) THEN
113 DO i=lft,llt
114 n = i + nft
115 func(el2fa(nn6+n))=gbuf%EINT(i)/
116 . max(em30,mass(el2fa(nn6+n)))
117 ENDDO
118 ELSEIF (ifunc == 7) THEN
119 DO i=lft,llt
120 n = i + nft
121 for = gbuf%FOR(i)
122 area = gbuf%AREA(i)
123 feq = for*for
124 func(el2fa(nn6+n)) = sqrt(feq)/area
125 ENDDO
126 ELSEIF (ifunc == 14) THEN
127 DO i=lft,llt
128 n = i + nft
129 func(el2fa(nn6+n)) = gbuf%FOR(i) / gbuf%AREA(i)
130 ENDDO
131 ELSE
132 DO i=lft,llt
133 n = i + nft
134 func(el2fa(nn6+n)) = zero
135 ENDDO
136 ENDIF
137C-----------------------------------------------
138C POUTRES
139C-----------------------------------------------
140 ELSEIF (ity == 5) THEN
141 IF (ifunc == 3) THEN
142 DO i=lft,llt
143 n = i + nft
144 func(el2fa(nn7+n)) = (gbuf%EINT(i) + gbuf%EINT(i+llt))
145 . / max(em30,mass(el2fa(nn7+n)))
146 ENDDO
147 ELSEIF (ifunc == 7) THEN
148 DO i=lft,llt
149 n = i + nft
150 a1 = geo(1,ixp(5,n))
151 b1 = geo(2,ixp(5,n))
152 b2 = geo(18,ixp(5,n))
153 b3 = geo(4,ixp(5,n))
154 f1 = gbuf%FOR(jj(1)+i)
155 m1 = gbuf%MOM(jj(1)+i)
156 m2 = gbuf%MOM(jj(2)+i)
157 m3 = gbuf%MOM(jj(3)+i)
158 yeq= f1*f1 + three* a1 *
159 + ( m1*m1 / max(b3,em30)
160 + + m2*m2 / max(b1,em30)
161 + + m3*m3 / max(b2,em30) )
162 func(el2fa(nn7+n)) = sqrt(yeq)/a1
163 ENDDO
164 ELSEIF (ifunc == 14) THEN
165 DO i=lft,llt
166 n = i + nft
167 func(el2fa(nn7+n)) = gbuf%FOR(jj(1)+i)
168 . / geo(1,ixp(5,n))
169 ENDDO
170 ELSEIF (ifunc == 17) THEN
171 DO i=lft,llt
172 n = i + nft
173 func(el2fa(nn7+n)) = gbuf%FOR(jj(2)+i)
174 . / geo(1,ixp(5,n))
175 ENDDO
176 ELSEIF (ifunc == 19) THEN
177 DO i=lft,llt
178 n = i + nft
179 func(el2fa(nn7+n)) = gbuf%FOR(jj(3)+i)
180 . / geo(1,ixp(5,n))
181 ENDDO
182 ELSE
183 DO i=lft,llt
184 n = i + nft
185 func(el2fa(nn7+n)) = zero
186 ENDDO
187 ENDIF
188C-----------------------------------------------
189C RESSORTS
190C-----------------------------------------------
191 ELSEIF (ity == 6) THEN
192 IF (ifunc == 3) THEN
193 IF (mlw == 1) THEN
194 xm = one/geo(1,ixr(1,1+nft))
195 DO i=lft,llt
196 n = i + nft
197 func(el2fa(nn8+n)) = gbuf%EINT(i)*xm
198 ENDDO
199 ELSEIF (mlw == 2) THEN
200 xm = one/geo(1,ixr(1,1+nft))
201 DO i=lft,llt
202 n = i + nft
203 func(el2fa(nn8+n)) = gbuf%EINT(i)*xm
204 ENDDO
205 ELSEIF (mlw == 3) THEN
206 xm = one/geo(1,ixr(1,1+nft))
207 DO i=lft,llt
208 n = i + nft
209 func(el2fa(nn8+n)) = gbuf%EINT(i)*xm
210 ENDDO
211 ELSEIF (mlw == 4) THEN
212 xm = one/geo(1,ixr(1,1+nft))
213 DO i=lft,llt
214 n = i + nft
215 func(el2fa(nn8+n)) = gbuf%EINT(i)*xm
216 ENDDO
217 ELSEIF (mlw == 5) THEN
218 DO i=lft,llt
219 n = i + nft
220 func(el2fa(nn8+n)) = gbuf%EINT(i)/max(em30,gbuf%MASS(i))
221 ENDDO
222 ENDIF ! IF (MLW)
223 ELSEIF (ifunc == 11) THEN
224 DO i=lft,llt
225 n = i + nft
226* FUNC(EL2FA(NN8+N)) = ANIM(N)
227 ENDDO
228 ELSEIF (ifunc == 12) THEN
229 kk = numelr * anim_fe(11)
230 DO i=lft,llt
231 n = i + nft
232* FUNC(EL2FA(NN8+N)) = ANIM(N+KK)
233 ENDDO
234 ELSEIF (ifunc == 13) THEN
235 kk = numelr * (anim_fe(11)+anim_fe(12))
236 DO i=lft,llt
237 n = i + nft
238* FUNC(EL2FA(NN8+N)) = ANIM(N+KK)
239 ENDDO
240 ELSE
241 DO i=lft,llt
242 n = i + nft
243 func(el2fa(nn8+n)) = zero
244 ENDDO
245 ENDIF ! IF (IFUNC)
246C
247 IF (mlw == 3) THEN
248 DO i=lft,llt
249 n = i + nft
250 func(el2fa(nn8+n)+1) = func(el2fa(nn8+n))
251 ENDDO
252 ENDIF
253 ENDIF ! IF (ITY)
254C-----------------------------------------------
255C END OF LOOP ON OFFSETS
256C-----------------------------------------------
257 ENDDO ! DO OFFSET = 0,NEL-1,NVSIZ
258 ENDDO ! DO NG=1,NGROUP
259C-----------------------------------------------
260 DO n=1,nbf
261 r4 = func(n)
262 CALL write_r_c(r4,1)
263 ENDDO
264 IF (ifunc == 3) THEN
265 DO n=1,nanim1d
266 VALUE = xfunc1(1,n)
267 r4 = VALUE
268 CALL write_r_c(r4,1)
269 ENDDO
270 ELSE
271 DO n=1,nanim1d
272 r4 = zero
273 CALL write_r_c(r4,1)
274 ENDDO
275 ENDIF
276C---
277 RETURN
278 END
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
dfuncf
subroutine dfuncf(elbuf_tab, func, ifunc, iparg, geo, ixt, ixp, ixr, mass, pm, el2fa, nbf, iadp, nbpart, xfunc1)
Definition dfuncf.F:33
write_r_c
void write_r_c(float *w, int *len)
Definition write_routines.c:519