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