OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cutfunce.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!|| cutfunce ../engine/source/tools/sect/cutfunce.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.f
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!|| write_r_c ../common_source/tools/input_output/write_routtines.c
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| initbuf_mod ../engine/share/resol/initbuf.F
33!||====================================================================
34 SUBROUTINE cutfunce(NC ,NUMEL,ELBUF_TAB,IFUNC ,
35 . IPARG,PM ,IXS )
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE initbuf_mod
40 USE elbufdef_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "vect01_c.inc"
49#include "com01_c.inc"
50#include "param_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54C REAL
55 my_real
56 . pm(npropm,*)
57 INTEGER IPARG(NPARG,*),NC(5,*),IXS(NIXS,*)
58 INTEGER NUMEL,IFUNC
59 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
60C-----------------------------------------------
61 INTEGER I,J,N,IC,IL,IL_OLD,NG,NEL,MLW,JTURB,MT,G_PLA,II(6)
62C REAL
63 my_real
64 . off, p, vonm2, vonm, s1, s2, s12, s3, VALUE
65 REAL R4
66 TYPE(g_bufel_) ,POINTER :: GBUF
67 TYPE(l_bufel_) ,POINTER :: LBUF
68 TYPE(buf_mat_) ,POINTER :: MBUF
69C=======================================================================
70 il_old = -1
71 VALUE = zero
72 DO ic=1,numel
73 il = nc(5,ic)
74 IF(il/=il_old)THEN
75 il_old = il
76C
77 DO 490 ng=1,ngroup
78 CALL initbuf(iparg ,ng ,
79 2 mlw ,nel ,nft ,iad ,ity ,
80 3 npt ,jale ,ismstr ,jeul ,jtur ,
81 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
82 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
83 6 irep ,iint ,igtyp ,israt ,isrot ,
84 7 icsen ,isorth ,isorthg ,ifailure,jsms )
85 IF (ity/=1) GOTO 490
86 IF (nel+nft<il) GOTO 490
87C-----------------------------------------------
88C SOLID ELEMENT
89C-----------------------------------------------
90 gbuf => elbuf_tab(ng)%GBUF
91 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
92 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
93 i = il - nft
94 llt = nel
95 jturb=iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
96C
97 n = i + nft
98 off = gbuf%OFF(i)
99!
100 DO j=1,6
101 ii(j) = nel*(j-1)
102 ENDDO
103!
104c-----------
105 IF (ifunc==1 .AND. gbuf%G_PLA > 0) THEN
106 VALUE = gbuf%PLA(i)
107c-----------
108 ELSEIF (ifunc == 2) THEN
109 VALUE = gbuf%RHO(i)
110c-----------
111 ELSEIF (ifunc == 3) THEN
112 VALUE = gbuf%EINT(i)
113c-----------
114 ELSEIF(ifunc==4 .AND. jthe > 0) THEN
115 VALUE = gbuf%TEMP(i)
116c-----------
117 ELSEIF(ifunc==6.OR.ifunc==7)THEN
118 p = - (gbuf%SIG(ii(1)+i)
119 . + gbuf%SIG(ii(2)+i)
120 . + gbuf%SIG(ii(3)+i)) / three
121 VALUE = p
122 IF (ifunc==7) THEN
123 s1 = gbuf%SIG(ii(1)+i) + p
124 s2 = gbuf%SIG(ii(2)+i) + p
125 s3 = gbuf%SIG(ii(3)+i) + p
126 vonm2 = three*(gbuf%SIG(ii(4)+i)**2 +
127 . gbuf%SIG(ii(5)+i)**2 +
128 . gbuf%SIG(ii(6)+i)**2 +
129 . half*(s1*s1+s2*s2+s3*s3))
130 vonm= sqrt(vonm2)
131 VALUE = vonm
132 ENDIF
133c-----------
134 ELSEIF (ifunc==8 . and. jturb/=0) THEN
135C ENERGIE TURBULENTE
136 VALUE = gbuf%RK(i)
137 ELSEIF (ifunc==9) THEN
138C VISCOSITE TURBULENTE
139 IF((mlw==6 .OR. mlw==17).AND.jturb/=0)THEN
140 mt=ixs(1,n)
141 VALUE=pm(81,mt)*gbuf%RK(i)**2/
142 . max(em15,gbuf%RE(i))
143 ELSEIF (mlw==46 .OR. mlw==47)THEN
144 VALUE = mbuf%VAR(i)
145 ELSE
146 VALUE = zero
147 ENDIF
148C
149 ELSEIF(ifunc==10)THEN
150C VORTICITE
151 IF(mlw==6 .OR. mlw==17)THEN
152 VALUE = lbuf%VK(i)
153 ELSEIF(mlw==46 .OR. mlw==47)THEN
154 VALUE = mbuf%VAR(i)
155 ELSE
156 VALUE = zero
157 ENDIF
158C
159 ELSEIF(ifunc>=14.AND.ifunc<=19)THEN
160 VALUE = gbuf%SIG(ii(ifunc - 13) + i)
161 ELSE
162 VALUE = zero
163 ENDIF
164 GOTO 500
165C
166 490 CONTINUE
167 500 CONTINUE
168 ENDIF
169C-----------------------------------------------
170 r4 = VALUE
171 CALL write_r_c(r4,1)
172 ENDDO
173C-----------------------------------------------
174 RETURN
175 END
my_real
#define my_real
Definition cppsort.cpp:32
cutfunce
subroutine cutfunce(nc, numel, elbuf_tab, ifunc, iparg, pm, ixs)
Definition cutfunce.F:36
genani
subroutine genani(x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, swaft, smas, sxnorm, siad, iparg, pm, geo, ms, sinvert, cont, smater, icut, skew, xcut, fint, itab, sel2fa, fext, fopt, anin, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, mat_param, dd_iad, weight, eani, ipart, cluster, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, rby, swa4, tors, nom_opt, igrsurf, bufsf, idata, rdata, siadg, bufmat, bufgeo, kxx, ixx, ipartx, suix, sxusr, snfacptx, sixedge, sixfacet, sixsolid, snumx1, snumx2, snumx3, soffx1, soffx2, soffx3, smass1, smass2, smass3, sfunc1, sfunc2, sfunc3, kxsp, ixsp, nod2sp, ipartsp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, iflow, rflow, fncont, ftcont, temp, thke, err_thk_sh4, err_thk_sh3, diag_sms, ipari, fncont2, dr, ale_connectivity, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, dxancg, nod_pxfem, iel_pxfem, zi_ply, vgaz, fcontg, fncontg, ftcontg, fanreac, inod_crk, iel_crk, elcutc, iadc_crk, pdama2, res_sms, weight_md, nodglobxfe, nodedge, fcluster, mcluster, xfem_tab, w, nv46, ipartig3d, kxig3d, ixig3d, sig3dsolid, knot, wige, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, igrnod, h3d_data, subset, multi_fvm, knotlocpc, knotlocel, fcont_max, fncontp2, ftcontp2, glob_therm, drape_sh4n, drape_sh3n, drapeg, output)
Definition genani.F:239
max
#define max(a, b)
Definition macros.h:21
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519