OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
collect.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!|| collect ../engine/source/output/outfile/collect.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- uses -----------------------------------------------------
28!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
29!||====================================================================
30 SUBROUTINE collect(A,ITAB,WEIGHT,NODGLOB)
31 USE inoutfile_mod
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C C o m m o n B l o c k s
38C-----------------------------------------------
39#include "com01_c.inc"
40#include "com04_c.inc"
41#include "chara_c.inc"
42#include "units_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER ITAB(*),WEIGHT(*),NODGLOB(*)
47 my_real
48 . a(3,*)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I,FILEN,EMPL
53 CHARACTER FILNAM*100,CYCLENUM*7
54 double precision
55 . recglob(4,numnod)
56 INTEGER :: LEN_TMP_NAME
57 CHARACTER(len=2048) :: TMP_NAME
58
59C-----------------------------------------------
60
61 WRITE(cyclenum,'(I7.7)')ncycle
62 filnam=rootnam(1:rootlen)//'_'//chrun//'_'//cyclenum//'.adb'
63 len_tmp_name = outfile_name_len + len_trim(filnam)
64 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
65 OPEN(unit=idbg5,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',
66 . form='FORMATTED',status='UNKNOWN')
67
68 filen = rootlen+17
69
70 DO i = 1, numnod
71 empl = nodglob(i)
72 recglob(1,empl) = itab(i)
73 recglob(2,empl) = a(1,i)
74 recglob(3,empl) = a(2,i)
75 recglob(4,empl) = a(3,i)
76 END DO
77 DO i = 1, numnod
78 WRITE(idbg5,'(A,I10,I10,Z20,Z20,Z20)' )
79 . '>',ncycle,nint(recglob(1,i)),
80 . recglob(2,i),recglob(3,i),recglob(4,i)
81 END DO
82
83 WRITE (iout,1300) filnam(1:filen)
84 WRITE (istdo,1300) filnam(1:filen)
85 CLOSE(unit=idbg5)
86
87 1300 FORMAT (4x,' DEBUG ANALYSIS FILE:',1x,a,' WRITTEN')
88 RETURN
89
90 END
91!||====================================================================
92!|| collect_pit ../engine/source/output/outfile/collect.F
93!||====================================================================
94 SUBROUTINE collect_pit(A,ITAB,WEIGHT,NODGLOB)
95C-----------------------------------------------
96C I m p l i c i t T y p e s
97C-----------------------------------------------
98#include "implicit_f.inc"
99C-----------------------------------------------
100C C o m m o n B l o c k s
101C-----------------------------------------------
102#include "com01_c.inc"
103#include "com04_c.inc"
104#include "chara_c.inc"
105#include "units_c.inc"
106C-----------------------------------------------
107C D u m m y A r g u m e n t s
108C-----------------------------------------------
109 INTEGER ITAB(*),WEIGHT(*),NODGLOB(*)
110 my_real
111 . a(3,*)
112C-----------------------------------------------
113C L o c a l V a r i a b l e s
114C-----------------------------------------------
115 INTEGER I,FILEN,EMPL
116 CHARACTER FILNAM*100,CYCLENUM*7
117 double precision
118 . recglob(4,numnod)
119
120C-----------------------------------------------
121
122 WRITE(cyclenum,'(I7.7)')ncycle
123 filnam=rootnam(1:rootlen)//'_'//chrun//'_'//cyclenum//'.pit'
124
125 OPEN(unit=idbg5,file=filnam,access='SEQUENTIAL',
126 . form='FORMATTED',status='UNKNOWN')
127
128 filen = rootlen+17
129
130 DO i = 1, numnod
131 empl = nodglob(i)
132 recglob(1,empl) = itab(i)
133 recglob(2,empl) = a(1,i)
134 recglob(3,empl) = a(2,i)
135 recglob(4,empl) = a(3,i)
136 END DO
137 DO i = 1, numnod
138 WRITE(idbg5,'(A,I10,I10,Z20,Z20,Z20)' )
139 . '>',ncycle,nint(recglob(1,i)),
140 . recglob(2,i),recglob(3,i),recglob(4,i)
141 END DO
142
143 WRITE (iout,1300) filnam(1:filen)
144 WRITE (istdo,1300) filnam(1:filen)
145 CLOSE(unit=idbg5)
146
147 1300 FORMAT (4x,' DEBUG ANALYSIS FILE:',1x,a,' WRITTEN')
148 RETURN
149
150 END
151!||====================================================================
152!|| collectx ../engine/source/output/outfile/collect.F
153!||====================================================================
154 SUBROUTINE collectx(X,ITAB,WEIGHT,NODGLOB)
155C-----------------------------------------------
156C I m p l i c i t T y p e s
157C-----------------------------------------------
158#include "implicit_f.inc"
159C-----------------------------------------------
160C C o m m o n B l o c k s
161C-----------------------------------------------
162#include "com01_c.inc"
163#include "com04_c.inc"
164#include "chara_c.inc"
165#include "units_c.inc"
166C-----------------------------------------------
167C D u m m y A r g u m e n t s
168C-----------------------------------------------
169 INTEGER ITAB(*),WEIGHT(*),NODGLOB(*)
170 my_real
171 . x(3,*)
172C-----------------------------------------------
173C L o c a l V a r i a b l e s
174C-----------------------------------------------
175 INTEGER I,FILEN,EMPL
176 CHARACTER FILNAM*100,CYCLENUM*7
177 double precision
178 . recglob(4,numnod)
179
180C-----------------------------------------------
181
182 WRITE(cyclenum,'(I7.7)')ncycle
183 filnam=rootnam(1:rootlen)//'_'//chrun//'_'//cyclenum//'.xdb'
184
185 OPEN(unit=67,file=filnam,access='SEQUENTIAL',
186 . form='FORMATTED',status='UNKNOWN')
187
188 filen = rootlen+17
189
190 DO i = 1, numnod
191 empl = nodglob(i)
192 recglob(1,empl) = itab(i)
193 recglob(2,empl) = x(1,i)
194 recglob(3,empl) = x(2,i)
195 recglob(4,empl) = x(3,i)
196 END DO
197 DO i = 1, numnod
198 WRITE(67,'(A,I10,I10,Z20,Z20,Z20)' )
199 . '>',ncycle,nint(recglob(1,i)),
200 . recglob(2,i),recglob(3,i),recglob(4,i)
201 END DO
202
203 WRITE (iout,1300) filnam(1:filen)
204 WRITE (istdo,1300) filnam(1:filen)
205 CLOSE(unit=67)
206
207 1300 FORMAT (4x,' DEBUG ANALYSIS FILE:',1x,a,' WRITTEN')
208 RETURN
209
210 END
211!||====================================================================
212!|| collectv ../engine/source/output/outfile/collect.F
213!||====================================================================
214 SUBROUTINE collectv(V,ITAB,WEIGHT,NODGLOB)
215C-----------------------------------------------
216C I m p l i c i t T y p e s
217C-----------------------------------------------
218#include "implicit_f.inc"
219C-----------------------------------------------
220C C o m m o n B l o c k s
221C-----------------------------------------------
222#include "com01_c.inc"
223#include "com04_c.inc"
224#include "chara_c.inc"
225#include "units_c.inc"
226C-----------------------------------------------
227C D u m m y A r g u m e n t s
228C-----------------------------------------------
229 INTEGER ITAB(*),WEIGHT(*),NODGLOB(*)
230 my_real
231 . v(3,*)
232C-----------------------------------------------
233C L o c a l V a r i a b l e s
234C-----------------------------------------------
235 INTEGER I,FILEN,EMPL
236 CHARACTER FILNAM*100,CYCLENUM*7
237 double precision
238 . recglob(4,numnod)
239
240C-----------------------------------------------
241
242 WRITE(cyclenum,'(I7.7)')ncycle
243 filnam=rootnam(1:rootlen)//'_'//chrun//'_'//cyclenum//'.vdb'
244
245 OPEN(unit=67,file=filnam,access='SEQUENTIAL',
246 . form='FORMATTED',status='UNKNOWN')
247
248 filen = rootlen+17
249
250 DO i = 1, numnod
251 empl = nodglob(i)
252 recglob(1,empl) = itab(i)
253 recglob(2,empl) = v(1,i)
254 recglob(3,empl) = v(2,i)
255 recglob(4,empl) = v(3,i)
256 END DO
257 DO i = 1, numnod
258 WRITE(67,'(A,I10,I10,Z20,Z20,Z20)' )
259 . '>',ncycle,nint(recglob(1,i)),
260 . recglob(2,i),recglob(3,i),recglob(4,i)
261 END DO
262
263 WRITE (iout,1300) filnam(1:filen)
264 WRITE (istdo,1300) filnam(1:filen)
265 CLOSE(unit=67)
266
267 1300 FORMAT (4x,' DEBUG ANALYSIS FILE:',1x,a,' WRITTEN')
268 RETURN
269
270 END
271
272!||====================================================================
273!|| collectm ../engine/source/output/outfile/collect.F
274!||--- called by ------------------------------------------------------
275!|| resol ../engine/source/engine/resol.F
276!||--- calls -----------------------------------------------------
277!|| my_orders ../common_source/tools/sort/my_orders.c
278!||--- uses -----------------------------------------------------
279!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
280!||====================================================================
281 SUBROUTINE collectm(NODNX_SMS,ITAB,WEIGHT,NODGLOB)
282 USE inoutfile_mod
283C-----------------------------------------------
284C I m p l i c i t T y p e s
285C-----------------------------------------------
286#include "implicit_f.inc"
287C-----------------------------------------------
288C C o m m o n B l o c k s
289C-----------------------------------------------
290#include "com01_c.inc"
291#include "com04_c.inc"
292#include "chara_c.inc"
293#include "units_c.inc"
294C-----------------------------------------------
295C D u m m y A r g u m e n t s
296C-----------------------------------------------
297 INTEGER ITAB(*),WEIGHT(*),NODGLOB(*),NODNX_SMS(*)
298C-----------------------------------------------
299C L o c a l V a r i a b l e s
300C-----------------------------------------------
301 INTEGER I,FILEN,EMPL,NK,N,M
302 CHARACTER FILNAM*100,CYCLENUM*7
303 INTEGER RTRI(2,NUMNOD),RECGLOB(2,NUMNOD),
304 . ITRI(NUMNOD),INDEX(2*NUMNOD),WORK(70000)
305
306 INTEGER :: LEN_TMP_NAME
307 CHARACTER(len=2048) :: TMP_NAME
308
309C-----------------------------------------------
310
311 WRITE(cyclenum,'(I7.7)')ncycle
312 filnam=rootnam(1:rootlen)//'_'//chrun//'_'//cyclenum//'.mdb'
313 len_tmp_name = outfile_name_len + len_trim(filnam)
314 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
315 OPEN(unit=67,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',
316 . form='FORMATTED',status='UNKNOWN')
317
318 filen = rootlen+17
319
320 DO i = 1, numnod
321 empl = nodglob(i)
322 rtri(1,empl) = itab(i)
323 rtri(2,empl) = nodnx_sms(i)
324 END DO
325
326 DO i = 1, numnod
327 itri(i) =rtri(2,i)
328 index(i)=i
329 END DO
330 CALL my_orders(0,work,itri,index,numnod,1)
331 DO i = 1, numnod
332 recglob(1,i) = rtri(1,index(i))
333 recglob(2,i) = rtri(2,index(i))
334 END DO
335
336 WRITE(67,'(A)') ' NODE ID',' NO TERMS'
337 DO i = 1, numnod
338 WRITE(67,'(I10,I10)' )
339 . rtri(1,i),rtri(2,i)
340 END DO
341
342 WRITE(67,'(A)')'----- RESUME OF MATRIX STRUCTURE -----'
343 i =1
344 nk=1
345 n=recglob(2,i)
346 DO WHILE( i+1 < numnod)
347 m=recglob(2,i+1)
348 IF(m==n)THEN
349 nk=nk+1
350 ELSE
351 WRITE(67,'(A,I10,A,I10)')
352 . 'NO of NODES WITH ',n,' TERMS =',nk
353 nk=1
354 n =m
355 END IF
356 i=i+1
357 END DO
358 WRITE(67,'(A,I10,A,I10)')
359 . 'NO of NODES WITH ',n,' TERMS =',nk
360
361 WRITE (iout,1300) filnam(1:filen)
362 WRITE (istdo,1300) filnam(1:filen)
363 CLOSE(unit=67)
364
365 1300 FORMAT (4x,' DEBUG ANALYSIS FILE:',1x,a,' WRITTEN')
366 RETURN
367
368 END
369
370
371!||====================================================================
372!|| collectt ../engine/source/output/outfile/collect.F
373!||--- called by ------------------------------------------------------
374!|| resol ../engine/source/engine/resol.F
375!||--- uses -----------------------------------------------------
376!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
377!||====================================================================
378 SUBROUTINE collectt(TEMP,ITAB,WEIGHT,NODGLOB)
379 USE inoutfile_mod
380C-----------------------------------------------
381C I m p l i c i t T y p e s
382C-----------------------------------------------
383#include "implicit_f.inc"
384C-----------------------------------------------
385C C o m m o n B l o c k s
386C-----------------------------------------------
387#include "com01_c.inc"
388#include "com04_c.inc"
389#include "chara_c.inc"
390#include "units_c.inc"
391C-----------------------------------------------
392C D u m m y A r g u m e n t s
393C-----------------------------------------------
394 INTEGER ITAB(*),WEIGHT(*),NODGLOB(*)
395 my_real
396 . temp(*)
397C-----------------------------------------------
398C L o c a l V a r i a b l e s
399C-----------------------------------------------
400 INTEGER I,FILEN,EMPL
401 CHARACTER FILNAM*100,CYCLENUM*7
402 double precision
403 . recglob(2,numnod)
404 INTEGER :: LEN_TMP_NAME
405 CHARACTER(len=2148) :: TMP_NAME
406
407C-----------------------------------------------
408
409 WRITE(cyclenum,'(I7.7)')ncycle
410 filnam=rootnam(1:rootlen)//'_'//chrun//'_'//cyclenum//'.tdb'
411 len_tmp_name = outfile_name_len + len_trim(filnam)
412 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
413
414 OPEN(unit=idbg8,file=filnam,access='SEQUENTIAL',
415 . form='FORMATTED',status='UNKNOWN')
416
417 filen = rootlen+17
418
419 DO i = 1, numnod
420 empl = nodglob(i)
421 recglob(1,empl) = itab(i)
422 recglob(2,empl) = temp(i)
423 END DO
424 DO i = 1, numnod
425 WRITE(idbg8,'(A,I10,I10,Z20)' )
426 . '>',ncycle,nint(recglob(1,i)),
427 . recglob(2,i)
428 END DO
429
430 WRITE (iout,1300) filnam(1:filen)
431 WRITE (istdo,1300) filnam(1:filen)
432 CLOSE(unit=idbg8)
433
434 1300 FORMAT (4x,' DEBUG ANALYSIS FILE:',1x,a,' WRITTEN')
435 RETURN
436
437 END
collect
subroutine collect(a, itab, weight, nodglob)
Definition collect.F:31
collectv
subroutine collectv(v, itab, weight, nodglob)
Definition collect.F:215
collectm
subroutine collectm(nodnx_sms, itab, weight, nodglob)
Definition collect.F:282
collect_pit
subroutine collect_pit(a, itab, weight, nodglob)
Definition collect.F:95
collectx
subroutine collectx(x, itab, weight, nodglob)
Definition collect.F:155
collectt
subroutine collectt(temp, itab, weight, nodglob)
Definition collect.F:379
my_real
#define my_real
Definition cppsort.cpp:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::outfile_name
character(len=outfile_char_len) outfile_name
Definition inoutfile_mod.F:111
inoutfile_mod::outfile_name_len
integer outfile_name_len
Definition inoutfile_mod.F:109