1!$Id:$
2      subroutine pprtd
3
4!      * * F E A P * * A Finite Element Analysis Program
5
6!....  Copyright (c) 1984-2017: Regents of the University of California
7!                               All rights reserved
8
9!-----[--.----+----.----+----.-----------------------------------------]
10!      Purpose: Show current dictionary entries
11
12!      Inputs:
13!         none
14
15!      Outputs:
16!         none      - To screen/file
17!-----[--.----+----.----+----.-----------------------------------------]
18      implicit  none
19
20      include  'allotn.h'
21      include  'allotd.h'
22      include  'cdata.h'
23      include  'comfil.h'
24      include  'iofile.h'
25      include  'memuse.h'
26      include  'pdata2.h'
27
28      include  'pointer.h'
29
30      character c*1, ptype(2)*8
31      logical   skip,cinput
32      integer   i, j, ity, lines
33
34      save
35
36      data      lines /9/
37      data      ptype /' Program',' User   '/
38
39!     Output dictionary names
40
41      totimem = 0
42      totrmem = 0
43      skip   = idev.ne.1 .and. ior.lt.0
44      if(ior.lt.0) then
45        write(*,2000)
46      endif
47      write(iow,2000)
48      do j = 1,ndict,lines
49        do i = j,min(j+lines-1,ndict)
50          if(ddict(i).eq.pdict(i)) then
51            ity = 1
52          else
53            ity = 2
54          endif
55          if(ior.lt.0) then
56            write(*,2001) i,dict(i),ddict(i),iprec(i),ipoint(i)
57     &                     ,np(pdict(i)),ptype(ity)
58          endif
59          write(iow,2001) i,dict(i),ddict(i),iprec(i),ipoint(i)
60     &                     ,np(pdict(i)),ptype(ity)
61          if(iprec(i).eq.1) then
62            totimem = totimem + ipoint(i)
63          else
64            totrmem = totrmem + ipoint(i)
65          endif
66        end do ! i
67        if(skip .and. min(j+lines,ndict).ne.ndict) then
68          write(*,*) '   ** PRESS ENTER **'
69!          read(*,1000) c
70          if(.not.cinput()) then
71            write(*,*) 'CINPUT error in PPRTD'
72          end if
73          c = record(1:1)
74          write(  *,2000)
75        endif
76      end do ! j
77      if(maxuse.gt.0) then
78        if(skip) then
79          write(*,*) '   ** PRESS ENTER **'
80!          read(*,1000) c
81          if(.not.cinput()) then
82            write(*,*) 'CINPUT error in PPRTD'
83          end if
84          c = record(1:1)
85        endif
86        if(ior.lt.0) then
87          write(*,2002) totimem,totrmem,totimem+totrmem,maxuse
88        endif
89        write(iow,2002) totimem,totrmem,totimem+totrmem,maxuse
90      else
91        if(ior.lt.0) then
92          write(*,2002) totimem,totrmem
93        endif
94        write(iow,2002) totimem,totrmem
95      endif
96
97!     Formats
98
99!1000  format(a)
1002000  format(5x,'D i c t i o n a r y    o f   A r r a y s'//
101     & 10x,' Entry  Array   Array  Array    Array            Pointer'/
102     & 10x,'Number  Names  Number  Precn   Length          Value',
103     &     ' Type')
104
1052001  format(10x,i5,3x,a5,2i7,1i9,1i16,a8)
1062002  format(10x,'Total memory used by FEAP:'/
107     &       20x,'Integer Arrays = ',1i9/
108     &       20x,'Real    Arrays = ',1i9:/
109     &       20x,'Total used     = ',1i9/
110     &       20x,'Total allowed  = ',1i9)
111
112      end
113