1      subroutine dia_report_file(opt,fil,lfn)
2c
3c $Id$
4c
5      implicit none
6c
7#include "dia_common.fh"
8#include "dia_params.fh"
9#include "mafdecls.fh"
10c
11      character*8 opt
12      character*255 fil
13      integer lfn
14c
15      integer i,j,num,numi,numj
16      integer i_ii,l_ii,i_ic,l_ic
17      integer i_ji,l_ji,i_jc,l_jc,i_jr,l_jr
18c
19      if(me.ne.0) return
20c
21      if(opt.eq.'local   '.and.index(fil,'.loc').gt.0) then
22      open(unit=lfn,file=fil(1:index(fil,' ')-1))
23      rewind(lfn)
24      read(lfn,1000) num
25 1000 format(i7)
26      read(lfn,1000) numi
27      do 1 i=1,numi
28      read(lfn,1000) j
29    1 continue
30      read(lfn,1000) numj
31      if(.not.ma_push_get(mt_int,3*numi,'ii',l_ii,i_ii))
32     + call md_abort('Could not allocate ii',0)
33      if(.not.ma_push_get(mt_byte,12*numi,'ic',l_ic,i_ic))
34     + call md_abort('Could not allocate ic',0)
35      if(.not.ma_push_get(mt_int,4*numj,'ji',l_ji,i_ji))
36     + call md_abort('Could not allocate ji',0)
37      if(.not.ma_push_get(mt_byte,12*numj,'jc',l_jc,i_jc))
38     + call md_abort('Could not allocate jc',0)
39      if(.not.ma_push_get(mt_dbl,numj,'jr',l_jr,i_jr))
40     + call md_abort('Could not allocate jr',0)
41      call dia_report_loc(lfn,numi,numj,int_mb(i_ii),int_mb(i_ji),
42     + byte_mb(i_ic),byte_mb(i_jc),dbl_mb(i_jr))
43      if(.not.ma_pop_stack(l_jr))
44     + call md_abort('Failed to deallocate jr',0)
45      if(.not.ma_pop_stack(l_jc))
46     + call md_abort('Failed to deallocate jc',0)
47      if(.not.ma_pop_stack(l_ji))
48     + call md_abort('Failed to deallocate ji',0)
49      if(.not.ma_pop_stack(l_ic))
50     + call md_abort('Failed to deallocate ic',0)
51      if(.not.ma_pop_stack(l_ii))
52     + call md_abort('Failed to deallocate ii',0)
53      close(unit=lfn)
54      endif
55c
56      return
57      end
58      subroutine dia_report_loc(lfn,numi,numj,ndxi,ndxj,itxt,jtxt,tim)
59c
60      implicit none
61c
62#include "dia_common.fh"
63#include "dia_params.fh"
64c
65      integer lfn,numi,numj
66      integer ndxi(numi,3),ndxj(numj,4)
67      character*12 itxt(numi),jtxt(numj)
68      real*8 tim(numj)
69c
70      integer i,j,k,nskip,it,jt(10)
71      real*8 ctime,ptime,dtime,timi,timf
72c
73      rewind(lfn)
74      read(lfn,1000) j
75      read(lfn,1000) j
76 1000 format(i7)
77      do 1 i=1,numi
78      read(lfn,1001) (ndxi(i,j),j=1,3),itxt(i)
79 1001 format(i7,i5,i6,1x,a12)
80    1 continue
81      read(lfn,1000) j
82      do 2 i=1,numj
83      read(lfn,1001) (ndxj(i,j),j=1,3),jtxt(i)
84    2 continue
85      nskip=numi+numj+3
86c
87      do 3 i=1,numi
88      rewind(lfn)
89      do 4 j=1,nskip
90      read(lfn,1000,end=3) k
91    4 continue
92      do 6 j=1,numj
93      ndxj(j,4)=0
94      tim(j)=0.0d0
95    6 continue
96      ptime=-1.0d0
97      timi=0.0d0
98    5 continue
99      read(lfn,1002,end=11) ctime,it,(jt(k),k=1,10)
100 1002 format(f12.6,i6,10i6)
101      if(ptime.le.0.0d0) timi=ctime
102      if(timf.lt.ctime) timf=ctime
103      if(it.ne.ndxi(i,1)) goto 5
104c
105      if(ptime.ge.0.0d0) then
106      dtime=ctime-ptime
107      do 7 j=1,numj
108      if(ndxj(j,4).ne.0) tim(j)=tim(j)+dtime
109    7 continue
110      endif
111c
112      do 8 j=1,numj
113      ndxj(j,4)=0
114    8 continue
115      ptime=ctime
116c
117      do 9 k=1,10
118      if(jt(k).eq.0) goto 9
119      do 10 j=1,numj
120      if(ndxj(j,1).eq.jt(k)) ndxj(j,4)=1
121   10 continue
122    9 continue
123c
124      goto 5
125   11 continue
126c
127      dtime=ctime-ptime
128      do 12 j=1,numj
129      if(ndxj(j,4).ne.0) tim(j)=tim(j)+dtime
130   12 continue
131c
132      do 13 j=1,numj
133      if(tim(j).gt.0.0d0) then
134      write(6,1003) ndxi(i,3),itxt(i),
135     + ndxj(j,3),jtxt(j),tim(j),100.0d0*tim(j)/(timf-timi)
136 1003 format(i7,1x,a,i7,1x,a,f12.6,' ps = ',f6.2,' %')
137      endif
138   13 continue
139      write(6,1004)
140 1004 format(' ')
141c
142    3 continue
143c
144      return
145      end
146