OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
th_surf_load_pressure.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!> \brief OPTION /TH/SURF output for P and A
25!! \details Subroutine to define for each segment
26!! the list of th surfaces where a pressure is applied
27
28!||====================================================================
29!|| th_surf_load_pressure ../starter/source/output/th/th_surf_load_pressure.F
30!||--- called by ------------------------------------------------------
31!|| lectur ../starter/source/starter/lectur.F
32!||--- calls -----------------------------------------------------
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!||====================================================================
36 SUBROUTINE th_surf_load_pressure(IGRSURF ,TH_SURF , IPRES ,ILOADP ,LLOADP ,
37 . SIZLOADP ,NLOADP ,SLLOADP ,NIBCLD ,NPRELD ,
38 . NSURF ,NUMNOD )
39C
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE my_alloc_mod
44 USE th_surf_mod , ONLY : th_surf_
45 USE groupdef_mod , ONLY : surf_
46 USE message_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER , INTENT(IN) :: SIZLOADP ,NLOADP ,SLLOADP ,NIBCLD ,NPRELD, NSURF ,NUMNOD
58 INTEGER , INTENT(IN) :: ILOADP(SIZLOADP,NLOADP) !< Integer tabs for load pressures (/PFLUID, /PBLAST, /LOAD/PRESSURE )
59 INTEGER , INTENT(IN) :: LLOADP(SLLOADP) !< List of segments of surface where load pressures is applied (/PFLUID, /PBLAST, /LOAD/PRESSURE )
60 INTEGER , INTENT(IN) :: IPRES(NIBCLD,NPRELD) !< List of segments and pressure options for /PLOAD
61 TYPE (SURF_) ,DIMENSION(NSURF), INTENT(IN) :: IGRSURF !< Type for surfaces definition
62 TYPE (TH_SURF_), INTENT(INOUT) :: TH_SURF !< Type for /TH/SURF and load pressures output tabs
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,NOD1,NOD2,NOD3,NOD4,NSEGPL,NSEGPLOAD,IAD,
67 . NS,NL,NLOADPL,N,NN,N1,N2,N3,N4,NLOADPRESS,IS,SIZE_NEW,NSEGLOADP,NSEGLOADFB,ADSEG
68 INTEGER, DIMENSION (:), ALLOCATABLE :: OLD_TAB
69 INTEGER, DIMENSION (:), ALLOCATABLE :: TAG
70C-----------------------------------------------
71
72 th_surf%NSURF = 0
73 DO n=1,nsurf
74 IF(igrsurf(n)%TH_SURF == 1) THEN
75 th_surf%NSURF = th_surf%NSURF + 1
76 ENDIF
77 ENDDO
78
79 nloadpress = npreld + nloadp
80
81C ! Initialisations
82
83 th_surf%IOK = 0
84 th_surf%S_PLOAD_KSEGS = 0
85 th_surf%S_PLOAD_SEGS = 0
86
87 th_surf%S_LOADP_KSEGS = 0
88 th_surf%S_LOADP_SEGS = 0
89
90 th_surf%PLOAD_FLAG = 0
91 th_surf%LOADP_FLAG = 0
92
93 IF(th_surf%NSURF >0 .AND.nloadpress > 0 ) THEN
94
95 th_surf%IOK = 1
96
97C ! Initialisations and allocation
98
99 nsegpl = 0
100 DO nl=1,npreld ! PLOAD option
101 n4 = ipres(4,nl)
102 IF(n4/=-1) nsegpl = nsegpl + 1
103 ENDDO
104 nsegpload = nsegpl
105
106 IF(nsegpl > 0) THEN
107 CALL my_alloc(th_surf%PLOAD_KSEGS,nsegpl+1)
108 CALL my_alloc(th_surf%PLOAD_SEGS,th_surf%NSURF*nsegpl)
109 th_surf%PLOAD_KSEGS = 0
110 th_surf%PLOAD_SEGS = 0
111 ENDIF
112C
113 nsegpl = 0
114 DO nl=1,nloadp ! LOADP (PDFLUID, PBLAST, LOAD_HYD)
115 nsegpl = nsegpl + iloadp(1,nl)/4
116 ENDDO
117 IF(nsegpl > 0) THEN
118 CALL my_alloc(th_surf%LOADP_KSEGS,nsegpl+1)
119 CALL my_alloc(th_surf%LOADP_SEGS,th_surf%NSURF*nsegpl)
120 th_surf%LOADP_KSEGS = 0
121 th_surf%LOADP_SEGS = 0
122 ENDIF
123 nsegloadp = nsegpl
124C
125 CALL my_alloc(tag,numnod)
126 tag(1:numnod) = 0
127
128C ! list of th surfaces to which each segment of PLOAD is included
129
130 nsegpl = 0
131 IF(nsegpload > 0) THEN
132 DO nl=1,npreld
133 n1 = ipres(1,nl)
134 n2 = ipres(2,nl)
135 n3 = ipres(3,nl)
136 n4 = ipres(4,nl)
137 IF(n4/=-1)THEN
138 tag(n1) = 1
139 tag(n2) = 1
140 tag(n3) = 1
141 tag(n4) = 1
142 nsegpl = nsegpl + 1
143 ns = 0
144 adseg = th_surf%PLOAD_KSEGS(nsegpl)
145 DO n =1,nsurf
146 IF(igrsurf(n)%TH_SURF == 1) THEN
147 nn = igrsurf(n)%NSEG
148 DO i=1,nn
149 nod1=igrsurf(n)%NODES(i,1)
150 nod2=igrsurf(n)%NODES(i,2)
151 nod3=igrsurf(n)%NODES(i,3)
152 nod4=igrsurf(n)%NODES(i,4)
153 IF(tag(nod1)==1.AND.tag(nod2)==1.AND.tag(nod3)==1) THEN
154 ns = ns + 1
155 th_surf%PLOAD_SEGS(adseg+ns) = n
156 EXIT
157 ENDIF
158 ENDDO
159 ENDIF
160 ENDDO
161 th_surf%PLOAD_KSEGS(nsegpl+1) = adseg +ns
162 tag(n1) = 0
163 tag(n2) = 0
164 tag(n3) = 0
165 tag(n4) = 0
166 ENDIF
167 ENDDO
168C
169 IF(th_surf%PLOAD_KSEGS(nsegpl+1) > 0) th_surf%PLOAD_FLAG = 1
170 ENDIF
171C
172C ! list of th surfaces to which each segment of LOADP (PDFLUID, PBLAST, LOAD_HYD) is included
173 nsegpl = 0
174 IF(nsegloadp > 0) THEN
175 DO nl=1,nloadp !_HYD
176 iad = iloadp(4,nl)
177 DO n=1, iloadp(1,nl)/4
178 n1=lloadp(iad+4*(n-1))
179 n2=lloadp(iad+4*(n-1)+1)
180 n3=lloadp(iad+4*(n-1)+2)
181 n4=lloadp(iad+4*(n-1)+3)
182 tag(n1) = 1
183 tag(n2) = 1
184 tag(n3) = 1
185 tag(n4) = 1
186 nsegpl = nsegpl + 1
187 ns = 0
188 adseg = th_surf%LOADP_KSEGS(nsegpl)
189 DO is =1,nsurf
190 IF(igrsurf(is)%TH_SURF == 1) THEN
191 nn = igrsurf(is)%NSEG
192 DO i=1,nn
193 nod1=igrsurf(is)%NODES(i,1)
194 nod2=igrsurf(is)%NODES(i,2)
195 nod3=igrsurf(is)%NODES(i,3)
196 nod4=igrsurf(is)%NODES(i,4)
197 IF(tag(nod1)==1.AND.tag(nod2)==1.AND.tag(nod3)==1) THEN
198 ns = ns + 1
199 th_surf%LOADP_SEGS(adseg+ns) = is
200 EXIT
201 ENDIF
202 ENDDO
203 ENDIF
204 ENDDO
205 th_surf%LOADP_KSEGS(nsegpl+1) = adseg +ns
206 tag(n1) = 0
207 tag(n2) = 0
208 tag(n3) = 0
209 tag(n4) = 0
210 ENDDO
211 ENDDO
212C
213 IF(th_surf%LOADP_KSEGS(nsegpl+1) > 0) th_surf%LOADP_FLAG = 1
214 ENDIF
215C
216 IF(ALLOCATED(tag)) DEALLOCATE(tag)
217
218C
219C ! Reallocate table to the right size
220
221 IF(nsegpload > 0) THEN
222C
223 size_new = th_surf%PLOAD_KSEGS(nsegpload + 1)
224 th_surf%S_PLOAD_KSEGS= nsegpload + 1
225 th_surf%S_PLOAD_SEGS= th_surf%PLOAD_KSEGS(nsegpload + 1)
226
227 CALL my_alloc (old_tab,size_new)
228 DO i=1,size_new
229 old_tab(i)=th_surf%PLOAD_SEGS(i)
230 ENDDO
231
232C !reallocate with new size and copy saved values
233 IF(ALLOCATED(th_surf%PLOAD_SEGS)) DEALLOCATE(th_surf%PLOAD_SEGS)
234
235 CALL my_alloc(th_surf%PLOAD_SEGS,th_surf%S_PLOAD_SEGS)
236 DO i=1,size_new
237 th_surf%PLOAD_SEGS(i) = old_tab(i)
238 ENDDO
239 IF(ALLOCATED(old_tab)) DEALLOCATE(old_tab)
240C
241 ENDIF
242
243 IF(nsegloadp > 0) THEN
244
245 size_new = th_surf%LOADP_KSEGS( nsegloadp + 1)
246 th_surf%S_LOADP_KSEGS= nsegloadp + 1
247 th_surf%S_LOADP_SEGS= th_surf%LOADP_KSEGS(nsegloadp + 1)
248
249 CALL my_alloc (old_tab,size_new)
250 DO i=1,size_new
251 old_tab(i)=th_surf%LOADP_SEGS(i)
252 ENDDO
253 IF(ALLOCATED(old_tab)) DEALLOCATE(th_surf%LOADP_SEGS)
254
255C !reallocate with new size and copy saved values
256 CALL my_alloc(th_surf%LOADP_SEGS,th_surf%LOADP_KSEGS( nsegloadp + 1))
257 DO i=1,size_new
258 th_surf%LOADP_SEGS(i) = old_tab(i)
259 ENDDO
260 IF(ALLOCATED(old_tab)) DEALLOCATE(old_tab)
261
262 ENDIF
263
264 ENDIF
265
266 RETURN
267 END
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
th_surf_mod
OPTION /TH/SURF outputs of Pressure and Area needed Tabs.
Definition th_surf_mod.F:60
groupdef_mod::surf_
Definition groupdef_mod.F:745
th_surf_mod::th_surf_
Definition th_surf_mod.F:75
th_surf_load_pressure
subroutine th_surf_load_pressure(igrsurf, th_surf, ipres, iloadp, lloadp, sizloadp, nloadp, slloadp, nibcld, npreld, nsurf, numnod)
OPTION /TH/SURF output for P and A.
Definition th_surf_load_pressure.F:39