OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pblast.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!|| pblast_load_computation ../engine/source/loads/pblast/pblast.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.f
27!||--- calls -----------------------------------------------------
28!|| my_barrier ../engine/source/system/machine.F
29!|| pblast_1 ../engine/source/loads/pblast/pblast_1.F
30!|| pblast_2 ../engine/source/loads/pblast/pblast_2.F
31!|| pblast_3 ../engine/source/loads/pblast/pblast_3.F
32!||--- uses -----------------------------------------------------
33!|| groupdef_mod ../common_source/modules/groupdef_mod.F
34!|| h3d_mod ../engine/share/modules/h3d_mod.F
35!|| pblast_mod ../common_source/modules/loads/pblast_mod.F90
36!|| th_surf_mod ../common_source/modules/interfaces/th_surf_mod.f
37!||====================================================================
38 SUBROUTINE pblast_load_computation (PBLAST,ILOADP ,FAC ,A , V , X ,
39 1 IADC ,FSKY ,LLOADP ,FEXT ,NODA_SURF, NODA_PEXT,
40 2 ITAB ,H3D_DATA,TH_SURF ,WFEXT)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE h3d_mod
45 USE pblast_mod
46 USE groupdef_mod
47 USE th_surf_mod , ONLY : th_surf_
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "comlock.inc"
53#include "param_c.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com04_c.inc"
58#include "com06_c.inc"
59#include "com08_c.inc"
60#include "mvsiz_p.inc"
61#include "tabsiz_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 TYPE(pblast_),INTENT(INOUT) :: PBLAST
66 INTEGER,INTENT(IN) :: LLOADP(SLLOADP)
67 INTEGER,INTENT(INOUT) :: ILOADP(SIZLOADP,NLOADP)
68 INTEGER,INTENT(IN) :: IADC(*)
69 INTEGER, INTENT(IN) :: ITAB(NUMNOD)
70 my_real,INTENT(INOUT) :: fac(lfacload,nloadp)
71 my_real,INTENT(IN) :: v(3,numnod),x(3,numnod)
72 my_real,INTENT(INOUT) :: a(3,numnod),fsky(8,sfsky/8), fext(3,numnod)
73 my_real,INTENT(INOUT) :: noda_surf(numnod)
74 my_real,INTENT(INOUT) :: noda_pext(numnod)
75 TYPE(h3d_database),INTENT(IN) :: H3D_DATA
76 TYPE (TH_SURF_) , INTENT(INOUT) :: TH_SURF
77 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER :: NL, ABAC_ID, ID, II, IJK, NN(4), NNOD, IAD , IL, NSEGPL
82 my_real :: DTMIN_LOC, T_STOP, TA_FIRST
83 DOUBLE PRECISION :: WFEXT_LOC
84 LOGICAL :: IS_RESET
85
86C-----------------------------------------------
87C D e s c r i p t i o n
88C-----------------------------------------------
89C this subroutines is applying pressure load to
90C a segment submitted to a blast wave.
91C Preussre time histories are built from "UFC 3-340-02, Dec. 5th 2008" tables which are hardcoded in unit system {g, cm, mus}
92C 3 different models are available to build the pressure time history :
93C FREE AIR (ABAC_ID = 1)
94C SURFACE BURST (ABAC_ID = 2)
95C AIR BURST (ABAC_ID = 3)
96C-----------------------------------------------
97C P r e - C o n d i t i o n
98C-----------------------------------------------
99 pblast%PBLAST_DT%DT = ep20
100 pblast%PBLAST_DT%IDT = 0
101
102 IF(pblast%NLOADP_B==0)THEN
103 RETURN
104 ENDIF
105 nsegpl = th_surf%NSEGLOADPF
106C-----------------------------------------------,
107C S o u r c e C o d e
108C-----------------------------------------------
109!$OMP PARALLEL
110!$OMP+ SHARED(FAC,A,V,X,WFEXT,IADC,FSKY,LLOADP,FEXT,ITAB,H3D_DATA,TT,ILOADP)
111!$OMP+ PRIVATE(ABAC_ID,ID,DTMIN_LOC,NL,WFEXT_LOC,TA_FIRST,IJK)
112
113 !-----------------------------------------------
114 ! LOOP OVER all /LOAD/PBLAST options
115 !-----------------------------------------------
116
117 DO nl=nloadp_f+1, nloadp_f+pblast%NLOADP_B
118
119 abac_id = iloadp(07,nl)
120 id = iloadp(08,nl) !user_id
121 ta_first = fac(07,nl)
122 t_stop = fac(13,nl)
123 il = nl-nloadp_f
124 is_reset = pblast%PBLAST_TAB(il)%IS_RESET
125 wfext_loc = zero
126 dtmin_loc = ep20
127
128 IF(tt <= t_stop)THEN
129 SELECT CASE(abac_id)
130 CASE(1)
131 !--- LOADING MODEL : FREE AIR, SPHERICAL CHARGE
132 CALL pblast_1(pblast,
133 1 iloadp ,fac ,a ,v ,x ,
134 2 iadc ,fsky ,lloadp ,fext ,noda_surf, noda_pext,
135 3 itab ,h3d_data ,nl ,dtmin_loc ,wfext_loc,
136 4 th_surf ,nsegpl )
137
138 CASE(2)
139 !--- LOADING MODEL : GROUND REFLECTION, HEMISPHERICAL CHARGE
140 CALL pblast_2(pblast,
141 1 iloadp ,fac ,a ,v ,x ,
142 2 iadc ,fsky ,lloadp ,fext ,noda_surf, noda_pext,
143 3 itab ,h3d_data ,nl ,dtmin_loc ,wfext_loc,
144 4 th_surf ,nsegpl )
145 CASE(3)
146 !--- LOADING MODEL : SURFACE BURST, SPHERICAL CHARGE
147 CALL pblast_3(pblast,
148 1 iloadp ,fac ,a ,v ,x ,
149 2 iadc ,fsky ,lloadp ,fext ,noda_surf, noda_pext,
150 3 itab ,h3d_data ,nl ,dtmin_loc ,wfext_loc,
151 4 th_surf ,nsegpl )
152
153 END SELECT
154
155 ELSEIF(tt > t_stop)THEN
156 dtmin_loc = ep20
157 IF(.NOT. is_reset)THEN
158 ! FLUSH fsky array to 0.
159!$OMP DO SCHEDULE(GUIDED,MVSIZ)
160 DO ii = 1,iloadp(1,nl)/4
161 !nodes of structural face : N1,N2,N3,N4
162 nn(1)=lloadp(iloadp(4,nl)+4*(ii-1))
163 nn(2)=lloadp(iloadp(4,nl)+4*(ii-1)+1)
164 nn(3)=lloadp(iloadp(4,nl)+4*(ii-1)+2)
165 nn(4)=lloadp(iloadp(4,nl)+4*(ii-1)+3)
166 IF(nn(4) /= 0 .AND.nn(1) /= nn(2) .AND. nn(1) /= nn(3) .AND. nn(1) /= nn(4) .AND.
167 . nn(2) /= nn(3) .AND. nn(2) /= nn(4) .AND. nn(3) /= nn(4) )THEN
168 nnod=4
169 ELSE
170 nnod=3
171 ENDIF
172 DO ijk=1,nnod
173 iad = iadc(iloadp(4,nl)+4*(ii-1)+(ijk-1)) ! node indexes in FSKY related to current option /LOAD/PBLAST
174 fsky(1:3,iad) = zero
175 ENDDO
176 pblast%PBLAST_TAB(il)%IS_RESET = .true.
177 enddo! next II
178!$OMP END DO
179 endif!(.NOT. IS_RESET)
180
181 ENDIF
182
183#include "lockon.inc"
184 wfext = wfext + wfext_loc
185 ! Time Step (DT_PBLAST) and corresponding option id (IDT_PBLAST)
186 ! if nothing was loaded : set time step to go on arrival time (no CPU time wasted in nothing happen elsewhere)
187 ! if load has started, use positive impulse to determine a time step for this current option
188
189 IF(dtmin_loc < pblast%PBLAST_DT%DT)THEN
190 pblast%PBLAST_DT%IDT = id
191 pblast%PBLAST_DT%DT = dtmin_loc
192 ENDIF
193
194#include "lockoff.inc"
195
196 CALL my_barrier()
197
198 ENDDO !next NL
199
200!$OMP END PARALLEL
201
202
203 END SUBROUTINE
#define my_real
Definition cppsort.cpp:32
OPTION /TH/SURF outputs of Pressure and Area needed Tabs.
Definition th_surf_mod.F:60
subroutine pblast_load_computation(pblast, iloadp, fac, a, v, x, iadc, fsky, lloadp, fext, noda_surf, noda_pext, itab, h3d_data, th_surf, wfext)
Definition pblast.F:41
subroutine pblast_1(pblast, iloadp, fac, a, v, x, iadc, fsky, lloadp, fext, noda_surf, noda_pext, itab, h3d_data, nl, dtmin_loc, wfext_loc, th_surf, nsegpl)
Definition pblast_1.F:46
subroutine pblast_2(pblast, iloadp, fac, a, v, x, iadc, fsky, lloadp, fext, noda_surf, noda_pext, itab, h3d_data, nl, dtmin_loc, wfext_loc, th_surf, nsegpl)
Definition pblast_2.F:46
subroutine pblast_3(pblast, iloadp, fac, a, v, x, iadc, fsky, lloadp, fext, noda_surf, noda_pext, itab, h3d_data, nl, dtmin_loc, wfext_loc, th_surf, nsegpl)
Definition pblast_3.F:46
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
subroutine my_barrier
Definition machine.F:31