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
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
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_routines.c:519