OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
forcepinch.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!|| forcepinch ../engine/source/loads/general/forcepinch.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.f
27!||--- calls -----------------------------------------------------
28!|| finter ../engine/source/tools/curve/finter.F
29!|| finter_smooth ../engine/source/tools/curve/finter_smooth.F
30!|| get_u_numsens ../engine/source/user_interface/usensor.F
31!|| get_u_sens_fpar ../engine/source/user_interface/usensor.F
32!|| get_u_sens_ipar ../engine/source/user_interface/usensor.F
33!|| get_u_sens_value ../engine/source/user_interface/usensor.F
34!|| set_u_sens_value ../engine/source/user_interface/usensor.F
35!||--- uses -----------------------------------------------------
36!|| h3d_mod ../engine/share/modules/h3d_mod.F
37!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
38!|| python_funct_mod ../common_source/modules/python_mod.F90
39!|| sensor_mod ../common_source/modules/sensor_mod.F90
40!||====================================================================
41 SUBROUTINE forcepinch (IB ,FAC ,NPC ,TF ,A ,
42 2 V ,X ,SKEW ,AR ,VR ,
43 3 NSENSOR,SENSOR_TAB ,WEIGHT ,TFEXC ,IADC ,
44 4 FSKY ,FSKYV ,FEXT ,H3D_DATA,
45 5 APINCH ,VPINCH, PYTHON, WFEXT)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE h3d_mod
50 USE pinchtype_mod
51 USE sensor_mod
52 USE python_funct_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57#include "comlock.inc"
58#include "param_c.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com04_c.inc"
63#include "com06_c.inc"
64#include "com08_c.inc"
65#include "scr14_c.inc"
66#include "scr16_c.inc"
67#include "parit_c.inc"
68C-----------------------------------------------
69C E x t e r n a l F u n c t i o n s
70C-----------------------------------------------
71 INTEGER GET_U_NUMSENS,GET_U_SENS_FPAR,GET_U_SENS_IPAR,
72 . GET_U_SENS_VALUE,SET_U_SENS_VALUE
73 EXTERNAL GET_U_NUMSENS,GET_U_SENS_FPAR,GET_U_SENS_IPAR,
74 . GET_U_SENS_VALUE,SET_U_SENS_VALUE
75C-----------------------------------------------,
76C D u m m y A r g u m e n t s
77C-----------------------------------------------
78 INTEGER ,INTENT(IN) :: NSENSOR
79 INTEGER NPC(*)
80 INTEGER IB(NIBCLD,*)
81 INTEGER WEIGHT(*), IADC(4,*)
82 my_real
83 . fac(lfaccld,*), tf(*), a(3,*), v(3,*), ar(3,*), vr(3,*),
84 . x(3,*), skew(lskew,*), tfexc,
85 . fsky(8,lsky), fskyv(lsky,8),fext(3,*),
86 . apinch(3,*),vpinch(3,*)
87 TYPE(h3d_database) :: H3D_DATA
88 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
89 TYPE(PYTHON_) :: PYTHON
90 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 INTEGER NL, N1, ISK, N2, N3, N4, N5, K1, K2, K3, ISENS,K,LL,IERR,
95 . ICODE,IAD,N_OLD, Bric(2), Face(2), NumBric, IBRIC, IANIM,I,
96 . ISMOOTH
97 my_real
98 . nx, ny, nz, axi, aa, a0, vv, fx, fy, fz, ax, dydx, ts,
99 . sixth,wfextt,x_old, f1, f2,xsens,fcx,fcy
100 my_real finter, zfx,zfy,zfz, zzfx,zzfy,zzfz,ps, zx,zy,zz,finter_smooth
101 my_real
102 . fcypinch, fxpinch, fypinch, fzpinch, aapinch
103 EXTERNAL finter,finter_smooth
104
105C=======================================================================
106 sixth = one_over_6
107 tfexc = zero
108 wfextt = zero
109 n_old = 0
110 x_old = zero
111 ianim = anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT+
112 . anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT
113C
114 DO 10 nl=nconld-nploadpinch+1,nconld
115 n1 = ib(1,nl)
116 n2 = ib(2,nl)
117 n3 = ib(3,nl)
118 n4 = ib(4,nl)
119 n5 = ib(5,nl)
120 fcy = fac(1,nl)
121 fcx = fac(2,nl)
122 fcypinch= fac(1,nl)
123C
124 isens = 0
125 xsens = one
126 DO k=1,nsensor
127 IF(ib(6,nl)==sensor_tab(k)%SENS_ID) isens=k
128 ENDDO
129 IF(isens==0)THEN
130 ts=tt
131 ELSE
132 ts = tt-sensor_tab(isens)%TSTART
133 IF(ts < zero) GOTO 10
134 ENDIF
135C----------------
136C PINCHING PRESSURE
137C----------------
138 IF(n_old/=n5.OR.x_old/=ts) THEN
139
140 ismooth = 0
141 IF (n5 > 0) ismooth = npc(2*nfunct+n5+1)
142!! F1 = FINTER(N5,TS*FCX,NPC,TF,DYDX)
143 IF (ismooth == 0) THEN
144 f1 = finter(n5,ts*fcx,npc,tf,dydx)
145 ELSE IF(ismooth > 0) THEN
146 f1 = finter_smooth(n5,ts*fcx,npc,tf,dydx)
147 ELSE
148 ismooth = -ismooth ! the id the python function is saved in the position of ISMOOTH in the NPC array
149 CALL python_call_funct1d(python, ismooth,(ts)*fcx, f1)
150 ENDIF ! IF (ISMOOTH == 0)
151 n_old = n5
152 x_old = ts
153 ENDIF
154 aapinch = fcypinch*f1*xsens
155C
156 IF(n4/=0)THEN
157 nx = (x(2,n3)-x(2,n1))*(x(3,n4)-x(3,n2)) - (x(3,n3)-x(3,n1))*(x(2,n4)-x(2,n2))
158 ny = (x(3,n3)-x(3,n1))*(x(1,n4)-x(1,n2)) - (x(1,n3)-x(1,n1))*(x(3,n4)-x(3,n2))
159 nz = (x(1,n3)-x(1,n1))*(x(2,n4)-x(2,n2)) - (x(2,n3)-x(2,n1))*(x(1,n4)-x(1,n2))
160C
161 fxpinch = aapinch*nx*one_over_8
162 fypinch = aapinch*ny*one_over_8
163 fzpinch = aapinch*nz*one_over_8
164C
165 apinch(1,n1) = apinch(1,n1) + fxpinch
166 apinch(2,n1) = apinch(2,n1) + fypinch
167 apinch(3,n1) = apinch(3,n1) + fzpinch
168C
169 apinch(1,n2) = apinch(1,n2) + fxpinch
170 apinch(2,n2) = apinch(2,n2) + fypinch
171 apinch(3,n2) = apinch(3,n2) + fzpinch
172C
173 apinch(1,n3) = apinch(1,n3) + fxpinch
174 apinch(2,n3) = apinch(2,n3) + fypinch
175 apinch(3,n3) = apinch(3,n3) + fzpinch
176C
177 apinch(1,n4) = apinch(1,n4) + fxpinch
178 apinch(2,n4) = apinch(2,n4) + fypinch
179 apinch(3,n4) = apinch(3,n4) + fzpinch
180C
181C
182 wfextt=wfextt+dt1*(fxpinch*(vpinch(1,n1)+vpinch(1,n2)+vpinch(1,n3)+vpinch(1,n4))
183 1 +fypinch*(vpinch(2,n1)+vpinch(2,n2)+vpinch(2,n3)+vpinch(2,n4))
184 2 +fzpinch*(vpinch(3,n1)+vpinch(3,n2)+vpinch(3,n3)+vpinch(3,n4)))
185
186 ELSE ![pm] 3 nodes : triangles(not implemented at the moment)
187 ! true triangles.
188 nx = (x(2,n3)-x(2,n1))*(x(3,n3)-x(3,n2)) - (x(3,n3)-x(3,n1))*(x(2,n3)-x(2,n2))
189 ny = (x(3,n3)-x(3,n1))*(x(1,n3)-x(1,n2)) - (x(1,n3)-x(1,n1))*(x(3,n3)-x(3,n2))
190 nz = (x(1,n3)-x(1,n1))*(x(2,n3)-x(2,n2)) - (x(2,n3)-x(2,n1))*(x(1,n3)-x(1,n2))
191C
192 fxpinch = aapinch*nx*sixth
193 fypinch = aapinch*ny*sixth
194 fzpinch = aapinch*nz*sixth
195C
196 apinch(1,n1)=apinch(1,n1)+fxpinch
197 apinch(2,n1)=apinch(2,n1)+fypinch
198 apinch(3,n1)=apinch(3,n1)+fzpinch
199C
200 apinch(1,n2)=apinch(1,n2)+fxpinch
201 apinch(2,n2)=apinch(2,n2)+fypinch
202 apinch(3,n2)=apinch(3,n2)+fzpinch
203C
204 apinch(1,n3)=apinch(1,n3)+fxpinch
205 apinch(2,n3)=apinch(2,n3)+fypinch
206 apinch(3,n3)=apinch(3,n3)+fzpinch
207C
208 ENDIF
209 10 CONTINUE
210C
211!$OMP ATOMIC
212 wfext = wfext + wfextt
213C
214 RETURN
215 END
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
forcepinch
subroutine forcepinch(ib, fac, npc, tf, a, v, x, skew, ar, vr, nsensor, sensor_tab, weight, tfexc, iadc, fsky, fskyv, fext, h3d_data, apinch, vpinch, python, wfext)
Definition forcepinch.F:46
h3d_mod
Definition h3d_mod.F:308
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::nploadpinch
integer nploadpinch
Definition pinchtype_mod.F:74
resol
subroutine resol(timers, element, nodes, coupling, af, iaf, iskwn, neth, ipart, nom_opt, kxx, ixx, ixtg, ixs, ixq, ixt, ixp, ixr, ifill, mat_elem, ims, npc, ibcl, ibfv, idum, las, laccelm, nnlink, lnlink, iparg, dd_iad, igrv, iexlnk, kinet, ipari, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, nodpor, monvol, ilink, llink, linale, neflsw, nnflsw, icut, cluster, itask, inoise, thke, damp, pm, skews, geo, eani, bufmat, bufgeo, bufsf, w, veul, fill, dfill, alph, wb, dsave, asave, msnf, tf, forc, vel, fsav, fzero, xlas, accelm, agrv, fr_wave, failwave, parts0, elbuf, rwbuf, sensors, rwsav, rby, rivet, secbuf, volmon, lambda, wa, fv, partsav, uwa, val2, phi, segvar, r, crflsw, flsw, fani, xcut, anin, tani, secfcum, bufnois, idata, rdata, iframe, kxsp, ixsp, nod2sp, ispsym, ispcond, xframe, spbuf, xspsym, vspsym, pv, fsavd, ibvel, lbvel, wasph, w16, isphio, lprtsph, lonfsph, vsphio, fbvel, lagbuf, ibcslag, iactiv, dampr, gjbufi, gjbufr, rbmpc, ibmpc, sphveln, nbrcvois, nbsdvois, lnrcvois, lnsdvois, nercvois, nesdvois, lercvois, lesdvois, npsegcom, lsegcom, nporgeo, ixtg1, npbyl, lpbyl, rbyl, igeo, ipm, madprt, madsh4, madsh3, madsol, madnod, madfail, iad_rby, fr_rby, fr_wall, iad_rby2, fr_rby2, iad_i2m, fr_i2m, addcni2, procni2, iadi2, fr_mv, iadmv2, fr_ll, fr_rl, iadcj, fr_cj, fr_sec, iad_sec, iad_cut, fr_cut, rg_cut, newfront, fr_mad, fxbipm, fxbrpm, fxbnod, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, fxbelm, fxbsig, fxbgrvi, fxbgrvr, eigipm, eigibuf, eigrpm, lnodpor, fr_i18, graphe, iflow, rflow, lgrav, dd_r2r, fasolfr, fr_lagf, llagf, lprw, icontact, rcontact, sh4tree, sh3tree, ipadmesh, padmesh, msc, mstg, inc, intg, ptg, iskwp, nskwp, isensp, nsensp, iaccp, naccp, ipart_state, acontact, pcontact, factiv, sh4trim, sh3trim, mscnd, incnd, ibfflux, fbfflux, rbym, irbym, lnrbym, icodrbym, ibcv, fconv, ibftemp, fbftemp, iad_rbym, fr_rbym, weight_rm, ms_ply, zi_ply, inod_pxfem, iel_pxfem, iadc_pxfem, adsky_pxfem, icode_ply, icodt_ply, iskew_ply, admsms, madclnod, nom_sect, mcpc, mcptg, dmelc, dmeltg, mssa, dmels, mstr, dmeltr, msp, dmelp, msrt, dmelrt, ibcr, fradia, res_sms, table, irbe2, lrbe2, iad_rbe2, fr_rbe2, phie, msf, procne_pxfem, iadsdp_pxfem, iadrcp_pxfem, icfield, lcfield, cfield, msz2, diag_sms, iloadp, lloadp, loadp, inod_crk, iel_crk, iadc_crk, adsky_crk, cne_crk, procne_crk, iadsdp_crk, iadrcp_crk, ibufssg_io, ibc_ply, dmint2, ibordnode, elbuf_tab, por, nodedge, iad_edge, fr_edge, fr_nbedge, crknodiad, lgauge, gauge, igaup, ngaup, nodlevxf, dd_r2r_elem, nodglobxfe, sph2sol, sol2sph, irst, dmsph, wagap, xfem_tab, elcutc, nodenr, kxfenod2elc, enrtag, rthbu f, kxig3d, ixig3d, knot, wige, wsmcomp, stack, cputime_mp_glob, cputime_mp, tab_ump, poin_ump, sol2sph_typ, irunn_bis, addcsrect, iad_frnor, fr_nor, procnor, iad_fredg, fr_edg, drape_sh4n, drape_sh3n, tab_mat, nativ0_sms, multi_fvm, segquadfr, ms_2d, h3d_data, subsets, igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, igrsurf, forneqs, nloc_dmg, iskwp_l, knotlocpc, knotlocel, pinch_data, tag_skins6, ale_connectivity, xcell, xface, ne_nercvois, ne_nesdvois, ne_lercvois, ne_lesdvois, ibcscyc, lbcscyc, t_monvol, id_global_vois, face_vois, dynain_data, fcont_max, ebcs_tab, diffusion, kloadpinter, loadpinter, dgaploadint, drapeg, user_windows, output, interfaces, dt, loads, python, dpl0cld, vel0cld, ndamp_vrel, id_damp_vrel, fr_damp_vrel, ndamp_vrel_rbyg, names_and_titles, unitab, liflow, lrflow, glob_therm, pblast, rbe3)
Definition resol.F:633
h3d_mod::h3d_database
Definition h3d_mod.F:435