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

Go to the source code of this file.

Functions/Subroutines

subroutine w_sectio (nstrf, cep, cel, proc, nstrf_l, nodlocal, len_ia)

Function/Subroutine Documentation

◆ w_sectio()

subroutine w_sectio ( integer, dimension(*) nstrf,
integer, dimension(*) cep,
integer, dimension(*) cel,
integer proc,
integer nstrf_l,
integer, dimension(*) nodlocal,
integer len_ia )

Definition at line 31 of file w_sectio.F.

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
nlocal
integer function nlocal(n, p)
Definition ddtools.F:349
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645