Rozgrzebany SCCOR dla wham-M
[unres.git] / source / wham / src-M / bxread.F
1       subroutine bxread(nazwa,islice,ii,jj,kk,ll,mm,iR,ib,iparm)
2       implicit none
3       include "DIMENSIONS"
4       include "DIMENSIONS.ZSCOPT"
5       include "DIMENSIONS.FREE"
6 #ifdef MPI
7       include "mpif.h"
8       integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
9       include "COMMON.MPI"
10 #endif
11       include "COMMON.CHAIN"
12       include "COMMON.IOUNITS"
13       include "COMMON.PROTFILES"
14       include "COMMON.NAMES"
15       include "COMMON.VAR"
16       include "COMMON.GEO"
17       include "COMMON.ENEPS"
18       include "COMMON.PROT"
19       include "COMMON.INTERACT"
20       include "COMMON.FREE"
21       include "COMMON.SBRIDGE"
22       real*4 csingle(3,maxres2)
23       character*64 nazwa,bprotfile_temp
24       character*3 liczba
25       integer i,is,ie,j,ii,jj,k,kk,l,ll,mm,if
26       integer nrec,nlines,iscor,islice
27       double precision energ
28       integer ilen,iroof
29       external ilen,iroof
30       double precision rmsdev,energia(0:max_ene),efree,eini,temp
31       double precision prop(maxQ)
32       integer ntot_all(0:maxprocs-1)
33       integer iparm,ib,iib,ir,nprop,nthr,nrec_slice
34       double precision etot,time
35       logical lerr
36       nrec_slice=(rec_end(iR,ib,iparm)-rec_start(iR,ib,iparm)+1)/nslice
37       is=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice
38       ie=rec_start(iR,ib,iparm)+islice*nrec_slice-1
39       write (iout,*) "bxread: islice",islice," nslice",nslice,
40      & " nrec_slice",nrec_slice
41       write (iout,*) "is",is," ie",ie,"rec_start",
42      &  rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm)
43       do i=is,ie
44             read(ientin,rec=i+1,err=101) 
45      &        ((csingle(l,k),l=1,3),k=1,nres),
46      &        ((csingle(l,k+nres),l=1,3),k=nnt,nct),
47      &        nss,(ihpb(k),jhpb(k),k=1,nss),
48      &        eini,efree,rmsdev,(prop(j),j=1,nQ),iscor
49             ii=ii+1
50             kk=kk+1
51             if (mod(kk,isampl(iparm)).eq.0) then
52             jj=jj+1
53             write(ientout,rec=jj)
54      &        ((csingle(l,k),l=1,3),k=1,nres),
55      &        ((csingle(l,k+nres),l=1,3),k=nnt,nct),
56      &        nss,(ihpb(k),jhpb(k),k=1,nss),
57      &        eini,efree,rmsdev,(prop(j),j=1,nQ),iR,ib,iparm
58 #ifdef DEBUG
59             do i=1,2*nres
60               do j=1,3
61                 c(j,i)=csingle(j,i)
62               enddo
63             enddo
64             call int_from_cart1(.false.)
65             write (iout,*) "Writing conformation, record",jj
66             write (iout,*) "Cartesian coordinates"
67             write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
68             write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
69             write (iout,*) "Internal coordinates"
70             write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
71             write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
72             write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
73             write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
74             write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
75             write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
76             write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
77             write (iout,'(f10.5,i5)') rmsdev,iscor
78 #endif
79             endif
80           enddo
81   101     continue
82           close(ientin)
83           write (iout,*) ii," conformations read from DA file ",
84      &      nazwa(:ilen(nazwa))
85           write (iout,*) kk," conformations read so far, slice",islice
86           write (iout,*) jj," conformations stored so far, slice",islice
87
88       return
89       end