Ann new file getpp3.f90.

lib/superfox/getpp3.f90

@@ -0,0 +1,22 @@
+subroutine getpp3(s3,workdat,p)
+
+  use sfox_mod
+  real s3(NQ,NN)
+  integer workdat(NN)
+  integer a(NN)
+
+!  a(1:NN)=workdat(NN:1:-1)
+  a=workdat
+
+  psum=0.
+  do j=1,NN
+     i=a(j)+1
+     x=s3(i,j)
+     s3(i,j)=0.
+     psum=psum + x
+     s3(i,j)=x
+  enddo
+  p=psum/NN
+
+  return
+end subroutine getpp3