1      subroutine argos_prop_stat(mdstep,stime,eww,esw,ess,esk,epme)
2c
3      implicit none
4c
5#include "argos_prop.fh"
6#include "msgids.fh"
7#include "mafdecls.fh"
8#include "global.fh"
9c
10      logical frequency
11      external frequency
12c
13      integer mdstep
14      real*8 eww(mpe,2),esw(msf,mpe,2),ess(msf,msf,mpe,2),epme
15      real*8 stime,esk(msf)
16c
17      integer i,j
18      character*10 pdate,ptime
19      real*8 facs,fact,tfacs,tfact,rt
20c
21      nsum=nsum+1
22      nsumt=nsumt+1
23      nsump=nsump+1
24      do 8 i=1,maxpro
25      if(abs(p(i)).lt.tiny) p(i)=zero
26      psum(i)=psum(i)+p(i)
27      p2sum(i)=p2sum(i)+p(i)*p(i)
28      pslop(i)=pslop(i)+stime*p(i)
29      psumt(i)=psumt(i)+p(i)
30      p2sumt(i)=p2sumt(i)+p(i)*p(i)
31      pslopt(i)=pslopt(i)+stime*p(i)
32      psump(i)=psump(i)+p(i)
33    8 continue
34      tsum=tsum+stime
35      t2sum=t2sum+stime*stime
36      tsumt=tsumt+stime
37      t2sumt=t2sumt+stime*stime
38c
39      if(frequency(mdstep,nfoutp)) then
40      if(.not.lhdr) then
41      call swatch(pdate,ptime)
42      write(lfnout,1000) pdate,ptime
43 1000 format(/,' MOLECULAR DYNAMICS TIME STEP INFORMATION',T110,2A10,//,
44     + '    Time      Temp    Pres      Volume Tscalw Tscals  Pscal ',
45     + '   U(ele)    U(vdW)      U(pot)     U(kin)     U(tot) ',/,
46     + '     ps         K      Pa        nm**3                      ',
47     + '   kJ/mol    kJ/mol      kJ/mol     kJ/mol     kJ/mol ',/)
48      if(lpstep) write(lfnout,1010)
49 1010 format(14X,
50     + '   U(bnd)     U(ang)     U(dih)     U(imp)  ',
51     + '   Ui(ele)    Ui(vdW) ',
52     + '   Uw(ele)    Uw(vdW)    U(kin)     U(pot)     U(tot)',/,14X,
53     + '   kJ/mol     kJ/mol     kJ/mol     kJ/mol  ',
54     + '   kJ/mol     kJ/mol  ',
55     + '   kJ/mol     kJ/mol     kJ/mol     kJ/mol     kJ/mol  ',/)
56      lhdr=.true.
57      endif
58      write(lfnout,1001) stime,temp,pres,volume,p(21),p(22),p(15),
59     + p(24),p(25),p(26),p(27),p(32)
60 1001 format(1x,f10.5,0pf8.2,1pe9.2,0pf10.3,3f7.4,5(1pe11.4),i5,i7)
61      if(lpstep) then
62      if(nwm.gt.0) then
63      rt=one/nwm
64      write(lfnout,1011) rt*p(56),rt*p(57),rt*p(58),rt*p(59),rt*p(52),
65     + rt*p(53),rt*p(54),rt*p(55),rt*p(64),rt*p(66),rt*p(67)
66 1011 format('   solvent  ',11f11.2)
67      endif
68      do 1 i=1,nsf
69      j=isprop+(i-1)*27
70      rt=p(j+7)+p(j+8)+p(j+9)+p(j+10)+p(j+2)+p(j+3)+p(j+5)+p(j+6)
71      write(lfnout,1012) i,p(j+7),p(j+8),p(j+9),p(j+10),
72     + p(j+2),p(j+3),p(j+5),p(j+6),p(j+16),rt,rt+p(j+16)
73 1012 format('   solute',i3,11f11.2)
74    1 continue
75      endif
76      endif
77c
78      if(frequency(mdstep,nfstat)) then
79      call swatch(pdate,ptime)
80      write(lfnout,2000) pdate,ptime,nsum,nsumt
81 2000 format(/,' MOLECULAR DYNAMICS STATISTICAL INFORMATION',t110,2a10,
82     + //,t41,2(3X,'Statistics over last ',I8,' steps',2X),/,
83     + t41,2(3X,'Average',5X,'RMS fluct',5X,'Drift/ps',3X),/)
84      facs=one/dble(nsum)
85      fact=one/dble(nsumt)
86      tfacs=one/(t2sum-facs*tsum*tsum)
87      tfact=one/(t2sumt-fact*tsumt*tsumt)
88      do 15 i=1,nprop
89      j=ixp(i)
90      if(lp(j)) write(lfnout,2001) pronam(j)(1:39),
91     + psum(j)*facs,sqrt(abs((p2sum(j)-psum(j)*psum(j)*facs)*facs)),
92     + (pslop(j)-facs*psum(j)*tsum)*tfacs,
93     + psumt(j)*fact,sqrt(abs((p2sumt(j)-psumt(j)*psumt(j)*fact)*fact)),
94     + (pslopt(j)-fact*psumt(j)*tsumt)*tfact,
95     + pronam(j)(40:50)
96 2001 format(1x,a39,t41,2(3(1pe12.5,1x),1x),a11)
97      psum(j)=zero
98      p2sum(j)=zero
99      pslop(j)=zero
100   15 continue
101      tsum=zero
102      t2sum=zero
103      nsum=0
104      lhdr=.false.
105      endif
106c
107      return
108      end
109c $Id$
110