dist1cut wham & cluster
[unres.git] / source / wham / src-M / molread_zs.F
index 3480671..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
 
@@ -385,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)       
@@ -438,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
@@ -528,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
 
@@ -568,6 +655,7 @@ c    &                       constr_homology
               ii=ii+1
               l_homo(k,ii)=.false.
             endif
+           endif
             enddo
           enddo
         lim_odl=ii
@@ -720,6 +808,9 @@ c
          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,
@@ -762,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----------------------------------------------------------------------