Merge branch 'lipid' of mmka.chem.univ.gda.pl:unres into lipid

[unres.git] / source / wham / src-NEWSC-NEWCORR / bxread.F

diff --git a/source/wham/src-NEWSC-NEWCORR/bxread.F b/source/wham/src-NEWSC-NEWCORR/bxread.F
new file mode 100644 (file)
index 0000000..c459499
--- /dev/null
+++ b/source/wham/src-NEWSC-NEWCORR/bxread.F
@@ -0,0 +1,89 @@
+      subroutine bxread(nazwa,islice,ii,jj,kk,ll,mm,iR,ib,iparm)
+      implicit none
+      include "DIMENSIONS"
+      include "DIMENSIONS.ZSCOPT"
+      include "DIMENSIONS.FREE"
+#ifdef MPI
+      include "mpif.h"
+      integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
+      include "COMMON.MPI"
+#endif
+      include "COMMON.CHAIN"
+      include "COMMON.IOUNITS"
+      include "COMMON.PROTFILES"
+      include "COMMON.NAMES"
+      include "COMMON.VAR"
+      include "COMMON.GEO"
+      include "COMMON.ENEPS"
+      include "COMMON.PROT"
+      include "COMMON.INTERACT"
+      include "COMMON.FREE"
+      include "COMMON.SBRIDGE"
+      real*4 csingle(3,maxres2)
+      character*64 nazwa,bprotfile_temp
+      character*3 liczba
+      integer i,is,ie,j,ii,jj,k,kk,l,ll,mm,if
+      integer nrec,nlines,iscor,islice
+      double precision energ
+      integer ilen,iroof
+      external ilen,iroof
+      double precision rmsdev,energia(0:max_ene),efree,eini,temp
+      double precision prop(maxQ)
+      integer ntot_all(0:maxprocs-1)
+      integer iparm,ib,iib,ir,nprop,nthr,nrec_slice
+      double precision etot,time
+      logical lerr
+      nrec_slice=(rec_end(iR,ib,iparm)-rec_start(iR,ib,iparm)+1)/nslice
+      is=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice
+      ie=rec_start(iR,ib,iparm)+islice*nrec_slice-1
+      write (iout,*) "bxread: islice",islice," nslice",nslice,
+     & " nrec_slice",nrec_slice
+      write (iout,*) "is",is," ie",ie,"rec_start",
+     &  rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm)
+      do i=is,ie
+            read(ientin,rec=i+1,err=101) 
+     &        ((csingle(l,k),l=1,3),k=1,nres),
+     &        ((csingle(l,k+nres),l=1,3),k=nnt,nct),
+     &        nss,(ihpb(k),jhpb(k),k=1,nss),
+     &        eini,efree,rmsdev,(prop(j),j=1,nQ),iscor
+            ii=ii+1
+            kk=kk+1
+            if (mod(kk,isampl(iparm)).eq.0) then
+            jj=jj+1
+            write(ientout,rec=jj)
+     &        ((csingle(l,k),l=1,3),k=1,nres),
+     &        ((csingle(l,k+nres),l=1,3),k=nnt,nct),
+     &        nss,(ihpb(k),jhpb(k),k=1,nss),
+     &        eini,efree,rmsdev,(prop(j),j=1,nQ),iR,ib,iparm
+#ifdef DEBUG
+            do i=1,2*nres
+              do j=1,3
+                c(j,i)=csingle(j,i)
+              enddo
+            enddo
+            call int_from_cart1(.false.)
+            write (iout,*) "Writing conformation, record",jj
+            write (iout,*) "Cartesian coordinates"
+            write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
+            write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
+            write (iout,*) "Internal coordinates"
+            write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
+            write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
+            write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
+            write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
+            write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
+            write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
+            write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
+            write (iout,'(f10.5,i5)') rmsdev,iscor
+#endif
+            endif
+          enddo
+  101     continue
+          close(ientin)
+          write (iout,*) ii," conformations read from DA file ",
+     &      nazwa(:ilen(nazwa))
+          write (iout,*) kk," conformations read so far, slice",islice
+          write (iout,*) jj," conformations stored so far, slice",islice
+
+      return
+      end