OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_skin_pre_map.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!|| h3d_skin_pre_map ../engine/source/output/h3d/h3d_results/h3d_skin_pre_map.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- uses -----------------------------------------------------
28!|| h3d_inc_mod ../engine/share/modules/h3d_inc_mod.F
29!|| loads_mod ../common_source/modules/loads/loads_mod.F90
30!|| pblast_mod ../common_source/modules/loads/pblast_mod.F90
31!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
32!||====================================================================
33 SUBROUTINE h3d_skin_pre_map(IB ,ILOADP ,LLOADP ,IMAPSKP,LOADS,PBLAST)
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE pinchtype_mod
38 USE h3d_inc_mod
39 USE loads_mod
40 USE pblast_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45#include "param_c.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com04_c.inc"
50#include "tabsiz_c.inc"
51C-----------------------------------------------
52C E x t e r n a l F u n c t i o n s
53C-----------------------------------------------
54C-----------------------------------------------,
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER, DIMENSION(SIZLOADP,NLOADP), INTENT(IN) :: ILOADP
58 INTEGER, DIMENSION(SLLOADP), INTENT(IN) :: LLOADP
59 INTEGER, DIMENSION(NIBCLD,NCONLD), INTENT(IN) :: IB
60 INTEGER, DIMENSION(NUMSKINP0), INTENT(OUT) :: IMAPSKP
61 TYPE (LOADS_) , INTENT(IN) :: LOADS
62 TYPE(pblast_),INTENT(IN) :: PBLAST
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER NL, N1, ISK, N2, N3, N4, N5, J,IXST,
67 . IAD ,NP ,NP0 ,NPRES ,N,NSKIN_I,NSKINP0,SHIFT
68 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IRECT
69 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGN
70C=======================================================================
71 ALLOCATE(irect(4,max(1,numskinp)),itagn(max(1,numnod)))
72C
73 itagn = 0
74 np = 0
75 DO nl=1,nconld-nploadpinch
76 n1 = ib(1,nl)
77 n2 = ib(2,nl)
78 n3 = ib(3,nl)
79 n4 = ib(4,nl)
80C
81 IF (n1==0.OR.n2==0.OR.n3==0.OR.n4==-1) cycle
82 np = np +1
83 irect(1:4,np) = ib(1:4,nl)
84 IF (irect(4,np)==0) irect(4,np)=irect(3,np)
85 IF (n4==0) n4 = n3
86 itagn(n1) = 1
87 itagn(n2) = 1
88 itagn(n3) = 1
89 itagn(n4) = 1
90 imapskp(np) = np
91 END DO
92 np0 = np
93C----add only not existing
94 shift = nloadp_f+pblast%NLOADP_B
95 DO nl=1+shift,nloadp_hyd+shift
96 iad = iloadp(4,nl)
97 DO n=1, iloadp(1,nl)/4
98 n1 = lloadp(iad+4*(n-1))
99 n2 = lloadp(iad+4*(n-1)+1)
100 n3 = lloadp(iad+4*(n-1)+2)
101 n4 = lloadp(iad+4*(n-1)+3)
102 IF (n1==0.OR.n2==0.OR.n3==0) cycle
103 IF (n4==0) n4 = n3
104 np0 = np0 +1
105 IF(itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4)<4) THEN
106 np = np +1
107 itagn(n1) = 1
108 itagn(n2) = 1
109 itagn(n3) = 1
110 itagn(n4) = 1
111 irect(1,np) = n1
112 irect(2,np) = n2
113 irect(3,np) = n3
114 irect(4,np) = n4
115 imapskp(np0) = np
116 ELSE
117 ixst = 0
118 j = 0
119 DO WHILE (ixst==0 .AND. j < np)
120 j = j + 1
121 IF (n1 /= irect(1,j)) cycle
122 IF (n2 /= irect(2,j)) cycle
123 IF (n3 /= irect(3,j)) cycle
124 IF (n4 /= irect(4,j)) cycle
125 ixst = 1
126 imapskp(np0) = j
127 END DO
128 IF (ixst == 0 )THEN
129 np = np +1
130 itagn(n1) = 1
131 itagn(n2) = 1
132 itagn(n3) = 1
133 itagn(n4) = 1
134 irect(1,np) = n1
135 irect(2,np) = n2
136 irect(3,np) = n3
137 irect(4,np) = n4
138 imapskp(np0) = np
139 END IF
140 END IF
141 ENDDO
142 END DO
143C
144 DO nl=1,nloadp_f+pblast%NLOADP_B
145 iad = iloadp(4,nl)
146 DO n=1, iloadp(1,nl)/4
147 n1 = lloadp(iad+4*(n-1))
148 n2 = lloadp(iad+4*(n-1)+1)
149 n3 = lloadp(iad+4*(n-1)+2)
150 n4 = lloadp(iad+4*(n-1)+3)
151 IF (n1==0.OR.n2==0.OR.n3==0) cycle
152 IF (n4==0) n4 = n3
153 np0 = np0 +1
154 IF(itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4)<4) THEN
155 np = np +1
156 itagn(n1) = 1
157 itagn(n2) = 1
158 itagn(n3) = 1
159 itagn(n4) = 1
160 irect(1,np) = n1
161 irect(2,np) = n2
162 irect(3,np) = n3
163 irect(4,np) = n4
164 imapskp(np0) = np
165 ELSE
166 ixst = 0
167 j = 0
168 DO WHILE (ixst==0 .AND. j < np)
169 j = j + 1
170 IF (n1 /= irect(1,j)) cycle
171 IF (n2 /= irect(2,j)) cycle
172 IF (n3 /= irect(3,j)) cycle
173 IF (n4 /= irect(4,j)) cycle
174 ixst = 1
175 imapskp(np0) = j
176 END DO
177 IF (ixst == 0 )THEN
178 np = np +1
179 itagn(n1) = 1
180 itagn(n2) = 1
181 itagn(n3) = 1
182 itagn(n4) = 1
183 irect(1,np) = n1
184 irect(2,np) = n2
185 irect(3,np) = n3
186 irect(4,np) = n4
187 imapskp(np0) = np
188 END IF
189 END IF
190 ENDDO
191 END DO
192C
193 DO nl=1,loads%NLOAD_CYL
194 DO n=1, loads%LOAD_CYL(nl)%NSEG
195 n1 = loads%LOAD_CYL(nl)%SEGNOD(n,1)
196 n2 = loads%LOAD_CYL(nl)%SEGNOD(n,2)
197 n3 = loads%LOAD_CYL(nl)%SEGNOD(n,3)
198 n4 = loads%LOAD_CYL(nl)%SEGNOD(n,4)
199 IF (n4==0) n4 = n3
200 np0 = np0 +1
201 IF(itagn(n1)+itagn(n2)+itagn(n3)+itagn(n4)<4) THEN
202 np = np +1
203 itagn(n1) = 1
204 itagn(n2) = 1
205 itagn(n3) = 1
206 itagn(n4) = 1
207 irect(1,np) = n1
208 irect(2,np) = n2
209 irect(3,np) = n3
210 irect(4,np) = n4
211 imapskp(np0) = np
212 ELSE
213 ixst = 0
214 j = 0
215 DO WHILE (ixst==0 .AND. j < np)
216 j = j + 1
217 IF (n1 /= irect(1,j)) cycle
218 IF (n2 /= irect(2,j)) cycle
219 IF (n3 /= irect(3,j)) cycle
220 IF (n4 /= irect(4,j)) cycle
221 ixst = 1
222 imapskp(np0) = j
223 END DO
224 IF (ixst == 0 )THEN
225 np = np +1
226 itagn(n1) = 1
227 itagn(n2) = 1
228 itagn(n3) = 1
229 itagn(n4) = 1
230 irect(1,np) = n1
231 irect(2,np) = n2
232 irect(3,np) = n3
233 irect(4,np) = n4
234 imapskp(np0) = np
235 END IF
236 END IF
237 ENDDO
238 END DO
239 DEALLOCATE(irect,itagn)
240C
241 RETURN
242 END SUBROUTINE h3d_skin_pre_map
h3d_skin_pre_map
subroutine h3d_skin_pre_map(ib, iloadp, lloadp, imapskp, loads, pblast)
Definition h3d_skin_pre_map.F:34
max
#define max(a, b)
Definition macros.h:21
h3d_inc_mod
Definition h3d_inc_mod.F:42
h3d_inc_mod::numskinp
integer numskinp
Definition h3d_inc_mod.F:44
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::nploadpinch
integer nploadpinch
Definition pinchtype_mod.F:74