36
37
38
41 USE format_mod , ONLY : fmt_3i, fmt_8i
42
43
44
45#include "implicit_f.inc"
46
47
48
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"
56
57
58
59 INTEGER IXS(,*), 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
65
66
67
68 INTEGER IWA(10), I, J, FILEN
69 CHARACTER (LEN=NCHARTITLE) :: CARD
70 CHARACTER (LEN=100) ::
71 INTEGER :: LEN_TMP_NAME
72 CHARACTER(len=2148) :: TMP_NAME
73 INTEGER TITLE_LEN
74
75 title_len=len_trim(names_and_titles%TITLE)
76 card(1:title_len)=names_and_titles%TITLE(1:title_len)
77
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
86
88
89 OPEN(unit=iugeo,file=tmp_name(1:len_tmp_name),
90 . access='SEQUENTIAL',
91 . form='FORMATTED',status='UNKNOWN')
92
93 WRITE(iugeo,'(2A)')'#RADIOSS OUTPUT FILE V21 ',filnam(1:filen)
94 WRITE(iugeo,'(A)')'/HEAD'
95 WRITE(iugeo,'(A)') card(1:72)
96
97
98
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
121
122
123
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
148
149
150
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
171
172
173
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
191
192
193
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
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
267
268
269
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
288
289
290
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
309
310
311
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
330
331
332
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
351
352
353
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
372
373
374
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
393
394
395
396
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
417
418
419
420 WRITE(iugeo,'(A)') '/ENDDATA'
421
422 WRITE (iout,60) filnam(1:filen)
423 60 FORMAT (/4x,14h plot file:,1x,a,8h written/
424 . 4x,14h -------------/)
425
426 CLOSE (unit=iugeo,status='KEEP')
427
428 RETURN
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, parameter nchartitle