OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hist1.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!|| hist1 ../engine/source/output/th/hist1.F
25!||--- called by ------------------------------------------------------
26!|| radioss2 ../engine/source/engine/radioss2.F
27!||--- calls -----------------------------------------------------
28!|| cur_fil_c ../common_source/tools/input_output/write_routines.c
29!|| eor_c ../common_source/tools/input_output/write_routines.c
30!|| flu_fil_c ../common_source/tools/input_output/write_routines.c
31!|| fretitl2 ../engine/source/input/freform.F
32!|| my_ctime ../engine/source/system/timer_c.c
33!|| open_c ../common_source/tools/input_output/write_routines.c
34!|| write_c_c ../common_source/tools/input_output/write_routines.c
35!|| write_i_c ../common_source/tools/input_output/write_routines.c
36!|| write_r_c ../common_source/tools/input_output/write_routines.c
37!|| wrtdes ../engine/source/output/th/wrtdes.F
38!||--- uses -----------------------------------------------------
39!|| groupdef_mod ../common_source/modules/groupdef_mod.F
40!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
41!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
42!|| th_mod ../engine/share/modules/th_mod.F
43!||====================================================================
44 SUBROUTINE hist1(FILNAM,IFIL ,NTHGRP2,LONG ,
45 2 PM ,GEO ,IPART,
46 3 SUBSET,ITHGRP,ITHBUF,IGEO ,
47 4 IPM ,IPARTH ,NPARTH ,NVPARTH ,
48 5 NVSUBTH ,ITTYP,ITHFLAG,ITHVAR,IFILTITL,
49 6 SITHBUF,NAMES_AND_TITLES)
50C-----------------------------------------------
51C M o d u l e s
52C-----------------------------------------------
53 USE groupdef_mod
54 USE inoutfile_mod
55 USE th_mod
56 USE names_and_titles_mod, only:names_and_titles_,ltitle
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com04_c.inc"
65#include "units_c.inc"
66#include "param_c.inc"
67#include "scr05_c.inc"
68#include "scr13_c.inc"
69#include "scrfs_c.inc"
70#include "chara_c.inc"
71#include "titr_c.inc"
72#include "scr07_c.inc"
73#include "scr17_c.inc"
74#include "sysunit.inc"
75#include "rad2r_c.inc"
76#include "tabsiz_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER,INTENT(IN) :: SITHBUF ! Size of ithbuf
81 INTEGER,INTENT(IN), DIMENSION(SITHBUF) :: ITHBUF ! Time history buffer
82 INTEGER
83 . IPART(LIPART1,*),IPM(NPROPMI,*),IGEO(NPROPGI,*),
84 . ITHGRP(NITHGR,*), IFIL,
85 . nthgrp2, long,
86 . nparth,iparth(nparth,*),nvparth,nvsubth,
87 . ittyp,ithflag,ithvar(*),ifiltitl
88C REAL
89 my_real
90 . pm(npropm,*),geo(npropg,*)
91 CHARACTER FILNAM*100
92 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
93 TYPE(NAMES_AND_TITLES_),INTENT(IN) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 REAL R4
98 INTEGER ITITLE(100), IFILNAM(100), ICODE, I,
99 . II, N, ITY, K,
100 . NVAR,MID,PID,IAD1,IAD2,J,IAD,LTITL,NRECORD,
101 . SEEK_LOC,IPART1,IPART2
102C REAL
103 my_real
104 . tit40(10),tit80(20),tit100(25)
105 my_real,DIMENSION(20) :: title
106 CHARACTER EOR*8, CH8*8,BLA*7, CH8M*8, CH8L*8, CH8T*8
107 CHARACTER (LEN=LTITLE) :: CARD
108 CHARACTER CH80*80,TITL*100,VAR*10
109 INTEGER :: LEN_TMP_NAME, TITLSUM
110
111 CHARACTER(len=2148) :: TMP_NAME
112 INTEGER, dimension(:), allocatable :: IWA
113C-----------------------------------------------
114C E x t e r n a l F u n c t i o n s
115C-----------------------------------------------
116 CHARACTER STRR*8, STRI*8
117C-----------------------------------------------
118 EXTERNAL strr,stri
119 DATA bla/' '/
120 DATA eor/'ZZZZZEOR'/
121C=======================================================================
122C
123 card(1:ltitle)=names_and_titles%TITLE(1:ltitle)
124C ICODE=3017
125C ICODE=3023
126C ICODE=3030
127 IF(th_vers>=2021)THEN
128 icode=4021
129 ltitl = 100
130 ELSEIF(th_vers>=50)THEN
131 icode=3050
132 ltitl = 100
133 ELSEIF(th_vers>=47)THEN
134 icode=3041
135 ltitl = 80
136 ELSE
137 icode=3040
138 ltitl = 40
139 ENDIF
140C
141 len_tmp_name = outfile_name_len + rootlen+long
142 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
143C
144 IF(th_titles == 1)
145 . OPEN(unit=ifiltitl,file=tmp_name(1:len_tmp_name)//'_TITLES',
146 . access='SEQUENTIAL',
147 . form='formatted',STATUS='unknown')
148C
149 IF(ITTYP==0)THEN
150 OPEN(UNIT=IUNIT,FILE=TMP_NAME(1:LEN_TMP_NAME),
151 . ACCESS='sequential',
152 . FORM='unformatted',STATUS='unknown')
153.OR. ELSEIF(ITTYP==1ITTYP==2)THEN
154 OPEN(UNIT=IUNIT,FILE=TMP_NAME(1:LEN_TMP_NAME),
155 . ACCESS='sequential',
156 . FORM='formatted',STATUS='unknown')
157 ELSEIF(ITTYP==3)THEN
158 DO I=1,LEN_TMP_NAME
159 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
160 ENDDO
161 CALL CUR_FIL_C(IFIL)
162 IF(MCHECK==0)THEN
163 CALL OPEN_C(IFILNAM,LEN_TMP_NAME,0)
164
165 ELSE
166 CALL OPEN_C(IFILNAM,LEN_TMP_NAME,8)
167 RETURN
168 ENDIF
169 ELSEIF(ITTYP==4)THEN
170 DO I=1,LEN_TMP_NAME
171 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
172 ENDDO
173 CALL CUR_FIL_C(IFIL)
174 CALL OPEN_C(IFILNAM,LEN_TMP_NAME,3)
175 ITTYP=3
176 ELSEIF(ITTYP==5)THEN
177 DO I=1,LEN_TMP_NAME
178 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
179 ENDDO
180 CALL CUR_FIL_C(IFIL)
181 CALL OPEN_C(IFILNAM,LEN_TMP_NAME,6)
182 ITTYP=3
183 ENDIF
184C-------TITRE------------
185 IF(ITTYP==0)THEN
186 READ(CARD,'(20a4)')TITLE
187 WRITE(IUNIT)ICODE,TITLE
188 ELSEIF(ITTYP==1)THEN
189 CH8=STRI(ICODE)
190 WRITE(IUNIT,'(a)')FILNAM(1:ROOTLEN+LONG)
191 WRITE(IUNIT,'(2a)')CH8,CARD(1:72)
192 ELSEIF(ITTYP==2)THEN
193 WRITE(IUNIT,'(2a)')FILNAM(1:ROOTLEN+LONG),' format'
194 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,1,'i',72,'c'
195 WRITE(IUNIT,'(i5,a)')ICODE,CARD(1:72)
196 ELSEIF(ITTYP==3)THEN
197 DO I=1,80
198 ITITLE(I)=ICHAR(CARD(I:I))
199 ENDDO
200 CALL EOR_C(84)
201 CALL WRITE_I_C(ICODE,1)
202 CALL WRITE_C_C(ITITLE,80)
203 CALL EOR_C(84)
204 ENDIF
205C-------ivers date------------
206 CALL MY_CTIME(ITITLE)
207 DO I=1,24
208 CH80(I:I)=CHAR(ITITLE(I))
209 ENDDO
210 CH80(25:33) =' radioss '
211 CH80(34:59) =VERSIO(2)(9:34)
212 CH80(60:80) =CPUNAM
213 DO I=25,80
214 ITITLE(I)=ICHAR(CH80(I:I))
215 ENDDO
216 IF(ITTYP==0)THEN
217 READ(CH80,'(20a4)')TITLE
218 WRITE(IUNIT)TITLE
219 ELSEIF(ITTYP==1)THEN
220 WRITE(IUNIT,'(a)')CH80
221 ELSEIF(ITTYP==2)THEN
222 WRITE(IUNIT,'(2a)')FILNAM(1:ROOTLEN+LONG),' format'
223 WRITE(IUNIT,'(a,i5,a)')EOR,80,'c'
224 WRITE(IUNIT,'(a)')CH80
225 ELSEIF(ITTYP==3)THEN
226 CALL EOR_C(80)
227 CALL WRITE_C_C(ITITLE,80)
228 CALL EOR_C(80)
229 ENDIF
230C
231C-------ADDITIONAL RECORDS------------
232 IF(TH_VERS>=50)THEN
233C
234C number of additional records
235 NRECORD=2
236 IF(ITTYP==0)THEN
237 WRITE(IUNIT)NRECORD
238 ELSEIF(ITTYP==1)THEN
239 CH8=STRI(NRECORD)
240 WRITE(IUNIT,'(2a)')CH8
241 ELSEIF(ITTYP==2)THEN
242 WRITE(IUNIT,'(a,i5,a)')EOR,1,'i'
243 WRITE(IUNIT,'(i5)')NRECORD
244 ELSEIF(ITTYP==3)THEN
245 CALL EOR_C(4)
246 CALL WRITE_I_C(NRECORD,1)
247 CALL EOR_C(4)
248 ENDIF
249C
250C 1ER RECORD : LONGUEUR DES TITRES
251 IF(ITTYP==0)THEN
252 WRITE(IUNIT)LTITL
253 ELSEIF(ITTYP==1)THEN
254 CH8=STRI(LTITL)
255 WRITE(IUNIT,'(2a)')CH8
256 ELSEIF(ITTYP==2)THEN
257 WRITE(IUNIT,'(a,i5,a)')EOR,1,'i'
258 WRITE(IUNIT,'(i5)')LTITL
259 ELSEIF(ITTYP==3)THEN
260 CALL EOR_C(4)
261 CALL WRITE_I_C(LTITL,1)
262 CALL EOR_C(4)
263 ENDIF
264C
265C 2EME RECORD : FAC_MASS,FAC_LENGTH,FAC_TIME
266 IF(ITTYP==0)THEN
267 WRITE(IUNIT) FAC_MASS,FAC_LENGTH,FAC_TIME
268 ELSEIF(ITTYP==1)THEN
269 CH8M=STRR(FAC_MASS)
270 CH8L=STRR(FAC_LENGTH)
271 CH8T=STRR(FAC_TIME)
272 WRITE(IUNIT,'(3a8)')CH8M,CH8L,CH8T
273 ELSEIF(ITTYP==2)THEN
274 WRITE(IUNIT,'(a,i5,a)')EOR,3,'r'
275 WRITE(IUNIT,'((5(1x,1pe15.8)))')FAC_MASS,FAC_LENGTH,FAC_TIME
276 ELSEIF(ITTYP==3)THEN
277 CALL EOR_C(12)
278 R4=FAC_MASS
279 CALL WRITE_R_C(R4,1)
280 R4=FAC_LENGTH
281 CALL WRITE_R_C(R4,1)
282 R4=FAC_TIME
283 CALL WRITE_R_C(R4,1)
284 CALL EOR_C(12)
285 ENDIF
286 END IF
287C-------HIERARCHY INFO------------
288 ALLOCATE(IWA(6))
289 IWA(1)=NPART+NTHPART
290 IWA(2)=NUMMAT
291 IWA(3)=NUMGEO
292 IWA(4)=NSUBS
293 IWA(5)=NTHGRP2
294.AND. IF(NSECT==0NSFLSW/=0) IWA(5)=NTHGRP2+1
295 NGLOBTH=22
296 IF (IUNIT /= IUHIS) THEN
297 IWA(6)= 0
298 ELSE
299 IWA(6)= NGLOBTH
300 ENDIF
301c
302
303 CALL WRTDES(IWA,IWA,6,ITTYP,0)
304 J = IWA(6)
305 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
306 ALLOCATE(IWA(NGLOBTH))
307 DO I=1,J
308 IWA(I)=I
309 ENDDO
310
311 IF(IUNIT == IUHIS) CALL WRTDES(IWA,IWA,NGLOBTH,ITTYP,0)
312 NVAR = 0
313 DO N=1,NPART+NTHPART
314 NVAR=MAX(NVAR,IPARTH(NVPARTH,N))
315 ENDDO
316 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
317 ALLOCATE(IWA(NVAR))
318C-------PART DESCRIPTION------------
319 DO N=1,NPART+NTHPART
320 NVAR=IPARTH(NVPARTH,N)
321 IAD =IPARTH(NVPARTH+1,N)
322 CALL FRETITL2(TITL,IPART(LIPART1-LTITR+1,N),40)
323 DO I=1,LTITL
324 ITITLE(I)=ICHAR(TITL(I:I))
325 ENDDO
326 IF (N > NPART)THEN
327 IPART1 = 0
328 IPART2 = 0
329 ELSE
330 IPART1 = IPART(1,N)
331 IPART2 = IPART(2,N)
332 ENDIF
333 IF(ITTYP==0)THEN
334 IF(LTITL==40)THEN
335 READ(TITL,'(10a4)')TIT40
336 WRITE(IUNIT)IPART(4,N),TIT40,IPART(7,N),
337 . IPART1,IPART2,NVAR
338 ELSE IF(LTITL==80)THEN
339 READ(TITL,'(20a4)')TIT80
340 WRITE(IUNIT)IPART(4,N),TIT80,IPART(7,N),
341 . IPART1,IPART2,NVAR
342 ELSE
343 READ(TITL,'(25a4)')TIT100
344 WRITE(IUNIT)IPART(4,N),TIT100,IPART(7,N),
345 . IPART1,IPART2,NVAR
346 ENDIF
347 ELSEIF(ITTYP==1)THEN
348 ELSEIF(ITTYP==2)THEN
349 WRITE(IUNIT,'(a,i5,a,i5,a,i5,a)')EOR,1,'i',40,'c',4,'i'
350 WRITE(IUNIT,'(i10,a,4i5)')IPART(4,N),TITL(1:LTITL),
351 . IPART(7,N),IPART1,IPART2,NVAR
352 ELSEIF(ITTYP==3)THEN
353 CALL EOR_C(20+LTITL)
354 CALL WRITE_I_C(IPART(4,N),1)
355 CALL WRITE_C_C(ITITLE,LTITL)
356 CALL WRITE_I_C(IPART(7,N),1)
357 CALL WRITE_I_C(IPART1,1)
358 CALL WRITE_I_C(IPART2,1)
359 CALL WRITE_I_C(NVAR,1)
360 CALL EOR_C(20+LTITL)
361 ENDIF
362 II=0
363 DO I=IAD,IAD+NVAR-1
364 II=II+1
365 IF(I <= SITHBUF) THEN
366 IWA(II)=ITHBUF(I)
367 ELSE
368 IWA(II) = 0
369 ENDIF
370 ENDDO
371 IF(NVAR/=0)CALL WRTDES(IWA,IWA,NVAR,ITTYP,0)
372 ENDDO
373C-------MATER DESCRIPTION------------
374 DO N=1,NUMMAT
375 MID = IPM(1,N)
376 CALL FRETITL2(TITL,IPM(NPROPMI-LTITR+1,N),40)
377 TITLSUM=SUM(IPM(NPROPMI-LTITR+1:NPROPMI-LTITR+40,N))
378 IF(TITLSUM == 0)THEN
379 TITL(1:LTITL)=' '
380 TITL(1:8)='no_title'
381 ENDIF
382 DO I=1,LTITL
383 ITITLE(I)=ICHAR(TITL(I:I))
384 ENDDO
385 IF(ITTYP==0)THEN
386 IF(LTITL==40)THEN
387 READ(TITL,'(10a4)')TIT40
388 WRITE(IUNIT)MID,TIT40
389 ELSE IF(LTITL==80)THEN
390 READ(TITL,'(20a4)')TIT80
391 WRITE(IUNIT)MID,TIT80
392 ELSE
393 READ(TITL,'(25a4)')TIT100
394 WRITE(IUNIT)MID,TIT100
395 ENDIF
396 ELSEIF(ITTYP==1)THEN
397 ELSEIF(ITTYP==2)THEN
398 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,1,'i',LTITL,'c'
399 WRITE(IUNIT,'(i10,a)')MID,TITL(1:LTITL)
400 ELSEIF(ITTYP==3)THEN
401 CALL EOR_C(4+LTITL)
402 CALL WRITE_I_C(MID,1)
403 CALL WRITE_C_C(ITITLE,LTITL)
404 CALL EOR_C(4+LTITL)
405 ENDIF
406 ENDDO
407C-------GEO DESCRIPTION------------
408 DO N=1,NUMGEO
409 PID = IGEO(1,N)
410 CALL FRETITL2(TITL,IGEO(NPROPGI-LTITR+1,N),40)
411 DO I=1,LTITL
412 ITITLE(I)=ICHAR(TITL(I:I))
413 ENDDO
414 IF(ITTYP==0)THEN
415 IF(LTITL==40)THEN
416 READ(TITL,'(10a4)')TIT40
417 WRITE(IUNIT)PID,TIT40
418 ELSE IF(LTITL==80)THEN
419 READ(TITL,'(20a4)')TIT80
420 WRITE(IUNIT)PID,TIT80
421 ELSE
422 READ(TITL,'(25a4)')TIT100
423 WRITE(IUNIT)PID,TIT100
424 ENDIF
425 ELSEIF(ITTYP==1)THEN
426 ELSEIF(ITTYP==2)THEN
427 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,1,'i',LTITL,'c'
428 WRITE(IUNIT,'(i10,a)')PID,TITL(1:LTITL)
429
430 ELSEIF(ITTYP==3)THEN
431 CALL EOR_C(4+LTITL)
432 CALL WRITE_I_C(PID,1)
433 CALL WRITE_C_C(ITITLE,LTITL)
434 CALL EOR_C(4+LTITL)
435 ENDIF
436 ENDDO
437C-------HIERARCHY DESCRIPTION------------
438 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
439 NVAR = 0
440 DO N=1,NSUBS
441 NVAR=MAX(NVAR,SUBSET(N)%NVARTH(ITHFLAG))
442 ENDDO
443 ALLOCATE(IWA(NVAR))
444 DO N=1,NSUBS
445!! NVAR=ISUBTH(NVSUBTH,N)
446!! IAD =ISUBTH(NVSUBTH+1,N)
447 NVAR=SUBSET(N)%NVARTH(ITHFLAG)
448 IAD =SUBSET(N)%THIAD
449!! CALL FRETITL2(TITL,ISUBS(LISUB1-LTITR+1,N),40)
450 TITL = SUBSET(N)%TITLE
451 DO I=1,LTITL
452 ITITLE(I)=ICHAR(TITL(I:I))
453 ENDDO
454 IF(ITTYP==0)THEN
455 IF(LTITL==40)THEN
456 READ(TITL,'(10a4)')TIT40
457!! WRITE(IUNIT)ISUBS(1,N),ISUBS(10,N),
458!! . ISUBS(2,N),ISUBS(4,N),NVAR,TIT40
459 WRITE(IUNIT)SUBSET(N)%ID,SUBSET(N)%PARENT,
460 . SUBSET(N)%NCHILD,SUBSET(N)%NPART,NVAR,TIT40
461 ELSE IF(LTITL==00)THEN
462 READ(TITL,'(20a4)')TIT80
463!! WRITE(IUNIT)ISUBS(1,N),ISUBS(10,N),
464!! . ISUBS(2,N),ISUBS(4,N),NVAR,TIT80
465 WRITE(IUNIT)SUBSET(N)%ID,SUBSET(N)%PARENT,
466 . SUBSET(N)%NCHILD,SUBSET(N)%NPART,NVAR,TIT80
467 ELSE
468 READ(TITL,'(25a4)')TIT100
469!! WRITE(IUNIT)ISUBS(1,N),ISUBS(10,N),
470!! . ISUBS(2,N),ISUBS(4,N),NVAR,TIT100
471 WRITE(IUNIT)SUBSET(N)%ID,SUBSET(N)%PARENT,
472 . SUBSET(N)%NCHILD,SUBSET(N)%NPART,NVAR,TIT100
473 ENDIF
474 ELSEIF(ITTYP==1)THEN
475 ELSEIF(ITTYP==2)THEN
476 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,5,'i',LTITL,'c'
477!! WRITE(IUNIT,'(5i10,a)')ISUBS(1,N),ISUBS(10,N),
478!! . ISUBS(2,N),ISUBS(4,N),NVAR,TITL(1:LTITL)
479 WRITE(IUNIT,'(5i10,a)')SUBSET(N)%ID,SUBSET(N)%PARENT,
480 . SUBSET(N)%NCHILD,SUBSET(N)%NPART,NVAR,TITL(1:LTITL)
481 ELSEIF(ITTYP==3)THEN
482 CALL EOR_C(20+LTITL)
483!! CALL WRITE_I_C(ISUBS(1,N),1)
484 CALL WRITE_I_C(SUBSET(N)%ID,1)
485!! CALL WRITE_I_C(ISUBS(10,N),1)
486 CALL WRITE_I_C(SUBSET(N)%PARENT,1)
487!! CALL WRITE_I_C(ISUBS(2,N),1)
488 CALL WRITE_I_C(SUBSET(N)%NCHILD,1)
489!! CALL WRITE_I_C(ISUBS(4,N),1)
490 CALL WRITE_I_C(SUBSET(N)%NPART,1)
491 CALL WRITE_I_C(NVAR,1)
492 CALL WRITE_C_C(ITITLE,LTITL)
493 CALL EOR_C(20+LTITL)
494 ENDIF
495!! IF(ISUBS(2,N)/=0)CALL WRTDES(IBUFSSG(ISUBS(3,N)),
496!! . IBUFSSG(ISUBS(3,N)),ISUBS(2,N),ITTYP,0)
497 IF(SUBSET(N)%NCHILD/=0)CALL WRTDES(SUBSET(N)%CHILD,
498 . SUBSET(N)%CHILD,SUBSET(N)%NCHILD,ITTYP,0)
499!! IF(ISUBS(4,N)/=0)CALL WRTDES(IBUFSSG(ISUBS(5,N)),
500!! . IBUFSSG(ISUBS(5,N)),ISUBS(4,N),ITTYP,0)
501 IF(SUBSET(N)%NPART/=0)CALL WRTDES(SUBSET(N)%PART,
502 . SUBSET(N)%PART,SUBSET(N)%NPART,ITTYP,0)
503 II=0
504 DO I=IAD,IAD+NVAR-1
505 II=II+1
506 IWA(II)=ITHBUF(I)
507 ENDDO
508 IF(NVAR/=0)CALL WRTDES(IWA,IWA,NVAR,ITTYP,0)
509 ENDDO
510C-------TH GROUP------------
511 DO N=1,NTHGRP2
512 NVAR=ITHGRP(6,N)
513 CALL FRETITL2(TITL,ITHGRP(NITHGR-LTITR+1,N),40)
514 DO I=1,LTITL
515 ITITLE(I)=ICHAR(TITL(I:I))
516 ENDDO
517C (nstrands elements are treated as a spring group)
518 ITY=ITHGRP(2,N)
519 IF (ITY==100) ITY=6
520 IF(ITTYP==0)THEN
521 IF(LTITL==40)THEN
522 READ(TITL,'(10a4)')TIT40
523 WRITE(IUNIT)ITHGRP(1,N),ITY,
524 . ITHGRP(3,N),ITHGRP(4,N),ITHGRP(6,N),TIT40
525 ELSE IF(LTITL==80)THEN
526 READ(TITL,'(20a4)')TIT80
527 WRITE(IUNIT)ITHGRP(1,N),ITY,
528 . ITHGRP(3,N),ITHGRP(4,N),ITHGRP(6,N),TIT80
529 ELSE
530 READ(TITL,'(25a4)')tit100
531 WRITE(iunit)ithgrp(1,n),ity,
532 . ithgrp(3,n),ithgrp(4,n),ithgrp(6,n),tit100
533 ENDIF
534 ELSEIF(ittyp==1)THEN
535 ELSEIF(ittyp==2)THEN
536 WRITE(iunit,'(A,I5,A,I5,A)')eor,5,'I',ltitl,'C'
537 WRITE(iunit,'(5I10,A)')ithgrp(1,n),ity,
538 . ithgrp(3,n),ithgrp(4,n),ithgrp(6,n),titl(1:ltitl)
539 ELSEIF(ittyp==3)THEN
540 CALL eor_c(20+ltitl)
541 CALL write_i_c(ithgrp(1,n),1)
542 CALL write_i_c(ity,1)
543 CALL write_i_c(ithgrp(3,n),1)
544 CALL write_i_c(ithgrp(4,n),1)
545 CALL write_i_c(ithgrp(6,n),1)
546 CALL write_c_c(ititle,ltitl)
547 CALL eor_c(20+ltitl)
548 ENDIF
549 iad1=ithgrp(5,n)+2*ithgrp(4,n)
550 iad2=ithgrp(8,n)
551 DO j=1,ithgrp(4,n)
552 CALL fretitl2(titl,ithbuf(iad2),40)
553 DO i=1,ltitl
554 ititle(i)=ichar(titl(i:i))
555 ENDDO
556 IF(ittyp==0)THEN
557 IF(ltitl==40)THEN
558 READ(titl,'(10A4)')tit40
559 WRITE(iunit)ithbuf(iad1),tit40
560 ELSE IF(ltitl==80)THEN
561 READ(titl,'(20A4)')tit80
562 WRITE(iunit)ithbuf(iad1),tit80
563 ELSE
564 READ(titl,'(25A4)')tit100
565 WRITE(iunit)ithbuf(iad1),tit100
566 ENDIF
567 ELSEIF(ittyp==1)THEN
568 ELSEIF(ittyp==2)THEN
569 WRITE(iunit,'(A,I5,A,I5,A)')eor,1,'I',ltitl,'C'
570 WRITE(iunit,'(I10,A)')ithbuf(iad1),titl(1:ltitl)
571 ELSEIF(ittyp==3)THEN
572 CALL eor_c(4+ltitl)
573 CALL write_i_c(ithbuf(iad1),1)
574 CALL write_c_c(ititle,ltitl)
575 CALL eor_c(4+ltitl)
576 ENDIF
577 iad1=iad1+1
578 iad2=iad2+40
579 ENDDO
580 IF(nvar/=0)THEN
581 CALL wrtdes(ithbuf(ithgrp(7,n)),
582 . ithbuf(ithgrp(7,n)),nvar,ittyp,0)
583 IF(th_titles == 1)THEN
584 DO i=1,ithgrp(4,n)
585 DO j=1,nvar
586 DO k=1,10
587 var(k:k)=char(ithvar((ithgrp(9,n)-1+j-1)*10+k))
588 ENDDO
589 WRITE(ifiltitl,'(I10)')ithgrp(2,n)
590 WRITE(ifiltitl,'(A)')var(1:10)
591 ENDDO
592 ENDDO
593 ENDIF
594 ENDIF
595 ENDDO
596C-------TH GROUP + 1 section fluide------------
597 IF(ALLOCATED(iwa)) DEALLOCATE(iwa)
598 ALLOCATE(iwa(6))
599 IF(nsect==0.AND.nsflsw/=0) THEN
600 nvar=6
601 titl='FLUID SECTION'
602 IF(ittyp==0)THEN
603 IF(ltitl==40)THEN
604 READ(titl,'(10A4)')tit40
605 WRITE(iunit)104,104,
606 . 1,nsflsw,nvar,tit40
607 ELSE IF(ltitl==80)THEN
608 READ(titl,'(20A4)')tit80
609 WRITE(iunit)104,104,
610 . 1,nsflsw,nvar,tit80
611 ELSE
612 READ(titl,'(25A4)')tit100
613 WRITE(iunit)104,104,
614 . 1,nsflsw,nvar,tit100
615 ENDIF
616 ELSEIF(ittyp==1)THEN
617 ELSEIF(ittyp==2)THEN
618 WRITE(iunit,'(A,I5,A,I5,A)')eor,5,'I',ltitl,'C'
619 WRITE(iunit,'(5I10,A)')104,104,
620 . 1,nsflsw,ithgrp(6,n),titl(1:ltitl)
621 ELSEIF(ittyp==3)THEN
622 DO i=1,ltitl
623 ititle(i)=ichar(titl(i:i))
624 ENDDO
625 CALL eor_c(20+ltitl)
626 CALL write_i_c(104,1)
627 CALL write_i_c(104,1)
628 CALL write_i_c(1,1)
629 CALL write_i_c(nsflsw,1)
630 CALL write_i_c(nvar,1)
631 CALL write_c_c(ititle,ltitl)
632 CALL eor_c(20+ltitl)
633 ENDIF
634 DO j=1,nsflsw
635 IF(ittyp==0)THEN
636 IF(ltitl==40)THEN
637 WRITE(iunit)j,tit40
638 ELSE IF(ltitl==80)THEN
639 WRITE(iunit)j,tit80
640 ELSE
641 WRITE(iunit)j,tit100
642 ENDIF
643 ELSEIF(ittyp==1)THEN
644 ELSEIF(ittyp==2)THEN
645 WRITE(iunit,'(A,I5,A,I5,A)')eor,1,'I',ltitl,'C'
646 WRITE(iunit,'(I10,A)')j,titl(1:ltitl)
647 ELSEIF(ittyp==3)THEN
648 CALL eor_c(4+ltitl)
649 CALL write_i_c(j,1)
650 CALL write_c_c(ititle,ltitl)
651 CALL eor_c(4+ltitl)
652 ENDIF
653 ENDDO
654 DO i=1,6
655 iwa(i)=i
656 ENDDO
657 CALL wrtdes(iwa,iwa,6,ittyp,0)
658 ENDIF
659C
660 IF ((irad2r==1).AND.(r2r_siu==1)) THEN
661 CALL flu_fil_c()
662 IF (iddom==0) THEN
663 seek_loc = iunit-29
664 IF (iunit == 3) seek_loc = 1
665 seek_flag(seek_loc) = 1
666 ENDIF
667 ENDIF
668C
669 IF(th_titles == 1) CLOSE(ifiltitl)
670C
671 DEALLOCATE(iwa)
672 RETURN
673 END
my_real
#define my_real
Definition cppsort.cpp:32
hist1
subroutine hist1(filnam, ifil, nthgrp2, long, pm, geo, ipart, subset, ithgrp, ithbuf, igeo, ipm, iparth, nparth, nvparth, nvsubth, ittyp, ithflag, ithvar, ifiltitl, sithbuf, names_and_titles)
Definition hist1.F:50
groupdef_mod
Definition groupdef_mod.F:668
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
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ltitle
integer, parameter ltitle
Definition names_and_titles_mod.F:1012
th_mod
Definition th_mod.F:42
th_mod::th_titles
integer th_titles
Definition th_mod.F:70
radioss
program radioss
Definition radioss.F:34
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
names_and_titles_mod::names_and_titles_
Definition names_and_titles_mod.F:1021
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645
flu_fil_c
void flu_fil_c()
Definition write_routines.c:901
eor_c
void eor_c(int *len)
Definition write_routines.c:498
write_c_c
void write_c_c(int *w, int *len)
Definition write_routines.c:591
wrtdes
subroutine wrtdes(a, ia, l, iform, ir)
Definition wrtdes.F:45