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

Go to the source code of this file.

Functions/Subroutines

subroutine dfuncs (elbuf_tab, func, ifunc, iparg, ixs, pm, el2fa, nbf, isph3d)

Function/Subroutine Documentation

◆ dfuncs()

subroutine dfuncs ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
func,
integer ifunc,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
pm,
integer, dimension(*) el2fa,
integer nbf,
integer isph3d )

Definition at line 31 of file dfuncs.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 "vect01_c.inc"
45#include "mvsiz_p.inc"
46#include "com01_c.inc"
47#include "com04_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(*), pm(npropm,*)
55 INTEGER IPARG(NPARG,*),EL2FA(*),
56 . IXS(NIXS,*),IFUNC,NBF,ISPH3D
57 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
58 REAL WAL(NBF)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62C REAL
63 my_real
64 . evar(mvsiz),
65 . off, p, vonm2, vonm, s1, s2, s12, s3, VALUE
66 INTEGER I, NG, NEL,N, J, MLW,NN, JTURB,MT, IALEL,
67 . NN1,NN2,NN3,OFFSET,II(6),INOD, ISOLNOD,
68 . JHBE, JIVF, JCLOSE, JPLASOL, IREP, IGTYP,
69 . ICSEN, ISORTHG, IFAILURE, IINT
70 TYPE(G_BUFEL_) ,POINTER :: GBUF
71 REAL R4
72C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
73C La routine ne fonctionne que pour les IFUNC 3,6,7,14-19 (stress)
74C-----------------------------------------------
75 nn1 = 1
76 nn2 = 1
77 nn3 = nn2 + numels
78C
79 DO 900 ng=1,ngroup
80 CALL initbuf (iparg ,ng ,
81 2 mlw ,nel ,nft ,iad ,ity ,
82 3 npt ,jale ,ismstr ,jeul ,jtur ,
83 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
84 5 jpor ,jcvt ,jclose ,jplasol ,
85 6 irep ,iint ,igtyp ,israt ,isrot ,
86 7 icsen ,isorth ,isorthg ,ifailure)
87 DO offset = 0,nel-1,nvsiz
88 nft =iparg(3,ng) + offset
89 isolnod = iparg(28,ng)
90 lft=1
91 llt=min(nvsiz,nel-offset)
92!
93 DO i=1,6
94 ii(i) = (i-1)*llt
95 ENDDO
96!
97C-----------------------------------------------
98C SOLID 8N
99C-----------------------------------------------
100 IF (ity == 1) THEN
101C-----------
102 gbuf => elbuf_tab(ng)%GBUF
103c
104 IF (mlw == 0 .OR. mlw == 13 . or. igtyp == 0) THEN
105 DO i=lft,llt
106 evar(i) = zero
107 ENDDO
108 ELSE
109 jturb=iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
110C
111 IF (ifunc == 1) THEN
112 DO i=lft,llt
113 IF (gbuf%G_PLA > 0) THEN
114 evar(i) = gbuf%PLA(i)
115 ENDIF
116 ENDDO
117 ELSEIF(ifunc == 2)THEN
118 DO i=lft,llt
119 evar(i) = gbuf%RHO(i)
120 ENDDO
121 ELSEIF(ifunc == 3)THEN
122 DO i=lft,llt
123 n = i + nft
124 ialel=iparg(7,ng)+iparg(11,ng)
125 IF (ialel == 0) THEN
126 mt=ixs(1,n)
127 evar(i) = gbuf%EINT(i)/max(em30,pm(1,mt))
128 ELSE
129 evar(i) = gbuf%EINT(i)/max(em30,gbuf%RHO(i))
130 ENDIF
131 ENDDO
132 ELSEIF (ifunc == 4) THEN
133 DO i=lft,llt
134 IF (gbuf%G_TEMP > 0) THEN
135 evar(i) = gbuf%TEMP(i)
136 ENDIF
137 ENDDO
138 ELSEIF(ifunc == 6 .OR. ifunc == 7)THEN
139 DO i=lft,llt
140 n = i + nft
141 p = - (gbuf%SIG(ii(1) + i)
142 . + gbuf%SIG(ii(2) + i)
143 . + gbuf%SIG(ii(3) + i)) * third
144 VALUE = p
145 IF (ifunc == 7) THEN
146 s1=gbuf%SIG(ii(1) + i)+p
147 s2=gbuf%SIG(ii(2) + i)+p
148 s3=gbuf%SIG(ii(3) + i)+p
149 vonm2= three*(gbuf%SIG(ii(4) + i)**2 +
150 . gbuf%SIG(ii(5) + i)**2 +
151 . gbuf%SIG(ii(6) + i)**2 +
152 . half*(s1*s1+s2*s2+s3*s3) )
153 vonm= sqrt(vonm2)
154 VALUE = vonm
155 ENDIF
156 evar(i) = VALUE
157 ENDDO
158c-----------
159 ELSEIF(ifunc >= 14 .AND. ifunc <= 19)THEN
160 DO i=lft,llt
161 evar(i) = gbuf%SIG(ii(ifunc-13) + i)
162 ENDDO
163 ENDIF
164c-----------
165 IF (isolnod == 16) THEN
166 DO i=lft,llt
167 n = nn2 + i + nft
168 IF(el2fa(n)/=0)THEN
169 func(el2fa(n)) = evar(i)
170 func(el2fa(n)+1) = evar(i)
171 func(el2fa(n)+2) = evar(i)
172 func(el2fa(n)+3) = evar(i)
173 ENDIF
174 ENDDO
175 ELSE
176 DO i=lft,llt
177 n = nn2 + i + nft
178 IF(el2fa(n)/=0)THEN
179 func(el2fa(n)) = evar(i)
180 ENDIF
181 ENDDO
182 ENDIF
183 ENDIF
184C
185C-----------------------------------------------
186 ELSEIF (isph3d == 1.AND.ity == 51) THEN
187C TETRAS SPH.
188C-----------------------------------------------
189 gbuf => elbuf_tab(ng)%GBUF
190 IF (ifunc >= 14 .AND. ifunc <= 19) THEN
191 DO i=lft,llt
192 n = i + nft
193 IF (el2fa(nn3+n)/=0) THEN
194 func(el2fa(nn3+n)) = gbuf%SIG(ii(ifunc-13) + i)
195 ENDIF
196 ENDDO
197 ELSE
198 DO i=lft,llt
199 n = i + nft
200 IF(el2fa(nn3+n)/=0)THEN
201 func(el2fa(nn3+n)) = zero
202 ENDIF
203 ENDDO
204 ENDIF
205C
206 ENDIF
207C-----------------------------------------------
208C FIN DE BOUCLE SUR LES OFFSET
209C-----------------------------------------------
210 ENDDO
211 900 CONTINUE
212C-----------------------------------------------
213 DO n=1,nbf
214 r4 = func(n)
215 CALL write_r_c(r4,1)
216 ENDDO
217C-----------
218 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure)
Definition initbuf.F:38
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519