OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
desout.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!|| desout ../starter/source/output/outp/desout.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| fretitl2 ../starter/source/starter/freform.F
29!||--- uses -----------------------------------------------------
30!|| format_mod ../starter/share/modules1/format_mod.F90
31!||====================================================================
32 SUBROUTINE desout(X ,IXS ,IXQ ,IXC ,IXT ,
33 . IXP ,IXR ,IXTG ,ITAB ,PM ,
34 . GEO ,MS ,IXS10,IGEO ,IPM ,
35 . KXSP,IPART,IPARTSP,NAMES_AND_TITLES)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
40 USE names_and_titles_mod, only:names_and_titles_,nchartitle !< names_and_titles host the input deck names and titles for outputs
41 USE format_mod , ONLY : fmt_3i, fmt_8i
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com04_c.inc"
50#include "units_c.inc"
51#include "param_c.inc"
52#include "scr15_c.inc"
53#include "scr16_c.inc"
54#include "scr17_c.inc"
55#include "sphcom.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*), IXT(NIXT,*),
60 . IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),ITAB(*),
61 . IGEO(NPROPGI,*),IPM(NPROPMI,*),
62 . kxsp(nisp,*),ipart(lipart1,*),ipartsp(*)
63 my_real x(3,*),ms(*), pm(npropm,*), geo(npropg,*)
64 TYPE(names_and_titles_),INTENT(IN):: NAMES_AND_TITLES
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER IWA(10), I, J, FILEN
69 CHARACTER (LEN=NCHARTITLE) :: CARD !< Host the title to be print in OUTP
70 CHARACTER (LEN=100) :: FILNAM
71 INTEGER :: LEN_TMP_NAME
72 CHARACTER(len=2148) :: TMP_NAME
73 INTEGER TITLE_LEN
74C-----------------------------------------
75 title_len=len_trim(names_and_titles%TITLE)
76 card(1:title_len)=names_and_titles%TITLE(1:title_len)
77C
78 filnam=rootnam(1:rootlen)//'Y000'
79 filen = rootlen + 4
80 IF(irootyy/=2)THEN
81 filen = rootlen + 9
82 filnam=rootnam(1:rootlen)//'_0000.sty'
83 ENDIF
84 len_tmp_name = filen
85 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_tmp_name)
86
87 len_tmp_name = outfile_name_len+len_tmp_name
88C
89 OPEN(unit=iugeo,file=tmp_name(1:len_tmp_name),
90 . access='SEQUENTIAL',
91 . form='FORMATTED',status='UNKNOWN')
92C
93 WRITE(iugeo,'(2A)')'#RADIOSS OUTPUT FILE V21 ',filnam(1:filen)
94 WRITE(iugeo,'(A)')'/HEAD'
95 WRITE(iugeo,'(A)') card(1:72)
96C=======================================================================
97C GLOBAL
98C=======================================================================
99 WRITE(iugeo,'(A)')'/CONTROL'
100 WRITE(iugeo,'(A)')'Control information'
101 IF (outyy_fmt==2) THEN
102 WRITE(iugeo,'(A)')'#FORMAT: (3I8) '
103 WRITE(iugeo,'(A)')'# NUMMID NUMPID NUMNOD'
104 WRITE(iugeo,'(3I8)')nummat,numgeo,numnod
105 WRITE(iugeo,'(A)')'#FORMAT: (7I8) '
106 WRITE(iugeo,'(A)')
107 .'# NUMSOL NUMQUAD NUMSHEL NUMTRUS NUMBEAM NUMSPRI NUMSH3N NUMSPH'
108 WRITE(iugeo,'(8I8)')
109 . numels, numelq, numelc, numelt, numelp, numelr,numeltg, numsph
110 ELSE
111 WRITE(iugeo,'(A)')'#FORMAT: (3I10) '
112 WRITE(iugeo,'(A)')'# NUMMID NUMPID NUMNOD'
113 WRITE(iugeo,fmt=fmt_3i)nummat,numgeo,numnod
114 WRITE(iugeo,'(A)')'#FORMAT: (7I10) '
115 WRITE(iugeo,'(A)')
116 . '# NUMSOL NUMQUAD NUMSHEL NUMTRUS NUMBEAM'//
117 . ' NUMSPRI NUMSH3N NUMSPH'
118 WRITE(iugeo,fmt=fmt_8i)
119 . numels, numelq, numelc, numelt, numelp, numelr,numeltg, numsph
120 ENDIF
121C=======================================================================
122C MID
123C=======================================================================
124 WRITE(iugeo,'(A)')'/MID'
125 WRITE(iugeo,'(A)')'Material ID information'
126 IF (outyy_fmt==2) THEN
127 WRITE(iugeo,'(A)')'#FORMAT: (2I8,A40) '
128 ELSE
129 WRITE(iugeo,'(A)')'#FORMAT: (2I10,A40) '
130 ENDIF
131 WRITE(iugeo,'(2A)')'# SYSMID USRMID',
132 . ' MIDHEAD'
133 DO i=1,nummat
134 CALL fretitl2(card,ipm(npropmi-ltitr+1,i),ltitr)
135 WRITE(iugeo,'(2I8,A80)') i, ipm(1,i),card
136 ENDDO
137 IF (outyy_fmt==2) THEN
138 DO i=1,nummat
139 CALL fretitl2(card,ipm(npropmi-ltitr+1,i),ltitr)
140 WRITE(iugeo,'(2I8,A80)') i, ipm(1,i),card
141 ENDDO
142 ELSE
143 DO i=1,nummat
144 CALL fretitl2(card,ipm(npropmi-ltitr+1,i),ltitr)
145 WRITE(iugeo,'(2I10,A80)') i, ipm(1,i),card
146 ENDDO
147 ENDIF
148C=======================================================================
149C PID
150C=======================================================================
151 WRITE(iugeo,'(A)')'/PID'
152 WRITE(iugeo,'(A)')'Property ID information'
153 IF (outyy_fmt==2) THEN
154 WRITE(iugeo,'(A)')'#FORMAT: (2I8,A40) '
155 ELSE
156 WRITE(iugeo,'(A)')'#FORMAT: (2I10,A40) '
157 ENDIF
158 WRITE(iugeo,'(2A)')'# SYSPID USRPID',
159 . ' PIDHEAD'
160 IF (outyy_fmt==2) THEN
161 DO i=1,numgeo
162 CALL fretitl2(card,igeo(npropgi-ltitr+1,i),ltitr)
163 WRITE(iugeo,'(2I8,A80)') i,igeo(1,i),card
164 ENDDO
165 ELSE
166 DO i=1,numgeo
167 CALL fretitl2(card,igeo(npropgi-ltitr+1,i),ltitr)
168 WRITE(iugeo,'(2I10,A80)') i,igeo(1,i),card
169 ENDDO
170 ENDIF
171C=======================================================================
172C NODE
173C=======================================================================
174 WRITE(iugeo,'(A)')'/NODE'
175 WRITE(iugeo,'(A)')'Nodes information'
176 IF (outyy_fmt==2) THEN
177 WRITE(iugeo,'(A)')'#FORMAT: (2I8,1P4E16.9) '
178 ELSE
179 WRITE(iugeo,'(A)')'#FORMAT: (2I10,1P4G20.13) '
180 ENDIF
181 WRITE(iugeo,'(3A)')'# SYSNOD USRNOD',
182 . ' X Y Z',
183 . ' MASS'
184 IF (outyy_fmt==2) THEN
185 WRITE(iugeo,'(2I8,1P4E16.9)')
186 . (i,itab(i),x(1,i),x(2,i),x(3,i),ms(i),i=1,numnod)
187 ELSE
188 WRITE(iugeo,'(2I10,1P4G20.13)')
189 . (i,itab(i),x(1,i),x(2,i),x(3,i),ms(i),i=1,numnod)
190 ENDIF
191C=======================================================================
192C SOLID
193C=======================================================================
194 IF(numels10/=0)THEN
195 WRITE(iugeo,'(A)') '/SOLIDE'
196 WRITE(iugeo,'(A)')'3d Solid Elements'
197 IF (outyy_fmt==2) THEN
198 WRITE(iugeo,'(A)') '#FORMAT: (4I8/8X,8I8) '
199 ELSE
200 WRITE(iugeo,'(A)') '#FORMAT: (4I10/8X,8I10) '
201 ENDIF
202 WRITE(iugeo,'(A)') '# SYSSOL USRSOL SYSMID SYSPID'
203 WRITE(iugeo,'(2A)')'#SYSNOD1 SYSNOD2 SYSNOD3 SYSNOD4',
204 . ' SYSNOD5 SYSNOD6 SYSNOD7 SYSNOD8'
205 IF (outyy_fmt==2) THEN
206 WRITE(iugeo,'(4I8/8X,8I8)')
207 . (i,ixs(nixs,i),ixs(1,i),ixs(nixs-1,i),
208 . ixs(2,i),ixs(3,i),ixs(4,i),ixs(5,i),
209 . ixs(6,i),ixs(7,i),ixs(8,i),ixs(9,i),i=1,numels-numels10)
210 ELSE
211 WRITE(iugeo,'(4I10/8X,8I10)')
212 . (i,ixs(nixs,i),ixs(1,i),ixs(nixs-1,i),
213 . ixs(2,i),ixs(3,i),ixs(4,i),ixs(5,i),
214 . ixs(6,i),ixs(7,i),ixs(8,i),ixs(9,i),i=1,numels-numels10)
215 ENDIF
216 WRITE(iugeo,'(A)') '/TETRA10'
217 WRITE(iugeo,'(A)')'3d Solid Elements'
218 IF (outyy_fmt==2) THEN
219 WRITE(iugeo,'(A)') '#FORMAT: (4I8/8X,8I8/2I) '
220 ELSE
221 WRITE(iugeo,'(A)') '#FORMAT: (4I10/8X,8I10/2I) '
222 ENDIF
223 WRITE(iugeo,'(A)') '# SYSSOL USRSOL SYSMID SYSPID'
224 WRITE(iugeo,'(2A)')'#SYSNOD1 SYSNOD2 SYSNOD3 SYSNOD4',
225 . 'SYSNOD5 SYSNOD6 SYSNOD7 SYSNOD8',
226 . '#SYSNOD9 SYSNOD10'
227 IF (outyy_fmt==2) THEN
228 WRITE(iugeo,'(4I8/8X,10I8)')
229 . (numels8+i,ixs(nixs,numels8+i),
230 . ixs(1,numels8+i),ixs(nixs-1,numels8+i),
231 . ixs(2,numels8+i),ixs(4,numels8+i),
232 . ixs(7,numels8+i),ixs(6,numels8+i),
233 . ixs10(1,i),ixs10(2,i),ixs10(3,i),ixs10(4,i),
234 . ixs10(5,i),ixs10(6,i) ,i=1,numels10)
235 ELSE
236 WRITE(iugeo,'(4I10/8X,10I10)')
237 . (numels8+i,ixs(nixs,numels8+i),
238 . ixs(1,numels8+i),ixs(nixs-1,numels8+i),
239 . ixs(2,numels8+i),ixs(4,numels8+i),
240 . ixs(7,numels8+i),ixs(6,numels8+i),
241 . ixs10(1,i),ixs10(2,i),ixs10(3,i),ixs10(4,i),
242 . ixs10(5,i),ixs10(6,i) ,i=1,numels10)
243 ENDIF
244 ELSE
245 WRITE(iugeo,'(A)') '/SOLIDE'
246 WRITE(iugeo,'(A)')'3d Solid Elements'
247 IF (outyy_fmt==2) THEN
248 WRITE(iugeo,'(A)') '#FORMAT: (4I8/8X,8I8) '
249 ELSE
250 WRITE(iugeo,'(A)') '#FORMAT: (4I10/8X,8I10) '
251 ENDIF
252 WRITE(iugeo,'(a)') '# SYSSOL USRSOL SYSMID SYSPID'
253 WRITE(iugeo,'(2A)')'#SYSNOD1 SYSNOD2 SYSNOD3 SYSNOD4',
254 . ' SYSNOD5 SYSNOD6 SYSNOD7 SYSNOD8'
255 IF (outyy_fmt==2) THEN
256 WRITE(iugeo,'(4I8/8X,8I8)')
257 . (i,ixs(nixs,i),ixs(1,i),ixs(nixs-1,i),
258 . ixs(2,i),ixs(3,i),ixs(4,i),ixs(5,i),
259 . ixs(6,i),ixs(7,i),ixs(8,i),ixs(9,i),i=1,numels)
260 ELSE
261 WRITE(iugeo,'(4I10/8X,8I10)')
262 . (i,ixs(nixs,i),ixs(1,i),ixs(nixs-1,i),
263 . ixs(2,i),ixs(3,i),ixs(4,i),ixs(5,i),
264 . ixs(6,i),ixs(7,i),ixs(8,i),ixs(9,i),i=1,numels)
265 ENDIF
266 ENDIF
267C=======================================================================
268C QUAD
269C=======================================================================
270 WRITE(iugeo,'(a)') '/quad'
271 WRITE(IUGEO,'(a)')'2d solid elements'
272 IF (OUTYY_FMT==2) THEN
273 WRITE(IUGEO,'(a)') '#FORMAT: (8I8) '
274 ELSE
275 WRITE(iugeo,'(A)') '#FORMAT: (8I10) '
276 ENDIF
277 WRITE(iugeo,'(2A)')'#SYSQUAD USRQUAD SYSMID SYSPID',
278 . ' SYSNOD1 SYSNOD2 SYSNOD3 SYSNOD4'
279 IF (outyy_fmt==2) THEN
280 WRITE(iugeo,'(8I8)')
281 . (i,ixq(nixq,i),ixq(1,i),ixq(nixq-1,i),
282 . ixq(2,i),ixq(3,i),ixq(4,i),ixq(5,i),i=1,numelq)
283 ELSE
284 WRITE(iugeo,'(8I10)')
285 . (i,ixq(nixq,i),ixq(1,i),ixq(nixq-1,i),
286 . ixq(2,i),ixq(3,i),ixq(4,i),ixq(5,i),i=1,numelq)
287 ENDIF
288C=======================================================================
289C SHELL
290C=======================================================================
291 WRITE(iugeo,'(A)') '/SHELL'
292 WRITE(iugeo,'(A)')'3d Shell Elements '
293 IF (outyy_fmt==2) THEN
294 WRITE(iugeo,'(A)') '#FORMAT: (8I8) '
295 ELSE
296 WRITE(iugeo,'(A)') '#FORMAT: (8I10) '
297 ENDIF
298 WRITE(iugeo,'(2A)')'#SYSSHEL USRSHEL SYSMID SYSPID',
299 . ' SYSNOD1 SYSNOD2 SYSNOD3 SYSNOD4'
300 IF (outyy_fmt==2) THEN
301 WRITE(iugeo,'(8I8)')
302 . (i,ixc(nixc,i),ixc(1,i),ixc(nixc-1,i),
303 . ixc(2,i),ixc(3,i),ixc(4,i),ixc(5,i),i=1,numelc)
304 ELSE
305 WRITE(iugeo,'(8I10)')
306 . (i,ixc(nixc,i),ixc(1,i),ixc(nixc-1,i),
307 . ixc(2,i),ixc(3,i),ixc(4,i),ixc(5,i),i=1,numelc)
308 ENDIF
309C=======================================================================
310C TRUSS
311C=======================================================================
312 WRITE(iugeo,'(A)') '/TRUSS'
313 WRITE(iugeo,'(A)')'3d Truss Elements'
314 IF (outyy_fmt==2) THEN
315 WRITE(iugeo,'(A)') '#FORMAT: (6I8) '
316 ELSE
317 WRITE(iugeo,'(A)') '#FORMAT: (6I10) '
318 ENDIF
319 WRITE(iugeo,'(2A)') '#SYSTRUS USRTRUS SYSMID SYSPID',
320 . ' SYSNOD1 SYSNOD2'
321 IF (outyy_fmt==2) THEN
322 WRITE(iugeo,'(6I8)')
323 . (i,ixt(nixt,i),ixt(1,i),ixt(nixt-1,i),
324 . ixt(2,i),ixt(3,i),i=1,numelt)
325 ELSE
326 WRITE(iugeo,'(6I10)')
327 . (i,ixt(nixt,i),ixt(1,i),ixt(nixt-1,i),
328 . ixt(2,i),ixt(3,i),i=1,numelt)
329 ENDIF
330C=======================================================================
331C BEAM
332C=======================================================================
333 WRITE(iugeo,'(A)') '/BEAM'
334 WRITE(iugeo,'(A)')'3d Beam Elements'
335 IF (outyy_fmt==2) THEN
336 WRITE(iugeo,'(A)') '#FORMAT: (7I8) '
337 ELSE
338 WRITE(iugeo,'(A)') '#FORMAT: (7I10) '
339 ENDIF
340 WRITE(iugeo,'(2A)')'#SYSBEAM USRBEAM SYSMID SYSPID',
341 . ' SYSNOD1 SYSNOD2 SYSNOD3'
342 IF (outyy_fmt==2) THEN
343 WRITE(iugeo,'(7I8)')
344 . (i,ixp(nixp,i),ixp(1,i),ixp(nixp-1,i),
345 . ixp(2,i),ixp(3,i),ixp(4,i),i=1,numelp)
346 ELSE
347 WRITE(iugeo,'(7I10)')
348 . (i,ixp(nixp,i),ixp(1,i),ixp(nixp-1,i),
349 . ixp(2,i),ixp(3,i),ixp(4,i),i=1,numelp)
350 ENDIF
351C=======================================================================
352C SPRING
353C=======================================================================
354 WRITE(iugeo,'(A)') '/SPRING'
355 WRITE(iugeo,'(A)')'3d Spring Elements'
356 IF (outyy_fmt==2) THEN
357 WRITE(iugeo,'(A)') '#FORMAT: (6I8) '
358 ELSE
359 WRITE(iugeo,'(A)') '#FORMAT: (6I10) '
360 ENDIF
361 WRITE(iugeo,'(2A)')'#SYSSPRI USRSPRI SYSMID SYSPID',
362 . ' SYSNOD1 SYSNOD2'
363 IF (outyy_fmt==2) THEN
364 WRITE(iugeo,'(6I8)')
365 . (i,ixr(nixr,i),0,ixr(1,i),
366 . ixr(2,i),ixr(3,i),i=1,numelr)
367 ELSE
368 WRITE(iugeo,'(6I10)')
369 . (i,ixr(nixr,i),0,ixr(1,i),
370 . ixr(2,i),ixr(3,i),i=1,numelr)
371 ENDIF
372C=======================================================================
373C SHELL3N
374C=======================================================================
375 WRITE(iugeo,'(A)') '/SHELL3N'
376 WRITE(iugeo,'(A)')'3d Shell Elements (Triangle) '
377 IF (outyy_fmt==2) THEN
378 WRITE(iugeo,'(A)') '#FORMAT: (7I8) '
379 ELSE
380 WRITE(iugeo,'(A)') '#FORMAT: (7I10) '
381 ENDIF
382 WRITE(iugeo,'(2A)')'#SYSSH3N USRSH3N SYSMID SYSPID',
383 . ' SYSNOD1 SYSNOD2 SYSNOD3'
384 IF (outyy_fmt==2) THEN
385 WRITE(iugeo,'(7I8)')
386 . (i,ixtg(nixtg,i),ixtg(1,i),ixtg(nixtg-1,i),
387 . ixtg(2,i),ixtg(3,i),ixtg(4,i),i=1,numeltg)
388 ELSE
389 WRITE(iugeo,'(7I10)')
390 . (i,ixtg(nixtg,i),ixtg(1,i),ixtg(nixtg-1,i),
391 . ixtg(2,i),ixtg(3,i),ixtg(4,i),i=1,numeltg)
392 ENDIF
393C=======================================================================
394C
395C SPH
396C=======================================================================
397 WRITE(iugeo,'(A)') '/SPHCEL'
398 WRITE(iugeo,'(A)')'SPH particles'
399 IF (outyy_fmt==2) THEN
400 WRITE(iugeo,'(A)') '#FORMAT: (4I8/8X,I8) '
401 WRITE(iugeo,'(A)') '# SYSSPH USRSPH SYSMID SYSPID'
402 WRITE(iugeo,'(A)')'#SYSNOD'
403 ELSE
404 WRITE(iugeo,'(A)') '#FORMAT: (4I10/10X,I10) '
405 WRITE(iugeo,'(A)') '# SYSSPH USRSPH SYSMID SYSPID'
406 WRITE(iugeo,'(A)') '# SYSNOD'
407 ENDIF
408 IF (outyy_fmt==2) THEN
409 WRITE(iugeo,'(4I8/8X,I8)')
410 . (i,kxsp(nisp,i),ipart(1,ipartsp(i)),
411 . ipart(2,ipartsp(i)),kxsp(3,i),i=1,numsph)
412 ELSE
413 WRITE(iugeo,'(4I10/10X,I10)')
414 . (i,kxsp(nisp,i),ipart(1,ipartsp(i)),
415 . ipart(2,ipartsp(i)),kxsp(3,i),i=1,numsph)
416 ENDIF
417C=======================================================================
418C END
419C=======================================================================
420 WRITE(iugeo,'(A)') '/ENDDATA'
421C
422 WRITE (iout,60) filnam(1:filen)
423 60 FORMAT (/4x,14h plot file:,1x,a,8h written/
424 . 4x,14h -------------/)
425C
426 CLOSE (unit=iugeo,status='KEEP')
427C
428 RETURN
429 END
#define my_real
Definition cppsort.cpp:32
subroutine desout(x, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, itab, pm, geo, ms, ixs10, igeo, ipm, kxsp, ipart, ipartsp, names_and_titles)
Definition desout.F:36
end diagonal values have been computed in the(sparse) matrix id.SOL
for(i8=*sizetab-1;i8 >=0;i8--)
character(len=outfile_char_len) outfile_name
integer outfile_name_len
integer, parameter nchartitle
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804