OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_sectio.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/.
23C
24!||====================================================================
25!|| w_sectio ../starter/source/restart/ddsplit/w_sectio.F
26!||--- called by ------------------------------------------------------
27!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
28!||--- calls -----------------------------------------------------
29!|| nlocal ../starter/source/spmd/node/ddtools.F
30!||====================================================================
31 SUBROUTINE w_sectio(NSTRF ,CEP ,CEL,PROC,
32 2 NSTRF_L,NODLOCAL,LEN_IA)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER PROC, NSTRF_L, LEN_IA,
49 . nstrf(*), cep(*), cel(*), nodlocal(*)
50C-----------------------------------------------
51C F u n c t i o n
52C-----------------------------------------------
53 INTEGER NLOCAL
54 EXTERNAL nlocal
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER NNOD_S, NSELS_S, NSELQ_S, NSELC_S, NSELT_S,NSELP_S,TYP_S,
59 . nnod_s_l,nselr_s,nseltg_s, nsint_s, nsels_s_l, nselq_s_l,
60 . nselc_s_l, nselt_s_l, nselp_s_l, nselr_s_l, nseltg_s_l,
61 . n, n1, n2, n3, ip, j, k, off, ip_l, k0_l, kr0_l, len,
62 . nstr_l(nstrf_l)
63C
64 ip_l = 30
65 ip = 30
66 kr0_l=11
67 DO j = 1, ip
68 nstr_l(j) = nstrf(j)
69 ENDDO
70C
71 DO n = 1, nsect
72 typ_s = nstrf(ip+1)
73 n1 = nstrf(ip+4)
74 n2 = nstrf(ip+5)
75 n3 = nstrf(ip+6)
76 nnod_s = nstrf(ip+7)
77 nsels_s = nstrf(ip+8)
78 nselq_s = nstrf(ip+9)
79 nselc_s = nstrf(ip+10)
80 nselt_s = nstrf(ip+11)
81 nselp_s = nstrf(ip+12)
82 nselr_s = nstrf(ip+13)
83 nseltg_s= nstrf(ip+14)
84 nsint_s = nstrf(ip+15)
85 nsels_s_l = 0
86 nselq_s_l = 0
87 nselc_s_l = 0
88 nselt_s_l = 0
89 nselp_s_l = 0
90 nselr_s_l = 0
91 nseltg_s_l= 0
92 k0_l = ip_l
93C LEN = 30 + NSINT_S + NNOD_S
94 len = 30 + nsint_s
95 DO j = 1, len
96 nstr_l(ip_l+j) = nstrf(ip+j)
97 ENDDO
98 IF(n1/=0) THEN
99 IF(nlocal(n1,proc+1)==1)THEN
100 n1 = nodlocal(n1)
101 nstr_l(ip_l+4) = n1
102 ELSE
103 nstr_l(ip_l+4) = -n1
104 END IF
105 END IF
106 IF(n2/=0) THEN
107 IF(nlocal(n2,proc+1)==1)THEN
108 n2 = nodlocal(n2)
109 nstr_l(ip_l+5) = n2
110 ELSE
111 nstr_l(ip_l+5) = -n2
112 END IF
113 END IF
114 IF(n3/=0) THEN
115 IF(nlocal(n3,proc+1)==1)THEN
116 n3 = nodlocal(n3)
117 nstr_l(ip_l+6) = n3
118 ELSE
119 nstr_l(ip_l+6) = -n3
120 END IF
121 END IF
122 ip = ip + len
123 ip_l = ip_l + len
124C noeuds
125 nnod_s_l = 0
126 DO j = 1, nnod_s
127 k = nstrf(ip + j)
128 IF(nlocal(k,proc+1)==1)THEN
129 nnod_s_l = nnod_s_l + 1
130 nstr_l(ip_l + nnod_s_l) = nodlocal(k)
131 END IF
132 END DO
133 nstr_l(k0_l+7) = nnod_s_l
134 ip = ip + nnod_s
135 ip_l = ip_l + nnod_s_l
136C
137 off = 0
138C solides
139 DO j = 1, nsels_s
140 k = nstrf(ip + j*2 - 1)
141 IF(cep(k+off)==proc) THEN
142 nsels_s_l = nsels_s_l + 1
143 nstr_l(ip_l+nsels_s_l*2-1) = cel(k+off)
144 nstr_l(ip_l+nsels_s_l*2) = nstrf(ip+j*2)
145 ENDIF
146 END DO
147 nstr_l(k0_l+8) = nsels_s_l
148 ip_l = ip_l + 2*nsels_s_l
149 ip = ip + 2*nsels_s
150 off = off + numels
151C quad
152 DO j = 1, nselq_s
153 k = nstrf(ip + j*2 - 1)
154 IF(cep(k+off)==proc) THEN
155 nselq_s_l = nselq_s_l + 1
156 nstr_l(ip_l+nselq_s_l*2-1) = cel(k+off)
157 nstr_l(ip_l+nselq_s_l*2) = nstrf(ip+j*2)
158 ENDIF
159 END DO
160 nstr_l(k0_l+9) = nselq_s_l
161 ip_l = ip_l + 2*nselq_s_l
162 ip = ip + 2*nselq_s
163 off = off + numelq
164C shell
165 DO j = 1, nselc_s
166 k = nstrf(ip + j*2 - 1)
167 IF(cep(k+off)==proc) THEN
168 nselc_s_l = nselc_s_l + 1
169 nstr_l(ip_l+nselc_s_l*2-1) = cel(k+off)
170 nstr_l(ip_l+nselc_s_l*2) = nstrf(ip+j*2)
171 ENDIF
172 END DO
173 nstr_l(k0_l+10) = nselc_s_l
174 ip_l = ip_l + 2*nselc_s_l
175 ip = ip + 2*nselc_s
176 off = off + numelc
177C truss
178 DO j = 1, nselt_s
179 k = nstrf(ip + j*2 - 1)
180 IF(cep(k+off)==proc) THEN
181 nselt_s_l = nselt_s_l + 1
182 nstr_l(ip_l+nselt_s_l*2-1) = cel(k+off)
183 nstr_l(ip_l+nselt_s_l*2) = nstrf(ip+j*2)
184 ENDIF
185 END DO
186 nstr_l(k0_l+11) = nselt_s_l
187 ip_l = ip_l + 2*nselt_s_l
188 ip = ip + 2*nselt_s
189 off = off + numelt
190C poutre
191 DO j = 1, nselp_s
192 k = nstrf(ip + j*2 - 1)
193 IF(cep(k+off)==proc) THEN
194 nselp_s_l = nselp_s_l + 1
195 nstr_l(ip_l+nselp_s_l*2-1) = cel(k+off)
196 nstr_l(ip_l+nselp_s_l*2) = nstrf(ip+j*2)
197 ENDIF
198 END DO
199 nstr_l(k0_l+12) = nselp_s_l
200 ip_l = ip_l + 2*nselp_s_l
201 ip = ip + 2*nselp_s
202 off = off + numelp
203C ressort
204 DO j = 1, nselr_s
205 k = nstrf(ip + j*2 - 1)
206 IF(cep(k+off)==proc) THEN
207 nselr_s_l = nselr_s_l + 1
208 nstr_l(ip_l+nselr_s_l*2-1) = cel(k+off)
209 nstr_l(ip_l+nselr_s_l*2) = nstrf(ip+j*2)
210 ENDIF
211 END DO
212 nstr_l(k0_l+13) = nselr_s_l
213 ip_l = ip_l + 2*nselr_s_l
214 ip = ip + 2*nselr_s
215 off = off + numelr
216C triangle
217 DO j = 1, nseltg_s
218 k = nstrf(ip + j*2 - 1)
219 IF(cep(k+off)==proc) THEN
220 nseltg_s_l = nseltg_s_l + 1
221 nstr_l(ip_l+nseltg_s_l*2-1) = cel(k+off)
222 nstr_l(ip_l+nseltg_s_l*2) = nstrf(ip+j*2)
223 ENDIF
224 END DO
225 nstr_l(k0_l+14) = nseltg_s_l
226 ip_l = ip_l + 2*nseltg_s_l
227 ip = ip + 2*nseltg_s
228 off = off + numeltg
229C K0NEXT
230 nstr_l(k0_l+25) = k0_l+30+nsint_s+nnod_s_l+
231 + 2*(nsels_s_l+nselq_s_l+nselc_s_l+nselt_s_l+
232 + nselp_s_l+nselr_s_l+nseltg_s_l)+1
233 nstr_l(k0_l+26) = kr0_l+10
234 IF(typ_s>=100) nstr_l(k0_l+26)=nstr_l(k0_l+26)+12*nnod_s_l
235 IF(typ_s>=101) nstr_l(k0_l+26)=nstr_l(k0_l+26)+12*nnod_s_l
236 IF(typ_s>=102) nstr_l(k0_l+26)=nstr_l(k0_l+26)+6*nnod_s_l
237 kr0_l = nstr_l(k0_l+26)
238 ENDDO
239C
240 CALL write_i_c(nstr_l,nstrf_l)
241 len_ia = len_ia + nstrf_l
242C
243 RETURN
244 END
w_sectio
subroutine w_sectio(nstrf, cep, cel, proc, nstrf_l, nodlocal, len_ia)
Definition w_sectio.F:33
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645