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