1 subroutine cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm,*)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.FREE'
7 parameter (MaxTraj=2050)
9 include 'COMMON.INTERACT'
10 include 'COMMON.NAMES'
11 include 'COMMON.IOUNITS'
12 include 'COMMON.HEADER'
13 include 'COMMON.SBRIDGE'
14 include 'COMMON.PROTFILES'
15 include 'COMMON.OBCINKA'
20 character*256 nazwa,bprotfile_temp
21 real*4 rtime,rpotE,ruconst,rt_bath,rprop(maxQ)
23 integer iret,itmp,itraj,ntraj
24 real xoord(3,maxres2+2),prec
25 integer nstep(0:MaxTraj-1)
28 integer ii,jj(maxslice),kk(maxslice),ll(maxslice),mm(maxslice)
29 integer is(MaxSlice),ie(MaxSlice),nrec_slice
30 double precision ts(MaxSlice),te(MaxSlice),time_slice
33 write (iout,*) "cxread"
35 call set_slices(is,ie,ts,te,iR,ib,iparm)
36 write (iout,*) "after set_slices"
47 #if (defined(AIX) && !defined(JUBL))
48 call xdrfopen_(ixdrf,nazwa, "r", iret)
50 call xdrfopen(ixdrf,nazwa, "r", iret)
52 if (iret.eq.0) return1
55 call opentmp(islice1,ientout,bprotfile_temp)
59 #if (defined(AIX) && !defined(JUBL))
60 call xdrffloat_(ixdrf, rtime, iret)
61 c print *,"rtime",rtime," iret",iret
62 call xdrffloat_(ixdrf, rpotE, iret)
63 c write (iout,*) "rpotE",rpotE," iret",iret
65 call xdrffloat_(ixdrf, ruconst, iret)
66 call xdrffloat_(ixdrf, rt_bath, iret)
67 call xdrfint_(ixdrf, nss, iret)
70 call xdrfint(ixdrf, idssb(j), iret)
71 call xdrfint(ixdrf, jdssb(j), iret)
72 idssb(j)=idssb(j)-nres
73 jdssb(j)=jdssb(j)-nres
75 call xdrfint_(ixdrf, ihpb(j), iret)
76 call xdrfint_(ixdrf, jhpb(j), iret)
79 call xdrfint_(ixdrf, nprop, iret)
80 if (umbrella(iparm) .or. read_iset(iparm) .or. hamil_rep)
81 & call xdrfint(ixdrf, iset, iret)
83 call xdrffloat_(ixdrf, rprop(i), iret)
86 call xdrffloat(ixdrf, rtime, iret)
87 call xdrffloat(ixdrf, rpotE, iret)
88 c write (iout,*) "rpotE",rpotE," iret",iret
90 call xdrffloat(ixdrf, ruconst, iret)
91 call xdrffloat(ixdrf, rt_bath, iret)
92 call xdrfint(ixdrf, nss, iret)
93 c write (iout,*) "ruconst",ruconst," rt_bath",rt_bath," nss",nss
97 call xdrfint(ixdrf, idssb(j), iret)
98 call xdrfint(ixdrf, jdssb(j), iret)
100 call xdrfint(ixdrf, ihpb(j), iret)
101 call xdrfint(ixdrf, jhpb(j), iret)
104 call xdrfint(ixdrf, nprop, iret)
105 c write (iout,*) "nprop",nprop
106 if (it.gt.0 .and. nprop.ne.nprop_prev) then
107 write (iout,*) "Warning previous nprop",nprop_prev,
114 if (umbrella(iparm) .or. read_iset(iparm) .or. hamil_rep)
115 & call xdrfint(ixdrf, iset, iret)
117 call xdrffloat(ixdrf, rprop(i), iret)
121 itraj=mod(it,totraj(iR,iparm))
123 write (iout,*) "ii",ii," itraj",itraj," it",it
125 if (iset.eq.0) iset = 1
128 if (itraj.gt.ntraj) ntraj=itraj
129 nstep(itraj)=nstep(itraj)+1
130 c rprop(2)=dsqrt(rprop(2))
131 c rprop(3)=dsqrt(rprop(3))
133 write (iout,*) "umbrella ",umbrella
134 write (iout,*) rtime,rpotE,rt_bath,nss,
135 & (ihpb(j),jhpb(j),j=1,nss),(rprop(j),j=1,nprop)
136 write (iout,*) "nprop",nprop," iset",iset," myparm",myparm
142 #if (defined(AIX) && !defined(JUBL))
143 call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret)
145 call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret)
148 write (iout,'(10f8.3)') ((xoord(j,i),j=1,3),i=1,itmp)
151 if (itmp .ne. nres + nct - nnt + 1) then
152 write (iout,*) "Error: inconsistent sizes",itmp,nres+nct-nnt+1
158 c write (iout,*) "calling slice"
160 islice=slice(nstep(itraj),time,is,ie,ts,te)
161 c write (iout,*) "islice",islice
171 c(j,i+nres+nnt-1)=xoord(j,i+nres)
174 c write (iout,*) "Before boxshift"
178 c write (iout,*) "After oligomer"
187 xoord(j,i+nres)=c(j,i+nres+nnt-1)
191 c write (iout,*) "Before islice"
193 if (islice.gt.0 .and. islice.le.nslice .and. (.not.separate_parset
194 & .or. iset.eq.myparm)) then
196 kk(islice)=kk(islice)+1
197 mm(islice)=mm(islice)+1
199 write (iout,*) "islice",islice," ii",ii," kk",kk(islice),
201 write (iout,*) "itraj",itraj," nstep",nstep(itraj),
202 & " isampl",isampl(iparm)
205 if (mod(nstep(itraj),isampl(iparm)).eq.0 .and.
206 & conf_check(ll(islice)+1,1)) then
207 if (replica(iparm)) then
208 if (rt_bath.eq.0.0d0) then
209 write (iout,*) "ERROR: zero temperature",
210 & islice,kk(islice),mm(islice)
213 rt_bath=1.0d0/(rt_bath*1.987D-3)
215 if (abs(real(beta_h(i,iparm))-rt_bath).lt.1.0e-4) then
221 if (i.gt.nT_h(iparm)) then
222 write (iout,*) "Error - temperature of conformation",
223 & ii,1.0d0/(rt_bath*1.987D-3),
224 & " does not match any of the list"
226 & 1.0d0/(rt_bath*1.987D-3),
227 & (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm))
230 c call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
232 kk(islice)=kk(islice)-1
233 mm(islice)=mm(islice)-1
241 jj(islice)=jj(islice)+1
242 if (umbrella(iparm)) then
243 snk(iset,iib,iparm,islice)=snk(iset,iib,iparm,islice)+1
244 else if (hamil_rep) then
245 snk(1,iib,iparm,islice)=snk(1,iib,iparm,islice)+1
247 snk(iR,iib,iparm,islice)=snk(iR,iib,iparm,islice)+1
249 ll(islice)=ll(islice)+1
251 write (iout,*) "Writing conformation, record",ll(islice)
252 write (iout,*) "ib",ib," iib",iib
253 write (iout,*) "ntraj",ntraj," itraj",itraj,
254 & " nstep",nstep(itraj)
255 write (iout,*) "pote",rpotE," time",rtime
256 write (iout,*) "nss",nss
257 write (iout,*) (ihpb(k),jhpb(k),k=1,nss)
258 c if (replica(iparm)) then
259 c write (iout,*) "TEMP",1.0d0/(rt_bath*1.987D-3)
260 c write (iout,*) "TEMP list"
262 c & (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm))
264 c write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ
265 c write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss
266 c write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4
269 if (islice.ne.islice1) then
270 c write (iout,*) "islice",islice," islice1",islice1
272 c write (iout,*) "Closing file ",
273 c & bprotfile_temp(:ilen(bprotfile_temp))
274 call opentmp(islice,ientout,bprotfile_temp)
275 c write (iout,*) "Opening file ",
276 c & bprotfile_temp(:ilen(bprotfile_temp))
279 if (umbrella(iparm)) then
280 write(ientout,rec=ll(islice))
281 & ((xoord(l,k),l=1,3),k=1,nres),
282 & ((xoord(l,k),l=1,3),k=nres+1,nres+nct-nnt+1),
283 & nss,(ihpb(k),jhpb(k),k=1,nss),
284 & rpotE+0.0d0,efree,rmsdev,(rprop(i)+0.0d0,i=1,nQ),
286 else if (hamil_rep) then
287 write(ientout,rec=ll(islice))
288 & ((xoord(l,k),l=1,3),k=1,nres),
289 & ((xoord(l,k),l=1,3),k=nres+1,nres+nct-nnt+1),
290 & nss,(ihpb(k),jhpb(k),k=1,nss),
291 & rpotE+0.0d0,efree,rmsdev,(rprop(i)+0.0d0,i=1,nQ),
294 write(ientout,rec=ll(islice))
295 & ((xoord(l,k),l=1,3),k=1,nres),
296 & ((xoord(l,k),l=1,3),k=nres+1,nres+nct-nnt+1),
297 & nss,(ihpb(k),jhpb(k),k=1,nss),
298 & rpotE+0.0d0,efree,rmsdev,(rprop(i)+0.0d0,i=1,nQ),
302 call int_from_cart1(.false.)
303 write (iout,*) "Writing conformation, record",ll(islice)
304 write (iout,*) "Cartesian coordinates"
305 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
306 write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
307 write (iout,*) "Internal coordinates"
309 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
310 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
311 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
312 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
313 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
314 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
315 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
316 c write (iout,'(8f10.5)') (rprop(j),j=1,nQ)
317 write (iout,'(16i5)') iscor
327 #if (defined(AIX) && !defined(JUBL))
328 call xdrfclose_(ixdrf, iret)
330 call xdrfclose(ixdrf, iret)
332 write (iout,'(i10," trajectories found in file.")') ntraj+1
333 write (iout,'(a)') "Numbers of steps in trajectories:"
334 write (iout,'(8i10)') (nstep(i),i=0,ntraj)
335 write (iout,*) ii," conformations read from file",
336 & nazwa(:ilen(nazwa))
338 write (iout,*) mm(islice)," conformations read so far, slice",
340 write (iout,*) ll(islice),
341 & " conformations stored so far, slice",islice