arcos = 0.5D0*(PI-DSIGN(1.0D0,X)*PI)
[unres.git] / source / wham / src / xread.F
1       subroutine xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm)
2       implicit none
3       include "DIMENSIONS"
4       include "DIMENSIONS.ZSCOPT"
5       include "DIMENSIONS.FREE"
6       integer MaxTraj
7       parameter (MaxTraj=2050)
8 #ifdef MPI
9       include "mpif.h"
10       integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
11       include "COMMON.MPI"
12 #endif
13       include "COMMON.CHAIN"
14       include "COMMON.IOUNITS"
15       include "COMMON.PROTFILES"
16       include "COMMON.NAMES"
17       include "COMMON.VAR"
18       include "COMMON.GEO"
19       include "COMMON.ENEPS"
20       include "COMMON.PROT"
21       include "COMMON.INTERACT"
22       include "COMMON.FREE"
23       include "COMMON.SBRIDGE"
24       include "COMMON.OBCINKA"
25       real*4 csingle(3,maxres2)
26       character*64 nazwa
27       character*128 bprotfile_temp
28       integer i,j,k,l,ii,jj(maxslice),kk(maxslice),ll(maxslice),
29      &  mm(maxslice)
30       integer iscor,islice,islice1,slice
31       double precision energ
32       integer ilen,iroof
33       external ilen,iroof
34       double precision rmsdev,energia(0:max_ene),efree,eini,temp
35       double precision prop(maxQ)
36       integer ntot_all(0:maxprocs-1)
37       integer iparm,ib,iib,ir,nprop,nthr
38       double precision etot,time,ts(maxslice),te(maxslice)
39       integer is(maxslice),ie(maxslice),itraj,ntraj,it,iset
40       integer nstep(0:MaxTraj-1)
41       logical lerr
42
43       call set_slices(is,ie,ts,te,iR,ib,iparm)
44       do i=1,nQ
45         prop(i)=0.0d0
46       enddo
47       do i=0,MaxTraj-1
48         nstep(i)=0
49       enddo
50       ntraj=0
51       it=0
52       islice1=1
53       call opentmp(islice1,ientout,bprotfile_temp)
54       do while (.true.)
55         if (replica(iparm)) then
56           if (hamil_rep .or. umbrella(iparm)) then
57           read (ientin,*,end=1112,err=1112) time,eini,
58      &      etot,temp,nss,(ihpb(j),jhpb(j),j=1,nss),
59      &      nprop,(prop(j),j=1,nprop),iset
60           else
61           read (ientin,*,end=1112,err=1112) time,eini,
62      &      etot,temp,nss,(ihpb(j),jhpb(j),j=1,nss),
63      &      nprop,(prop(j),j=1,nprop)
64           endif
65           temp=1.0d0/(temp*1.987D-3)
66 c           write (iout,*) time,eini,etot,nss,
67 c     &     (ihpb(j),jhpb(j),j=1,nss),(prop(j),j=1,nprop)
68 c           call flush(iout)
69            do i=1,nT_h(iparm)
70              if (beta_h(i,iparm).eq.temp) then
71                iib = i
72                goto 22
73              endif
74            enddo
75   22       continue
76            if (i.gt.nT_h(iparm)) then
77              write (iout,*) "Error - temperature of conformation",
78      &       ii,1.0d0/(temp*1.987D-3),
79      &       " does not match any of the list"
80              write (iout,*)
81      &        1.0d0/(temp*1.987D-3),
82      &        (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm))
83              call flush(iout)
84              call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
85            endif
86         else
87            read (ientin,*,end=1112,err=1112) time,eini,
88      &       etot,nss,(ihpb(j),jhpb(j),j=1,nss),
89      &       nprop,(prop(j),j=1,nprop)
90              iib = ib
91         endif
92         itraj=mod(it,totraj(iR,iparm))
93 c        write (*,*) "ii",ii," itraj",itraj
94 c        call flush(iout)
95         it=it+1
96         if (itraj.gt.ntraj) ntraj=itraj
97         nstep(itraj)=nstep(itraj)+1
98         islice=slice(nstep(itraj),time,is,ie,ts,te)
99         read (ientin,'(8f10.5)',end=1112,err=1112)
100      &    ((csingle(l,k),l=1,3),k=1,nres),
101      &    ((csingle(l,k+nres),l=1,3),k=nnt,nct)
102         efree=0.0d0
103         if (islice.gt.0 .and. islice.le.nslice) then
104         ii=ii+1
105         kk(islice)=kk(islice)+1
106         mm(islice)=mm(islice)+1
107         if (mod(nstep(itraj),isampl(iparm)).eq.0) then
108         jj(islice)=jj(islice)+1
109         if (hamil_rep) then
110           snk(iR,iib,iset,islice)=snk(iR,iib,iset,islice)+1
111         else if (umbrella(iparm)) then
112           snk(iset,iib,iparm,islice)=snk(iset,iib,iparm,islice)+1
113         else
114           snk(iR,iib,iparm,islice)=snk(iR,iib,iparm,islice)+1
115         endif
116         ll(islice)=ll(islice)+1
117 c         write (iout,*) ii,kk,jj,ll,eini,(prop(j),j=1,nprop)
118 #ifdef DEBUG
119 c        write (iout,*) "Writing conformation, record",ll(islice)
120 c        write (iout,*) "ib",ib," iib",iib
121          if (replica(iparm)) then 
122            write (iout,*) "TEMP",1.0d0/(temp*1.987D-3)
123            write (iout,*) "TEMP list"
124            write (iout,*) 
125      &      (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm))
126          endif
127          call flush(iout)
128 #endif
129 c         write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ
130 c         write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss
131 c         write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4
132 c         call flush(iout)
133          if (islice.ne.islice1) then
134 c             write (iout,*) "islice",islice," islice1",islice1
135              close(ientout)
136 c             write (iout,*) "Closing file ",
137 c     &             bprotfile_temp(:ilen(bprotfile_temp))
138              call opentmp(islice,ientout,bprotfile_temp)
139 c             write (iout,*) "Opening file ",
140 c     &             bprotfile_temp(:ilen(bprotfile_temp))
141 c             call flush(iout)
142              islice1=islice
143          endif
144          write(ientout,rec=ll(islice)) 
145      &     ((csingle(l,k),l=1,3),k=1,nres),
146      &     ((csingle(l,k+nres),l=1,3),k=nnt,nct),
147      &     nss,(ihpb(k),jhpb(k),k=1,nss),
148      &     eini,efree,rmsdev,(prop(i),i=1,nQ),iR,iib,iparm
149 #ifdef DEBUG
150          do i=1,2*nres
151            do j=1,3
152              c(j,i)=csingle(j,i)
153            enddo
154          enddo
155          call int_from_cart1(.false.)
156          write (iout,*) "Writing conformation, record",ll(islice)
157          write (iout,*) "Cartesian coordinates"
158          write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
159          write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
160          write (iout,*) "Internal coordinates"
161          write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
162          write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
163          write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
164          write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
165          write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
166          write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
167          write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
168 c         write (iout,'(8f10.5)') (prop(j),j=1,nQ)
169          write (iout,'(16i5)') iscor
170          call flush(iout)
171 #endif
172          endif
173          endif
174        enddo
175  1112  continue
176        close(ientout)
177        write (iout,'(i10," trajectories found in file.")') ntraj+1
178        write (iout,'(a)') "Numbers of steps in trajectories:"
179        write (iout,'(8i10)') (nstep(i),i=0,ntraj)
180        write (iout,*) ii," conformations read from file",
181      &   nazwa(:ilen(nazwa))
182        write (iout,*) mm(islice)," conformations read so far, slice",
183      &    islice
184        write (iout,*) ll(islice)," conformations stored so far, slice",
185      &   islice
186        call flush(iout)
187        return
188        end