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_routtines.c
29!|| eor_c ../common_source/tools/input_output/write_routtines.c
30!|| flu_fil_c ../common_source/tools/input_output/write_routtines.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_routtines.c
34!|| write_c_c ../common_source/tools/input_output/write_routtines.c
35!|| write_i_c ../common_source/tools/input_output/write_routtines.c
36!|| write_r_c ../common_source/tools/input_output/write_routtines.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, NJOINV, NRBAGV,
99 . NG, II, N, IH, ITY, NEL, NFT, K, MTN, NACCELV,
100 . IRUNR,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 INTEGER, DIMENSION(20) :: TEXT
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 NOMBRE DE RECORDS ADDITIONNELS
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 IF (TH_VERS >= 2026)THEN
296 NGLOBTH=16
297 ELSEIF (TH_VERS >= 2021) THEN
298 NGLOBTH=15
299 ELSE
300 NGLOBTH=12
301 END IF
302c
303 IF (IUNIT /= IUHIS) THEN
304 IWA(6)= 0
305 ELSE
306 IWA(6)= NGLOBTH
307 ENDIF
308c
309
310 CALL WRTDES(IWA,IWA,6,ITTYP,0)
311 J = IWA(6)
312 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
313 ALLOCATE(IWA(NGLOBTH))
314 DO I=1,J
315 IWA(I)=I
316 ENDDO
317
318 IF(IUNIT == IUHIS) CALL WRTDES(IWA,IWA,NGLOBTH,ITTYP,0)
319 NVAR = 0
320 DO N=1,NPART+NTHPART
321 NVAR=MAX(NVAR,IPARTH(NVPARTH,N))
322 ENDDO
323 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
324 ALLOCATE(IWA(NVAR))
325C-------PART DESCRIPTION------------
326 DO N=1,NPART+NTHPART
327 NVAR=IPARTH(NVPARTH,N)
328 IAD =IPARTH(NVPARTH+1,N)
329 CALL FRETITL2(TITL,IPART(LIPART1-LTITR+1,N),40)
330 DO I=1,LTITL
331 ITITLE(I)=ICHAR(TITL(I:I))
332 ENDDO
333 IF (N > NPART)THEN
334 IPART1 = 0
335 IPART2 = 0
336 ELSE
337 IPART1 = IPART(1,N)
338 IPART2 = IPART(2,N)
339 ENDIF
340 IF(ITTYP==0)THEN
341 IF(LTITL==40)THEN
342 READ(TITL,'(10a4)')TIT40
343 WRITE(IUNIT)IPART(4,N),TIT40,IPART(7,N),
344 . IPART1,IPART2,NVAR
345 ELSE IF(LTITL==80)THEN
346 READ(TITL,'(20a4)')TIT80
347 WRITE(IUNIT)IPART(4,N),TIT80,IPART(7,N),
348 . IPART1,IPART2,NVAR
349 ELSE
350 READ(TITL,'(25a4)')TIT100
351 WRITE(IUNIT)IPART(4,N),TIT100,IPART(7,N),
352 . IPART1,IPART2,NVAR
353 ENDIF
354 ELSEIF(ITTYP==1)THEN
355 ELSEIF(ITTYP==2)THEN
356 WRITE(IUNIT,'(a,i5,a,i5,a,i5,a)')EOR,1,'i',40,'c',4,'i'
357 WRITE(IUNIT,'(i10,a,4i5)')IPART(4,N),TITL(1:LTITL),
358 . IPART(7,N),IPART1,IPART2,NVAR
359 ELSEIF(ITTYP==3)THEN
360 CALL EOR_C(20+LTITL)
361 CALL WRITE_I_C(IPART(4,N),1)
362 CALL WRITE_C_C(ITITLE,LTITL)
363 CALL WRITE_I_C(IPART(7,N),1)
364 CALL WRITE_I_C(IPART1,1)
365 CALL WRITE_I_C(IPART2,1)
366 CALL WRITE_I_C(NVAR,1)
367 CALL EOR_C(20+LTITL)
368 ENDIF
369 II=0
370 DO I=IAD,IAD+NVAR-1
371 II=II+1
372 IF(I <= SITHBUF) THEN
373 IWA(II)=ITHBUF(I)
374 ELSE
375 IWA(II) = 0
376 ENDIF
377 ENDDO
378 IF(NVAR/=0)CALL WRTDES(IWA,IWA,NVAR,ITTYP,0)
379 ENDDO
380C-------MATER DESCRIPTION------------
381 DO N=1,NUMMAT
382 MID = IPM(1,N)
383 CALL FRETITL2(TITL,IPM(NPROPMI-LTITR+1,N),40)
384 TITLSUM=SUM(IPM(NPROPMI-LTITR+1:NPROPMI-LTITR+40,N))
385 IF(TITLSUM == 0)THEN
386 TITL(1:LTITL)=' '
387 TITL(1:8)='no_title'
388 ENDIF
389 DO I=1,LTITL
390 ITITLE(I)=ICHAR(TITL(I:I))
391 ENDDO
392 IF(ITTYP==0)THEN
393 IF(LTITL==40)THEN
394 READ(TITL,'(10a4)')TIT40
395 WRITE(IUNIT)MID,TIT40
396 ELSE IF(LTITL==80)THEN
397 READ(TITL,'(20a4)')TIT80
398 WRITE(IUNIT)MID,TIT80
399 ELSE
400 READ(TITL,'(25a4)')TIT100
401 WRITE(IUNIT)MID,TIT100
402 ENDIF
403 ELSEIF(ITTYP==1)THEN
404 ELSEIF(ITTYP==2)THEN
405 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,1,'i',LTITL,'c'
406 WRITE(IUNIT,'(i10,a)')MID,TITL(1:LTITL)
407 ELSEIF(ITTYP==3)THEN
408 CALL EOR_C(4+LTITL)
409 CALL WRITE_I_C(MID,1)
410 CALL WRITE_C_C(ITITLE,LTITL)
411 CALL EOR_C(4+LTITL)
412 ENDIF
413 ENDDO
414C-------GEO DESCRIPTION------------
415 DO N=1,NUMGEO
416 PID = IGEO(1,N)
417 CALL FRETITL2(TITL,IGEO(NPROPGI-LTITR+1,N),40)
418 DO I=1,LTITL
419 ITITLE(I)=ICHAR(TITL(I:I))
420 ENDDO
421 IF(ITTYP==0)THEN
422 IF(LTITL==40)THEN
423 READ(TITL,'(10a4)')TIT40
424 WRITE(IUNIT)PID,TIT40
425 ELSE IF(LTITL==80)THEN
426 READ(TITL,'(20a4)')TIT80
427 WRITE(IUNIT)PID,TIT80
428 ELSE
429 READ(TITL,'(25a4)')TIT100
430 WRITE(IUNIT)PID,TIT100
431 ENDIF
432 ELSEIF(ITTYP==1)THEN
433 ELSEIF(ITTYP==2)THEN
434 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,1,'i',LTITL,'c'
435 WRITE(IUNIT,'(i10,a)')PID,TITL(1:LTITL)
436
437 ELSEIF(ITTYP==3)THEN
438 CALL EOR_C(4+LTITL)
439 CALL WRITE_I_C(PID,1)
440 CALL WRITE_C_C(ITITLE,LTITL)
441 CALL EOR_C(4+LTITL)
442 ENDIF
443 ENDDO
444C-------HIERARCHY DESCRIPTION------------
445 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
446 NVAR = 0
447 DO N=1,NSUBS
448 NVAR=MAX(NVAR,SUBSET(N)%NVARTH(ITHFLAG))
449 ENDDO
450 ALLOCATE(IWA(NVAR))
451 DO N=1,NSUBS
452!! NVAR=ISUBTH(NVSUBTH,N)
453!! IAD =ISUBTH(NVSUBTH+1,N)
454 NVAR=SUBSET(N)%NVARTH(ITHFLAG)
455 IAD =SUBSET(N)%THIAD
456!! CALL FRETITL2(TITL,ISUBS(LISUB1-LTITR+1,N),40)
457 TITL = SUBSET(N)%TITLE
458 DO I=1,LTITL
459 ITITLE(I)=ICHAR(TITL(I:I))
460 ENDDO
461 IF(ITTYP==0)THEN
462 IF(LTITL==40)THEN
463 READ(TITL,'(10a4)')TIT40
464!! WRITE(IUNIT)ISUBS(1,N),ISUBS(10,N),
465!! . ISUBS(2,N),ISUBS(4,N),NVAR,TIT40
466 WRITE(IUNIT)SUBSET(N)%ID,SUBSET(N)%PARENT,
467 . SUBSET(N)%NCHILD,SUBSET(N)%NPART,NVAR,TIT40
468 ELSE IF(LTITL==00)THEN
469 READ(TITL,'(20a4)')TIT80
470!! WRITE(IUNIT)ISUBS(1,N),ISUBS(10,N),
471!! . ISUBS(2,N),ISUBS(4,N),NVAR,TIT80
472 WRITE(IUNIT)SUBSET(N)%ID,SUBSET(N)%PARENT,
473 . SUBSET(N)%NCHILD,SUBSET(N)%NPART,NVAR,TIT80
474 ELSE
475 READ(TITL,'(25a4)')TIT100
476!! WRITE(IUNIT)ISUBS(1,N),ISUBS(10,N),
477!! . ISUBS(2,N),ISUBS(4,N),NVAR,TIT100
478 WRITE(IUNIT)SUBSET(N)%ID,SUBSET(N)%PARENT,
479 . SUBSET(N)%NCHILD,SUBSET(N)%NPART,NVAR,TIT100
480 ENDIF
481 ELSEIF(ITTYP==1)THEN
482 ELSEIF(ITTYP==2)THEN
483 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,5,'i',LTITL,'c'
484!! WRITE(IUNIT,'(5i10,a)')ISUBS(1,N),ISUBS(10,N),
485!! . ISUBS(2,N),ISUBS(4,N),NVAR,TITL(1:LTITL)
486 WRITE(IUNIT,'(5i10,a)')SUBSET(N)%ID,SUBSET(N)%PARENT,
487 . SUBSET(N)%NCHILD,SUBSET(N)%NPART,NVAR,TITL(1:LTITL)
488 ELSEIF(ITTYP==3)THEN
489 CALL EOR_C(20+LTITL)
490!! CALL WRITE_I_C(ISUBS(1,N),1)
491 CALL WRITE_I_C(SUBSET(N)%ID,1)
492!! CALL WRITE_I_C(ISUBS(10,N),1)
493 CALL WRITE_I_C(SUBSET(N)%PARENT,1)
494!! CALL WRITE_I_C(ISUBS(2,N),1)
495 CALL WRITE_I_C(SUBSET(N)%NCHILD,1)
496!! CALL WRITE_I_C(ISUBS(4,N),1)
497 CALL WRITE_I_C(SUBSET(N)%NPART,1)
498 CALL WRITE_I_C(NVAR,1)
499 CALL WRITE_C_C(ITITLE,LTITL)
500 CALL EOR_C(20+LTITL)
501 ENDIF
502!! IF(ISUBS(2,N)/=0)CALL WRTDES(IBUFSSG(ISUBS(3,N)),
503!! . IBUFSSG(ISUBS(3,N)),ISUBS(2,N),ITTYP,0)
504 IF(SUBSET(N)%NCHILD/=0)CALL WRTDES(SUBSET(N)%CHILD,
505 . SUBSET(N)%CHILD,SUBSET(N)%NCHILD,ITTYP,0)
506!! IF(ISUBS(4,N)/=0)CALL WRTDES(IBUFSSG(ISUBS(5,N)),
507!! . IBUFSSG(ISUBS(5,N)),ISUBS(4,N),ITTYP,0)
508 IF(SUBSET(N)%NPART/=0)CALL WRTDES(SUBSET(N)%PART,
509 . SUBSET(N)%PART,SUBSET(N)%NPART,ITTYP,0)
510 II=0
511 DO I=IAD,IAD+NVAR-1
512 II=II+1
513 IWA(II)=ITHBUF(I)
514 ENDDO
515 IF(NVAR/=0)CALL WRTDES(IWA,IWA,NVAR,ITTYP,0)
516 ENDDO
517C-------TH GROUP------------
518 DO N=1,NTHGRP2
519 NVAR=ITHGRP(6,N)
520 CALL FRETITL2(TITL,ITHGRP(NITHGR-LTITR+1,N),40)
521 DO I=1,LTITL
522 ITITLE(I)=ICHAR(TITL(I:I))
523 ENDDO
524C (nstrands elements are treated as a spring group)
525 ITY=ITHGRP(2,N)
526 IF (ITY==100) ITY=6
527 IF(ITTYP==0)THEN
528 IF(LTITL==40)THEN
529 READ(TITL,'(10a4)')TIT40
530 WRITE(IUNIT)ITHGRP(1,N),ITY,
531 . ITHGRP(3,N),ITHGRP(4,N),ITHGRP(6,N),TIT40
532 ELSE IF(LTITL==80)THEN
533 READ(TITL,'(20a4)')TIT80
534 WRITE(IUNIT)ITHGRP(1,N),ITY,
535 . ITHGRP(3,N),ITHGRP(4,N),ITHGRP(6,N),TIT80
536 ELSE
537 READ(TITL,'(25a4)')TIT100
538 WRITE(IUNIT)ITHGRP(1,N),ITY,
539 . ITHGRP(3,N),ITHGRP(4,N),ITHGRP(6,N),TIT100
540 ENDIF
541 ELSEIF(ITTYP==1)THEN
542 ELSEIF(ITTYP==2)THEN
543 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,5,'i',LTITL,'c'
544 WRITE(IUNIT,'(5i10,a)')ITHGRP(1,N),ITY,
545 . ITHGRP(3,N),ITHGRP(4,N),ITHGRP(6,N),TITL(1:LTITL)
546 ELSEIF(ITTYP==3)THEN
547 CALL EOR_C(20+LTITL)
548 CALL WRITE_I_C(ITHGRP(1,N),1)
549 CALL WRITE_I_C(ITY,1)
550 CALL WRITE_I_C(ITHGRP(3,N),1)
551 CALL WRITE_I_C(ITHGRP(4,N),1)
552 CALL WRITE_I_C(ITHGRP(6,N),1)
553 CALL WRITE_C_C(ITITLE,LTITL)
554 CALL EOR_C(20+LTITL)
555 ENDIF
556 IAD1=ITHGRP(5,N)+2*ITHGRP(4,N)
557 IAD2=ITHGRP(8,N)
558 DO J=1,ITHGRP(4,N)
559 CALL FRETITL2(TITL,ITHBUF(IAD2),40)
560 DO I=1,LTITL
561 ITITLE(I)=ICHAR(TITL(I:I))
562 ENDDO
563 IF(ITTYP==0)THEN
564 IF(LTITL==40)THEN
565 READ(TITL,'(10a4)')TIT40
566 WRITE(IUNIT)ITHBUF(IAD1),TIT40
567 ELSE IF(LTITL==80)THEN
568 READ(TITL,'(20a4)')TIT80
569 WRITE(IUNIT)ITHBUF(IAD1),TIT80
570 ELSE
571 READ(TITL,'(25a4)')TIT100
572 WRITE(IUNIT)ITHBUF(IAD1),TIT100
573 ENDIF
574 ELSEIF(ITTYP==1)THEN
575 ELSEIF(ITTYP==2)THEN
576 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,1,'i',LTITL,'c'
577 WRITE(IUNIT,'(i10,a)')ITHBUF(IAD1),TITL(1:LTITL)
578 ELSEIF(ITTYP==3)THEN
579 CALL EOR_C(4+LTITL)
580 CALL WRITE_I_C(ITHBUF(IAD1),1)
581 CALL WRITE_C_C(ITITLE,LTITL)
582 CALL EOR_C(4+LTITL)
583 ENDIF
584 IAD1=IAD1+1
585 IAD2=IAD2+40
586 ENDDO
587 IF(NVAR/=0)THEN
588 CALL WRTDES(ITHBUF(ITHGRP(7,N)),
589 . ITHBUF(ITHGRP(7,N)),NVAR,ITTYP,0)
590 IF(TH_TITLES == 1)THEN
591 DO I=1,ITHGRP(4,N)
592 DO J=1,NVAR
593 DO K=1,10
594 VAR(K:K)=CHAR(ITHVAR((ITHGRP(9,N)-1+J-1)*10+K))
595 ENDDO
596 WRITE(IFILTITL,'(i10)')ITHGRP(2,N)
597 WRITE(IFILTITL,'(a)')VAR(1:10)
598 ENDDO
599 ENDDO
600 ENDIF
601 ENDIF
602 ENDDO
603C-------TH GROUP + 1 section fluide------------
604 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
605 ALLOCATE(IWA(6))
606.AND. IF(NSECT==0NSFLSW/=0) THEN
607 NVAR=6
608 TITL='fluid section'
609 IF(ITTYP==0)THEN
610 IF(LTITL==40)THEN
611 READ(TITL,'(10a4)')TIT40
612 WRITE(IUNIT)104,104,
613 . 1,NSFLSW,NVAR,TIT40
614 ELSE IF(LTITL==80)THEN
615 READ(TITL,'(20a4)')TIT80
616 WRITE(IUNIT)104,104,
617 . 1,NSFLSW,NVAR,TIT80
618 ELSE
619 READ(TITL,'(25a4)')TIT100
620 WRITE(IUNIT)104,104,
621 . 1,NSFLSW,NVAR,TIT100
622 ENDIF
623 ELSEIF(ITTYP==1)THEN
624 ELSEIF(ITTYP==2)THEN
625 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,5,'i',LTITL,'c'
626 WRITE(IUNIT,'(5i10,a)')104,104,
627 . 1,NSFLSW,ITHGRP(6,N),TITL(1:LTITL)
628 ELSEIF(ITTYP==3)THEN
629 DO I=1,LTITL
630 ITITLE(I)=ICHAR(TITL(I:I))
631 ENDDO
632 CALL EOR_C(20+LTITL)
633 CALL WRITE_I_C(104,1)
634 CALL WRITE_I_C(104,1)
635 CALL WRITE_I_C(1,1)
636 CALL WRITE_I_C(NSFLSW,1)
637 CALL WRITE_I_C(NVAR,1)
638 CALL WRITE_C_C(ITITLE,LTITL)
639 CALL EOR_C(20+LTITL)
640 ENDIF
641 DO J=1,NSFLSW
642 IF(ITTYP==0)THEN
643 IF(LTITL==40)THEN
644 WRITE(IUNIT)J,TIT40
645 ELSE IF(LTITL==80)THEN
646 WRITE(IUNIT)J,TIT80
647 ELSE
648 WRITE(IUNIT)J,TIT100
649 ENDIF
650 ELSEIF(ITTYP==1)THEN
651 ELSEIF(ITTYP==2)THEN
652 WRITE(IUNIT,'(a,i5,a,i5,a)')EOR,1,'i',LTITL,'c'
653 WRITE(IUNIT,'(i10,a)')J,TITL(1:LTITL)
654 ELSEIF(ITTYP==3)THEN
655 CALL EOR_C(4+LTITL)
656 CALL WRITE_I_C(J,1)
657 CALL WRITE_C_C(ITITLE,LTITL)
658 CALL EOR_C(4+LTITL)
659 ENDIF
660 ENDDO
661 DO I=1,6
662 IWA(I)=I
663 ENDDO
664 CALL WRTDES(IWA,IWA,6,ITTYP,0)
665 ENDIF
666C
667.AND. IF ((IRAD2R==1)(R2R_SIU==1)) THEN
668 CALL FLU_FIL_C()
669 IF (IDDOM==0) THEN
670 SEEK_LOC = IUNIT-29
671 IF (IUNIT == 3) SEEK_LOC = 1
672 SEEK_FLAG(SEEK_LOC) = 1
673 ENDIF
674 ENDIF
675C
676 IF(TH_TITLES == 1) CLOSE(IFILTITL)
677C
678 DEALLOCATE(IWA)
679 RETURN
680 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:662
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:997
names_and_titles_mod::ltitle
integer, parameter ltitle
Definition names_and_titles_mod.F:1007
th_mod
Definition th_mod.F:42
th_mod::th_titles
integer th_titles
Definition th_mod.F:70
radioss2
subroutine radioss2(idata, midata, rdata, mrdata)
Definition radioss2.F:143
section
subroutine section(nnod, n1, n2, n3, nstrf, x, v, vr, fsav, fopta, secfcum, ms, in, ifram, xsec)
Definition section.F:34
names_and_titles_mod::names_and_titles_
Definition names_and_titles_mod.F:1016
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_routtines.c:645
eor_c
void eor_c(int *len)
Definition write_routtines.c:498
cur_fil_c
void cur_fil_c(int *nf)
Definition write_routtines.c:477
write_c_c
void write_c_c(int *w, int *len)
Definition write_routtines.c:591
open_c
void open_c(int *ifil, int *len, int *mod)
Definition write_routtines.c:180