X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fwham%2Fsrc-NEWSC%2Fconf_compar.F;fp=source%2Fwham%2Fsrc-NEWSC%2Fconf_compar.F;h=4b493452f6d06a00eb6945fe9d1e49a2a53f0fc1;hb=7308760ff07636ef6b1ee28d8c3a67a23c14b34b;hp=0000000000000000000000000000000000000000;hpb=9a54ab407f6d0d9d564d52763b3e2136450b9ffc;p=unres.git

diff --git a/source/wham/src-NEWSC/conf_compar.F b/source/wham/src-NEWSC/conf_compar.F
new file mode 100755
index 0000000..4b49345
--- /dev/null
+++ b/source/wham/src-NEWSC/conf_compar.F
@@ -0,0 +1,374 @@
+      subroutine conf_compar(jcon,lprn,print_class)
+      implicit real*8 (a-h,o-z)
+#ifdef MPI
+      include "mpif.h"
+#endif
+      include 'DIMENSIONS'
+      include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.COMPAR'
+      include 'DIMENSIONS.FREE'
+      include 'COMMON.CONTROL'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.COMPAR'
+      include 'COMMON.CHAIN' 
+      include 'COMMON.INTERACT'
+      include 'COMMON.VAR'
+      include 'COMMON.PEPTCONT'
+      include 'COMMON.CONTACTS1'
+      include 'COMMON.HEADER'
+      include 'COMMON.FREE'
+      include 'COMMON.ENERGIES'
+#ifdef MPI
+      include 'COMMON.MPI'
+#endif
+      integer ilen
+      external ilen
+      logical lprn,print_class
+      integer ncont_frag(mmaxfrag),
+     & icont_frag(2,maxcont,mmaxfrag),ncontsc,
+     & icontsc(1,maxcont),nsccont_frag(mmaxfrag),
+     & isccont_frag(2,maxcont,mmaxfrag)
+      integer isecstr(maxres)
+      integer itemp(maxfrag)
+      character*4 liczba
+      double precision Epot
+c      print *,"Enter conf_compar",jcon
+      call angnorm12(rmsang)
+c Level 1: check secondary and supersecondary structure
+      call elecont(lprn,ncont,icont,nnt,nct)
+      call secondary2(lprn,.false.,ncont,icont,isecstr)
+      call contact(lprn,ncontsc,icontsc,nnt,nct)
+      if (lprn) write(iout,*) "Assigning electrostatic contacts"
+      call contacts_between_fragments(lprn,3,ncont,icont,ncont_frag,
+     &   icont_frag)
+      if (lprn) write(iout,*) "Assigning sidechain contacts"
+      call contacts_between_fragments(lprn,3,ncontsc,icontsc,
+     &   nsccont_frag,isccont_frag)
+      do i=1,nlevel
+        do j=1,isnfrag(nlevel+1)
+          iclass(j,i)=0
+        enddo
+      enddo
+      do j=1,nfrag(1)
+        ind = icant(j,j)
+        if (lprn) then
+          write (iout,'(80(1h=))') 
+          write (iout,*) "Level",1," fragment",j
+          write (iout,'(80(1h=))') 
+        endif
+        rmsfrag(j,1)=rmscalc(0,1,j,jcon,lprn)
+c Compare electrostatic contacts in the current conf with that in the native
+c structure.
+        if (lprn) write (iout,*) 
+     &    "Comparing electrostatic contact map and local structure" 
+        ncnat=ncont_frag_ref(ind)
+c        write (iout,*) "before match_contact:",nc_fragm(j,1),
+c     &   nc_req_setf(j,1)
+        call match_secondary(j,isecstr,nsec_match,lprn)
+        if (lprn) write (iout,*) "Fragment",j," nsec_match",
+     &    nsec_match," length",len_frag(j,1)," min_len",
+     &    frac_sec*len_frag(j,1)
+        if (nsec_match.lt.frac_sec*len_frag(j,1)) then
+          iclass(j,1)=0
+          if (lprn) write (iout,*) "Fragment",j,
+     &      " has incorrect secondary structure"
+        else
+          iclass(j,1)=1
+          if (lprn) write (iout,*) "Fragment",j,
+     &      " has correct secondary structure"
+        endif
+        if (ielecont(j,1).gt.0) then
+          call match_contact(ishif1,ishif2,nc_match,ncon_match,
+     &      ncont_frag_ref(ind),icont_frag_ref(1,1,ind),
+     &      ncont_frag(ind),icont_frag(1,1,ind),
+     &      j,n_shift(1,j,1),n_shift(2,j,1),nc_fragm(j,1),
+     &      nc_req_setf(j,1),istruct(j),.true.,lprn)
+        else if (isccont(j,1).gt.0) then
+          call match_contact(ishif1,ishif2,nc_match,ncon_match,
+     &      nsccont_frag_ref(ind),isccont_frag_ref(1,1,ind),
+     &      nsccont_frag(ind),isccont_frag(1,1,ind),
+     &      j,n_shift(1,j,1),n_shift(2,j,1),nc_fragm(j,1),
+     &      nc_req_setf(j,1),istruct(j),.true.,lprn)
+        else if (iloc(j).gt.0) then
+c          write (iout,*) "n_shif",n_shift(1,j,1),n_shift(2,j,1)
+          call match_contact(ishif1,ishif2,nc_match,ncon_match,
+     &      0,icont_frag_ref(1,1,ind),
+     &      ncont_frag(ind),icont_frag(1,1,ind),
+     &      j,n_shift(1,j,1),n_shift(2,j,1),nc_fragm(j,1),
+     &      0,istruct(j),.true.,lprn)
+c          write (iout,*) "n_shif",n_shift(1,j,1),n_shift(2,j,1)
+        else
+          ishif=0
+          nc_match=1
+        endif
+        if (lprn) write (iout,*) "ishif1",ishif1," ishif2",ishif2
+        ishif=ishif1
+        qfrag(j,1)=qwolynes(1,j)
+        if (iabs(ishif2).gt.iabs(ishif1)) ishif=ishif2
+        if (lprn) write (iout,*) "ishift",ishif," nc_match",nc_match
+c        write (iout,*) "j",j," ishif",ishif," rms",rmsfrag(j,1)
+        if (irms(j,1).gt.0) then
+          if (rmsfrag(j,1).le.rmscutfrag(1,j,1)) then
+            iclass_rms=2
+            ishifft_rms=0
+          else
+            ishiff=0
+            rms=1.0d2
+            iclass_rms=0
+            do while (rms.gt.rmscutfrag(1,j,1) .and. 
+     &         ishiff.lt.n_shift(1,j,1))
+              ishiff=ishiff+1
+              rms=rmscalc(-ishiff,1,j,jcon,lprn)
+c              write(iout,*)"jcon,i,j,ishiff",jcon,i,j,-ishiff,
+c     &          " rms",rms," rmscut",rmscutfrag(1,j,1)
+              if (lprn) write (iout,*) "rms",rmsfrag(j,1) 
+              if (rms.gt.rmscutfrag(1,j,1)) then
+                rms=rmscalc(ishiff,1,j,jcon,lprn)
+c                write (iout,*) "jcon,1,j,ishiff",jcon,1,j,ishiff,
+c     &           " rms",rms
+              endif
+              if (lprn) write (iout,*) "rms",rmsfrag(j,1) 
+            enddo
+c            write (iout,*) "After loop: rms",rms,
+c     &        " rmscut",rmscutfrag(1,j,1)
+c            write (iout,*) "iclass_rms",iclass_rms
+            if (rms.le.rmscutfrag(1,j,1)) then
+              ishifft_rms=ishiff
+              rmsfrag(j,1)=rms
+              iclass_rms=1
+            endif
+c            write (iout,*) "iclass_rms",iclass_rms
+          endif
+c          write (iout,*) "ishif",ishif
+          if (iabs(ishifft_rms).gt.iabs(ishif)) ishif=ishifft_rms
+        else
+          iclass_rms=1
+        endif
+c        write (iout,*) "ishif",ishif," iclass",iclass(j,1),
+c     &    " iclass_rms",iclass_rms
+        if (nc_match.gt.0 .and. iclass_rms.gt.0) then
+          if (ishif.eq.0) then
+            iclass(j,1)=iclass(j,1)+6
+          else
+            iclass(j,1)=iclass(j,1)+2
+          endif
+        endif
+        ncont_nat(1,j,1)=nc_match
+        ncont_nat(2,j,1)=ncon_match
+        ishifft(j,1)=ishif
+c        write (iout,*) "iclass",iclass(j,1)
+      enddo
+c Next levels: Check arrangements of elementary fragments.
+      do i=2,nlevel
+        do j=1,nfrag(i)
+        if (i .eq. 2) ind = icant(ipiece(1,j,i),ipiece(2,j,i))
+        if (lprn) then
+            write (iout,'(80(1h=))') 
+            write (iout,*) "Level",i," fragment",j
+            write (iout,'(80(1h=))') 
+        endif
+c If an elementary fragment doesn't exist, don't check higher hierarchy levels.
+        do k=1,npiece(j,i)
+          ik=ipiece(k,j,i)
+          if (iclass(ik,1).eq.0) then
+            iclass(j,i)=0
+            goto 12
+          endif
+        enddo
+        if (i.eq.2 .and. ielecont(j,i).gt.0) then
+          iclass_con=0
+          ishifft_con=0
+          if (lprn) write (iout,*) 
+     &     "Comparing electrostatic contact map: fragments",
+     &      ipiece(1,j,i),ipiece(2,j,i)," ind",ind
+          call match_contact(ishif1,ishif2,nc_match,ncon_match,
+     &     ncont_frag_ref(ind),icont_frag_ref(1,1,ind),
+     &     ncont_frag(ind),icont_frag(1,1,ind),
+     &     j,n_shift(1,j,i),n_shift(2,j,i),nc_fragm(j,i),
+     &     nc_req_setf(j,i),2,.false.,lprn)
+          ishif=ishif1
+          if (iabs(ishif2).gt.iabs(ishif1)) ishif=ishif2
+          if (nc_match.gt.0) then
+            if (ishif.eq.0) then
+              iclass_con=2
+            else
+              iclass_con=1
+            endif
+          endif
+          ncont_nat(1,j,i)=nc_match
+          ncont_nat(2,j,i)=ncon_match
+          ishifft_con=ishif
+        else if (i.eq.2 .and. isccont(j,i).gt.0) then
+          iclass_con=0
+          ishifft_con=0
+          if (lprn) write (iout,*) 
+     &     "Comparing sidechain contact map: fragments",
+     &    ipiece(1,j,i),ipiece(2,j,i)," ind",ind
+          call match_contact(ishif1,ishif2,nc_match,ncon_match,
+     &     nsccont_frag_ref(ind),isccont_frag_ref(1,1,ind),
+     &     nsccont_frag(ind),isccont_frag(1,1,ind),
+     &     j,n_shift(1,j,i),n_shift(2,j,i),nc_fragm(j,i),
+     &     nc_req_setf(j,i),2,.false.,lprn)
+          ishif=ishif1
+          if (iabs(ishif2).gt.iabs(ishif1)) ishif=ishif2
+          if (nc_match.gt.0) then
+            if (ishif.eq.0) then
+              iclass_con=2
+            else
+              iclass_con=1
+            endif
+          endif
+          ncont_nat(1,j,i)=nc_match
+          ncont_nat(2,j,i)=ncon_match
+          ishifft_con=ishif
+        else if (i.eq.2) then
+          iclass_con=2
+          ishifft_con=0
+        endif
+        if (i.eq.2) qfrag(j,2)=qwolynes(2,j)
+        if (lprn) write (iout,*) 
+     &    "Comparing rms: fragments",
+     &     (ipiece(k,j,i),k=1,npiece(j,i))
+        rmsfrag(j,i)=rmscalc(0,i,j,jcon,lprn)
+        if (irms(j,i).gt.0) then
+          iclass_rms=0
+          ishifft_rms=0
+          if (lprn) write (iout,*) "rms",rmsfrag(j,i)
+c          write (iout,*) "i",i," j",j," rmsfrag",rmsfrag(j,i),
+c     &     " rmscutfrag",rmscutfrag(1,j,i)
+          if (rmsfrag(j,i).le.rmscutfrag(1,j,i)) then
+            iclass_rms=2
+            ishifft_rms=0
+          else
+            ishif=0
+            rms=1.0d2
+            do while (rms.gt.rmscutfrag(1,j,i) .and. 
+     &         ishif.lt.n_shift(1,j,i))
+              ishif=ishif+1
+              rms=rmscalc(-ishif,i,j,jcon,lprn)
+c              print *,"jcon,i,j,ishif",jcon,i,j,-ishif," rms",rms
+              if (lprn) write (iout,*) "rms",rmsfrag(j,i) 
+              if (rms.gt.rmscutfrag(1,j,i)) then
+                rms=rmscalc(ishif,i,j,jcon,lprn)
+c                print *,"jcon,i,j,ishif",jcon,i,j,ishif," rms",rms
+              endif
+              if (lprn) write (iout,*) "rms",rms
+            enddo
+            if (rms.le.rmscutfrag(1,j,i)) then
+              ishifft_rms=ishif
+              rmsfrag(j,i)=rms
+              iclass_rms=1
+            endif
+          endif
+        endif
+        if (irms(j,i).eq.0 .and. ielecont(j,i).eq.0 .and. 
+     &    isccont(j,i).eq.0 ) then
+          write (iout,*) "Error: no measure of comparison specified:",
+     &      " level",i," part",j
+          stop
+        endif
+        if (lprn) 
+     &  write (iout,*) "iclass_con",iclass_con," iclass_rms",iclass_rms
+        if (i.eq.2) then
+          iclass(j,i) = min0(iclass_con,iclass_rms)
+          if (iabs(ishifft_rms).gt.iabs(ishifft_con)) then
+            ishifft(j,i)=ishifft_rms
+          else
+            ishifft(j,i)=ishifft_con
+          endif
+        else if (i.gt.2) then
+          iclass(j,i) = iclass_rms
+          ishifft(j,i)= ishifft_rms
+        endif
+   12   continue
+        enddo
+      enddo
+      rms_nat=rmsnat(jcon)
+      qnat=qwolynes(0,0)
+C Compute the structural class
+      iscor=0
+      IF (.NOT. BINARY) THEN
+      do i=1,nlevel
+        IF (I.EQ.1) THEN
+        do j=1,nfrag(i)
+          itemp(j)=iclass(j,i)
+        enddo
+        do kk=-1,1
+          do j=1,nfrag(i)
+            idig = 2*isnfrag(nlevel+1)-2*isnfrag(i)-kk*nfrag(i)-j
+            iex = 2**idig
+            im=mod(itemp(j),2)
+            itemp(j)=itemp(j)/2
+c            write (iout,*) "i",i," j",j," idig",idig," iex",iex,
+c     &        " iclass",iclass(j,i)," im",im
+            iscor=iscor+im*iex
+          enddo
+        enddo
+        ELSE
+        do j=1,nfrag(i)
+          idig = 2*isnfrag(nlevel+1)-2*isnfrag(i)-j
+          iex = 2**idig
+          if (iclass(j,i).gt.0) then
+            im=1
+          else
+            im=0
+          endif
+c          write (iout,*) "i",i," j",j," idig",idig," iex",iex,
+c     &      " iclass",iclass(j,i)," im",im
+          iscor=iscor+im*iex
+        enddo
+        do j=1,nfrag(i)
+          idig = 2*isnfrag(nlevel+1)-2*isnfrag(i)-nfrag(i)-j
+          iex = 2**idig
+          if (iclass(j,i).gt.1) then
+            im=1
+          else
+            im=0
+          endif
+c          write (iout,*) "i",i," j",j," idig",idig," iex",iex,
+c     &      " iclass",iclass(j,i)," im",im
+          iscor=iscor+im*iex
+        enddo
+        ENDIF
+      enddo
+      iscore=iscor
+      ENDIF
+      if (print_class) then
+#ifdef MPI
+          write(istat,'(i6,$)') jcon+indstart(me)-1
+          write (istat,'(f10.2,$)') (potE(jcon,k),k=1,nParmSet),
+     &     -entfac(jcon)
+#else
+          write(istat,'(i6,$)') jcon
+          write (istat,'(f10.2,$)') (potE(jcon,k),k=1,nParmSet),
+     &      -entfac(jcon)
+#endif
+          write (istat,'(f8.3,2f6.3,$)') 
+     &      rms_nat,qnat,rmsang/(nres-3)
+          do j=1,nlevel
+            write(istat,'(1x,$,20(i3,$))')
+     &        (ncont_nat(1,k,j),k=1,nfrag(j))
+            if (j.lt.3) then
+              write(istat,'(1x,$,20(f5.1,f5.2$))')
+     &          (rmsfrag(k,j),qfrag(k,j),k=1,nfrag(j))
+            else
+              write(istat,'(1x,$,20(f5.1$))')
+     &          (rmsfrag(k,j),k=1,nfrag(j))
+            endif
+            write(istat,'(1x,$,20(i1,$))')
+     &        (iclass(k,j),k=1,nfrag(j))
+          enddo
+          if (binary) then
+            write (istat,'("  ",$)')
+            do j=1,nlevel
+              write (istat,'(100(i1,$))')(iclass(k,j),
+     &           k=1,nfrag(j))
+              if (j.lt.nlevel) write(iout,'(".",$)')
+            enddo
+            write (istat,*)
+          else
+            write (istat,'(i10)') iscore
+          endif
+      endif
+      RETURN
+      END