module io_database !----------------------------------------------------------------------------- use names use wham_data use io_units use io_base, only:ilen use energy_data, only:nnt,nct,nss,ihpb,jhpb,iset use geometry_data, only:nres,c #ifdef MPI use MPI_data ! include "COMMON.MPI" #endif implicit none !----------------------------------------------------------------------------- ! ! !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- ! readrtns.F !------------------------------------------------------------------------------- subroutine opentmp(islice,iunit,bprotfile_temp) ! implicit none ! include "DIMENSIONS" ! include "DIMENSIONS.ZSCOPT" ! include "DIMENSIONS.FREE" ! use MPI_data, only:me #ifdef MPI include "mpif.h" integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) ! include "COMMON.MPI" #endif ! include "COMMON.IOUNITS" ! include "COMMON.PROTFILES" ! include "COMMON.PROT" ! include "COMMON.FREE" character(len=64) :: bprotfile_temp character(len=3) :: liczba,liczba2 character(len=2) :: liczba1 integer :: iunit,islice ! integer ilen,iroof ! external ilen,iroof ! logical :: lerr ! integer :: lenrec,lenrec2 !el ! lenrec2=12*(nres+nct-nnt+1)+4*(2*nss+2)+24+8*nQ ! lenrec=lenrec2+8 write (liczba1,'(bz,i2.2)') islice #ifdef MPI write (liczba,'(bz,i3.3)') me !#ifdef MPI ! write (iout,*) "separate_parset ",separate_parset, ! & " myparm",myparm if (separate_parset) then write (liczba2,'(bz,i3.3)') myparm bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// & prefix(:ilen(prefix))//liczba//"_"//liczba2//".xbin.tmp"//liczba1 open (iunit,file=bprotfile_temp,status="unknown",& form="unformatted",access="direct",recl=lenrec) else bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// & prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1 open (iunit,file=bprotfile_temp,status="unknown",& form="unformatted",access="direct",recl=lenrec) endif #else bprotfile_temp = scratchdir(:ilen(scratchdir))// & "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1 open (iunit,file=bprotfile_temp,status="unknown",& form="unformatted",access="direct",recl=lenrec) #endif ! write (iout,*) "OpenTmp iunit",iunit," bprotfile_temp", ! & bprotfile_temp ! call flush(iout) return end subroutine opentmp !------------------------------------------------------------------------------- subroutine read_database(*) ! use energy_data, only:nct,nnt,nss ! implicit none ! include "DIMENSIONS" ! include "DIMENSIONS.ZSCOPT" ! include "DIMENSIONS.FREE" use MPI_data, only:me,nprocs #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(kind=4) :: csingle(3,nres*2) !(3,maxres2) character(len=64) :: nazwa,bprotfile_temp character(len=3) :: liczba character(len=2) :: liczba1 integer :: i,j,ii,jj(nslice),k,kk(nslice),l,& ll(nslice),mm(nslice),if integer :: nrec,nlines,iscor,iunit,islice real(kind=8) :: energ ! integer ilen,iroof ! external ilen,iroof real(kind=8) :: rmsdev,energia(0:n_ene),efree,eini,temp !el real(kind=8) :: rmsdev,energia(0:max_eneW),efree,eini,temp real(kind=8) :: prop(nQ) !(maxQ) integer :: ntot_all(nslice,0:nprocs-1)!(maxslice,0:maxprocs-1) integer :: iparm,ib,iib,ir,nprop,nthr,npars real(kind=8) :: etot,time integer :: ixdrf,iret logical :: lerr,linit lenrec1=12*(nres+nct-nnt+1)+4*(2*nss+2)+24 lenrec2=12*(nres+nct-nnt+1)+4*(2*nss+2)+24+8*nQ lenrec=lenrec2+8 write (iout,*) "lenrec",lenrec," lenrec1",lenrec1,& " lenrec2",lenrec2 do i=1,nQ prop(i)=0.0d0 enddo do islice=1,nslice ll(islice)=0 mm(islice)=0 enddo write (iout,*) "nparmset",nparmset if (hamil_rep) then npars=1 else npars=nparmset endif do iparm=1,npars if (replica(iparm)) then nthr = 1 else nthr = nT_h(iparm) endif do ib=1,nthr do iR=1,nRR(ib,iparm) write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ do islice=1,nslice jj(islice)=0 kk(islice)=0 enddo IF (NFILE_BIN(iR,ib,iparm).GT.0) THEN ! Read conformations from binary DA files (one per batch) and write them to ! a binary DA scratchfile. write (liczba,'(bz,i3.3)') me do if=1,nfile_bin(iR,ib,iparm) nazwa=protfiles(if,1,iR,ib,iparm) & (:ilen(protfiles(if,1,iR,ib,iparm)))//".bx" open (ientin,file=nazwa,status="old",form="unformatted",& access="direct",recl=lenrec2,err=1111) ii=0 do islice=1,nslice call opentmp(islice,ientout,bprotfile_temp) call bxread(nazwa,islice,ii,jj(islice),kk(islice),ll(islice),& mm(islice),iR,ib,iparm) close(ientout) enddo close(ientin) enddo ENDIF ! NFILE_BIN>0 ! IF (NFILE_ASC(iR,ib,iparm).GT.0) THEN ! Read conformations from multiple ASCII int files and write them to a binary ! DA scratchfile. do if=1,nfile_asc(iR,ib,iparm) nazwa=protfiles(if,2,iR,ib,iparm) & (:ilen(protfiles(if,2,iR,ib,iparm)))//".x" open(unit=ientin,file=nazwa,status='old',err=1111) write(iout,*) "reading ",nazwa(:ilen(nazwa)) ii=0 call xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm) enddo ! if ENDIF IF (NFILE_CX(iR,ib,iparm).gt.0) THEN ! Read conformations from cx files and write them to a binary ! DA scratchfile. do if=1,nfile_cx(iR,ib,iparm) nazwa=protfiles(if,2,iR,ib,iparm) & (:ilen(protfiles(if,2,iR,ib,iparm)))//".cx" write(iout,*) "reading ",nazwa(:ilen(nazwa)) ii=0 print *,"Calling cxread" call cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm,& *1111) write(iout,*)"after call cxread" close(ientout) write (iout,*) "exit cxread" call flush(iout) enddo ENDIF write(iout,*)"*********************in read database" do islice=1,nslice ! stot(islice)=0 stot(islice)=stot(islice)+jj(islice) enddo enddo enddo write (iout,*) "IPARM",iparm enddo if (nslice.eq.1) then #ifdef MPI write (liczba,'(bz,i3.3)') me bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// & prefix(:ilen(prefix))//liczba//".xbin.tmp" #else bprotfile_temp = scratchdir(:ilen(scratchdir))// & "/"//prefix(:ilen(prefix))//".xbin.tmp" #endif write(iout,*) mm(1)," conformations read",ll(1),& " conformations written to ",& bprotfile_temp(:ilen(bprotfile_temp)) else do islice=1,nslice write (liczba1,'(bz,i2.2)') islice #ifdef MPI write (liczba,'(bz,i3.3)') me bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// & prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1 #else bprotfile_temp = scratchdir(:ilen(scratchdir))// & "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1 #endif write(iout,*) mm(islice)," conformations read",ll(islice),& " conformations written to ",& bprotfile_temp(:ilen(bprotfile_temp)) enddo endif #ifdef MPI ! Check if everyone has the same number of conformations call MPI_Allgather(stot(1),nslice,MPI_INTEGER,& ntot_all(1,0),nslice,MPI_INTEGER,MPI_Comm_World,IERROR) lerr=.false. do i=0,nprocs-1 if (i.ne.me) then do islice=1,nslice if (stot(islice).ne.ntot_all(islice,i)) then write (iout,*) "Number of conformations at processor",i,& " differs from that at processor",me,& stot(islice),ntot_all(islice,i)," slice",islice lerr = .true. endif enddo endif enddo if (lerr) then write (iout,*) write (iout,*) "Numbers of conformations read by processors" write (iout,*) do i=0,nprocs-1 write (iout,'(8i10)') i,(ntot_all(islice,i),islice=1,nslice) enddo write (iout,*) "Calculation terminated." call flush(iout) return 1 endif do islice=1,nslice ntot(islice)=stot(islice) enddo write(iout,*) "end of read database" return #endif 1111 write(iout,*) "Error opening coordinate file ",nazwa(:ilen(nazwa)) call flush(iout) return 1 end subroutine read_database !-------------------------------------------------------------------------------- integer function iroof(n,m) integer :: n,m,ii ii = n/m if (ii*m .lt. n) ii=ii+1 iroof = ii return end function iroof !-------------------------------------------------------------------------------- ! bxread.F !-------------------------------------------------------------------------------- subroutine bxread(nazwa,islice,ii,jj,kk,ll,mm,iR,ib,iparm) ! implicit none ! include "DIMENSIONS" ! include "DIMENSIONS.ZSCOPT" ! include "DIMENSIONS.FREE" ! use energy_data, only:nnt,nct,nss,ihpb,jhpbi use MPI_data, only:nprocs #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" real(kind=4) :: csingle(3,nres*2) !(3,maxres2) character(len=64) :: nazwa,bprotfile_temp character(len=3) :: liczba integer :: i,is,ie,j,ii,jj,k,kk,l,ll,mm,if integer :: nrec,nlines,iscor,islice real(kind=8) :: energ ! integer ilen,iroof ! external ilen,iroof real(kind=8) :: rmsdev,energia(0:n_ene),efree,eini,temp !el real(kind=8) :: rmsdev,energia(0:max_eneW),efree,eini,temp real(kind=8) :: prop(nQ) !(maxQ) integer :: ntot_all(0:nprocs-1)!(0:maxprocs-1) integer :: iparm,ib,iib,ir,nprop,nthr,nrec_slice real(kind=8) :: etot,time logical :: lerr nrec_slice=(rec_end(iR,ib,iparm)-rec_start(iR,ib,iparm)+1)/nslice is=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice ie=rec_start(iR,ib,iparm)+islice*nrec_slice-1 write (iout,*) "bxread: islice",islice," nslice",nslice,& " nrec_slice",nrec_slice write (iout,*) "is",is," ie",ie,"rec_start",& rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm) do i=is,ie read(ientin,rec=i+1,err=101) & ((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(j),j=1,nQ),iscor ii=ii+1 kk=kk+1 if (mod(kk,isampl(iparm)).eq.0) then jj=jj+1 write(ientout,rec=jj) & ((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(j),j=1,nQ),iR,ib,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",jj 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) write (iout,'(f10.5,i5)') rmsdev,iscor #endif endif enddo 101 continue close(ientin) write (iout,*) ii," conformations read from DA file ",& nazwa(:ilen(nazwa)) write (iout,*) kk," conformations read so far, slice",islice write (iout,*) jj," conformations stored so far, slice",islice return end subroutine bxread !-------------------------------------------------------------------------------- ! cxread.F !-------------------------------------------------------------------------------- subroutine cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm,*) #define DEBUG #ifdef DEBUG use geometry, only:int_from_cart1 use geometry_data, only:vbld,rad2deg,theta,phi,alph,omeg integer :: iscor #endif ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' ! include 'DIMENSIONS.ZSCOPT' ! include 'DIMENSIONS.FREE' integer,parameter :: MaxTraj=2050 ! include 'COMMON.CHAIN' ! include 'COMMON.INTERACT' ! include 'COMMON.NAMES' ! include 'COMMON.IOUNITS' ! include 'COMMON.HEADER' ! include 'COMMON.SBRIDGE' ! include 'COMMON.PROTFILES' ! include 'COMMON.OBCINKA' ! include 'COMMON.FREE' ! include 'COMMON.VAR' ! include 'COMMON.GEO' ! include 'COMMON.PROT' character(len=64) :: nazwa,bprotfile_temp real(kind=4) :: rtime,rpotE,ruconst,rt_bath,rprop(nQ) !(2000) !(maxQ) real(kind=8) :: time integer :: iret,itmp,itraj,ntraj real(kind=4) :: xoord(3,2*nres+2),prec integer :: nstep(0:MaxTraj-1) ! integer ilen ! external ilen integer :: ii,jj(nslice),kk(nslice),ll(nslice),mm(nslice) !(maxslice) integer :: is(nSlice),ie(nSlice),nrec_slice real(kind=8) :: ts(nSlice),te(nSlice),time_slice integer :: iR,ib,iparm,i,j,it,islice,nprop_prev integer :: k,l,iib,islice1,nprop real(kind=8) :: efree,rmsdev integer :: ixdrf !el integer :: slice ! logical :: conf_check ! ixdrf=0 ! nprop=0 ! ruconst=0.0d0 ! rtime=0.0d0 ! rpotE=0.0d0 ! rt_bath=0.0d0 call set_slices(is,ie,ts,te,iR,ib,iparm) nprop_prev=0 do i=1,nQ rprop(i)=0.0d0 enddo do i=0,MaxTraj-1 nstep(i)=0 enddo ntraj=0 it=0 iret=1 #if (defined(AIX) && !defined(JUBL)) call xdrfopen_(ixdrf,nazwa, "r", iret) #else call xdrfopen(ixdrf,nazwa, "r", iret) #endif if (iret.eq.0) return 1 islice1=1 call opentmp(islice1,ientout,bprotfile_temp) print *,"bumbum" !d do while (iret.gt.0) #if (defined(AIX) && !defined(JUBL)) call xdrffloat_(ixdrf, rtime, iret) print *,"rtime",rtime," iret",iret !d call xdrffloat_(ixdrf, rpotE, iret) write (iout,*) "rpotE",rpotE," iret",iret !d call flush(iout) call xdrffloat_(ixdrf, ruconst, iret) call xdrffloat_(ixdrf, rt_bath, iret) call xdrfint_(ixdrf, nss, iret) do j=1,nss call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) enddo call xdrfint_(ixdrf, nprop, iret) if (umbrella(iparm) .or. read_iset(iparm) .or. hamil_rep) & call xdrfint(ixdrf, iset, iret) do i=1,nprop call xdrffloat_(ixdrf, rprop(i), iret) enddo #else call xdrffloat(ixdrf, rtime, iret) call xdrffloat(ixdrf, rpotE, iret) write (iout,*) "rpotE",rpotE," iret",iret !d call flush(iout) call xdrffloat(ixdrf, ruconst, iret) call xdrffloat(ixdrf, rt_bath, iret) call xdrfint(ixdrf, nss, iret) do j=1,nss call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) enddo call xdrfint(ixdrf, nprop, iret) write (iout,*) "nprop",nprop !d if (it.gt.0 .and. nprop.ne.nprop_prev) then write (iout,*) "Warning previous nprop",nprop_prev,& " current",nprop nprop=nprop_prev else nprop_prev=nprop endif call flush(iout) if (umbrella(iparm) .or. read_iset(iparm) .or. hamil_rep) & call xdrfint(ixdrf, iset, iret) do i=1,nprop call xdrffloat(ixdrf, rprop(i), iret) enddo #endif if (iret.eq.0) exit itraj=mod(it,totraj(iR,iparm)) #define DEBUG #ifdef DEBUG write (iout,*) "ii",ii," itraj",itraj," it",it #endif if (iset.eq.0) iset = 1 call flush(iout) it=it+1 if (itraj.gt.ntraj) ntraj=itraj nstep(itraj)=nstep(itraj)+1 ! rprop(2)=dsqrt(rprop(2)) ! rprop(3)=dsqrt(rprop(3)) #ifdef DEBUG write (iout,*) "umbrella ",umbrella write (iout,*) rtime,rpotE,rt_bath,nss,& (ihpb(j),jhpb(j),j=1,nss),(rprop(j),j=1,nprop) write (iout,*) "nprop",nprop," iset",iset," myparm",myparm call flush(iout) #endif prec=10000.0 itmp=0 #if (defined(AIX) && !defined(JUBL)) call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret) #else call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret) #endif #ifdef DEBUG write (iout,'(10f8.3)') ((xoord(j,i),j=1,3),i=1,2*nres+2) #endif #undef DEBUG if (iret.eq.0) exit if (itmp .ne. nres + nct - nnt + 1) then write (iout,*) "Error: inconsistent sizes",itmp,nres+nct-nnt+1 call flush(iout) exit endif time=rtime write (iout,*) "calling slice" !d call flush(iout) !d islice=slice(nstep(itraj),time,is,ie,ts,te) write (iout,*) "islice",islice !d call flush(iout) !d do i=1,nres do j=1,3 c(j,i)=xoord(j,i) enddo enddo do i=1,nct-nnt+1 do j=1,3 c(j,i+nres+nnt-1)=xoord(j,i+nres) enddo enddo if (islice.gt.0 .and. islice.le.nslice .and. (.not.separate_parset & .or. iset.eq.myparm)) then ii=ii+1 kk(islice)=kk(islice)+1 mm(islice)=mm(islice)+1 if (mod(nstep(itraj),isampl(iparm)).eq.0 .and. & conf_check(ll(islice)+1,1)) then if (replica(iparm)) then rt_bath=1.0d0/(rt_bath*1.987D-3) do i=1,nT_h(iparm) if (abs(real(beta_h(i,iparm))-rt_bath).lt.1.0e-4) 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/(rt_bath*1.987D-3),& " does not match any of the list" write (iout,*) & 1.0d0/(rt_bath*1.987D-3),& (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) call flush(iout) ! exit ! call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) ii=ii-1 kk(islice)=kk(islice)-1 mm(islice)=mm(islice)-1 goto 112 endif else iib = ib endif efree=0.0d0 jj(islice)=jj(islice)+1 if (umbrella(iparm)) then snk(iset,iib,iparm,islice)=snk(iset,iib,iparm,islice)+1 else if (hamil_rep) then snk(1,iib,iparm,islice)=snk(1,iib,iparm,islice)+1 else snk(iR,iib,iparm,islice)=snk(iR,iib,iparm,islice)+1 endif ll(islice)=ll(islice)+1 #ifdef DEBUG write (iout,*) "Writing conformation, record",ll(islice) write (iout,*) "ib",ib," iib",iib write (iout,*) "ntraj",ntraj," itraj",itraj,& " nstep",nstep(itraj) write (iout,*) "pote",rpotE," time",rtime ! if (replica(iparm)) then ! write (iout,*) "TEMP",1.0d0/(rt_bath*1.987D-3) ! write (iout,*) "TEMP list" ! write (iout,*) ! & (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) ! endif write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ ! write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss ! write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4 call flush(iout) #endif if (islice.ne.islice1) then ! write (iout,*) "islice",islice," islice1",islice1 close(ientout) ! write (iout,*) "Closing file ", ! & bprotfile_temp(:ilen(bprotfile_temp)) call opentmp(islice,ientout,bprotfile_temp) ! write (iout,*) "Opening file ", ! & bprotfile_temp(:ilen(bprotfile_temp)) islice1=islice endif if (umbrella(iparm)) then write(ientout,rec=ll(islice)) & ((xoord(l,k),l=1,3),k=1,nres),& ((xoord(l,k),l=1,3),k=nres+1,nres+nct-nnt+1),& nss,(ihpb(k),jhpb(k),k=1,nss),& rpotE+0.0d0,efree,rmsdev,(rprop(i)+0.0d0,i=1,nQ),& iset,iib,iparm else if (hamil_rep) then write(ientout,rec=ll(islice)) & ((xoord(l,k),l=1,3),k=1,nres),& ((xoord(l,k),l=1,3),k=nres+1,nres+nct-nnt+1),& nss,(ihpb(k),jhpb(k),k=1,nss),& rpotE+0.0d0,efree,rmsdev,(rprop(i)+0.0d0,i=1,nQ),& iR,iib,iset else write(ientout,rec=ll(islice)) & ((xoord(l,k),l=1,3),k=1,nres),& ((xoord(l,k),l=1,3),k=nres+1,nres+nct-nnt+1),& nss,(ihpb(k),jhpb(k),k=1,nss),& rpotE+0.0d0,efree,rmsdev,(rprop(i)+0.0d0,i=1,nQ),& iR,iib,iparm endif #ifdef DEBUG 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) ! write (iout,'(8f10.5)') (rprop(j),j=1,nQ) write (iout,'(16i5)') iscor call flush(iout) #endif endif endif 112 continue enddo close(ientout) #if (defined(AIX) && !defined(JUBL)) call xdrfclose_(ixdrf, iret) #else call xdrfclose(ixdrf, iret) #endif 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)) do islice=1,nslice write (iout,*) mm(islice)," conformations read so far, slice",& islice write (iout,*) ll(islice),& " conformations stored so far, slice",islice enddo call flush(iout) #undef DEBUG return end subroutine cxread !-------------------------------------------------------------------------------- ! xread.F !-------------------------------------------------------------------------------- subroutine xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm) use geometry_data ! implicit none ! include "DIMENSIONS" ! include "DIMENSIONS.ZSCOPT" ! include "DIMENSIONS.FREE" use MPI_data, only:nprocs #ifdef MPI include "mpif.h" integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) ! include "COMMON.MPI" #endif integer,parameter :: MaxTraj=2050 ! 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(kind=4) :: csingle(3,nres*2) character(len=64) :: nazwa,bprotfile_temp integer :: i,j,k,l,ii,jj(nslice),kk(nslice),ll(nslice),& mm(nslice) !(maxslice) integer :: iscor,islice,islice1 !el,slice real(kind=8) :: energ ! integer ilen,iroof ! external ilen,iroof real(kind=8) :: rmsdev,energia(0:n_ene),efree,eini,temp !el real(kind=8) :: rmsdev,energia(0:max_eneW),efree,eini,temp real(kind=8) :: prop(nQ) !(maxQ) integer :: ntot_all(0:nprocs-1)!(0:maxprocs-1) integer :: iparm,ib,iib,ir,nprop,nthr real(kind=8) :: etot,time,ts(nslice),te(nslice) integer :: is(nslice),ie(nslice),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) ! write (iout,*) time,eini,etot,nss, ! & (ihpb(j),jhpb(j),j=1,nss),(prop(j),j=1,nprop) ! 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) #ifdef MPI call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) #endif 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)) ! write (*,*) "ii",ii," itraj",itraj ! 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 ! write (iout,*) ii,kk,jj,ll,eini,(prop(j),j=1,nprop) #ifdef DEBUG ! write (iout,*) "Writing conformation, record",ll(islice) ! 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 ! write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ ! write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss ! write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4 ! call flush(iout) if (islice.ne.islice1) then ! write (iout,*) "islice",islice," islice1",islice1 close(ientout) ! write (iout,*) "Closing file ", ! & bprotfile_temp(:ilen(bprotfile_temp)) call opentmp(islice,ientout,bprotfile_temp) ! write (iout,*) "Opening file ", ! & bprotfile_temp(:ilen(bprotfile_temp)) ! 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) ! 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 subroutine xread !-------------------------------------------------------------------------------- ! enecalc1.F !-------------------------------------------------------------------------------- subroutine write_dbase(islice,*) use geometry_data use control_data, only:indpdb use w_compar_data use conform_compar, only:conf_compar ! implicit none ! include "DIMENSIONS" ! include "DIMENSIONS.ZSCOPT" ! include "DIMENSIONS.FREE" ! include "DIMENSIONS.COMPAR" use geometry, only:int_from_cart1 #ifdef MPI include "mpif.h" integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) ! include "COMMON.MPI" #endif ! include "COMMON.CONTROL" ! include "COMMON.CHAIN" ! include "COMMON.IOUNITS" ! include "COMMON.PROTFILES" ! include "COMMON.NAMES" ! include "COMMON.VAR" ! include "COMMON.SBRIDGE" ! include "COMMON.GEO" ! include "COMMON.FFIELD" ! include "COMMON.ENEPS" ! include "COMMON.LOCAL" ! include "COMMON.WEIGHTS" ! include "COMMON.INTERACT" ! include "COMMON.FREE" ! include "COMMON.ENERGIES" ! include "COMMON.COMPAR" ! include "COMMON.PROT" ! include "COMMON.CONTACTS1" character(len=64) :: nazwa character(len=80) :: bxname,cxname character(len=64) :: bprotfile_temp character(len=3) :: liczba,licz character(len=2) :: licz2 integer :: i,itj,ii,iii,j,k,l integer :: ixdrf,iret integer :: iscor,islice real(kind=8) :: rmsdev,efree,eini real(kind=4) :: csingle(3,nres*2) real(kind=8) :: energ ! integer ilen,iroof ! external ilen,iroof integer :: ir,ib,iparm integer :: isecstr(nres) write (licz2,'(bz,i2.2)') islice call opentmp(islice,ientout,bprotfile_temp) write (iout,*) "bprotfile_temp ",bprotfile_temp call flush(iout) if (.not.bxfile .and. .not. cxfile .and. indpdb.eq.0 & .and. ensembles.eq.0) then close(ientout,status="delete") return endif #ifdef MPI write (liczba,'(bz,i3.3)') me if (bxfile .or. cxfile .or. ensembles.gt.0) then if (.not.separate_parset) then bxname = prefix(:ilen(prefix))//liczba//".bx" else write (licz,'(bz,i3.3)') myparm bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx" endif open (ientin,file=bxname,status="unknown",& form="unformatted",access="direct",recl=lenrec1) endif #else if (bxfile .or. cxfile .or. ensembles.gt.0) then if (nslice.eq.1) then bxname = prefix(:ilen(prefix))//".bx" else bxname = prefix(:ilen(prefix))// & "_slice_"//licz2//".bx" endif open (ientin,file=bxname,status="unknown",& form="unformatted",access="direct",recl=lenrec1) write (iout,*) "Calculating energies; writing geometry",& " and energy components to ",bxname(:ilen(bxname)) endif #if (defined(AIX) && !defined(JUBL)) call xdrfopen_(ixdrf,cxname, "w", iret) #else call xdrfopen(ixdrf,cxname, "w", iret) #endif if (iret.eq.0) then write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname)) cxfile=.false. endif !el endif #endif if (indpdb.gt.0) then if (nslice.eq.1) then #ifdef MPI if (.not.separate_parset) then statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot)) & //liczba//'.stat' else write (licz,'(bz,i3.3)') myparm statname=prefix(:ilen(prefix))//'_par'//licz//'_'// & pot(:ilen(pot))//liczba//'.stat' endif #else statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//'.stat' #endif else #ifdef MPI if (.not.separate_parset) then statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))// & "_slice_"//licz2//liczba//'.stat' else write (licz,'(bz,i3.3)') myparm statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))// & '_par'//licz//"_slice_"//licz2//liczba//'.stat' endif #else statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot)) & //"_slice_"//licz2//'.stat' #endif endif open(istat,file=statname,status="unknown") endif #ifdef MPI do i=1,scount(me) #else do i=1,ntot(islice) #endif read(ientout,rec=i,err=101) & ((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,(q(k,i),k=1,nQ),iR,ib,iparm ! write (iout,*) iR,ib,iparm,eini,efree do j=1,2*nres do k=1,3 c(k,j)=csingle(k,j) enddo enddo call int_from_cart1(.false.) iscore=0 ! write (iout,*) "Calling conf_compar",i ! call flush(iout) anatemp= 1.0d0/(beta_h(ib,iparm)*1.987D-3) if (indpdb.gt.0) then call conf_compar(i,.false.,.true.) ! else ! call elecont(.false.,ncont,icont,nnt,nct) ! call secondary2(.false.,.false.,ncont,icont,isecstr) endif ! write (iout,*) "Exit conf_compar",i ! call flush(iout) if (bxfile .or.cxfile .or. ensembles.gt.0) write (ientin,rec=i) & ((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),& ! & potE(i,iparm),-entfac(i),rms_nat,iscore potE(i,nparmset),-entfac(i),rms_nat,iscore ! write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i) #ifndef MPI if (cxfile) call cxwrite(ixdrf,csingle,potE(i,nparmset),& -entfac(i),rms_nat,iscore) #endif enddo close(ientout,status="delete") close(istat) if (bxfile .or. cxfile .or. ensembles.gt.0) close(ientin) #ifdef MPI call MPI_Barrier(WHAM_COMM,IERROR) if (me.ne.Master .or. .not.bxfile .and. .not. cxfile & .and. ensembles.eq.0) return write (iout,*) if (bxfile .or. ensembles.gt.0) then if (nslice.eq.1) then if (.not.separate_parset) then bxname = prefix(:ilen(prefix))//".bx" else write (licz,'(bz,i3.3)') myparm bxname = prefix(:ilen(prefix))//"_par"//licz//".bx" endif else if (.not.separate_parset) then bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx" else write (licz,'(bz,i3.3)') myparm bxname = prefix(:ilen(prefix))//"par_"//licz// & "_slice_"//licz2//".bx" endif endif open (ientout,file=bxname,status="unknown",& form="unformatted",access="direct",recl=lenrec1) write (iout,*) "Master is creating binary database ",& bxname(:ilen(bxname)) endif if (cxfile) then if (nslice.eq.1) then if (.not.separate_parset) then cxname = prefix(:ilen(prefix))//".cx" else cxname = prefix(:ilen(prefix))//"_par"//licz//".cx" endif else if (.not.separate_parset) then cxname = prefix(:ilen(prefix))// & "_slice_"//licz2//".cx" else cxname = prefix(:ilen(prefix))//"_par"//licz// & "_slice_"//licz2//".cx" endif endif #if (defined(AIX) && !defined(JUBL)) call xdrfopen_(ixdrf,cxname, "w", iret) #else call xdrfopen(ixdrf,cxname, "w", iret) #endif if (iret.eq.0) then write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname)) cxfile=.false. endif endif do j=0,nprocs-1 write (liczba,'(bz,i3.3)') j if (separate_parset) then write (licz,'(bz,i3.3)') myparm bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx" else bxname = prefix(:ilen(prefix))//liczba//".bx" endif open (ientin,file=bxname,status="unknown",& form="unformatted",access="direct",recl=lenrec1) write (iout,*) "Master is reading conformations from ",& bxname(:ilen(bxname)) iii = 0 ! write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j) ! call flush(iout) do i=indstart(j),indend(j) iii = iii+1 read(ientin,rec=iii,err=101) & ((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,iscor if (bxfile .or. ensembles.gt.0) then write (ientout,rec=i) & ((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,iscor endif if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor) #ifdef DEBUG do k=1,2*nres do l=1,3 c(l,k)=csingle(l,k) enddo enddo call int_from_cart1(.false.) write (iout,'(2i5,3e15.5)') i,iii,eini,efree write (iout,*) "The Cartesian geometry is:" write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) write (iout,*) "The internal geometry is:" 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) write (iout,'(f10.5,i5)') rmsdev,iscor #endif enddo ! i write (iout,*) iii," conformations (from",indstart(j)," to",& indend(j),") read from ",& bxname(:ilen(bxname)) close (ientin,status="delete") enddo ! j if (bxfile .or. cxfile .or. ensembles.gt.0) close (ientout) #if (defined(AIX) && !defined(JUBL)) if (cxfile) call xdrfclose_(ixdrf,cxname,iret) #else if (cxfile) call xdrfclose(ixdrf,cxname,iret) #endif #endif return 101 write (iout,*) "Error in scratchfile." call flush(iout) return 1 end subroutine write_dbase !------------------------------------------------------------------------------- subroutine cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor) ! implicit none ! include "DIMENSIONS" ! include "DIMENSIONS.ZSCOPT" ! include "DIMENSIONS.FREE" ! include "DIMENSIONS.COMPAR" #ifdef MPI include "mpif.h" integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) ! include "COMMON.MPI" #endif ! include "COMMON.CONTROL" ! include "COMMON.CHAIN" ! include "COMMON.IOUNITS" ! include "COMMON.PROTFILES" ! include "COMMON.NAMES" ! include "COMMON.VAR" ! include "COMMON.SBRIDGE" ! include "COMMON.GEO" ! include "COMMON.FFIELD" ! include "COMMON.ENEPS" ! include "COMMON.LOCAL" ! include "COMMON.WEIGHTS" ! include "COMMON.INTERACT" ! include "COMMON.FREE" ! include "COMMON.ENERGIES" ! include "COMMON.COMPAR" ! include "COMMON.PROT" integer :: i,j,itmp,iscor,iret,ixdrf real(kind=8) :: rmsdev,efree,eini real(kind=4) :: csingle(3,nres*2),xoord(3,2*nres+2) real(kind=4) :: prec ! write (iout,*) "cxwrite" ! call flush(iout) prec=10000.0 do i=1,nres do j=1,3 xoord(j,i)=csingle(j,i) enddo enddo do i=nnt,nct do j=1,3 xoord(j,nres+i-nnt+1)=csingle(j,i+nres) enddo enddo itmp=nres+nct-nnt+1 ! write (iout,*) "itmp",itmp ! call flush(iout) #if (defined(AIX) && !defined(JUBL)) call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret) ! write (iout,*) "xdrf3dfcoord" ! call flush(iout) call xdrfint_(ixdrf, nss, iret) do j=1,nss call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) enddo call xdrffloat_(ixdrf,real(eini),iret) call xdrffloat_(ixdrf,real(efree),iret) call xdrffloat_(ixdrf,real(rmsdev),iret) call xdrfint_(ixdrf,iscor,iret) #else call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret) call xdrfint(ixdrf, nss, iret) do j=1,nss call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) enddo call xdrffloat(ixdrf,real(eini),iret) call xdrffloat(ixdrf,real(efree),iret) call xdrffloat(ixdrf,real(rmsdev),iret) call xdrfint(ixdrf,iscor,iret) #endif return end subroutine cxwrite !------------------------------------------------------------------------------- ! slices.F !------------------------------------------------------------------------------- subroutine set_slices(is,ie,ts,te,iR,ib,iparm) ! implicit none ! include 'DIMENSIONS' ! include 'DIMENSIONS.ZSCOPT' ! include 'DIMENSIONS.FREE' ! include 'COMMON.IOUNITS' ! include 'COMMON.PROTFILES' ! include 'COMMON.OBCINKA' ! include 'COMMON.PROT' integer :: islice,iR,ib,iparm integer :: is(MaxSlice),ie(MaxSlice),nrec_slice real(kind=8) :: ts(MaxSlice),te(MaxSlice),time_slice do islice=1,nslice if (time_end_collect(iR,ib,iparm).ge.1.0d10) then ts(islice)=time_start_collect(iR,ib,iparm) te(islice)=time_end_collect(iR,ib,iparm) nrec_slice=(rec_end(iR,ib,iparm)- & rec_start(iR,ib,iparm)+1)/nslice is(islice)=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice ie(islice)=rec_start(iR,ib,iparm)+islice*nrec_slice-1 else time_slice=(time_end_collect(iR,ib,iparm) & -time_start_collect(iR,ib,iparm))/nslice ts(islice)=time_start_collect(iR,ib,iparm)+(islice-1)* & time_slice te(islice)=time_start_collect(iR,ib,iparm)+islice*time_slice is(islice)=rec_start(iR,ib,iparm) ie(islice)=rec_end(iR,ib,iparm) endif enddo write (iout,*) "nrec_slice",nrec_slice," time_slice",time_slice write (iout,*) "is",(is(islice),islice=1,nslice) write (iout,*) "ie",(ie(islice),islice=1,nslice) write (iout,*) "rec_start",& rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm) write (iout,*) "ts",(ts(islice),islice=1,nslice) write (iout,*) "te",(te(islice),islice=1,nslice) write (iout,*) "time_start",& time_start_collect(iR,ib,iparm)," time_end",& time_end_collect(iR,ib,iparm) call flush(iout) return end subroutine set_slices !----------------------------------------------------------------------------- integer function slice(irecord,time,is,ie,ts,te) ! implicit none ! include 'DIMENSIONS' ! include 'DIMENSIONS.ZSCOPT' ! include 'DIMENSIONS.FREE' ! include 'COMMON.IOUNITS' ! include 'COMMON.PROTFILES' ! include 'COMMON.OBCINKA' ! include 'COMMON.PROT' integer :: is(MaxSlice),ie(MaxSlice),nrec_slice real(kind=8) :: ts(MaxSlice),te(MaxSlice),time_slice integer :: i,ii,irecord real(kind=8) :: time ! write (iout,*) "within slice nslice",nslice ! call flush(iout) if (irecord.lt.is(1) .or. time.lt.ts(1)) then ii=0 else ii=1 do while (ii.le.nslice .and. & (irecord.lt.is(ii) .or. irecord.gt.ie(ii) .or. & time.lt.ts(ii) .or. time.gt.te(ii)) ) ! write (iout,*) "ii",ii,time,ts(ii) ! call flush(iout) ii=ii+1 enddo endif ! write (iout,*) "end: ii",ii ! call flush(iout) slice=ii return end function slice !----------------------------------------------------------------------------- ! enecalc1.F !----------------------------------------------------------------------------- logical function conf_check(ii,iprint) use names, only:ntyp1 use geometry_data use energy_data, only:itype,dsc use geometry, only:int_from_cart1 ! use ! include "DIMENSIONS" ! include "DIMENSIONS.ZSCOPT" ! include "DIMENSIONS.FREE" !#ifdef MPI ! use MPI_data ! include "mpif.h" ! include "COMMON.MPI" !#endif ! include "COMMON.CHAIN" ! include "COMMON.IOUNITS" ! include "COMMON.PROTFILES" ! include "COMMON.NAMES" ! include "COMMON.VAR" ! include "COMMON.SBRIDGE" ! include "COMMON.GEO" ! include "COMMON.FFIELD" ! include "COMMON.ENEPS" ! include "COMMON.LOCAL" ! include "COMMON.WEIGHTS" ! include "COMMON.INTERACT" ! include "COMMON.FREE" ! include "COMMON.ENERGIES" ! include "COMMON.CONTROL" ! include "COMMON.TORCNSTR" ! implicit none #ifdef MPI include "mpif.h" integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) #endif integer :: j,k,l,ii,itj,iprint if (.not. check_conf) then conf_check=.true. return endif call int_from_cart1(.false.) do j=nnt+1,nct if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and. & (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0)) then if (iprint.gt.0) & write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),& " for conformation",ii if (iprint.gt.1) then write (iout,*) "The Cartesian geometry is:" write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) write (iout,*) "The internal geometry is:" 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) endif if (iprint.gt.0) write (iout,*) & "This conformation WILL NOT be added to the database." conf_check=.false. return endif enddo do j=nnt,nct itj=itype(j) if (itype(j).ne.10 .and.itype(j).ne.ntyp1 .and. & (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0) then if (iprint.gt.0) & write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j),& " for conformation",ii if (iprint.gt.1) then write (iout,*) "The Cartesian geometry is:" write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) write (iout,*) "The internal geometry is:" 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) endif if (iprint.gt.0) write (iout,*) & "This conformation WILL NOT be added to the database." conf_check=.false. return endif enddo do j=3,nres if (theta(j).le.0.0d0) then if (iprint.gt.0) & write (iout,*) "Zero theta angle(s) in conformation",ii if (iprint.gt.1) then write (iout,*) "The Cartesian geometry is:" write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) write (iout,*) "The internal geometry is:" 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) endif if (iprint.gt.0) write (iout,*) & "This conformation WILL NOT be added to the database." conf_check=.false. return endif if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad enddo conf_check=.true. ! write (iout,*) "conf_check passed",ii return end function conf_check !----------------------------------------------------------------------------- end module io_database