dist1cut wham & cluster
[unres.git] / source / wham / src-M / molread_zs.F
index dee1afc..ed6a161 100644 (file)
@@ -137,6 +137,9 @@ C        enddo
       if (itype(1).eq.ntyp1) nnt=2
       if (itype(nres).eq.ntyp1) nct=nct-1
       write(iout,*) 'NNT=',NNT,' NCT=',NCT
+      write (iout,*) "calling read_saxs_consrtr",nsaxs
+      if (nsaxs.gt.0) call read_saxs_constr
+
       if (constr_homology.gt.0) then
 c       write (iout,*) "About to call read_constr_homology"
 c       call flush(iout)
@@ -324,6 +327,73 @@ c      print *,"energy",energ," iscor",iscor
       return
    10 return1
       end
+c-------------------------------------------------------------------------------
+      subroutine read_saxs_constr
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
+#ifdef MPI
+      include 'mpif.h'
+#endif
+      include 'COMMON.CONTROL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.SBRIDGE'
+      double precision cm(3)
+c      read(inp,*) nsaxs
+      write (iout,*) "Calling read_saxs nsaxs",nsaxs
+      call flush(iout)
+      if (saxs_mode.eq.0) then
+c SAXS distance distribution
+      do i=1,nsaxs
+        read(inp,*) distsaxs(i),Psaxs(i)
+      enddo
+      Cnorm = 0.0d0
+      do i=1,nsaxs
+        Cnorm = Cnorm + Psaxs(i)
+      enddo
+      write (iout,*) "Cnorm",Cnorm
+      do i=1,nsaxs
+        Psaxs(i)=Psaxs(i)/Cnorm
+      enddo
+      write (iout,*) "Normalized distance distribution from SAXS"
+      do i=1,nsaxs
+        write (iout,'(f8.2,e15.5)') distsaxs(i),Psaxs(i)
+      enddo
+      Wsaxs0=0.0d0
+      do i=1,nsaxs
+        Wsaxs0=Wsaxs0-Psaxs(i)*dlog(Psaxs(i))
+      enddo
+      write (iout,*) "Wsaxs0",Wsaxs0
+      else
+c SAXS "spheres".
+      do i=1,nsaxs
+        read (inp,'(30x,3f8.3)') (Csaxs(j,i),j=1,3)
+      enddo
+      do j=1,3
+        cm(j)=0.0d0
+      enddo
+      do i=1,nsaxs
+        do j=1,3
+          cm(j)=cm(j)+Csaxs(j,i)
+        enddo
+      enddo
+      do j=1,3
+        cm(j)=cm(j)/nsaxs
+      enddo
+      do i=1,nsaxs
+        do j=1,3
+          Csaxs(j,i)=Csaxs(j,i)-cm(j)
+        enddo
+      enddo
+      write (iout,*) "SAXS sphere coordinates"
+      do i=1,nsaxs
+        write (iout,'(i5,3f10.5)') i,(Csaxs(j,i),j=1,3)
+      enddo
+      endif
+      return
+      end
 c====-------------------------------------------------------------------
       subroutine read_constr_homology
 
@@ -339,6 +409,7 @@ c====-------------------------------------------------------------------
       include 'COMMON.IOUNITS'
       include 'COMMON.GEO'
       include 'COMMON.INTERACT'
+      include 'include_unres/COMMON.NAMES'
       include 'COMMON.HOMRESTR'
 c
 c For new homol impl
@@ -359,13 +430,15 @@ c    &    sigma_odl_temp(maxres,maxres,max_template)
       logical lprn /.true./
       integer ilen
       external ilen
-      logical unres_pdb
+      logical unres_pdb,liiflag
 c
 c     FP - Nov. 2014 Temporary specifications for new vars
 c
-      double precision rescore_tmp,x12,y12,z12,rescore2_tmp
+      double precision rescore_tmp,x12,y12,z12,rescore2_tmp,
+     &                 rescore3_tmp
       double precision, dimension (max_template,maxres) :: rescore
       double precision, dimension (max_template,maxres) :: rescore2
+      double precision, dimension (max_template,maxres) :: rescore3
       character*24 tpl_k_rescore
 c -----------------------------------------------------------------
 c Reading multiple PDB ref structures and calculation of retraints
@@ -382,6 +455,7 @@ c Alternative: reading from input
       call reada(controlcard,"HOMOL_SCD",waga_d,1.0d0) ! new
       call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) ! for diff ways of calc sigma
       call reada(controlcard,'DIST2_CUT',dist2_cut,9999.0d0)
+      dist1cut=(index(controlcard,'DIST1CUT').gt.0)
       call readi(controlcard,"HOMOL_SET",homol_nset,1)
       read2sigma=(index(controlcard,'READ2SIGMA').gt.0)
       call readi(controlcard,"IHSET",ihset,1)       
@@ -410,8 +484,6 @@ cd      call flush(iout)
 c
 c  New
 c
-      lim_theta=0
-      lim_xx=0
 c
 c  Reading HM global scores (prob not required)
 c
@@ -437,6 +509,10 @@ c521  continue
       enddo
 c     write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
 
+      if (read_homol_frag) then
+        call read_klapaucjusz
+      else
+
       do k=1,constr_homology
 
         read(inp,'(a)') pdbfile
@@ -462,7 +538,7 @@ c
         tpl_k_rescore="template"//kic2//".sco"
 
         unres_pdb=.false.
-        call readpdb
+        call readpdb_template(k)
 cref        do i=1,2*nres
 cref          do j=1,3
 cref            crefjlee(j,i)=c(j,i)
@@ -494,14 +570,18 @@ c
 c         write(iout,*) "tpl_k_rescore - ",tpl_k_rescore
           open (ientin,file=tpl_k_rescore,status='old')
           if (nnt.gt.1) rescore(k,1)=0.0d0
-          do irec=nnt,maxdim ! loop for reading res sim 
+          do irec=nnt,nct ! loop for reading res sim 
             if (read2sigma) then
              read (ientin,*,end=1401) i_tmp,rescore2_tmp,rescore_tmp,
-     &                                idomain_tmp
+     &                                rescore3_tmp,idomain_tmp
              i_tmp=i_tmp+nnt-1
              idomain(k,i_tmp)=idomain_tmp
              rescore(k,i_tmp)=rescore_tmp
              rescore2(k,i_tmp)=rescore2_tmp
+             rescore3(k,i_tmp)=rescore3_tmp
+             write(iout,'(a7,i5,3f10.5,i5)') "rescore",
+     &                      i_tmp,rescore2_tmp,rescore_tmp,
+     &                                rescore3_tmp,idomain_tmp
             else
              idomain(k,irec)=1
              read (ientin,*,end=1401) rescore_tmp
@@ -523,7 +603,19 @@ c           write(iout,*) "rescore(",k,irec,") =",rescore(k,irec)
               z12=c(3,i)-c(3,j)
               distal=dsqrt(x12*x12+y12*y12+z12*z12) 
 c              write (iout,*) k,i,j,distal,dist2_cut
-
+           if (dist1cut .and. k.gt.1) then
+              ii=ii+1
+              if (l_homo(1,ii)) then
+                ii_in_use(ii)=1
+                l_homo(k,ii)=.true.
+                ires_homo(ii)=i
+                jres_homo(ii)=j
+                odl(k,ii)=distal
+                sigma_odl(k,ii)=sigma_odl(1,ii)
+              else
+                l_homo(k,ii)=.false.
+              endif   
+           else
             if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0
      &            .and. distal.le.dist2_cut ) then
 
@@ -563,6 +655,7 @@ c    &                       constr_homology
               ii=ii+1
               l_homo(k,ii)=.false.
             endif
+           endif
             enddo
           enddo
         lim_odl=ii
@@ -601,7 +694,8 @@ c           write (iout,'(i5,10(2f8.2,4x))') i,sigma_dih(k,i)
 c           sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)*
 c                          rescore(k,i-2)*rescore(k,i-3)  !  right expression ?
 c   Instead of res sim other local measure of b/b str reliability possible
-            sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i))
+            if (sigma_dih(k,i).ne.0)
+     &       sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i))
 c           sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i)
           enddo
           lim_dih=nct-nnt-2 
@@ -633,14 +727,14 @@ c            read (ientin,*) sigma_theta(k,i) ! 1st variant
              sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+
      &                        rescore(k,i-2))/3.0
 c             if (read2sigma) sigma_theta(k,i)=sigma_theta(k,i)/3.0
-             sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i))
+             if (sigma_theta(k,i).ne.0)
+     &       sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i))
 
 c            sigma_theta(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)*
 c                             rescore(k,i-2) !  right expression ?
 c            sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i)
           enddo
         endif
-        lim_theta=nct-nnt-1 
 
         if (waga_d.gt.0.0d0) then
 c       open (ientin,file=tpl_k_sigma_d,status='old')
@@ -666,15 +760,14 @@ c              write (iout,*) "xxtpl(",k,i,") =",xxtpl(k,i)
 c              write (iout,*) "yytpl(",k,i,") =",yytpl(k,i)
 c              write (iout,*) "zztpl(",k,i,") =",zztpl(k,i)
 c              write(iout,*)  "rescore(",k,i,") =",rescore(k,i)
-               sigma_d(k,i)=rescore(k,i) !  right expression ?
-               sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i))
+               sigma_d(k,i)=rescore3(k,i) !  right expression ?
+               if (sigma_d(k,i).ne.0)
+     &          sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i))
 
 c              sigma_d(k,i)=hmscore(k)*rescore(k,i) !  right expression ?
 c              sigma_d(k,i)=sigma_d(k,i)*sigma_d(k,i)
 c              read (ientin,*) sigma_d(k,i) ! 1st variant
-               if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1 ! right?
           enddo
-          lim_xx=nct-nnt+1 
         endif
       enddo
 c
@@ -683,26 +776,41 @@ c shift data in all arrays
 c
       if (waga_dist.ne.0.0d0) then
         ii=0
+        liiflag=.true.
         do i=nnt,nct-2 
          do j=i+2,nct 
           ii=ii+1
-          if (ii_in_use(ii).eq.0) then 
-             do ki=ii,lim_odl-1
-              ires_homo(ki)=ires_homo(ki+1)
-              jres_homo(ki)=jres_homo(ki+1)
-              ii_in_use(ki)=ii_in_use(ki+1)
+          if (ii_in_use(ii).eq.0.and.liiflag) then
+            liiflag=.false.
+            iistart=ii
+          endif
+          if (ii_in_use(ii).ne.0.and..not.liiflag.or.
+     &                   .not.liiflag.and.ii.eq.lim_odl) then
+             if (ii.eq.lim_odl) then
+              iishift=ii-iistart+1
+             else
+              iishift=ii-iistart
+             endif
+             liiflag=.true.
+             do ki=iistart,lim_odl-iishift
+              ires_homo(ki)=ires_homo(ki+iishift)
+              jres_homo(ki)=jres_homo(ki+iishift)
+              ii_in_use(ki)=ii_in_use(ki+iishift)
               do k=1,constr_homology
-               odl(k,ki)=odl(k,ki+1)
-               sigma_odl(k,ki)=sigma_odl(k,ki+1)
-               l_homo(k,ki)=l_homo(k,ki+1)
+               odl(k,ki)=odl(k,ki+iishift)
+               sigma_odl(k,ki)=sigma_odl(k,ki+iishift)
+               l_homo(k,ki)=l_homo(k,ki+iishift)
               enddo
              enddo
-             ii=ii-1
-             lim_odl=lim_odl-1
+             ii=ii-iishift
+             lim_odl=lim_odl-iishift
           endif
          enddo
         enddo
       endif
+
+      endif ! .not. klapaucjusz
+
       if (constr_homology.gt.0) call homology_partition
       if (constr_homology.gt.0) call init_int_table
 cd      write (iout,*) "homology_partition: lim_theta= ",lim_theta,
@@ -723,17 +831,19 @@ cd      write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
      &  ki=1,constr_homology)
        enddo
        write (iout,*) "Dihedral angle restraints from templates"
-       do i=nnt+3,lim_dih
-        write (iout,'(i5,100(2f8.2,4x))') i,(rad2deg*dih(ki,i),
+       do i=nnt+3,nct
+        write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)),
+     &      (rad2deg*dih(ki,i),
      &      rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology)
        enddo
        write (iout,*) "Virtual-bond angle restraints from templates"
-       do i=nnt+2,lim_theta
-        write (iout,'(i5,100(2f8.2,4x))') i,(rad2deg*thetatpl(ki,i),
+       do i=nnt+2,nct
+        write (iout,'(i5,a4,100(2f8.2,4x))') i,restyp(itype(i)),
+     &      (rad2deg*thetatpl(ki,i),
      &      rad2deg/dsqrt(sigma_theta(ki,i)),ki=1,constr_homology)
        enddo
        write (iout,*) "SC restraints from templates"
-       do i=nnt,lim_xx
+       do i=nnt,nct
         write(iout,'(i5,100(4f8.2,4x))') i,
      &  (xxtpl(ki,i),yytpl(ki,i),zztpl(ki,i),
      &   1.0d0/dsqrt(sigma_d(ki,i)),ki=1,constr_homology)
@@ -743,3 +853,265 @@ c -----------------------------------------------------------------
       return
       end
 c----------------------------------------------------------------------
+      subroutine read_klapaucjusz
+
+      include 'DIMENSIONS'
+      include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
+#ifdef MPI
+      include 'mpif.h'
+#endif
+      include 'COMMON.SETUP'
+      include 'COMMON.CONTROL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.INTERACT'
+      include 'COMMON.NAMES'
+      include 'COMMON.HOMRESTR'
+      character*256 fragfile
+      integer ninclust(maxclust),inclust(max_template,maxclust),
+     &  nresclust(maxclust),iresclust(maxres,maxclust)
+
+      character*2 kic2
+      character*24 model_ki_dist, model_ki_angle
+      character*500 controlcard
+      integer ki, i, j, k, l, ii_in_use(maxdim),i_tmp,idomain_tmp
+      integer idomain(max_template,maxres)
+      logical lprn /.true./
+      integer ilen
+      external ilen
+      logical unres_pdb,liiflag
+c
+c
+      double precision rescore_tmp,x12,y12,z12,rescore2_tmp
+      double precision, dimension (max_template,maxres) :: rescore
+      double precision, dimension (max_template,maxres) :: rescore2
+      character*24 tpl_k_rescore
+
+c
+c For new homol impl
+c
+      include 'COMMON.VAR'
+c
+      double precision chomo(3,maxres2+2,max_template)
+      call getenv("FRAGFILE",fragfile) 
+      open(ientin,file=fragfile,status="old",err=10)
+      read(ientin,*) constr_homology,nclust
+      l_homo = .false.
+      sigma_theta=0.0
+      sigma_d=0.0
+      sigma_dih=0.0
+c Read pdb files 
+      do k=1,constr_homology 
+        read(ientin,'(a)') pdbfile
+        write (iout,'(a,5x,a)') 'KLAPAUCJUSZ: Opening PDB file',
+     &  pdbfile(:ilen(pdbfile))
+        open(ipdbin,file=pdbfile,status='old',err=33)
+        goto 34
+  33    write (iout,'(a,5x,a)') 'Error opening PDB file',
+     &  pdbfile(:ilen(pdbfile))
+        stop
+  34    continue
+        unres_pdb=.false.
+        call readpdb_template(k)
+        do i=1,2*nres
+          do j=1,3
+            chomo(j,i,k)=c(j,i)
+          enddo
+        enddo
+        do i=1,nres
+          rescore(k,i)=0.2d0
+          rescore2(k,i)=1.0d0
+        enddo
+      enddo
+c Read clusters
+      do i=1,nclust
+        read(ientin,*) ninclust(i),nresclust(i)
+        read(ientin,*) (inclust(k,i),k=1,ninclust(i))
+        read(ientin,*) (iresclust(k,i),k=1,nresclust(i))
+      enddo
+c
+c Loop over clusters
+c
+      do l=1,nclust
+        do ll = 1,ninclust(l)
+        
+        k = inclust(ll,l)
+        do i=1,nres
+          idomain(k,i)=0
+        enddo
+        do i=1,nresclust(l)
+          if (nnt.gt.1)  then
+            idomain(k,iresclust(i,l)+1) = 1
+          else
+            idomain(k,iresclust(i,l)) = 1
+          endif
+        enddo
+c
+c     Distance restraints
+c
+c          ... --> odl(k,ii)
+C Copy the coordinates from reference coordinates (?)
+        do i=1,2*nres
+          do j=1,3
+            c(j,i)=chomo(j,i,k)
+c           write (iout,*) "c(",j,i,") =",c(j,i)
+          enddo
+        enddo
+        call int_from_cart1(.false.)
+        call int_from_cart(.true.,.false.)
+        call sc_loc_geom(.false.)
+        do i=1,nres
+          thetaref(i)=theta(i)
+          phiref(i)=phi(i)
+        enddo
+        if (waga_dist.ne.0.0d0) then
+          ii=0
+          do i = nnt,nct-2 
+            do j=i+2,nct 
+
+              x12=c(1,i)-c(1,j)
+              y12=c(2,i)-c(2,j)
+              z12=c(3,i)-c(3,j)
+              distal=dsqrt(x12*x12+y12*y12+z12*z12) 
+c              write (iout,*) k,i,j,distal,dist2_cut
+
+            if (idomain(k,i).eq.idomain(k,j).and.idomain(k,i).ne.0
+     &            .and. distal.le.dist2_cut ) then
+
+              ii=ii+1
+              ii_in_use(ii)=1
+              l_homo(k,ii)=.true.
+
+c             write (iout,*) "k",k
+c             write (iout,*) "i",i," j",j," constr_homology",
+c    &                       constr_homology
+              ires_homo(ii)=i
+              jres_homo(ii)=j
+              odl(k,ii)=distal
+              if (read2sigma) then
+                sigma_odl(k,ii)=0
+                do ik=i,j
+                 sigma_odl(k,ii)=sigma_odl(k,ii)+rescore2(k,ik)
+                enddo
+                sigma_odl(k,ii)=sigma_odl(k,ii)/(j-i+1)
+                if (odl(k,ii).gt.dist_cut) sigma_odl(k,ii) = 
+     &        sigma_odl(k,ii)*dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+              else
+                if (odl(k,ii).le.dist_cut) then
+                 sigma_odl(k,ii)=rescore(k,i)+rescore(k,j) 
+                else
+#ifdef OLDSIGMA
+                 sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* 
+     &                      dexp(0.5d0*(odl(k,ii)/dist_cut)**2)
+#else
+                 sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* 
+     &                      dexp(0.5d0*(odl(k,ii)/dist_cut)**2-0.5d0)
+#endif
+                endif
+              endif
+              sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) 
+            else
+              ii=ii+1
+c              l_homo(k,ii)=.false.
+            endif
+            enddo
+          enddo
+        lim_odl=ii
+        endif
+c
+c     Theta, dihedral and SC retraints
+c
+        if (waga_angle.gt.0.0d0) then
+          do i = nnt+3,nct 
+            if (idomain(k,i).eq.0) then 
+c               sigma_dih(k,i)=0.0
+               cycle
+            endif
+            dih(k,i)=phiref(i)
+            sigma_dih(k,i)=(rescore(k,i)+rescore(k,i-1)+
+     &                     rescore(k,i-2)+rescore(k,i-3))/4.0
+c            write (iout,*) "k",k," l",l," i",i," rescore",rescore(k,i),
+c     &       " sigma_dihed",sigma_dih(k,i)
+            if (sigma_dih(k,i).ne.0)
+     &       sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i))
+          enddo
+          lim_dih=nct-nnt-2 
+        endif
+
+        if (waga_theta.gt.0.0d0) then
+          do i = nnt+2,nct
+             if (idomain(k,i).eq.0) then  
+c              sigma_theta(k,i)=0.0
+              cycle
+             endif
+             thetatpl(k,i)=thetaref(i)
+             sigma_theta(k,i)=(rescore(k,i)+rescore(k,i-1)+
+     &                        rescore(k,i-2))/3.0
+             if (sigma_theta(k,i).ne.0)
+     &       sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i))
+          enddo
+        endif
+
+        if (waga_d.gt.0.0d0) then
+          do i = nnt,nct
+               if (itype(i).eq.10) cycle 
+               if (idomain(k,i).eq.0 ) then 
+c                  sigma_d(k,i)=0.0
+                  cycle
+               endif
+               xxtpl(k,i)=xxref(i)
+               yytpl(k,i)=yyref(i)
+               zztpl(k,i)=zzref(i)
+               sigma_d(k,i)=rescore(k,i)
+               if (sigma_d(k,i).ne.0)
+     &          sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i))
+               if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1
+          enddo
+        endif
+      enddo ! l
+      enddo ! ll
+c
+c remove distance restraints not used in any model from the list
+c shift data in all arrays
+c
+      if (waga_dist.ne.0.0d0) then
+        ii=0
+        liiflag=.true.
+        do i=nnt,nct-2 
+         do j=i+2,nct 
+          ii=ii+1
+          if (ii_in_use(ii).eq.0.and.liiflag) then
+            liiflag=.false.
+            iistart=ii
+          endif
+          if (ii_in_use(ii).ne.0.and..not.liiflag.or.
+     &                   .not.liiflag.and.ii.eq.lim_odl) then
+             if (ii.eq.lim_odl) then
+              iishift=ii-iistart+1
+             else
+              iishift=ii-iistart
+             endif
+             liiflag=.true.
+             do ki=iistart,lim_odl-iishift
+              ires_homo(ki)=ires_homo(ki+iishift)
+              jres_homo(ki)=jres_homo(ki+iishift)
+              ii_in_use(ki)=ii_in_use(ki+iishift)
+              do k=1,constr_homology
+               odl(k,ki)=odl(k,ki+iishift)
+               sigma_odl(k,ki)=sigma_odl(k,ki+iishift)
+               l_homo(k,ki)=l_homo(k,ki+iishift)
+              enddo
+             enddo
+             ii=ii-iishift
+             lim_odl=lim_odl-iishift
+          endif
+         enddo
+        enddo
+      endif
+
+      return
+   10 stop "Error infragment file"
+      end
+c----------------------------------------------------------------------