OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hist1.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "scr05_c.inc"
#include "scr13_c.inc"
#include "scrfs_c.inc"
#include "chara_c.inc"
#include "titr_c.inc"
#include "scr07_c.inc"
#include "scr17_c.inc"
#include "sysunit.inc"
#include "rad2r_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ hist1()

subroutine hist1 ( character filnam,
integer ifil,
integer nthgrp2,
integer long,
pm,
geo,
integer, dimension(lipart1,*) ipart,
type (subset_), dimension(nsubs) subset,
integer, dimension(nithgr,*) ithgrp,
integer, dimension(sithbuf), intent(in) ithbuf,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropmi,*) ipm,
integer, dimension(nparth,*) iparth,
integer nparth,
integer nvparth,
integer nvsubth,
integer ittyp,
integer ithflag,
integer, dimension(*) ithvar,
integer ifiltitl,
integer, intent(in) sithbuf,
type(names_and_titles_), intent(in) names_and_titles )
Parameters
[in]names_and_titlesNAMES_AND_TITLES host the input deck names and titles for outputs

Definition at line 44 of file hist1.F.

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 ELSEIF(ittyp==1.OR.ittyp==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.AND. IF(NSECT==0NSFLSW/=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
my_real
#define my_real
Definition cppsort.cpp:32
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
section
subroutine section(nnod, n1, n2, n3, nstrf, x, v, vr, fsav, fopta, secfcum, ms, in, ifram, xsec)
Definition section.F:34
stri
character *8 function stri(n)
Definition stri.F:24
strr
character *8 function strr(y)
Definition strr.F:34
names_and_titles_mod::names_and_titles_
Definition names_and_titles_mod.F:1021
my_ctime
void my_ctime(int *p)
Definition timer_c.c:29
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
cur_fil_c
void cur_fil_c(int *nf)
Definition write_routines.c:477
write_c_c
void write_c_c(int *w, int *len)
Definition write_routines.c:591
open_c
void open_c(int *ifil, int *len, int *mod)
Definition write_routines.c:180
wrtdes
subroutine wrtdes(a, ia, l, iform, ir)
Definition wrtdes.F:45