OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
th_surf_load_pressure.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

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.

Function/Subroutine Documentation

◆ th_surf_load_pressure()

subroutine th_surf_load_pressure ( type (surf_), dimension(nsurf), intent(in) igrsurf,
type (th_surf_), intent(inout) th_surf,
integer, dimension(nibcld,npreld), intent(in) ipres,
integer, dimension(sizloadp,nloadp), intent(in) iloadp,
integer, dimension(slloadp), intent(in) lloadp,
integer, intent(in) sizloadp,
integer, intent(in) nloadp,
integer, intent(in) slloadp,
integer, intent(in) nibcld,
integer, intent(in) npreld,
integer, intent(in) nsurf,
integer, intent(in) numnod )

OPTION /TH/SURF output for P and A.

Subroutine to define for each segment the list of th surfaces where a pressure is applied

Parameters
[in]iloadpInteger tabs for load pressures (/PFLUID, /PBLAST, /LOAD/PRESSURE )
[in]lloadpList of segments of surface where load pressures is applied (/PFLUID, /PBLAST, /LOAD/PRESSURE )
[in]ipresList of segments and pressure options for /PLOAD
[in]igrsurfType for surfaces definition
[in,out]th_surfType for /TH/SURF and load pressures output tabs

Definition at line 36 of file th_surf_load_pressure.F.

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
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
nl
character *2 function nl()
Definition message.F:2354
groupdef_mod::surf_
Definition groupdef_mod.F:745
th_surf_mod::th_surf_
Definition th_surf_mod.F:75