OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hist13.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "com10_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "scr05_c.inc"
#include "scr12_c.inc"
#include "scr13_c.inc"
#include "scr17_c.inc"
#include "scrfs_c.inc"
#include "chara_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hist13 (iparg, ixs, ixq, ixc, ixt, ixp, ixr, itab, pm, npby, ixtg, irfe, laccelm, ipari, ipart, ithgrp, ithbuf, chrun_old, names_and_titles)

Function/Subroutine Documentation

◆ hist13()

subroutine hist13 ( integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(*) itab,
pm,
integer, dimension(nnpby,*) npby,
integer, dimension(nixtg,*) ixtg,
integer irfe,
integer, dimension(3,*) laccelm,
integer, dimension(npari,*) ipari,
integer, dimension(lipart1,*) ipart,
integer, dimension(nithgr,*) ithgrp,
integer, dimension(*) ithbuf,
character chrun_old,
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 38 of file hist13.F.

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 IF(nsmat/=0.AND.invstr<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
my_real
#define my_real
Definition cppsort.cpp:32
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
stri
character *8 function stri(n)
Definition stri.F:24
names_and_titles_mod::names_and_titles_
Definition names_and_titles_mod.F:1016
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
wrtdes
subroutine wrtdes(a, ia, l, iform, ir)
Definition wrtdes.F:45