Merge branch 'prerelease-3.2.1' into czarek

[unres.git] / source / xdrfpdb / src-M / xdrf2x1.f

diff --git a/source/xdrfpdb/src-M/xdrf2x1.f b/source/xdrfpdb/src-M/xdrf2x1.f
new file mode 100644 (file)
index 0000000..53f8fb0
--- /dev/null
+++ b/source/xdrfpdb/src-M/xdrf2x1.f
@@ -0,0 +1,67 @@
+      implicit real*8 (a-h,o-z)
+      integer ihpb(100),jhpb(100)
+      real*4 coord(3,1000)
+      real*4 prec,potE,efree,rmsdev,qfrag(100)
+      real*8 etot
+      character*80 arg,xfile
+      character*8 ucase,cfreq
+      external ucase
+      logical oneletter
+      integer rescode
+      external rescode
+      
+      ifreq=1
+      if (iargc().lt.2) then
+        print '(a)',
+     &    "Usage: xdrf2x1 cxfile conf [pdbfile]"
+        stop
+      endif
+      call getarg(1,arg)
+      iext = index(arg,'.cx') - 1
+      if (iext.lt.0) then
+        print *,"Error - not a cx file"
+        stop
+      endif
+      print *,"arg ",arg
+      call getarg(2,cfreq)
+      read (cfreq,*) iconf
+      print *,"iconf",iconf
+      if (iargc().gt.2) then
+        call getarg(3,pdbfile)
+      else
+        xfile=arg(:iext)//'.x'
+      endif
+      open(9,file=xfile)
+
+      call xdrfopen(ixdrf,arg, "r", iret)
+      print *,"iret",iret 
+      kk = 0
+      do while(.true.) 
+       prec=10000.0
+       isize=0
+       call xdrf3dfcoord(ixdrf, coord, isize, prec, iret)
+       call xdrfint(ixdrf, nss, iret) 
+       do j=1,nss
+        call xdrfint(ixdrf, ihpb(j), iret)
+        call xdrfint(ixdrf, jhpb(j), iret)
+       enddo
+       call xdrffloat(ixdrf, potE, iret)
+       if(iret.eq.0) exit
+       kk = kk + 1
+       call xdrffloat(ixdrf, efree, iret)
+       call xdrffloat(ixdrf, rmsdev, iret)
+       call xdrfint(ixdrf, iscor, iret)
+       if (kk.eq.iconf) then
+         print *,"pote",pote," efree",efree," rmsdev",rmsdev
+
+         print *,"isize",isize
+
+         write (9,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
+         write (9,'(i4,$)') nss,(ihpb(j),jhpb(j),j=1,nss)
+         write (9,'(i4,20f7.4)') nfrag,(qfrag(i),i=1,nfrag)
+         write (9,'(8f10.5)') ((coord(k,j),k=1,3),j=1,isize)
+         stop
+       endif
+      enddo
+     
+      end