OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dfuncf.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr14_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dfuncf (elbuf_tab, func, ifunc, iparg, geo, ixt, ixp, ixr, mass, pm, el2fa, nbf, iadp, nbpart, xfunc1)

Function/Subroutine Documentation

◆ dfuncf()

subroutine dfuncf ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
func,
integer ifunc,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
mass,
pm,
integer, dimension(*) el2fa,
integer nbf,
integer, dimension(*) iadp,
integer nbpart,
xfunc1 )

Definition at line 30 of file dfuncf.F.

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
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
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519