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