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