X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fwham%2Fsrc-NEWSC%2Fxread.F;fp=source%2Fwham%2Fsrc-NEWSC%2Fxread.F;h=ac35de1b3af3b564453c4ff74b0434dac6064c4b;hb=8f4b74d4d25238eaf813420dc03adec7379a7f64;hp=0000000000000000000000000000000000000000;hpb=0f16e6a86d4e9cfd5c8583879b6b97a35a2f0eda;p=unres.git diff --git a/source/wham/src-NEWSC/xread.F b/source/wham/src-NEWSC/xread.F new file mode 100755 index 0000000..ac35de1 --- /dev/null +++ b/source/wham/src-NEWSC/xread.F @@ -0,0 +1,187 @@ + subroutine xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm) + implicit none + include "DIMENSIONS" + include "DIMENSIONS.ZSCOPT" + include "DIMENSIONS.FREE" + integer MaxTraj + parameter (MaxTraj=2050) +#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" + include "COMMON.OBCINKA" + real*4 csingle(3,maxres2) + character*64 nazwa,bprotfile_temp + integer i,j,k,l,ii,jj(maxslice),kk(maxslice),ll(maxslice), + & mm(maxslice) + integer iscor,islice,islice1,slice + 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 + double precision etot,time,ts(maxslice),te(maxslice) + integer is(maxslice),ie(maxslice),itraj,ntraj,it,iset + integer nstep(0:MaxTraj-1) + logical lerr + + call set_slices(is,ie,ts,te,iR,ib,iparm) + do i=1,nQ + prop(i)=0.0d0 + enddo + do i=0,MaxTraj-1 + nstep(i)=0 + enddo + ntraj=0 + it=0 + islice1=1 + call opentmp(islice1,ientout,bprotfile_temp) + do while (.true.) + if (replica(iparm)) then + if (hamil_rep .or. umbrella(iparm)) then + read (ientin,*,end=1112,err=1112) time,eini, + & etot,temp,nss,(ihpb(j),jhpb(j),j=1,nss), + & nprop,(prop(j),j=1,nprop),iset + else + read (ientin,*,end=1112,err=1112) time,eini, + & etot,temp,nss,(ihpb(j),jhpb(j),j=1,nss), + & nprop,(prop(j),j=1,nprop) + endif + temp=1.0d0/(temp*1.987D-3) +c write (iout,*) time,eini,etot,nss, +c & (ihpb(j),jhpb(j),j=1,nss),(prop(j),j=1,nprop) +c call flush(iout) + do i=1,nT_h(iparm) + if (beta_h(i,iparm).eq.temp) then + iib = i + goto 22 + endif + enddo + 22 continue + if (i.gt.nT_h(iparm)) then + write (iout,*) "Error - temperature of conformation", + & ii,1.0d0/(temp*1.987D-3), + & " does not match any of the list" + write (iout,*) + & 1.0d0/(temp*1.987D-3), + & (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) + call flush(iout) + call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) + endif + else + read (ientin,*,end=1112,err=1112) time,eini, + & etot,nss,(ihpb(j),jhpb(j),j=1,nss), + & nprop,(prop(j),j=1,nprop) + iib = ib + endif + itraj=mod(it,totraj(iR,iparm)) +c write (*,*) "ii",ii," itraj",itraj +c call flush(iout) + it=it+1 + if (itraj.gt.ntraj) ntraj=itraj + nstep(itraj)=nstep(itraj)+1 + islice=slice(nstep(itraj),time,is,ie,ts,te) + read (ientin,'(8f10.5)',end=1112,err=1112) + & ((csingle(l,k),l=1,3),k=1,nres), + & ((csingle(l,k+nres),l=1,3),k=nnt,nct) + efree=0.0d0 + if (islice.gt.0 .and. islice.le.nslice) then + ii=ii+1 + kk(islice)=kk(islice)+1 + mm(islice)=mm(islice)+1 + if (mod(nstep(itraj),isampl(iparm)).eq.0) then + jj(islice)=jj(islice)+1 + if (hamil_rep) then + snk(iR,iib,iset,islice)=snk(iR,iib,iset,islice)+1 + else if (umbrella(iparm)) then + snk(iset,iib,iparm,islice)=snk(iset,iib,iparm,islice)+1 + else + snk(iR,iib,iparm,islice)=snk(iR,iib,iparm,islice)+1 + endif + ll(islice)=ll(islice)+1 +c write (iout,*) ii,kk,jj,ll,eini,(prop(j),j=1,nprop) +#ifdef DEBUG +c write (iout,*) "Writing conformation, record",ll(islice) +c write (iout,*) "ib",ib," iib",iib + if (replica(iparm)) then + write (iout,*) "TEMP",1.0d0/(temp*1.987D-3) + write (iout,*) "TEMP list" + write (iout,*) + & (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) + endif + call flush(iout) +#endif +c write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ +c write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss +c write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4 +c call flush(iout) + if (islice.ne.islice1) then +c write (iout,*) "islice",islice," islice1",islice1 + close(ientout) +c write (iout,*) "Closing file ", +c & bprotfile_temp(:ilen(bprotfile_temp)) + call opentmp(islice,ientout,bprotfile_temp) +c write (iout,*) "Opening file ", +c & bprotfile_temp(:ilen(bprotfile_temp)) +c call flush(iout) + islice1=islice + endif + write(ientout,rec=ll(islice)) + & ((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(i),i=1,nQ),iR,iib,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",ll(islice) + 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) +c write (iout,'(8f10.5)') (prop(j),j=1,nQ) + write (iout,'(16i5)') iscor + call flush(iout) +#endif + endif + endif + enddo + 1112 continue + close(ientout) + write (iout,'(i10," trajectories found in file.")') ntraj+1 + write (iout,'(a)') "Numbers of steps in trajectories:" + write (iout,'(8i10)') (nstep(i),i=0,ntraj) + write (iout,*) ii," conformations read from file", + & nazwa(:ilen(nazwa)) + write (iout,*) mm(islice)," conformations read so far, slice", + & islice + write (iout,*) ll(islice)," conformations stored so far, slice", + & islice + call flush(iout) + return + end