OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hist13.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!|| hist13 ../engine/source/output/th/hist13.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!|| open_c ../common_source/tools/input_output/write_routtines.c
31!|| write_c_c ../common_source/tools/input_output/write_routtines.c
32!|| write_i_c ../common_source/tools/input_output/write_routtines.c
33!|| wrtdes ../engine/source/output/th/wrtdes.F
34!||--- uses -----------------------------------------------------
35!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
36!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
37!||====================================================================
38 SUBROUTINE hist13(IPARG ,IXS ,IXQ ,IXC ,IXT ,
39 2 IXP ,IXR ,ITAB ,PM ,
40 3 NPBY ,IXTG ,IRFE ,LACCELM,
41 4 IPARI ,IPART,ITHGRP ,ITHBUF,CHRUN_OLD,NAMES_AND_TITLES)
42C=======================================================================
43C OLD TH V3 RADIOSS INPUT V3 or V4
44C=======================================================================
45 USE inoutfile_mod
46 USE names_and_titles_mod,only:names_and_titles_,ltitle
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "com10_c.inc"
56#include "units_c.inc"
57#include "param_c.inc"
58#include "scr05_c.inc"
59#include "scr12_c.inc"
60#include "scr13_c.inc"
61#include "scr17_c.inc"
62#include "scrfs_c.inc"
63#include "chara_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER IRFE
68 INTEGER IPARG(NPARG,*), IXS(NIXS,*), IXQ(NIXQ,*),
69 . IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*),
70 . ixtg(nixtg,*),itab(*),
71 . ipari(npari,*),laccelm(3,*),ipart(lipart1,*), npby(nnpby,*),
72 . ithgrp(nithgr,*), ithbuf(*)
73
74 my_real pm(npropm,nummat)
75 CHARACTER CHRUN_OLD*2
76 TYPE(NAMES_AND_TITLES_),INTENT(IN) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs+
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER ITITLE(80), IFILNAM(2148), ICODE, I, NJOINV, NRBAGV,
81 . NG, II, N, IH, ITY, NEL, NFT, K, MTN, NACCELV,NINTERS,
82 . IRUNR,NN,IAD,J,ITYP
83
84 CHARACTER EOR*8, CH8*8, FILNAM*100, BLA*7
85 CHARACTER(LEN=LTITLE) :: CARD
86 my_real,DIMENSION(20) :: TITLE
87 INTEGER :: LEN_TMP_NAME
88 CHARACTER(len=2148) :: TMP_NAME
89 INTEGER, DIMENSION(20) :: TEXT
90 INTEGER NGLV, NMTV, NINV, NRWV, NRBV, NNODV, NSCV, NELQV, NELSV, NELCV, NELTV, NELPV, NELRV, NELTGV, NELURV
91 INTEGER, dimension(:), allocatable :: IWA
92C-----------------------------------------------
93C E x t e r n a l F u n c t i o n s
94C-----------------------------------------------
95 CHARACTER STRI*8
96C-----------------------------------------------
97 EXTERNAL STRI
98 DATA bla/' '/
99 DATA eor/'ZZZZZEOR'/
100C-----------------------------------------------
101C S o u r c e L i n e s
102C-----------------------------------------------
103 ninters = 0
104 DO n=1,nthgrp
105 ityp=ithgrp(2,n)
106 nn =ithgrp(4,n)
107 IF(ityp==101)ninters = ninters + nn
108 ENDDO
109C
110 filnam=rootnam(1:rootlen)//'T'//chrun_old
111C
112 card(1:ltitle)=names_and_titles%TITLE(1:ltitle)
113C ICODE=3017
114C ICODE=3023
115 icode=3030
116C ICODE=3040
117C
118 len_tmp_name = outfile_name_len + rootlen+3
119 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:rootlen+3)
120
121 IF(itform==0)THEN
122 OPEN(unit=iuhis,file=tmp_name(1:len_tmp_name),
123 . access='SEQUENTIAL',
124 . form='UNFORMATTED',status='UNKNOWN')
125 ELSEIF(itform==1.OR.itform==2)THEN
126 OPEN(unit=iuhis,file=tmp_name(1:len_tmp_name),
127 . access='sequential',
128 . FORM='formatted',STATUS='unknown')
129 ELSEIF(ITFORM==3)THEN
130 DO I=1,LEN_TMP_NAME
131 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
132 ENDDO
133 CALL CUR_FIL_C(1)
134 CALL OPEN_C(IFILNAM,LEN_TMP_NAME,0)
135 ELSEIF(ITFORM==4)THEN
136 DO I=1,LEN_TMP_NAME
137 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
138 ENDDO
139 CALL CUR_FIL_C(1)
140 CALL OPEN_C(IFILNAM,LEN_TMP_NAME,3)
141 ITFORM=3
142 ELSEIF(ITFORM==5)THEN
143 DO I=1,LEN_TMP_NAME
144 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
145 ENDDO
146 CALL CUR_FIL_C(1)
147 CALL OPEN_C(IFILNAM,LEN_TMP_NAME,6)
148 ITFORM=3
149 ENDIF
150C
151 IF(ITFORM==0)THEN
152 READ(CARD,'(20a4)')TITLE
153 WRITE(IUHIS)ICODE,TITLE
154 ELSEIF(ITFORM==1)THEN
155 CH8=STRI(ICODE)
156 WRITE(IUHIS,'(a)')FILNAM(1:ROOTLEN+3)
157 WRITE(IUHIS,'(2a)')CH8,CARD(1:72)
158 ELSEIF(ITFORM==2)THEN
159 WRITE(IUHIS,'(2a)')FILNAM(1:ROOTLEN+3),' format'
160 WRITE(IUHIS,'(a,i5,a,i5,a)')EOR,1,'i',72,'c'
161 WRITE(IUHIS,'(i5,a)')ICODE,CARD(1:72)
162 ELSEIF(ITFORM==3)THEN
163 DO 5 I=1,80
164 5 ITITLE(I)=ICHAR(CARD(I:I))
165 CALL EOR_C(84)
166 CALL WRITE_I_C(ICODE,1)
167 CALL WRITE_C_C(ITITLE,80)
168 CALL EOR_C(84)
169 ENDIF
170C
171.AND. IF(NSMAT/=0INVSTR<40) THEN
172C 009 DO N=1,NPART
173 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
174 ALLOCATE(IWA(NUMMAT))
175 DO N=1,NUMMAT-1
176 IWA(N)=0
177 ENDDO
178 DO N=1,NPART
179 IF(IPART(8,N)>=1) IWA(IPART(1,N))=1
180 ENDDO
181 NSMAT=0
182 DO N=1,NUMMAT-1
183 NSMAT=NSMAT+IWA(N)
184 ENDDO
185 ENDIF
186C
187 NGLV=12
188 NMTV=6
189 NINV=6
190 NRWV=6
191 NRBV=9
192 NNODV=9
193 NSCV=9
194 NJOINV=6
195 NRBAGV=9
196C NELV=22
197 NACCELV=3
198 NELSV=19
199 NELTV=6
200 NELPV=9
201 NELRV=14
202 NELCV=22
203 NELQV =NELSV
204 NELTGV=NELCV
205 NELURV=12
206C
207C
208 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
209 ALLOCATE(IWA(35))
210 IWA(1) =NGLV
211 IWA(2) =NSMAT
212 IWA(3) =NMTV
213 IWA(4) =NSNOD
214 IWA(5) =NNODV
215 IWA(6) =NSELQ
216 IWA(7) =NELQV
217 IWA(8) =NSELS
218 IWA(9) =NELSV
219 IWA(10)=NSELC
220 IWA(11)=NELCV
221 IWA(12)=NSELT
222 IWA(13)=NELTV
223 IWA(14)=NSELP
224 IWA(15)=NELPV
225 IWA(16)=NSELR
226 IWA(17)=NELRV
227 IWA(18)=NINTERS
228 IWA(19)=NINV
229 IWA(20)=NRWALL
230 IWA(21)=NRWV
231 IWA(22)=NSRBY
232 IWA(23)=NRBV
233 IWA(24)=NSECT
234 IF (NSECT ==0 ) IWA(24)=NSFLSW
235 IWA(25)=NSCV
236 IWA(26)=NJOINT
237 IWA(27)=NJOINV
238 IWA(28)=NRBAG+NVOLU
239 IWA(29)=NRBAGV
240 IWA(30)=NSELTG
241 IWA(31)=NELTGV
242 IWA(32)=NSELU
243 IWA(33)=NELURV
244 IWA(34)=NACCELM
245 IWA(35)=NACCELV
246 IUNIT=IUHIS
247 CALL WRTDES(IWA,IWA,35,ITFORM,0)
248 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
249 ALLOCATE(IWA(2*NUMMAT + NPART))
250 IF(NSMAT/=0) THEN
251 IF(INVSTR<40) THEN
252C 009 DO N=1,NPART
253 DO N=1,NUMMAT-1
254 IWA(N)=0
255 ENDDO
256 II=0
257 DO N=1,NPART
258 IF(IPART(8,N)>=1)THEN
259 II=IPART(1,N)
260 IWA(II)=IPART(5,N)
261 ENDIF
262 ENDDO
263 NSMAT=0
264C 009 DO N=1,NPART
265 DO N=1,NUMMAT-1
266 IF(IWA(N)/=0)THEN
267 NSMAT=NSMAT+1
268 IWA(NSMAT)=IWA(N)
269 ENDIF
270 ENDDO
271 ELSE
272 DO N=1,NPART
273 IWA(N)=IPART(4,N)
274 ENDDO
275 ENDIF
276 ENDIF
277C
278 IF(NSMAT/=0) THEN
279 CALL WRTDES(IWA,IWA,NSMAT,ITFORM,0)
280 ENDIF
281C--------------------------------
282 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
283 IF(NINTERS/=0) THEN
284 ALLOCATE(IWA(NINTERS))
285 II=0
286 DO N=1,NTHGRP
287 ITYP=ITHGRP(2,N)
288 NN =ITHGRP(4,N)
289 IAD =ITHGRP(5,N)
290 IF(ITYP==101)THEN
291 DO J=IAD,IAD+NN-1
292 I=ITHBUF(J)
293 II=II+1
294 IWA(II)=IPARI(15,I)
295 ENDDO
296 ENDIF
297 ENDDO
298 CALL WRTDES(IWA,IWA,NINTERS,ITFORM,0)
299 ENDIF
300C
301 IF(NRWALL /= 0) THEN
302 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
303 ALLOCATE(IWA(NRWALL))
304 II=0
305 DO I=1,NRWALL
306 II=II+1
307 IWA(II)=II
308 ENDDO
309 CALL WRTDES(IWA,IWA,NRWALL,ITFORM,0)
310 DEALLOCATE(IWA)
311 ENDIF
312C
313C--------------------------------
314 IF(NSRBY/=0) THEN
315 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
316 ALLOCATE(IWA(NSRBY))
317 II=0
318 DO N=1,NTHGRP
319 ITYP=ITHGRP(2,N)
320 NN =ITHGRP(4,N)
321 IAD =ITHGRP(5,N)
322 IF(ITYP==103)THEN
323 DO J=IAD,IAD+NN-1
324 I=ITHBUF(J)
325 II=II+1
326 IWA(II)=ITAB(NPBY(1,I))
327c IWA(II)=ITHBUF(J)
328 ENDDO
329 ENDIF
330 ENDDO
331 CALL WRTDES(IWA,IWA,NSRBY,ITFORM,0)
332 ENDIF
333C--------------------------------
334C
335 IF(NSECT/=0) THEN
336 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
337 ALLOCATE(IWA(NSECT))
338 II=0
339 DO I=1,NSECT
340 II=II+1
341 IWA(II)=II
342 ENDDO
343 CALL WRTDES(IWA,IWA,NSECT,ITFORM,0)
344 ELSEIF(NSFLSW/=0) THEN
345 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
346 ALLOCATE(IWA(NSFLSW))
347 II=0
348 DO I=1,NSFLSW
349 II=II+1
350 IWA(II)=II
351 ENDDO
352 CALL WRTDES(IWA,IWA,NSFLSW,ITFORM,0)
353 ENDIF
354C
355 IF(NJOINT/=0) THEN
356 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
357 ALLOCATE(IWA(NJOINT))
358 II=0
359 DO I=1,NJOINT
360 II=II+1
361 IWA(II)=II
362 ENDDO
363 CALL WRTDES(IWA,IWA,NJOINT,ITFORM,0)
364 ENDIF
365C
366 IF(NRBAG+NVOLU/=0) THEN
367 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
368 ALLOCATE(IWA(NRBAG+NVOLU))
369 II=0
370 DO I=1,NRBAG+NVOLU
371 II=II+1
372 IWA(II)=II
373 ENDDO
374 CALL WRTDES(IWA,IWA,NRBAG+NVOLU,ITFORM,0)
375 ENDIF
376C
377C--------------------------------
378 IF(NACCELM/=0) THEN
379 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
380 ALLOCATE(IWA(NACCELM))
381 DO N=1,NACCELM
382 IWA(N)=LACCELM(2,N)
383 ENDDO
384 CALL WRTDES(IWA,IWA,NACCELM,ITFORM,0)
385 ENDIF
386C
387 IF(NSNOD/=0) THEN
388 II=0
389 DO N=1,NTHGRP
390 ITYP=ITHGRP(2,N)
391 NN =ITHGRP(4,N)
392 IAD =ITHGRP(5,N)
393 IF(ITYP==0)THEN
394 DO J=IAD,IAD+NN-1
395 I=ITHBUF(J)
396 II=II+1
397c IWA(II)=ITAB(I)
398 ENDDO
399 ENDIF
400 ENDDO
401 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
402 ALLOCATE(IWA(II))
403 II=0
404 DO N=1,NTHGRP
405 ITYP=ITHGRP(2,N)
406 NN =ITHGRP(4,N)
407 IAD =ITHGRP(5,N)
408 IF(ITYP==0)THEN
409 DO J=IAD,IAD+NN-1
410 I=ITHBUF(J)
411 II=II+1
412 IWA(II)=ITAB(I)
413 ENDDO
414 ENDIF
415 ENDDO
416
417 CALL WRTDES(IWA,IWA,II,ITFORM,0)
418 ENDIF
419C
420 IF (NSELS>0) THEN
421 II=0
422 DO N=1,NTHGRP
423 ITYP=ITHGRP(2,N)
424 NN =ITHGRP(4,N)
425 IAD =ITHGRP(5,N)
426 IF(ITYP==1)THEN
427 DO J=IAD,IAD+NN-1
428 I=ITHBUF(J)
429 MTN=NINT(PM(19,IXS(1,I)))
430 II=II+1
431 II=II+1
432 ENDDO
433 ENDIF
434 ENDDO
435 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
436 ALLOCATE(IWA(II))
437 II=0
438 DO N=1,NTHGRP
439 ITYP=ITHGRP(2,N)
440 NN =ITHGRP(4,N)
441 IAD =ITHGRP(5,N)
442 IF(ITYP==1)THEN
443 DO J=IAD,IAD+NN-1
444 I=ITHBUF(J)
445 MTN=NINT(PM(19,IXS(1,I)))
446 II=II+1
447 IWA(II)=IXS(NIXS,I)
448 II=II+1
449 IWA(II)=MTN
450 ENDDO
451 ENDIF
452 ENDDO
453 CALL WRTDES(IWA,IWA,II,ITFORM,0)
454 ENDIF
455C
456 IF (NSELQ>0) THEN
457 II=0
458 DO N=1,NTHGRP
459 ITYP=ITHGRP(2,N)
460 NN =ITHGRP(4,N)
461 IAD =ITHGRP(5,N)
462 IF(ITYP==2)THEN
463 DO J=IAD,IAD+NN-1
464 I=ITHBUF(J)
465 MTN=NINT(PM(19,IXQ(1,I)))
466 II=II+1
467 IWA(II)=IXQ(NIXQ,I)
468 II=II+1
469 IWA(II)=MTN
470 ENDDO
471 ENDIF
472 ENDDO
473 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
474 ALLOCATE(IWA(II))
475 II=0
476 DO N=1,NTHGRP
477 ITYP=ITHGRP(2,N)
478 NN =ITHGRP(4,N)
479 IAD =ITHGRP(5,N)
480 IF(ITYP==2)THEN
481 DO J=IAD,IAD+NN-1
482 I=ITHBUF(J)
483 MTN=NINT(PM(19,IXQ(1,I)))
484 II=II+1
485 IWA(II)=IXQ(NIXQ,I)
486 II=II+1
487 IWA(II)=MTN
488 ENDDO
489 ENDIF
490 ENDDO
491
492 CALL WRTDES(IWA,IWA,II,ITFORM,0)
493 ENDIF
494C
495 IF (NSELC>0) THEN
496 II=0
497 DO N=1,NTHGRP
498 ITYP=ITHGRP(2,N)
499 NN =ITHGRP(4,N)
500 IAD =ITHGRP(5,N)
501 IF(ITYP==3)THEN
502 DO J=IAD,IAD+NN-1
503 I=ITHBUF(J)
504 MTN=NINT(PM(19,IXC(1,I)))
505 II=II+1
506 II=II+1
507 ENDDO
508 ENDIF
509 ENDDO
510 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
511 ALLOCATE(IWA(II))
512 II=0
513 DO N=1,NTHGRP
514 ITYP=ITHGRP(2,N)
515 NN =ITHGRP(4,N)
516 IAD =ITHGRP(5,N)
517 IF(ITYP==3)THEN
518 DO J=IAD,IAD+NN-1
519 I=ITHBUF(J)
520 MTN=NINT(PM(19,IXC(1,I)))
521 II=II+1
522 IWA(II)=IXC(NIXC,I)
523 II=II+1
524 IWA(II)=MTN
525 ENDDO
526 ENDIF
527 ENDDO
528 CALL WRTDES(IWA,IWA,II,ITFORM,0)
529 ENDIF
530C
531 IF (NSELTG>0) THEN
532 II=0
533 DO N=1,NTHGRP
534 ITYP=ITHGRP(2,N)
535 NN =ITHGRP(4,N)
536 IAD =ITHGRP(5,N)
537 IF(ITYP==7)THEN
538 DO J=IAD,IAD+NN-1
539 I=ITHBUF(J)
540 MTN=NINT(PM(19,IXTG(1,I)))
541 II=II+1
542 IWA(II)=IXTG(NIXTG,I)
543 II=II+1
544 IWA(II)=MTN
545 ENDDO
546 ENDIF
547 ENDDO
548 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
549 ALLOCATE(IWA(II))
550 II=0
551 DO N=1,NTHGRP
552 ITYP=ITHGRP(2,N)
553 NN =ITHGRP(4,N)
554 IAD =ITHGRP(5,N)
555 IF(ITYP==7)THEN
556 DO J=IAD,IAD+NN-1
557 I=ITHBUF(J)
558 MTN=NINT(PM(19,IXTG(1,I)))
559 II=II+1
560 IWA(II)=IXTG(NIXTG,I)
561 II=II+1
562 IWA(II)=MTN
563 ENDDO
564 ENDIF
565 ENDDO
566
567 CALL WRTDES(IWA,IWA,II,ITFORM,0)
568 ENDIF
569C
570 IF (NSELT>0) THEN
571 II=0
572 DO N=1,NTHGRP
573 ITYP=ITHGRP(2,N)
574 NN =ITHGRP(4,N)
575 IAD =ITHGRP(5,N)
576 IF(ITYP==4)THEN
577 DO J=IAD,IAD+NN-1
578 I=ITHBUF(J)
579 MTN=NINT(PM(19,IXT(1,I)))
580 II=II+1
581 II=II+1
582 ENDDO
583 ENDIF
584 ENDDO
585 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
586 ALLOCATE(IWA(II))
587 II=0
588 DO N=1,NTHGRP
589 ITYP=ITHGRP(2,N)
590 NN =ITHGRP(4,N)
591 IAD =ITHGRP(5,N)
592 IF(ITYP==4)THEN
593 DO J=IAD,IAD+NN-1
594 I=ITHBUF(J)
595 MTN=NINT(PM(19,IXT(1,I)))
596 II=II+1
597 IWA(II)=IXT(NIXT,I)
598 II=II+1
599 IWA(II)=MTN
600 ENDDO
601 ENDIF
602 ENDDO
603 CALL WRTDES(IWA,IWA,II,ITFORM,0)
604 ENDIF
605C
606 IF (NSELP>0) THEN
607 II=0
608 DO N=1,NTHGRP
609 ITYP=ITHGRP(2,N)
610 NN =ITHGRP(4,N)
611 IAD =ITHGRP(5,N)
612 IF(ITYP==5)THEN
613 DO J=IAD,IAD+NN-1
614 I=ITHBUF(J)
615 MTN=NINT(PM(19,IXP(1,I)))
616 II=II+1
617 II=II+1
618 ENDDO
619 ENDIF
620 ENDDO
621 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
622 ALLOCATE(IWA(II))
623 II=0
624 DO N=1,NTHGRP
625 ITYP=ITHGRP(2,N)
626 NN =ITHGRP(4,N)
627 IAD =ITHGRP(5,N)
628 IF(ITYP==5)THEN
629 DO J=IAD,IAD+NN-1
630 I=ITHBUF(J)
631 MTN=NINT(PM(19,IXP(1,I)))
632 II=II+1
633 IWA(II)=IXP(NIXP,I)
634 II=II+1
635 IWA(II)=MTN
636 ENDDO
637 ENDIF
638 ENDDO
639
640 CALL WRTDES(IWA,IWA,II,ITFORM,0)
641 ENDIF
642C
643 IF (NSELR>0) THEN
644 II=0
645 DO N=1,NTHGRP
646 ITYP=ITHGRP(2,N)
647 NN =ITHGRP(4,N)
648 IAD =ITHGRP(5,N)
649 IF(ITYP==6)THEN
650 DO J=IAD,IAD+NN-1
651 I=ITHBUF(J)
652 II=II+1
653 II=II+1
654 ENDDO
655 ELSEIF(ITYP==100) THEN
656 DO J=IAD,IAD+NN-1
657 I=ITHBUF(J)
658 II=II+1
659 II=II+1
660 ENDDO
661 ENDIF
662 ENDDO
663 IF(ALLOCATED(IWA)) DEALLOCATE(IWA)
664 ALLOCATE(IWA(II))
665 II=0
666 DO N=1,NTHGRP
667 ITYP=ITHGRP(2,N)
668 NN =ITHGRP(4,N)
669 IAD =ITHGRP(5,N)
670 IF(ITYP==6)THEN
671 DO J=IAD,IAD+NN-1
672 I=ITHBUF(J)
673 II=II+1
674 IWA(II)=IXR(NIXR,I)
675 II=II+1
676 IWA(II)=0
677 ENDDO
678 ELSEIF(ITYP==100) THEN
679 DO J=IAD,IAD+NN-1
680 I=ITHBUF(J)
681 II=II+1
682 IWA(II)=ITHBUF(J+2*NN)
683 II=II+1
684 IWA(II)=0
685 ENDDO
686 ENDIF
687 ENDDO
688 CALL WRTDES(IWA,IWA,II,ITFORM,0)
689 ENDIF
690C
691 RETURN
692 END
my_real
#define my_real
Definition cppsort.cpp:32
hist13
subroutine hist13(iparg, ixs, ixq, ixc, ixt, ixp, ixr, itab, pm, npby, ixtg, irfe, laccelm, ipari, ipart, ithgrp, ithbuf, chrun_old, names_and_titles)
Definition hist13.F:42
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
names_and_titles_mod::names_and_titles_
Definition names_and_titles_mod.F:1016