--- /dev/null
+ 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
projects / unres.git / blobdiff