OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dfunc0.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!|| dfunc0 ../starter/source/output/anim/dfunc0.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE dfunc0(ELBUF_TAB ,FUNC ,IFUNC ,IPARG ,PM ,
31 2 EL2FA ,NBF ,SPBUF ,IPART ,IPARTSP )
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE elbufdef_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "vect01_c.inc"
44#include "mvsiz_p.inc"
45#include "sphcom.inc"
46#include "com01_c.inc"
47#include "scr17_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,*),spbuf(nspbuf,*)
55 INTEGER IPARG(NPARG,*),EL2FA(*),IFUNC,NBF,
56 . ipart(lipart1,*),ipartsp(*)
57 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 my_real
62 . evar(mvsiz),
63 . p, vonm2, vonm, s1, s2, s12, s3, VALUE
64 INTEGER I,II(6),NG,NEL,N,MLW,NN,NN1,JTURB,MT,IALEL,IPRT
65 TYPE(g_bufel_) ,POINTER :: GBUF
66 REAL R4,WA(NBF)
67C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
68C La routine ne fonctionne que pour les IFUNC 3,6,7,14-19 (stress)
69C=======================================================================
70 nn1 = 1
71c NN2 = NN1 + (NUMSPH+MAXPJET)
72C
73C-----------------------------------------------
74 DO 900 ng=1,ngroup
75 nel = iparg(2,ng)
76 nft = iparg(3,ng)
77 ity = iparg(5,ng)
78 lft=1
79 llt=nel
80!
81 DO i=1,6
82 ii(i) = (i-1)*nel
83 ENDDO
84!
85C-----------------------------------------------
86 IF (ity == 51) THEN
87C PARTICULES SPH.
88C-----------------------------------------------
89 IF (ifunc == 0) THEN
90 DO i=lft,llt
91 n = i + nft
92 func(el2fa(nn1+n)) = spbuf(1,n)
93 ENDDO
94 ELSE
95 gbuf => elbuf_tab(ng)%GBUF
96 jturb= iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
97 ialel= iparg(7,ng)+iparg(11,ng)
98c
99 IF (ifunc == 3) THEN
100 DO i=lft,llt
101 n = i + nft
102 IF(ialel == 0)THEN
103 iprt=ipartsp(n)
104 mt =ipart(1,iprt)
105 VALUE = gbuf%EINT(i)/max(em30,pm(89,mt))
106 ELSE
107 VALUE = gbuf%EINT(i)/max(em30,gbuf%RHO(i))
108 ENDIF
109 func(el2fa(nn1+n)) = VALUE
110 ENDDO
111c
112 ELSEIF (ifunc == 6 .OR. ifunc == 7) THEN
113 DO i=lft,llt
114!! II = (I-1)*6
115 n = i + nft
116 IF(el2fa(nn1+n)/=0)THEN
117 p = - (gbuf%SIG(ii(1) + i)
118 . + gbuf%SIG(ii(2) + i)
119 . + gbuf%SIG(ii(3) + i) ) * third
120 VALUE = p
121 IF(ifunc == 7) THEN
122 s1=gbuf%SIG(ii(1) + i) + p
123 s2=gbuf%SIG(ii(2) + i) + p
124 s3=gbuf%SIG(ii(3) + i) + p
125 vonm2= three*(gbuf%SIG(ii(4) + i)**2 +
126 . gbuf%SIG(ii(5) + i)**2 +
127 . gbuf%SIG(ii(6) + i)**2 +
128 . half*(s1*s1+s2*s2+s3*s3) )
129 vonm= sqrt(vonm2)
130 VALUE = vonm
131 ENDIF
132 func(el2fa(nn1+n)) = VALUE
133 ENDIF
134 ENDDO
135c
136 ELSEIF (ifunc >= 14 .AND. ifunc <= 19) THEN
137 DO i=lft,llt
138!! II = (I-1)*6
139 n = i + nft
140 IF(el2fa(nn1+n)/=0)THEN
141 func(el2fa(nn1+n)) = gbuf%SIG(ii(ifunc - 13) + i)
142 ENDIF
143 ENDDO
144 ELSE
145 DO i=lft,llt
146 n = i + nft
147 IF(el2fa(nn1+n)/=0)THEN
148 func(el2fa(nn1+n)) = zero
149 ENDIF
150 ENDDO
151 ENDIF
152 ENDIF
153 ENDIF
154C-----------------------------------------------
155C FIN DE BOUCLE SUR LES GROUPES
156C-----------------------------------------------
157 900 CONTINUE
158C-----------------------------------------------
159 DO n=1,nbf
160 r4 = func(n)
161 CALL write_r_c(r4,1)
162 ENDDO
163C-----------
164 RETURN
165 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
dfunc0
subroutine dfunc0(elbuf_tab, func, ifunc, iparg, pm, el2fa, nbf, spbuf, ipart, ipartsp)
Definition dfunc0.F:32
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519